From: Stephane Glondu Date: Thu, 3 Sep 2020 12:52:01 +0000 (+0200) Subject: New upstream version 4.10.0 X-Git-Tag: archive/raspbian/4.11.1-5+rpi1~1^2~25^2~3 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=18bbb5f83135ea8fc5d7be855c36231e026381e8;p=ocaml.git New upstream version 4.10.0 --- diff --git a/.depend b/.depend index 83c43d90..c40e2f0f 100644 --- a/.depend +++ b/.depend @@ -9,12 +9,14 @@ utils/build_path_prefix_map.cmx : \ utils/build_path_prefix_map.cmi utils/build_path_prefix_map.cmi : utils/ccomp.cmo : \ + utils/profile.cmi \ utils/misc.cmi \ utils/load_path.cmi \ utils/config.cmi \ utils/clflags.cmi \ utils/ccomp.cmi utils/ccomp.cmx : \ + utils/profile.cmx \ utils/misc.cmx \ utils/load_path.cmx \ utils/config.cmx \ @@ -51,6 +53,11 @@ utils/consistbl.cmx : \ utils/consistbl.cmi utils/consistbl.cmi : \ utils/misc.cmi +utils/domainstate.cmo : \ + utils/domainstate.cmi +utils/domainstate.cmx : \ + utils/domainstate.cmi +utils/domainstate.cmi : utils/identifiable.cmo : \ utils/misc.cmi \ utils/identifiable.cmi @@ -373,7 +380,6 @@ parsing/parsetree.cmi : \ parsing/asttypes.cmi parsing/pprintast.cmo : \ parsing/parsetree.cmi \ - utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ parsing/asttypes.cmi \ @@ -381,7 +387,6 @@ parsing/pprintast.cmo : \ parsing/pprintast.cmi parsing/pprintast.cmx : \ parsing/parsetree.cmi \ - utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ parsing/asttypes.cmi \ @@ -393,7 +398,6 @@ parsing/pprintast.cmi : \ parsing/printast.cmo : \ parsing/pprintast.cmi \ parsing/parsetree.cmi \ - utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ parsing/asttypes.cmi \ @@ -401,7 +405,6 @@ parsing/printast.cmo : \ parsing/printast.cmx : \ parsing/pprintast.cmx \ parsing/parsetree.cmi \ - utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ parsing/asttypes.cmi \ @@ -421,14 +424,12 @@ typing/annot.cmi : \ typing/btype.cmo : \ typing/types.cmi \ typing/path.cmi \ - utils/misc.cmi \ typing/ident.cmi \ parsing/asttypes.cmi \ typing/btype.cmi typing/btype.cmx : \ typing/types.cmx \ typing/path.cmx \ - utils/misc.cmx \ typing/ident.cmx \ parsing/asttypes.cmi \ typing/btype.cmi @@ -438,6 +439,7 @@ typing/btype.cmi : \ parsing/asttypes.cmi typing/ctype.cmo : \ typing/types.cmi \ + typing/type_immediacy.cmi \ typing/subst.cmi \ typing/predef.cmi \ typing/path.cmi \ @@ -452,6 +454,7 @@ typing/ctype.cmo : \ typing/ctype.cmi typing/ctype.cmx : \ typing/types.cmx \ + typing/type_immediacy.cmx \ typing/subst.cmx \ typing/predef.cmx \ typing/path.cmx \ @@ -466,6 +469,7 @@ typing/ctype.cmx : \ typing/ctype.cmi typing/ctype.cmi : \ typing/types.cmi \ + typing/type_immediacy.cmi \ typing/path.cmi \ parsing/longident.cmi \ typing/ident.cmi \ @@ -595,6 +599,8 @@ typing/includeclass.cmi : \ typing/includecore.cmo : \ typing/types.cmi \ typing/typedtree.cmi \ + typing/type_immediacy.cmi \ + typing/printtyp.cmi \ typing/path.cmi \ typing/ident.cmi \ typing/env.cmi \ @@ -606,6 +612,8 @@ typing/includecore.cmo : \ typing/includecore.cmx : \ typing/types.cmx \ typing/typedtree.cmx \ + typing/type_immediacy.cmx \ + typing/printtyp.cmx \ typing/path.cmx \ typing/ident.cmx \ typing/env.cmx \ @@ -617,10 +625,12 @@ typing/includecore.cmx : \ typing/includecore.cmi : \ typing/types.cmi \ typing/typedtree.cmi \ + typing/type_immediacy.cmi \ typing/path.cmi \ parsing/location.cmi \ typing/ident.cmi \ - typing/env.cmi + typing/env.cmi \ + typing/ctype.cmi typing/includemod.cmo : \ typing/types.cmi \ typing/typedtree.cmi \ @@ -676,7 +686,6 @@ typing/mtype.cmo : \ typing/types.cmi \ typing/subst.cmi \ typing/path.cmi \ - utils/misc.cmi \ parsing/location.cmi \ typing/ident.cmi \ typing/env.cmi \ @@ -689,7 +698,6 @@ typing/mtype.cmx : \ typing/types.cmx \ typing/subst.cmx \ typing/path.cmx \ - utils/misc.cmx \ parsing/location.cmx \ typing/ident.cmx \ typing/env.cmx \ @@ -716,6 +724,7 @@ typing/oprint.cmx : \ typing/oprint.cmi : \ typing/outcometree.cmi typing/outcometree.cmi : \ + typing/type_immediacy.cmi \ parsing/asttypes.cmi typing/parmatch.cmo : \ utils/warnings.cmi \ @@ -862,6 +871,7 @@ typing/printpat.cmi : \ typing/printtyp.cmo : \ utils/warnings.cmi \ typing/types.cmi \ + typing/type_immediacy.cmi \ typing/primitive.cmi \ typing/predef.cmi \ typing/path.cmi \ @@ -875,13 +885,13 @@ typing/printtyp.cmo : \ typing/env.cmi \ typing/ctype.cmi \ utils/clflags.cmi \ - parsing/builtin_attributes.cmi \ typing/btype.cmi \ parsing/asttypes.cmi \ typing/printtyp.cmi typing/printtyp.cmx : \ utils/warnings.cmx \ typing/types.cmx \ + typing/type_immediacy.cmx \ typing/primitive.cmx \ typing/predef.cmx \ typing/path.cmx \ @@ -895,7 +905,6 @@ typing/printtyp.cmx : \ typing/env.cmx \ typing/ctype.cmx \ utils/clflags.cmx \ - parsing/builtin_attributes.cmx \ typing/btype.cmx \ parsing/asttypes.cmi \ typing/printtyp.cmi @@ -915,7 +924,6 @@ typing/printtyped.cmo : \ parsing/printast.cmi \ typing/path.cmi \ parsing/parsetree.cmi \ - utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ typing/ident.cmi \ @@ -927,7 +935,6 @@ typing/printtyped.cmx : \ parsing/printast.cmx \ typing/path.cmx \ parsing/parsetree.cmi \ - utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ typing/ident.cmx \ @@ -1032,6 +1039,14 @@ typing/tast_mapper.cmi : \ typing/typedtree.cmi \ typing/env.cmi \ parsing/asttypes.cmi +typing/type_immediacy.cmo : \ + parsing/builtin_attributes.cmi \ + typing/type_immediacy.cmi +typing/type_immediacy.cmx : \ + parsing/builtin_attributes.cmx \ + typing/type_immediacy.cmi +typing/type_immediacy.cmi : \ + parsing/parsetree.cmi typing/typeclass.cmo : \ utils/warnings.cmi \ typing/typetexp.cmi \ @@ -1186,6 +1201,7 @@ typing/typedecl.cmo : \ typing/typedecl_variance.cmi \ typing/typedecl_unboxed.cmi \ typing/typedecl_immediacy.cmi \ + typing/type_immediacy.cmi \ typing/subst.cmi \ typing/printtyp.cmi \ typing/primitive.cmi \ @@ -1218,6 +1234,7 @@ typing/typedecl.cmx : \ typing/typedecl_variance.cmx \ typing/typedecl_unboxed.cmx \ typing/typedecl_immediacy.cmx \ + typing/type_immediacy.cmx \ typing/subst.cmx \ typing/printtyp.cmx \ typing/primitive.cmx \ @@ -1260,21 +1277,22 @@ typing/typedecl_immediacy.cmo : \ typing/types.cmi \ typing/typedecl_unboxed.cmi \ typing/typedecl_properties.cmi \ + typing/type_immediacy.cmi \ parsing/location.cmi \ typing/ctype.cmi \ - parsing/builtin_attributes.cmi \ typing/typedecl_immediacy.cmi typing/typedecl_immediacy.cmx : \ typing/types.cmx \ typing/typedecl_unboxed.cmx \ typing/typedecl_properties.cmx \ + typing/type_immediacy.cmx \ parsing/location.cmx \ typing/ctype.cmx \ - parsing/builtin_attributes.cmx \ typing/typedecl_immediacy.cmi typing/typedecl_immediacy.cmi : \ typing/types.cmi \ typing/typedecl_properties.cmi \ + typing/type_immediacy.cmi \ parsing/location.cmi \ typing/ident.cmi \ typing/env.cmi @@ -1347,7 +1365,6 @@ typing/typedtree.cmo : \ typing/primitive.cmi \ typing/path.cmi \ parsing/parsetree.cmi \ - utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ typing/ident.cmi \ @@ -1359,7 +1376,6 @@ typing/typedtree.cmx : \ typing/primitive.cmx \ typing/path.cmx \ parsing/parsetree.cmi \ - utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ typing/ident.cmx \ @@ -1485,6 +1501,7 @@ typing/typeopt.cmi : \ lambda/lambda.cmi \ typing/env.cmi typing/types.cmo : \ + typing/type_immediacy.cmi \ typing/primitive.cmi \ typing/path.cmi \ parsing/parsetree.cmi \ @@ -1495,6 +1512,7 @@ typing/types.cmo : \ parsing/asttypes.cmi \ typing/types.cmi typing/types.cmx : \ + typing/type_immediacy.cmx \ typing/primitive.cmx \ typing/path.cmx \ parsing/parsetree.cmi \ @@ -1505,6 +1523,7 @@ typing/types.cmx : \ parsing/asttypes.cmi \ typing/types.cmi typing/types.cmi : \ + typing/type_immediacy.cmi \ typing/primitive.cmi \ typing/path.cmi \ parsing/parsetree.cmi \ @@ -1524,7 +1543,6 @@ typing/typetexp.cmo : \ utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ - typing/includemod.cmi \ typing/env.cmi \ typing/ctype.cmi \ utils/clflags.cmi \ @@ -1545,7 +1563,6 @@ typing/typetexp.cmx : \ utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ - typing/includemod.cmx \ typing/env.cmx \ typing/ctype.cmx \ utils/clflags.cmx \ @@ -1561,7 +1578,6 @@ typing/typetexp.cmi : \ parsing/parsetree.cmi \ parsing/longident.cmi \ parsing/location.cmi \ - typing/includemod.cmi \ typing/env.cmi \ typing/ctype.cmi \ parsing/asttypes.cmi @@ -1569,7 +1585,6 @@ typing/untypeast.cmo : \ typing/typedtree.cmi \ typing/path.cmi \ parsing/parsetree.cmi \ - utils/misc.cmi \ parsing/longident.cmi \ parsing/location.cmi \ typing/ident.cmi \ @@ -1581,7 +1596,6 @@ typing/untypeast.cmx : \ typing/typedtree.cmx \ typing/path.cmx \ parsing/parsetree.cmi \ - utils/misc.cmx \ parsing/longident.cmx \ parsing/location.cmx \ typing/ident.cmx \ @@ -1919,9 +1933,7 @@ asmcomp/arch.cmx : \ utils/config.cmx \ utils/clflags.cmx asmcomp/asmgen.cmo : \ - middle_end/flambda/un_anf.cmi \ lambda/translmod.cmi \ - middle_end/symbol.cmi \ asmcomp/split.cmi \ asmcomp/spill.cmi \ asmcomp/selection.cmi \ @@ -1933,22 +1945,17 @@ asmcomp/asmgen.cmo : \ asmcomp/printmach.cmi \ asmcomp/printlinear.cmi \ asmcomp/printcmm.cmi \ - middle_end/printclambda.cmi \ typing/primitive.cmi \ - typing/path.cmi \ utils/misc.cmi \ asmcomp/mach.cmi \ parsing/location.cmi \ asmcomp/liveness.cmi \ asmcomp/linscan.cmi \ - middle_end/linkage_name.cmi \ asmcomp/linearize.cmi \ lambda/lambda.cmi \ asmcomp/interval.cmi \ asmcomp/interf.cmi \ typing/ident.cmi \ - middle_end/flambda/flambda_to_clambda.cmi \ - middle_end/flambda/flambda.cmi \ asmcomp/emitaux.cmi \ asmcomp/emit.cmi \ asmcomp/deadcode.cmi \ @@ -1957,18 +1964,16 @@ asmcomp/asmgen.cmo : \ asmcomp/comballoc.cmi \ asmcomp/coloring.cmi \ asmcomp/cmmgen.cmi \ + asmcomp/cmm_helpers.cmi \ asmcomp/cmm.cmi \ - middle_end/closure/closure.cmi \ utils/clflags.cmi \ middle_end/clambda.cmi \ asmcomp/CSE.cmo \ - middle_end/flambda/build_export_info.cmi \ + middle_end/backend_intf.cmi \ asmcomp/debug/available_regs.cmi \ asmcomp/asmgen.cmi asmcomp/asmgen.cmx : \ - middle_end/flambda/un_anf.cmx \ lambda/translmod.cmx \ - middle_end/symbol.cmx \ asmcomp/split.cmx \ asmcomp/spill.cmx \ asmcomp/selection.cmx \ @@ -1980,22 +1985,17 @@ asmcomp/asmgen.cmx : \ asmcomp/printmach.cmx \ asmcomp/printlinear.cmx \ asmcomp/printcmm.cmx \ - middle_end/printclambda.cmx \ typing/primitive.cmx \ - typing/path.cmx \ utils/misc.cmx \ asmcomp/mach.cmx \ parsing/location.cmx \ asmcomp/liveness.cmx \ asmcomp/linscan.cmx \ - middle_end/linkage_name.cmx \ asmcomp/linearize.cmx \ lambda/lambda.cmx \ asmcomp/interval.cmx \ asmcomp/interf.cmx \ typing/ident.cmx \ - middle_end/flambda/flambda_to_clambda.cmx \ - middle_end/flambda/flambda.cmx \ asmcomp/emitaux.cmx \ asmcomp/emit.cmx \ asmcomp/deadcode.cmx \ @@ -2004,19 +2004,18 @@ asmcomp/asmgen.cmx : \ asmcomp/comballoc.cmx \ asmcomp/coloring.cmx \ asmcomp/cmmgen.cmx \ + asmcomp/cmm_helpers.cmx \ asmcomp/cmm.cmx \ - middle_end/closure/closure.cmx \ utils/clflags.cmx \ middle_end/clambda.cmx \ asmcomp/CSE.cmx \ - middle_end/flambda/build_export_info.cmx \ + middle_end/backend_intf.cmi \ asmcomp/debug/available_regs.cmx \ asmcomp/asmgen.cmi asmcomp/asmgen.cmi : \ lambda/lambda.cmi \ - typing/ident.cmi \ - middle_end/flambda/flambda.cmi \ asmcomp/cmm.cmi \ + middle_end/clambda.cmi \ middle_end/backend_intf.cmi asmcomp/asmlibrarian.cmo : \ utils/misc.cmi \ @@ -2057,7 +2056,7 @@ asmcomp/asmlink.cmo : \ utils/config.cmi \ middle_end/compilenv.cmi \ file_formats/cmx_format.cmi \ - asmcomp/cmmgen.cmi \ + asmcomp/cmm_helpers.cmi \ asmcomp/cmm.cmi \ utils/clflags.cmi \ utils/ccomp.cmi \ @@ -2075,7 +2074,7 @@ asmcomp/asmlink.cmx : \ utils/config.cmx \ middle_end/compilenv.cmx \ file_formats/cmx_format.cmi \ - asmcomp/cmmgen.cmx \ + asmcomp/cmm_helpers.cmx \ asmcomp/cmm.cmx \ utils/clflags.cmx \ utils/ccomp.cmx \ @@ -2102,6 +2101,7 @@ asmcomp/asmpackager.cmo : \ middle_end/compilenv.cmi \ middle_end/compilation_unit.cmi \ file_formats/cmx_format.cmi \ + middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ utils/ccomp.cmi \ asmcomp/asmlink.cmi \ @@ -2125,6 +2125,7 @@ asmcomp/asmpackager.cmx : \ middle_end/compilenv.cmx \ middle_end/compilation_unit.cmx \ file_formats/cmx_format.cmi \ + middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ utils/ccomp.cmx \ asmcomp/asmlink.cmx \ @@ -2136,26 +2137,26 @@ asmcomp/asmpackager.cmi : \ asmcomp/branch_relaxation.cmo : \ utils/misc.cmi \ asmcomp/mach.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.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/linear.cmx \ asmcomp/cmm.cmx \ asmcomp/branch_relaxation_intf.cmx \ asmcomp/branch_relaxation.cmi asmcomp/branch_relaxation.cmi : \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ asmcomp/branch_relaxation_intf.cmo asmcomp/branch_relaxation_intf.cmo : \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ asmcomp/cmm.cmi \ asmcomp/arch.cmo asmcomp/branch_relaxation_intf.cmx : \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ asmcomp/cmm.cmx \ asmcomp/arch.cmx asmcomp/cmm.cmo : \ @@ -2164,7 +2165,6 @@ asmcomp/cmm.cmo : \ lambda/debuginfo.cmi \ middle_end/backend_var.cmi \ parsing/asttypes.cmi \ - asmcomp/arch.cmo \ asmcomp/cmm.cmi asmcomp/cmm.cmx : \ utils/targetint.cmx \ @@ -2172,7 +2172,6 @@ asmcomp/cmm.cmx : \ lambda/debuginfo.cmx \ middle_end/backend_var.cmx \ parsing/asttypes.cmi \ - asmcomp/arch.cmx \ asmcomp/cmm.cmi asmcomp/cmm.cmi : \ utils/targetint.cmi \ @@ -2180,14 +2179,11 @@ asmcomp/cmm.cmi : \ lambda/debuginfo.cmi \ middle_end/backend_var.cmi \ parsing/asttypes.cmi -asmcomp/cmmgen.cmo : \ - middle_end/flambda/un_anf.cmi \ - typing/types.cmi \ +asmcomp/cmm_helpers.cmo : \ utils/targetint.cmi \ lambda/switch.cmi \ asmcomp/strmatch.cmi \ asmcomp/proc.cmi \ - middle_end/printclambda_primitives.cmi \ typing/primitive.cmi \ utils/numbers.cmi \ utils/misc.cmi \ @@ -2205,16 +2201,12 @@ asmcomp/cmmgen.cmo : \ middle_end/backend_var.cmi \ parsing/asttypes.cmi \ asmcomp/arch.cmo \ - asmcomp/afl_instrument.cmi \ - asmcomp/cmmgen.cmi -asmcomp/cmmgen.cmx : \ - middle_end/flambda/un_anf.cmx \ - typing/types.cmx \ + asmcomp/cmm_helpers.cmi +asmcomp/cmm_helpers.cmx : \ utils/targetint.cmx \ lambda/switch.cmx \ asmcomp/strmatch.cmx \ asmcomp/proc.cmx \ - middle_end/printclambda_primitives.cmx \ typing/primitive.cmx \ utils/numbers.cmx \ utils/misc.cmx \ @@ -2232,19 +2224,71 @@ asmcomp/cmmgen.cmx : \ middle_end/backend_var.cmx \ parsing/asttypes.cmi \ asmcomp/arch.cmx \ + asmcomp/cmm_helpers.cmi +asmcomp/cmm_helpers.cmi : \ + utils/targetint.cmi \ + typing/primitive.cmi \ + parsing/location.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + file_formats/cmx_format.cmi \ + asmcomp/cmmgen_state.cmi \ + asmcomp/cmm.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + parsing/asttypes.cmi +asmcomp/cmmgen.cmo : \ + typing/types.cmi \ + middle_end/printclambda_primitives.cmi \ + typing/primitive.cmi \ + utils/misc.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + utils/config.cmi \ + middle_end/compilenv.cmi \ + asmcomp/cmmgen_state.cmi \ + asmcomp/cmm_helpers.cmi \ + asmcomp/cmm.cmi \ + utils/clflags.cmi \ + middle_end/clambda_primitives.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_var.cmi \ + parsing/asttypes.cmi \ + asmcomp/arch.cmo \ + asmcomp/afl_instrument.cmi \ + asmcomp/cmmgen.cmi +asmcomp/cmmgen.cmx : \ + typing/types.cmx \ + middle_end/printclambda_primitives.cmx \ + typing/primitive.cmx \ + utils/misc.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + utils/config.cmx \ + middle_end/compilenv.cmx \ + asmcomp/cmmgen_state.cmx \ + asmcomp/cmm_helpers.cmx \ + asmcomp/cmm.cmx \ + utils/clflags.cmx \ + middle_end/clambda_primitives.cmx \ + middle_end/clambda.cmx \ + middle_end/backend_var.cmx \ + parsing/asttypes.cmi \ + asmcomp/arch.cmx \ asmcomp/afl_instrument.cmx \ asmcomp/cmmgen.cmi asmcomp/cmmgen.cmi : \ - file_formats/cmx_format.cmi \ asmcomp/cmm.cmi \ middle_end/clambda.cmi asmcomp/cmmgen_state.cmo : \ utils/misc.cmi \ + middle_end/compilenv.cmi \ asmcomp/cmm.cmi \ middle_end/clambda.cmi \ asmcomp/cmmgen_state.cmi asmcomp/cmmgen_state.cmx : \ utils/misc.cmx \ + middle_end/compilenv.cmx \ asmcomp/cmm.cmx \ middle_end/clambda.cmx \ asmcomp/cmmgen_state.cmi @@ -2278,14 +2322,18 @@ asmcomp/comballoc.cmi : \ asmcomp/deadcode.cmo : \ asmcomp/reg.cmi \ asmcomp/proc.cmi \ + utils/numbers.cmi \ asmcomp/mach.cmi \ utils/config.cmi \ + asmcomp/cmm.cmi \ asmcomp/deadcode.cmi asmcomp/deadcode.cmx : \ asmcomp/reg.cmx \ asmcomp/proc.cmx \ + utils/numbers.cmx \ asmcomp/mach.cmx \ utils/config.cmx \ + asmcomp/cmm.cmx \ asmcomp/deadcode.cmi asmcomp/deadcode.cmi : \ asmcomp/mach.cmi @@ -2299,8 +2347,10 @@ asmcomp/emit.cmo : \ asmcomp/proc.cmi \ utils/misc.cmi \ asmcomp/mach.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ + lambda/lambda.cmi \ asmcomp/emitaux.cmi \ + utils/domainstate.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ middle_end/compilenv.cmi \ @@ -2319,8 +2369,10 @@ asmcomp/emit.cmx : \ asmcomp/proc.cmx \ utils/misc.cmx \ asmcomp/mach.cmx \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ + lambda/lambda.cmx \ asmcomp/emitaux.cmx \ + utils/domainstate.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ middle_end/compilenv.cmx \ @@ -2330,7 +2382,7 @@ asmcomp/emit.cmx : \ asmcomp/arch.cmx \ asmcomp/emit.cmi asmcomp/emit.cmi : \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ asmcomp/cmm.cmi asmcomp/emitaux.cmo : \ lambda/debuginfo.cmi \ @@ -2375,11 +2427,32 @@ asmcomp/interval.cmx : \ asmcomp/interval.cmi : \ asmcomp/reg.cmi \ asmcomp/mach.cmi +asmcomp/linear.cmo : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi \ + asmcomp/linear.cmi +asmcomp/linear.cmx : \ + asmcomp/reg.cmx \ + asmcomp/mach.cmx \ + lambda/lambda.cmx \ + lambda/debuginfo.cmx \ + asmcomp/cmm.cmx \ + asmcomp/linear.cmi +asmcomp/linear.cmi : \ + asmcomp/reg.cmi \ + asmcomp/mach.cmi \ + lambda/lambda.cmi \ + lambda/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/linearize.cmo : \ asmcomp/reg.cmi \ asmcomp/proc.cmi \ utils/misc.cmi \ asmcomp/mach.cmi \ + asmcomp/linear.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ asmcomp/cmm.cmi \ @@ -2389,15 +2462,14 @@ asmcomp/linearize.cmx : \ asmcomp/proc.cmx \ utils/misc.cmx \ asmcomp/mach.cmx \ + asmcomp/linear.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ asmcomp/cmm.cmx \ asmcomp/linearize.cmi asmcomp/linearize.cmi : \ - asmcomp/reg.cmi \ asmcomp/mach.cmi \ - lambda/debuginfo.cmi \ - asmcomp/cmm.cmi + asmcomp/linear.cmi asmcomp/linscan.cmo : \ asmcomp/reg.cmi \ asmcomp/proc.cmi \ @@ -2433,6 +2505,7 @@ asmcomp/mach.cmo : \ asmcomp/debug/reg_with_debug_info.cmi \ asmcomp/debug/reg_availability_set.cmi \ asmcomp/reg.cmi \ + lambda/lambda.cmi \ lambda/debuginfo.cmi \ asmcomp/cmm.cmi \ middle_end/backend_var.cmi \ @@ -2442,6 +2515,7 @@ asmcomp/mach.cmx : \ asmcomp/debug/reg_with_debug_info.cmx \ asmcomp/debug/reg_availability_set.cmx \ asmcomp/reg.cmx \ + lambda/lambda.cmx \ lambda/debuginfo.cmx \ asmcomp/cmm.cmx \ middle_end/backend_var.cmx \ @@ -2450,6 +2524,7 @@ asmcomp/mach.cmx : \ asmcomp/mach.cmi : \ asmcomp/debug/reg_availability_set.cmi \ asmcomp/reg.cmi \ + lambda/lambda.cmi \ lambda/debuginfo.cmi \ asmcomp/cmm.cmi \ middle_end/backend_var.cmi \ @@ -2475,26 +2550,27 @@ asmcomp/printcmm.cmi : \ asmcomp/cmm.cmi asmcomp/printlinear.cmo : \ asmcomp/printmach.cmi \ - asmcomp/printcmm.cmi \ asmcomp/mach.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ + lambda/lambda.cmi \ lambda/debuginfo.cmi \ asmcomp/printlinear.cmi asmcomp/printlinear.cmx : \ asmcomp/printmach.cmx \ - asmcomp/printcmm.cmx \ asmcomp/mach.cmx \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ + lambda/lambda.cmx \ lambda/debuginfo.cmx \ asmcomp/printlinear.cmi asmcomp/printlinear.cmi : \ - asmcomp/linearize.cmi + asmcomp/linear.cmi asmcomp/printmach.cmo : \ asmcomp/debug/reg_availability_set.cmi \ asmcomp/reg.cmi \ asmcomp/proc.cmi \ asmcomp/printcmm.cmi \ asmcomp/mach.cmi \ + lambda/lambda.cmi \ asmcomp/interval.cmi \ lambda/debuginfo.cmi \ utils/config.cmi \ @@ -2509,6 +2585,7 @@ asmcomp/printmach.cmx : \ asmcomp/proc.cmx \ asmcomp/printcmm.cmx \ asmcomp/mach.cmx \ + lambda/lambda.cmx \ asmcomp/interval.cmx \ lambda/debuginfo.cmx \ utils/config.cmx \ @@ -2587,7 +2664,7 @@ asmcomp/schedgen.cmo : \ asmcomp/reg.cmi \ asmcomp/proc.cmi \ asmcomp/mach.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ asmcomp/cmm.cmi \ utils/clflags.cmi \ asmcomp/arch.cmo \ @@ -2596,14 +2673,14 @@ asmcomp/schedgen.cmx : \ asmcomp/reg.cmx \ asmcomp/proc.cmx \ asmcomp/mach.cmx \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ asmcomp/cmm.cmx \ utils/clflags.cmx \ asmcomp/arch.cmx \ asmcomp/schedgen.cmi asmcomp/schedgen.cmi : \ asmcomp/mach.cmi \ - asmcomp/linearize.cmi + asmcomp/linear.cmi asmcomp/scheduling.cmo : \ asmcomp/schedgen.cmi \ asmcomp/scheduling.cmi @@ -2611,7 +2688,7 @@ asmcomp/scheduling.cmx : \ asmcomp/schedgen.cmx \ asmcomp/scheduling.cmi asmcomp/scheduling.cmi : \ - asmcomp/linearize.cmi + asmcomp/linear.cmi asmcomp/selectgen.cmo : \ lambda/simplif.cmi \ asmcomp/reg.cmi \ @@ -3171,7 +3248,6 @@ lambda/simplif.cmo : \ utils/warnings.cmi \ typing/stypes.cmi \ typing/primitive.cmi \ - utils/misc.cmi \ parsing/location.cmi \ lambda/lambda.cmi \ typing/ident.cmi \ @@ -3183,7 +3259,6 @@ lambda/simplif.cmx : \ utils/warnings.cmx \ typing/stypes.cmx \ typing/primitive.cmx \ - utils/misc.cmx \ parsing/location.cmx \ lambda/lambda.cmx \ typing/ident.cmx \ @@ -3553,6 +3628,30 @@ middle_end/closure/closure.cmi : \ lambda/lambda.cmi \ middle_end/clambda.cmi \ middle_end/backend_intf.cmi +middle_end/closure/closure_middle_end.cmo : \ + middle_end/printclambda.cmi \ + typing/path.cmi \ + lambda/lambda.cmi \ + typing/ident.cmi \ + middle_end/compilenv.cmi \ + middle_end/closure/closure.cmi \ + utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/closure/closure_middle_end.cmi +middle_end/closure/closure_middle_end.cmx : \ + middle_end/printclambda.cmx \ + typing/path.cmx \ + lambda/lambda.cmx \ + typing/ident.cmx \ + middle_end/compilenv.cmx \ + middle_end/closure/closure.cmx \ + utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/closure/closure_middle_end.cmi +middle_end/closure/closure_middle_end.cmi : \ + lambda/lambda.cmi \ + middle_end/clambda.cmi \ + middle_end/backend_intf.cmi middle_end/flambda/alias_analysis.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ @@ -3803,14 +3902,12 @@ middle_end/flambda/closure_offsets.cmi : \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/effect_analysis.cmo : \ middle_end/semantics_of_primitives.cmi \ - utils/misc.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda.cmi \ middle_end/clambda_primitives.cmi \ middle_end/flambda/effect_analysis.cmi middle_end/flambda/effect_analysis.cmx : \ middle_end/semantics_of_primitives.cmx \ - utils/misc.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda.cmx \ middle_end/clambda_primitives.cmx \ @@ -3859,7 +3956,6 @@ middle_end/flambda/export_info_for_pack.cmo : \ middle_end/flambda/simple_value_approx.cmi \ middle_end/flambda/base_types/set_of_closures_origin.cmi \ middle_end/flambda/base_types/set_of_closures_id.cmi \ - utils/misc.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/export_info.cmi \ @@ -3874,7 +3970,6 @@ middle_end/flambda/export_info_for_pack.cmx : \ middle_end/flambda/simple_value_approx.cmx \ middle_end/flambda/base_types/set_of_closures_origin.cmx \ middle_end/flambda/base_types/set_of_closures_id.cmx \ - utils/misc.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/export_info.cmx \ @@ -4018,7 +4113,6 @@ middle_end/flambda/flambda_invariants.cmo : \ middle_end/flambda/parameter.cmi \ utils/numbers.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ - utils/misc.cmi \ lambda/lambda.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_iterators.cmi \ @@ -4043,7 +4137,6 @@ middle_end/flambda/flambda_invariants.cmx : \ middle_end/flambda/parameter.cmx \ utils/numbers.cmx \ middle_end/flambda/base_types/mutable_variable.cmx \ - utils/misc.cmx \ lambda/lambda.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_iterators.cmx \ @@ -4059,13 +4152,11 @@ middle_end/flambda/flambda_invariants.cmi : \ middle_end/flambda/flambda.cmi middle_end/flambda/flambda_iterators.cmo : \ middle_end/variable.cmi \ - utils/misc.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda.cmi \ middle_end/flambda/flambda_iterators.cmi middle_end/flambda/flambda_iterators.cmx : \ middle_end/variable.cmx \ - utils/misc.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda.cmx \ middle_end/flambda/flambda_iterators.cmi @@ -4076,65 +4167,81 @@ middle_end/flambda/flambda_iterators.cmi : \ middle_end/flambda/flambda_middle_end.cmo : \ utils/warnings.cmi \ middle_end/variable.cmi \ + middle_end/flambda/un_anf.cmi \ middle_end/symbol.cmi \ middle_end/flambda/share_constants.cmi \ middle_end/flambda/remove_unused_program_constructs.cmi \ middle_end/flambda/remove_unused_closure_vars.cmi \ middle_end/flambda/ref_to_variables.cmi \ utils/profile.cmi \ + middle_end/printclambda.cmi \ utils/misc.cmi \ parsing/location.cmi \ + middle_end/linkage_name.cmi \ middle_end/flambda/lift_let_to_initialize_symbol.cmi \ middle_end/flambda/lift_constants.cmi \ middle_end/flambda/lift_code.cmi \ + lambda/lambda.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/inlining_cost.cmi \ middle_end/flambda/inline_and_simplify.cmi \ middle_end/flambda/initialize_symbol_to_let_symbol.cmi \ + middle_end/flambda/flambda_to_clambda.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda_invariants.cmi \ middle_end/flambda/flambda.cmi \ lambda/debuginfo.cmi \ + middle_end/compilenv.cmi \ middle_end/flambda/base_types/closure_id.cmi \ middle_end/flambda/closure_conversion.cmi \ utils/clflags.cmi \ + middle_end/clambda.cmi \ + middle_end/flambda/build_export_info.cmi \ middle_end/backend_intf.cmi \ middle_end/flambda/flambda_middle_end.cmi middle_end/flambda/flambda_middle_end.cmx : \ utils/warnings.cmx \ middle_end/variable.cmx \ + middle_end/flambda/un_anf.cmx \ middle_end/symbol.cmx \ middle_end/flambda/share_constants.cmx \ middle_end/flambda/remove_unused_program_constructs.cmx \ middle_end/flambda/remove_unused_closure_vars.cmx \ middle_end/flambda/ref_to_variables.cmx \ utils/profile.cmx \ + middle_end/printclambda.cmx \ utils/misc.cmx \ parsing/location.cmx \ + middle_end/linkage_name.cmx \ middle_end/flambda/lift_let_to_initialize_symbol.cmx \ middle_end/flambda/lift_constants.cmx \ middle_end/flambda/lift_code.cmx \ + lambda/lambda.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/inlining_cost.cmx \ middle_end/flambda/inline_and_simplify.cmx \ middle_end/flambda/initialize_symbol_to_let_symbol.cmx \ + middle_end/flambda/flambda_to_clambda.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda_invariants.cmx \ middle_end/flambda/flambda.cmx \ lambda/debuginfo.cmx \ + middle_end/compilenv.cmx \ middle_end/flambda/base_types/closure_id.cmx \ middle_end/flambda/closure_conversion.cmx \ utils/clflags.cmx \ + middle_end/clambda.cmx \ + middle_end/flambda/build_export_info.cmx \ middle_end/backend_intf.cmi \ middle_end/flambda/flambda_middle_end.cmi middle_end/flambda/flambda_middle_end.cmi : \ lambda/lambda.cmi \ - typing/ident.cmi \ - middle_end/flambda/flambda.cmi \ + middle_end/clambda.cmi \ middle_end/backend_intf.cmi middle_end/flambda/flambda_to_clambda.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/var_within_closure.cmi \ + middle_end/flambda/un_anf.cmi \ middle_end/flambda/base_types/tag.cmi \ middle_end/symbol.cmi \ middle_end/flambda/base_types/static_exception.cmi \ @@ -4153,6 +4260,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \ middle_end/flambda/export_info.cmi \ lambda/debuginfo.cmi \ middle_end/compilenv.cmi \ + middle_end/compilation_unit.cmi \ middle_end/flambda/closure_offsets.cmi \ middle_end/flambda/base_types/closure_id.cmi \ utils/clflags.cmi \ @@ -4163,6 +4271,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \ middle_end/flambda/flambda_to_clambda.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/var_within_closure.cmx \ + middle_end/flambda/un_anf.cmx \ middle_end/flambda/base_types/tag.cmx \ middle_end/symbol.cmx \ middle_end/flambda/base_types/static_exception.cmx \ @@ -4181,6 +4290,7 @@ middle_end/flambda/flambda_to_clambda.cmx : \ middle_end/flambda/export_info.cmx \ lambda/debuginfo.cmx \ middle_end/compilenv.cmx \ + middle_end/compilation_unit.cmx \ middle_end/flambda/closure_offsets.cmx \ middle_end/flambda/base_types/closure_id.cmx \ utils/clflags.cmx \ @@ -4337,7 +4447,6 @@ middle_end/flambda/inconstant_idents.cmo : \ middle_end/flambda/base_types/set_of_closures_id.cmi \ middle_end/flambda/parameter.cmi \ utils/numbers.cmi \ - utils/misc.cmi \ utils/int_replace_polymorphic_compare.cmi \ utils/identifiable.cmi \ middle_end/flambda/flambda_utils.cmi \ @@ -4353,7 +4462,6 @@ middle_end/flambda/inconstant_idents.cmx : \ middle_end/flambda/base_types/set_of_closures_id.cmx \ middle_end/flambda/parameter.cmx \ utils/numbers.cmx \ - utils/misc.cmx \ utils/int_replace_polymorphic_compare.cmx \ utils/identifiable.cmx \ middle_end/flambda/flambda_utils.cmx \ @@ -4721,6 +4829,8 @@ middle_end/flambda/invariant_params.cmi : \ middle_end/flambda/lift_code.cmo : \ middle_end/variable.cmi \ utils/strongly_connected_components.cmi \ + middle_end/flambda/base_types/mutable_variable.cmi \ + lambda/lambda.cmi \ utils/int_replace_polymorphic_compare.cmi \ middle_end/flambda/flambda_iterators.cmi \ middle_end/flambda/flambda.cmi \ @@ -4729,6 +4839,8 @@ middle_end/flambda/lift_code.cmo : \ middle_end/flambda/lift_code.cmx : \ middle_end/variable.cmx \ utils/strongly_connected_components.cmx \ + middle_end/flambda/base_types/mutable_variable.cmx \ + lambda/lambda.cmx \ utils/int_replace_polymorphic_compare.cmx \ middle_end/flambda/flambda_iterators.cmx \ middle_end/flambda/flambda.cmx \ @@ -4853,7 +4965,6 @@ middle_end/flambda/projection.cmi : \ middle_end/flambda/ref_to_variables.cmo : \ middle_end/variable.cmi \ middle_end/flambda/base_types/mutable_variable.cmi \ - utils/misc.cmi \ lambda/lambda.cmi \ middle_end/internal_variable_names.cmi \ utils/int_replace_polymorphic_compare.cmi \ @@ -4864,7 +4975,6 @@ middle_end/flambda/ref_to_variables.cmo : \ middle_end/flambda/ref_to_variables.cmx : \ middle_end/variable.cmx \ middle_end/flambda/base_types/mutable_variable.cmx \ - utils/misc.cmx \ lambda/lambda.cmx \ middle_end/internal_variable_names.cmx \ utils/int_replace_polymorphic_compare.cmx \ @@ -5159,6 +5269,7 @@ middle_end/flambda/traverse_for_exported_symbols.cmi : \ middle_end/flambda/base_types/export_id.cmi \ middle_end/flambda/base_types/closure_id.cmi middle_end/flambda/un_anf.cmo : \ + middle_end/symbol.cmi \ middle_end/semantics_of_primitives.cmi \ middle_end/printclambda.cmi \ utils/misc.cmi \ @@ -5171,6 +5282,7 @@ middle_end/flambda/un_anf.cmo : \ parsing/asttypes.cmi \ middle_end/flambda/un_anf.cmi middle_end/flambda/un_anf.cmx : \ + middle_end/symbol.cmx \ middle_end/semantics_of_primitives.cmx \ middle_end/printclambda.cmx \ utils/misc.cmx \ @@ -5183,6 +5295,7 @@ middle_end/flambda/un_anf.cmx : \ parsing/asttypes.cmi \ middle_end/flambda/un_anf.cmi middle_end/flambda/un_anf.cmi : \ + middle_end/symbol.cmi \ middle_end/clambda.cmi middle_end/flambda/unbox_closures.cmo : \ middle_end/variable.cmi \ @@ -5438,7 +5551,7 @@ asmcomp/debug/compute_ranges.cmo : \ asmcomp/printlinear.cmi \ utils/numbers.cmi \ utils/misc.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ utils/int_replace_polymorphic_compare.cmi \ asmcomp/debug/compute_ranges_intf.cmo \ asmcomp/cmm.cmi \ @@ -5447,7 +5560,7 @@ asmcomp/debug/compute_ranges.cmx : \ asmcomp/printlinear.cmx \ utils/numbers.cmx \ utils/misc.cmx \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ utils/int_replace_polymorphic_compare.cmx \ asmcomp/debug/compute_ranges_intf.cmx \ asmcomp/cmm.cmx \ @@ -5456,11 +5569,11 @@ asmcomp/debug/compute_ranges.cmi : \ asmcomp/debug/compute_ranges_intf.cmo asmcomp/debug/compute_ranges_intf.cmo : \ utils/numbers.cmi \ - asmcomp/linearize.cmi \ + asmcomp/linear.cmi \ utils/identifiable.cmi asmcomp/debug/compute_ranges_intf.cmx : \ utils/numbers.cmx \ - asmcomp/linearize.cmx \ + asmcomp/linear.cmx \ utils/identifiable.cmx asmcomp/debug/reg_availability_set.cmo : \ asmcomp/debug/reg_with_debug_info.cmi \ @@ -5617,7 +5730,6 @@ driver/errors.cmi : driver/main.cmo : \ utils/warnings.cmi \ utils/profile.cmi \ - utils/misc.cmi \ driver/makedepend.cmi \ driver/main_args.cmi \ parsing/location.cmi \ @@ -5633,7 +5745,6 @@ driver/main.cmo : \ driver/main.cmx : \ utils/warnings.cmx \ utils/profile.cmx \ - utils/misc.cmx \ driver/makedepend.cmx \ driver/main_args.cmx \ parsing/location.cmx \ @@ -5650,13 +5761,17 @@ driver/main.cmi : driver/main_args.cmo : \ utils/warnings.cmi \ utils/profile.cmi \ + utils/misc.cmi \ utils/config.cmi \ + driver/compenv.cmi \ utils/clflags.cmi \ driver/main_args.cmi driver/main_args.cmx : \ utils/warnings.cmx \ utils/profile.cmx \ + utils/misc.cmx \ utils/config.cmx \ + driver/compenv.cmx \ utils/clflags.cmx \ driver/main_args.cmi driver/main_args.cmi : @@ -5700,6 +5815,7 @@ driver/optcompile.cmo : \ utils/config.cmi \ middle_end/compilenv.cmi \ driver/compile_common.cmi \ + middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ asmcomp/asmgen.cmi \ driver/optcompile.cmi @@ -5714,6 +5830,7 @@ driver/optcompile.cmx : \ utils/config.cmx \ middle_end/compilenv.cmx \ driver/compile_common.cmx \ + middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ asmcomp/asmgen.cmx \ driver/optcompile.cmi @@ -5732,9 +5849,7 @@ driver/optmain.cmo : \ utils/warnings.cmi \ utils/profile.cmi \ asmcomp/proc.cmi \ - asmcomp/printmach.cmi \ driver/optcompile.cmi \ - utils/misc.cmi \ driver/makedepend.cmi \ driver/main_args.cmi \ parsing/location.cmi \ @@ -5754,9 +5869,7 @@ driver/optmain.cmx : \ utils/warnings.cmx \ utils/profile.cmx \ asmcomp/proc.cmx \ - asmcomp/printmach.cmx \ driver/optcompile.cmx \ - utils/misc.cmx \ driver/makedepend.cmx \ driver/main_args.cmx \ parsing/location.cmx \ @@ -5917,6 +6030,7 @@ toplevel/opttoploop.cmo : \ driver/compmisc.cmi \ middle_end/compilenv.cmi \ driver/compenv.cmi \ + middle_end/closure/closure_middle_end.cmi \ utils/clflags.cmi \ typing/btype.cmi \ middle_end/backend_intf.cmi \ @@ -5963,6 +6077,7 @@ toplevel/opttoploop.cmx : \ driver/compmisc.cmx \ middle_end/compilenv.cmx \ driver/compenv.cmx \ + middle_end/closure/closure_middle_end.cmx \ utils/clflags.cmx \ typing/btype.cmx \ middle_end/backend_intf.cmi \ @@ -5982,27 +6097,21 @@ toplevel/opttoploop.cmi : \ parsing/location.cmi \ typing/env.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 \ driver/compmisc.cmi \ - driver/compenv.cmi \ utils/clflags.cmi \ toplevel/opttopmain.cmi toplevel/opttopmain.cmx : \ - utils/warnings.cmx \ - asmcomp/printmach.cmx \ toplevel/opttoploop.cmx \ toplevel/opttopdirs.cmx \ utils/misc.cmx \ driver/main_args.cmx \ parsing/location.cmx \ driver/compmisc.cmx \ - driver/compenv.cmx \ utils/clflags.cmx \ toplevel/opttopmain.cmi toplevel/opttopmain.cmi : @@ -6012,7 +6121,6 @@ toplevel/opttopstart.cmx : \ toplevel/opttopmain.cmx toplevel/topdirs.cmo : \ utils/warnings.cmi \ - typing/typetexp.cmi \ typing/types.cmi \ toplevel/trace.cmi \ toplevel/toploop.cmi \ @@ -6041,7 +6149,6 @@ toplevel/topdirs.cmo : \ toplevel/topdirs.cmi toplevel/topdirs.cmx : \ utils/warnings.cmx \ - typing/typetexp.cmx \ typing/types.cmx \ toplevel/trace.cmx \ toplevel/toploop.cmx \ @@ -6168,10 +6275,8 @@ toplevel/toploop.cmi : \ parsing/location.cmi \ typing/env.cmi toplevel/topmain.cmo : \ - utils/warnings.cmi \ toplevel/toploop.cmi \ toplevel/topdirs.cmi \ - utils/profile.cmi \ utils/misc.cmi \ driver/main_args.cmi \ parsing/location.cmi \ @@ -6180,10 +6285,8 @@ toplevel/topmain.cmo : \ utils/clflags.cmi \ toplevel/topmain.cmi toplevel/topmain.cmx : \ - utils/warnings.cmx \ toplevel/toploop.cmx \ toplevel/topdirs.cmx \ - utils/profile.cmx \ utils/misc.cmx \ driver/main_args.cmx \ parsing/location.cmx \ diff --git a/.gitattributes b/.gitattributes index ce51bd79..9be9e33a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -27,6 +27,8 @@ *.png binary *.tfm binary +/boot/menhir/parser.ml* -diff + # configure is declared as binary so that it doesn't get included in diffs. # This also means it will have the correct Unix line-endings, even on Windows. /configure binary @@ -165,6 +167,7 @@ tools/pre-commit-githook text eol=lf tools/markdown-add-pr-links.sh text eol=lf runtime/caml/m.h.in text eol=lf runtime/caml/s.h.in text eol=lf +runtime/caml/compatibility.h typo.long-line=may # These are all Perl scripts, so may not actually require this manual/tools/caml-tex text eol=lf @@ -176,6 +179,7 @@ manual/tools/texexpand text eol=lf # Tests which include references spanning multiple lines fail with \r\n # endings, so use \n endings only, even on Windows. +testsuite/tests/basic-modules/anonymous.ml text eol=lf testsuite/tests/basic-more/morematch.ml text eol=lf testsuite/tests/basic-more/robustmatch.ml text eol=lf testsuite/tests/parsing/*.ml text eol=lf diff --git a/.gitignore b/.gitignore index 04ddcaa0..5da73a82 100644 --- a/.gitignore +++ b/.gitignore @@ -45,6 +45,7 @@ _build /autom4te.cache /ocamlc /config.cache +/ocaml-*.cache /config.log /config.status /libtool @@ -69,7 +70,6 @@ _build /boot/camlheader /boot/ocamlc.opt -/bytecomp/runtimedef.ml /bytecomp/opcodes.ml /bytecomp/opcodes.mli @@ -177,6 +177,7 @@ _build /runtime/caml/m.h /runtime/caml/s.h /runtime/primitives +/runtime/primitives.new /runtime/prims.c /runtime/caml/opnames.h /runtime/caml/version.h @@ -189,6 +190,8 @@ _build /runtime/.gdb_history /runtime/*.d.c /runtime/*.pic.c +/runtime/domain_state32.inc +/runtime/domain_state64.inc /stdlib/camlheader /stdlib/target_camlheader @@ -242,14 +245,9 @@ _build /tools/primreq.opt /tools/ocamldumpobj /tools/keywords -/tools/lexer299.ml -/tools/ocaml299to3 /tools/ocamlmklib /tools/ocamlmklib.opt /tools/ocamlmklibconfig.ml -/tools/lexer301.ml -/tools/scrapelabels -/tools/addlabels /tools/objinfo_helper /tools/read_cmt /tools/read_cmt.opt @@ -262,6 +260,8 @@ _build /tools/caml-tex /utils/config.ml +/utils/domainstate.ml +/utils/domainstate.mli /yacc/ocamlyacc /yacc/version.h diff --git a/.travis.yml b/.travis.yml index da9f2a3c..8fbf24c6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,10 +18,11 @@ sudo: false language: c git: submodules: false -script: bash -e tools/ci/travis/travis-ci.sh +script: tools/ci/travis/travis-ci.sh matrix: include: - - env: CI_KIND=build XARCH=i386 + - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0 + - env: CI_KIND=build XARCH=i386 CONFIG_ARG=--disable-stdlib-manpages addons: apt: packages: @@ -32,7 +33,13 @@ matrix: - libx11-dev:i386 - libc6-dev:i386 - env: CI_KIND=build XARCH=x64 - - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0 + addons: + apt: + packages: + - texlive-latex-extra + - texlive-fonts-recommended + - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--disable-shared + - env: CI_KIND=build XARCH=x64 MIN_BUILD=1 - env: CI_KIND=changes - env: CI_KIND=manual - env: CI_KIND=check-typo diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b60089b2..ae670072 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -383,6 +383,44 @@ why the change is desirable and why it should go into stdlib. So: be prepared for some serious review process! But yes, yes, contributions are welcome and appreciated. Promised. +## Contributing optimizations + +Contributions to improve the compiler's optimization capabilities are +welcome. However, due to the potential risks involved with such +changes, we ask the following of contributors when submitting pull +requests: + + - Explain the benefits of the optimization (faster code, smaller + code, improved cache behaviour, lower power consumption, increased + compilation speed). + + - Explain when the optimization does and does not apply. + + - Explain when, if ever, the optimization may be detrimental. + + - Provide benchmark measurements to justify the expected + benefits. Measurements should ideally include experiments with + full-scale applications as well as with microbenchmarks. Which + kinds of measurements are appropriate will vary depending on the + optimization; some optimizations may have to be measured indirectly + (for example, by measuring cache misses for a code size + optimization). Measurements showing clear benefits when combined + with some other optimization/change are acceptable. + + - At least some of the measurements provided should be from + experiments on open source code. + + - If assistance is sought with benchmarking then this should be made + clear on the initial pull request submission. + + - Justify the correctness of the optimization, and discuss a testing + strategy to ensure that it does not introduce bugs. The use of + formal methods to increase confidence is encouraged. + +A major criterion in assessing whether to include an optimisation in +the compiler is the balance between the increased complexity of the +compiler code and the expected benefits of the benchmark. Contributors +are asked to bear this in mind when making submissions. ## Contributor License Agreement diff --git a/Changes b/Changes index ff969c88..fc5591eb 100644 --- a/Changes +++ b/Changes @@ -1,14 +1,523 @@ -OCaml 4.09.1 (16 Mars 2020): ----------------------------- +OCaml 4.10.0 (21 February 2020) +------------------------------- + +(Changes that can break existing programs are marked with a "*") + +### Language features + +- #7757, #1726: multi-indices for extended indexing operators: + `a.%{0;1;2}` desugars to `( .%{ ;.. } ) a [|0;1;2|]` + (Florian Angeletti, review by Gabriel Radanne) + +* #1859, #9117: enforce safe (immutable) strings by removing + the -unsafe-string option by default. This can be overridden by + a configure-time option (available since 4.04 in 2016): + --disable-force-safe-string since 4.08, -no-force-safe-since + between 4.07 and 4.04. + In the force-safe-string mode (now the default), the return type of the + String_val macro in C stubs is `const char*` instead of + `char*`. This change may break C FFI code. + (Kate Deplaix) + + +- #6662, #8908: allow writing "module _ = E" to ignore module expressions + (Thomas Refis, review by Gabriel Radanne) + +### Runtime system: + +- #8809, #9292: Add a best-fit allocator for the major heap; still + experimental, it should be much better than current allocation + policies (first-fit and next-fit) for programs with large heaps, + reducing both GC cost and memory usage. + This new best-fit is not (yet) the default; set it explicitly with + OCAMLRUNPARAM="a=2" (or Gc.set from the program). You may also want + to increase the `space_overhead` parameter of the GC (a percentage, + 80 by default), for example OCAMLRUNPARAM="o=85", for optimal + speed. + (Damien Doligez, review by Stephen Dolan, Jacques-Henri Jourdan, + Xavier Leroy, Leo White) + +* #8713, #8940, #9115, #9143, #9202, #9251: + Introduce a state table in the runtime to contain the global variables. + (The Multicore runtime will have one such state for each domain.) + + This changes the status of some internal variables of the OCaml runtime; + in many cases the header file originally defining the internal variable + provides a compatibility macro with the old name, but programs + re-defining those variables by hand need to be fixed. + + (KC Sivaramakrishnan and Stephen Dolan, + compatibility hacking by David Allsopp, Florian Angeletti, Kate Deplaix, + Jacques Garrigue, Guillaume Munch-Maccagnoni and Nicolás Ojeda Bär, + review by David Allsopp, Alain Frisch, Nicolas Ojeda Bar, + Gabriel Scherer, Damien Doligez, and Guillaume Munch-Maccagnoni) + +- #8993: New C functions caml_process_pending_actions{,_exn} in + caml/signals.h, intended for executing all pending actions inside + long-running C functions (requested minor and major collections, + signal handlers, finalisers, and memprof callbacks). The function + caml_process_pending_actions_exn returns any exception arising + during their execution, allowing resources to be cleaned-up before + re-raising. + (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan, + Stephen Dolan, and Gabriel Scherer) + +* #8691, #8897, #9027: Allocation functions are now guaranteed not to + trigger any OCaml callback when called from C. In long-running C + functions, this can be replaced with calls to + caml_process_pending_actions at safe points. + Side effect of this change: in bytecode mode, polling for + asynchronous callbacks is performed at every minor heap allocation, + in addition to function calls and loops as in previous OCaml + releases. + (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer and + Guillaume Munch-Maccagnoni) + +* #9037: caml_check_urgent_gc is now guaranteed not to trigger any + finaliser. In long-running C functions, this can be replaced + with calls to caml_process_pending_actions at safe points. + (Guillaume Munch-Maccagnoni, review by Jacques-Henri Jourdan and + Stephen Dolan) + + +- #8619: Ensure Gc.minor_words remains accurate after a GC. + (Stephen Dolan, Xavier Leroy and David Allsopp, + review by Xavier Leroy and Gabriel Scherer) + +- #8667: Limit GC credit to 1.0 + (Leo White, review by Damien Doligez) + +- #8670: Fix stack overflow detection with systhreads + (Stephen Dolan, review by Xavier Leroy, Anil Madhavapeddy, Gabriel Scherer, + Frédéric Bour and Guillaume Munch-Maccagnoni) + +* #8711: The major GC hooks are no longer allowed to interact with the + OCaml heap. + (Jacques-Henri Jourdan, review by Damien Doligez) + +- #8630: Use abort() instead of exit(2) in caml_fatal_error, and add + the new hook caml_fatal_error_hook. + (Jacques-Henri Jourdan, review by Xavier Leroy) + +- #8641: Better call stacks when a C call is involved in byte code mode + (Jacques-Henri Jourdan, review by Xavier Leroy) + +- #8634, #8668, #8684, #9103 (originally #847): Statistical memory profiling. + In OCaml 4.10, support for allocations in the minor heap in native + mode is not available, and callbacks for promotions and + deallocations are not available. + Hence, there is not any public API for this feature yet. + (Jacques-Henri Jourdan, review by Stephen Dolan, Gabriel Scherer + and Damien Doligez) + +- #9268, #9271: Fix bytecode backtrace generation with large integers present. + (Stephen Dolan and Mark Shinwell, review by Gabriel Scherer and + Jacques-Henri Jourdan) + +### Standard library: + +- #8760: List.concat_map : ('a -> 'b list) -> 'a list -> 'b list + (Gabriel Scherer, review by Daniel Bünzli and Thomas Refis) + +- #8832: List.find_map : ('a -> 'b option) -> 'a list -> 'b option + (Gabriel Scherer, review by Jeremy Yallop, Nicolás Ojeda Bär + and Daniel Bünzli) + +- #7672, #1492: Add `Filename.quote_command` to produce properly-quoted + commands for execution by Sys.command. + (Xavier Leroy, review by David Allsopp and Damien Doligez) + +- #8971: Add `Filename.null`, the conventional name of the "null" device. + (Nicolás Ojeda Bär, review by Xavier Leroy and Alain Frisch) + +- #8651: add '%#F' modifier in printf to output OCaml float constants + in hexadecimal + (Pierre Roux, review by Gabriel Scherer and Xavier Leroy) + + +- #8657: Optimization in [Array.make] when initializing with unboxed + or young values. + (Jacques-Henri Jourdan, review by Gabriel Scherer and Stephen Dolan) + +- #8716: Optimize [Array.fill] and [Hashtbl.clear] with a new runtime primitive + (Alain Frisch, review by David Allsopp, Stephen Dolan and Damien Doligez) + +- #8530: List.sort: avoid duplicate work by chop + (Guillaume Munch-Maccagnoni, review by David Allsopp, Damien Doligez and + Gabriel Scherer) + +### Other libraries: + +- #1939, #2023: Implement Unix.truncate and Unix.ftruncate on Windows. + (Florent Monnier and Nicolás Ojeda Bär, review by David Allsopp) + +### Code generation and optimizations: + +- #8806: Add an [@@immediate64] attribute for types that are known to + be immediate only on 64 bit platforms + (Jérémie Dimino, review by Vladimir Keleshev) + +- #9028, #9032: Fix miscompilation by no longer assuming that + untag_int (tag_int x) = x in Cmmgen; the compilation of `(n lsl 1) + 1`, + for example, would be incorrect if evaluated with a large value for `n`. + (Stephen Dolan, review by Vincent Laviron and Xavier Leroy) + +- #8672: Optimise Switch code generation on booleans. + (Stephen Dolan, review by Pierre Chambart) + + +- #8990: amd64: Emit 32bit registers for Iconst_int when we can + (Xavier Clerc, Tom Kelly and Mark Shinwell, review by Xavier Leroy) + +- #2322: Add pseudo-instruction `Ladjust_trap_depth` to replace + dummy Lpushtrap generated in linearize + (Greta Yorsh and Vincent Laviron, review by Xavier Leroy) + +- #8707: Simplif: more regular treatment of Tupled and Curried functions + (Gabriel Scherer, review by Leo White and Alain Frisch) + +- #8526: Add compile-time option -function-sections in ocamlopt to emit + each function in a separate named text section on supported targets. + (Greta Yorsh, review by Pierre Chambart) + +- #2321: Eliminate dead ICatch handlers + (Greta Yorsh, review by Pierre Chambart and Vincent Laviron) + +- #8919: lift mutable lets along with immutable ones + (Leo White, review by Pierre Chambart) + +- #8909: Graph coloring register allocator: the weights put on + preference edges should not be divided by 2 in branches of + conditional constructs, because it is not good for performance + and because it leads to ignoring preference edges with 0 weight. + (Eric Stavarache, review by Xavier Leroy) + +- #9006: int32 code generation improvements + (Stephen Dolan, designed with Greta Yorsh, review by Xavier Clerc, + Xavier Leroy and Alain Frisch) + +- #9041: amd64: Avoid stall in sqrtsd by clearing destination. + (Stephen Dolan, with thanks to Andrew Hunter, Will Hasenplaugh, + Spiros Eliopoulos and Brian Nigito. Review by Xavier Leroy) + +- #2165: better unboxing heuristics for let-bound identifiers + (Alain Frisch, review by Vincent Laviron and Gabriel Scherer) + +- #8735: unbox across static handlers + (Alain Frisch, review by Vincent Laviron and Gabriel Scherer) + +### Manual and documentation: + +- #8718, #9089: syntactic highlighting for code examples in the manual + (Florian Angeletti, report by Anton Kochkov, review by Gabriel Scherer) + +- #9101: add links to section anchor before the section title, + make the name of those anchor explicits. + (Florian Angeletti, review by Daniel Bünzli, Sébastien Hinderer, + and Gabriel Scherer) + +- #9257, cautionary guidelines for using the internal runtime API + without too much updating pain. + (Florian Angeletti, review by Daniel Bünzli, Guillaume Munch-Maccagnoni + and KC Sivaramakrishnan) + + +- #8950: move local opens in pattern out of the extension chapter + (Florian Angeletti, review and suggestion by Gabriel Scherer) + +- #9088, #9097: fix operator character classes + (Florian Angelettion, review by Gabriel Scherer, + report by Clément Busschaert) + +- #9169: better documentation for the best-fit allocation policy + (Gabriel Scherer, review by Guillaume Munch-Maccagnoni + and Florian Angeletti) + +### Compiler user-interface and warnings: + +- #8833: Hint for (type) redefinitions in toplevel session + (Florian Angeletti, review by Gabriel Scherer) + +- #2127, #9185: Refactor lookup functions + Included observable changes: + - makes the location of usage warnings and alerts for constructors more + precise + - don't warn about a constructor never being used to build values when it + has been defined as private + (Leo White, Hugo Heuzard review by Thomas Refis, Florian Angeletti) + +- #8702, #8777: improved error messages for fixed row polymorphic variants + (Florian Angeletti, report by Leo White, review by Thomas Refis) + +- #8844: Printing faulty constructors, inline records fields and their types + during type mismatches. Also slightly changed other type mismatches error + output. + (Mekhrubon Turaev, review by Florian Angeletti, Leo White) + +- #8885: Warn about unused local modules + (Thomas Refis, review by Alain Frisch) + +- #8872: Add ocamlc option "-output-complete-exe" to build a self-contained + binary for bytecode programs, containing the runtime and C stubs. + (Stéphane Glondu, Nicolás Ojeda Bär, review by Jérémie Dimino and Daniel + Bünzli) + +- #8874: add tests for typechecking error messages and pack them into + pretty-printing boxes. + (Oxana Kostikova, review by Gabriel Scherer) + +- #8891: Warn about unused functor parameters + (Thomas Refis, review by Gabriel Radanne) + +- #8903: Improve errors for first-class modules + (Leo White, review by Jacques Garrigue) + +- #8914: clarify the warning on unboxable types used in external primitives (61) + (Gabriel Scherer, review by Florian Angeletti, report on the Discourse forum) + +- #9046: disable warning 30 by default + This outdated warning complained on label/constructor name conflicts + within a mutually-recursive type declarations; there is now no need + to complain thanks to type-based disambiguation. + (Gabriel Scherer) + +### Tools: + +* #6792, #8654 ocamldebug now supports programs using Dynlink. This + changes ocamldebug messages, which may break compatibility + with older emacs modes. + (Whitequark and Jacques-Henri Jourdan, review by Gabriel Scherer + and Xavier Clerc) + +- #8621: Make ocamlyacc a Windows Unicode application + (David Allsopp, review by Nicolás Ojeda Bär) + +* #8834, `ocaml`: adhere to the XDG base directory specification to + locate an `.ocamlinit` file. Reads an `$XDG_CONFIG_HOME/ocaml/init.ml` + file before trying to lookup `~/.ocamlinit`. On Windows the behaviour + is unchanged. + (Daniel C. Bünzli, review by David Allsopp, Armaël Guéneau and + Nicolás Ojeda Bär) + +- #9113: ocamldoc: fix the rendering of multi-line code blocks + in the 'man' backend. + (Gabriel Scherer, review by Florian Angeletti) + +- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types. + (David Allsopp, report by San Vu Ngoc) + +- #9181: make objinfo work on Cygwin and look for the caml_plugin_header + symbol in both the static and the dynamic symbol tables. + (Sébastien Hinderer, review by Gabriel Scherer and David Allsopp) + +### Build system: + +- #8840: use ocaml{c,opt}.opt when available to build internal tools + On my machine this reduces parallel-build times from 3m30s to 2m50s. + (Gabriel Scherer, review by Xavier Leroy and Sébastien Hinderer) + +- #8650: ensure that "make" variables are defined before use; + revise generation of config/util.ml to better quote special characters + (Xavier Leroy, review by David Allsopp) + +- #8690, #8696: avoid rebuilding the world when files containing primitives + change. + (Stephen Dolan, review by Gabriel Scherer, Sébastien Hinderer and + Thomas Refis) + +- #8835: new configure option --disable-stdlib-manpages to disable building + and installation of the library manpages. + (David Allsopp, review by Florian Angeletti and Gabriel Scherer) + +- #8837: build manpages using ocamldoc.opt when available + cuts the manpages build time from 14s to 4s + (Gabriel Scherer, review by David Allsopp and Sébastien Hinderer, + report by David Allsopp) + +- #8843, #8841: fix use of off_t on 32-bit systems. + (Stephen Dolan, report by Richard Jones, review by Xavier Leroy) + +- #8947, #9134, #9302, #9311: fix/improve support for the BFD library + (Sébastien Hinderer, review by Damien Doligez and David Allsopp) + +- #8951: let make's default target build the compiler + (Sébastien Hinderer, review by David Allsopp) + +- #8995: allow developers to specify frequently-used configure options in + Git (ocaml.configure option) and a directory for host-specific, shareable + config.cache files (ocaml.configure-cache option). See HACKING.adoc for + further details. + (David Allsopp, review by Gabriel Scherer) + +- #9136: Don't propagate Cygwin-style prefix from configure to + Makefile.config on Windows ports. + (David Allsopp, review by Sébastien Hinderer) + +### Internal/compiler-libs changes: + +- #8828: Added abstractions for variants, records, constructors, fields and + extension constructor types mismatch. + (Mekhrubon Turaev, review by Florian Angeletti, Leo White and Gabriel Scherer) + +- #7927, #8527: Replace long tuples into records in typeclass.ml + (Ulugbek Abdullaev, review by David Allsopp and Gabriel Scherer) + +- #1963: split cmmgen into generic Cmm helpers and clambda transformations + (Vincent Laviron, review by Mark Shinwell) + +- #1901: Fix lexing of character literals in comments + (Pieter Goetschalckx, review by Damien Doligez) + +- #1932: Allow octal escape sequences and identifiers containing apostrophes + in ocamlyacc actions and comments. + (Pieter Goetschalckx, review by Damien Doligez) + +- #2288: Move middle end code from [Asmgen] to [Clambda_middle_end] and + [Flambda_middle_end]. Run [Un_anf] from the middle end, not [Cmmgen]. + (Mark Shinwell, review by Pierre Chambart) + +- #8692: Remove Misc.may_map and similar + (Leo White, review by Gabriel Scherer and Thomas Refis) + +- #8677: Use unsigned comparisons in amd64 and i386 emitter of Lcondbranch3. + (Greta Yorsh, review by Xavier Leroy) + +- #8766: Parmatch: introduce a type for simplified pattern heads + (Gabriel Scherer and Thomas Refis, review by Stephen Dolan and + Florian Angeletti) + +- #8774: New implementation of Env.make_copy_of_types + (Alain Frisch, review by Thomas Refis, Leo White and Jacques Garrigue) + +- #7924: Use a variant instead of an int in Bad_variance exception + (Rian Douglas, review by Gabriel Scherer) + +- #8890: in -dtimings output, show time spent in C linker clearly + (Valentin Gatien-Baron) + +- #8910, #8911: minor improvements to the printing of module types + (Gabriel Scherer, review by Florian Angeletti) + +- #8913: ocamltest: improve 'promote' implementation to take + skipped lines/bytes into account + (Gabriel Scherer, review by Sébastien Hinderer) + +- #8908: Use an option instead of a string for module names ("_" becomes None), + and a dedicated type for functor parameters: "()" maps to "Unit" (instead of + "*"). + (Thomas Refis, review by Gabriel Radanne) + +- #8928: Move contains_calls and num_stack_slots from Proc to Mach.fundecl + (Greta Yorsh, review by Florian Angeletti and Vincent Laviron) + +- #8959, #8960, #8968, #9023: minor refactorings in the typing of patterns: + + refactor the {let,pat}_bound_idents* functions + + minor bugfix in type_pat + + refactor the generic pattern-traversal functions + in Typecore and Typedtree + + restrict the use of Need_backtrack + (Gabriel Scherer and Florian Angeletti, + review by Thomas Refis and Gabriel Scherer) + +- #9030: clarify and document the parameter space of type_pat + (Gabriel Scherer and Florian Angeletti and Jacques Garrigue, + review by Florian Angeletti and Thomas Refis) + +- #8975: "ocamltests" files are no longer required or used by + "ocamltest". Instead, any text file in the testsuite directory containing a + valid "TEST" block will be automatically included in the testsuite. + (Nicolás Ojeda Bär, review by Gabriel Scherer and Sébastien Hinderer) + +- #8992: share argument implementations between executables + (Florian Angeletti, review by Gabriel Scherer) + +- #9015: fix fatal error in pprint_ast (#8789) + (Damien Doligez, review by ...) + +### Bug fixes: + +- #5673, #7636: unused type variable causes generalization error + (Jacques Garrigue and Leo White, review by Leo White, + reports by Jean-Louis Giavitto and Christophe Raffalli) + +- #6922, #8955: Fix regression with -principal type inference for inherited + methods, allowing to compile ocamldoc with -principal + (Jacques Garrigue, review by Leo White) + +- #7925, #8611: fix error highlighting for exceptionally + long toplevel phrases + (Kyle Miller, reported by Armaël Guéneau, review by Armaël Guéneau + and Nicolás Ojeda Bär) + +- #8622: Don't generate #! headers over 127 characters. + (David Allsopp, review by Xavier Leroy and Stephen Dolan) + +- #8715: minor bugfixes in CamlinternalFormat; removes the unused + and misleading function CamlinternalFormat.string_of_formatting_gen + (Gabriel Scherer and Florian Angeletti, + review by Florian Angeletti and Gabriel Radanne) + +- #8792, #9018: Possible (latent) bug in Ctype.normalize_type + removed incrimined Btype.log_type, replaced by Btype.set_type + (Jacques Garrigue, report by Alain Frisch, review by Thomas Refis) + +- #8856, #8860: avoid stackoverflow when printing cyclic type expressions + in some error submessages. + (Florian Angeletti, report by Mekhrubon Turaev, review by Leo White) + +- #8875: fix missing newlines in the output from MSVC invocation. + (Nicolás Ojeda Bär, review by Gabriel Scherer) + +- #8921, #8924: Fix stack overflow with Flambda + (Vincent Laviron, review by Pierre Chambart and Leo White, + report by Aleksandr Kuzmenko) + +- #8892, #8895: fix the definition of Is_young when CAML_INTERNALS is not + defined. + (David Allsopp, review by Xavier Leroy) + +- #8896: deprecate addr typedef in misc.h + (David Allsopp, suggestion by Xavier Leroy) + +- #8981: Fix check for incompatible -c and -o options. + (Greta Yorsh, review by Damien Doligez) + +- #9019, #9154: Unsound exhaustivity of GADTs from incomplete unification + Also fixes bug found by Thomas Refis in #9012 + (Jacques Garrigue, report and review by Leo White, Thomas Refis) + +- #9031: Unregister Windows stack overflow handler while shutting + the runtime down. + (Dmitry Bely, review by David Allsopp) + +- #9051: fix unregistered local root in win32unix/select.c (could result in + `select` returning file_descr-like values which weren't in the original sets) + and correct initialisation of some blocks allocated with caml_alloc_small. + (David Allsopp, review by Xavier Leroy) + +- #9073, #9120: fix incorrect GC ratio multiplier when allocating custom blocks + with caml_alloc_custom_mem in runtime/custom.c + (Markus Mottl, review by Gabriel Scherer and Damien Doligez) + +- #9209, #9212: fix a development-version regression caused by #2288 + (Kate Deplaix and David Allsopp, review by Sébastien Hinderer + and Gabriel Scherer ) + +- #9218, #9269: avoid a rare wrong module name error with "-annot" and + inline records. + (Florian Angeletti, review by Gabriel Scherer, report by Kate Deplaix) + +- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908) + (Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer) + +OCaml 4.09 maintenance branch: +------------------------------ - #8855, #8858: Links for tools not created when installing with --disable-installing-byecode-programs (e.g. ocamldep.opt installed, but ocamldep link not created) (David Allsopp, report by Thomas Leonard) -- #8947, #9134, #9302: fix/improve support for the BFD library - (Sébastien Hinderer, review by Damien Doligez and David Allsopp) - - #8953, #8954: Fix error submessages in the toplevel: do not display dummy locations (Armaël Guéneau, review by Gabriel Scherer) @@ -23,19 +532,15 @@ OCaml 4.09.1 (16 Mars 2020): - #9050, #9076: install missing compilerlibs/ocamlmiddleend archives (Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering) -- #9073, #9120: fix incorrect GC ratio multiplier when allocating custom blocks - with caml_alloc_custom_mem in runtime/custom.c - (Markus Mottl, review by Gabriel Scherer and Damien Doligez) - -- #9144, #9180: multiple definitions of global variables in the C runtime, - causing problems with GCC 10.0 and possibly with other C compilers - (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell) - - #9180: pass -fno-common option to C compiler when available, so as to detect problematic multiple definitions of global variables in the C runtime (Xavier Leroy, review by Mark Shinwell) +- #9144, #9180: multiple definitions of global variables in the C runtime, + causing problems with GCC 10.0 and possibly with other C compilers + (Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell) + - #9128: Fix a bug in bytecode mode which could lead to a segmentation fault. The bug was caused by the fact that the atom table shared a page with some bytecode. The fix makes sure both the atom table and @@ -46,8 +551,6 @@ OCaml 4.09.1 (16 Mars 2020): OCaml 4.09.0 (19 September 2019): --------------------------------- -(Changes that can break existing programs are marked with a "*") - ### Runtime system: * #1725, #2279: Deprecate Obj.set_tag and Obj.truncate @@ -879,7 +1382,7 @@ OCaml 4.08.0 (13 June 2019) fixes an imenu crash. (Wilfred Hughes, review by Christophe Troestler) -- #1711: the new 'open' flag in OCAMLRUNPARAM takes a comma-separated list of +- #1711: the new 'open' flag in OCAMLPARAM takes a comma-separated list of modules to open as if they had been passed via the command line -open flag. (Nicolás Ojeda Bär, review by Mark Shinwell) @@ -6505,7 +7008,7 @@ Native-code compiler: float comparisons. Standard library: -- Format: new function ikfprintf analoguous to ifprintf with a continuation +- Format: new function ikfprintf analogous to ifprintf with a continuation argument. * #4210, #4245: stricter range checking in string->integer conversion functions (int_of_string, Int32.of_string, Int64.of_string, diff --git a/HACKING.adoc b/HACKING.adoc index 2958e851..ea25c988 100644 --- a/HACKING.adoc +++ b/HACKING.adoc @@ -20,7 +20,7 @@ git checkout -b my-modification + ---- ./configure -make world.opt +make ---- 3. Try the newly built compiler binaries `ocamlc`, `ocamlopt` or their @@ -233,6 +233,39 @@ Additionally, there are some developer specific targets in link:Makefile.dev[]. These targets are automatically available when working in a Git clone of the repository, but are not available from a tarball. +=== Automatic configure options + +If you have options to `configure` which you always (or at least frequently) +use, it's possible to store them in Git, and `configure` will automatically add +them. For example, you may wish to avoid building the debug runtime by default +while developing, in which case you can issue +`git config --global ocaml.configure '--disable-debug-runtime'`. The `configure` +script will alert you that it has picked up this option and added it _before_ +any options you specified for `configure`. + +Options are added before those passed on the command line, so it's possible to +override them, for example `./configure --enable-debug-runtime` will build the +debug runtime, since the enable flag appears after the disable flag. You can +also use the full power of Git's `config` command and have options specific to +particular clone or worktree. + +=== Speeding up configure + +`configure` includes the standard `-C` option which caches various test results +in the file `config.cache` and can use those results to avoid running tests in +subsequent invocations. This mechanism works fine, except that it is easy to +clean the cache by mistake (e.g. with `git clean -dfX`). The cache is also +host-specific which means the file has to be deleted if you run `configure` with +a new `--host` value (this is quite common on Windows, where `configure` is +also quite slow to run). + +You can elect to have host-specific cache files by issuing +`git config --global ocaml.configure-cache .`. The `configure` script will now +automatically create `ocaml-host.cache` (e.g. `ocaml-x86_64-pc-windows.cache`, +or `ocaml-default.cache`). If you work with multiple worktrees, you can share +these cache files by issuing `git config --global ocaml.configure-cache ..`. The +directory is interpreted _relative_ to the `configure` script. + === Bootstrapping The OCaml compiler is bootstrapped. This means that diff --git a/INSTALL.adoc b/INSTALL.adoc index 2643c6f2..9d63aaf5 100644 --- a/INSTALL.adoc +++ b/INSTALL.adoc @@ -70,20 +70,13 @@ for guidance on how to edit the generated files by hand. From the top directory, do: - make world.opt -+ -if your platform is supported by the native-code compiler (as reported during - the auto-configuration), or - - make world -+ -if not. + make -This builds the OCaml bytecode compiler for the first time. This phase is +This builds the OCaml compiler for the first time. This phase is fairly verbose; consider redirecting the output to a file: - make world > log.world 2>&1 # in sh - make world >& log.world # in csh + make > make.log 2>&1 # in sh + make >& make.log # in csh == (Optional) Running the testsuite @@ -147,11 +140,11 @@ contains some complex, atypical pieces of C code which can uncover bugs in optimizing compilers. Alternatively, try another C compiler (e.g. `gcc` instead of the vendor-supplied `cc`). -You can also build a debug version of the runtime system. Go to the `runtime/` -directory and do `make ocamlrund`. Then, copy `ocamlrund` to -`../boot/ocamlrun`, and try again. This version of the runtime system contains -lots of assertions and sanity checks that could help you pinpoint the problem. - +You can also use the debug version of the runtime system which is +normally built and installed by default. Run the bytecode program +that causes troubles with `ocamlrund` rather than with `ocamlrun`. +This version of the runtime system contains lots of assertions +and sanity checks that could help you pinpoint the problem. == Common problems diff --git a/Makefile b/Makefile index 67913fc9..802196d1 100644 --- a/Makefile +++ b/Makefile @@ -20,18 +20,11 @@ ROOTDIR = . include Makefile.config include Makefile.common -# For users who don't read the INSTALL file .PHONY: defaultentry -defaultentry: -ifeq "$(UNIX_OR_WIN32)" "unix" - @echo "Please refer to the installation instructions in file INSTALL." - @echo "If you've just unpacked the distribution, something like" - @echo " ./configure" - @echo " make world.opt" - @echo " make install" - @echo "should work. But see the file INSTALL for more details." +ifeq "$(NATIVE_COMPILER)" "true" +defaultentry: world.opt else - @echo "Please refer to the instructions in file README.win32.adoc." +defaultentry: world endif MKDIR=mkdir -p @@ -55,6 +48,11 @@ INCLUDES=-I utils -I parsing -I typing -I bytecomp -I file_formats \ COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \ -warn-error A \ -bin-annot -safe-string -strict-formats $(INCLUDES) +ifeq "$(FUNCTION_SECTIONS)" "true" +OPTCOMPFLAGS= -function-sections +else +OPTCOMPFLAGS= +endif LINKFLAGS= ifeq "$(strip $(NATDYNLINKOPTS))" "" @@ -72,14 +70,12 @@ DEPINCLUDES=$(INCLUDES) OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt) UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \ - utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \ - utils/clflags.cmo utils/profile.cmo \ - utils/load_path.cmo \ - utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ - utils/consistbl.cmo \ - utils/strongly_connected_components.cmo \ - utils/targetint.cmo \ - utils/int_replace_polymorphic_compare.cmo + utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \ + utils/clflags.cmo utils/profile.cmo utils/load_path.cmo \ + utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \ + utils/consistbl.cmo utils/strongly_connected_components.cmo \ + utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \ + utils/domainstate.cmo PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/docstrings.cmo parsing/syntaxerr.cmo \ @@ -91,7 +87,7 @@ PARSING=parsing/location.cmo parsing/longident.cmo \ parsing/builtin_attributes.cmo parsing/ast_invariants.cmo parsing/depend.cmo TYPING=typing/ident.cmo typing/path.cmo \ - typing/primitive.cmo typing/types.cmo \ + typing/primitive.cmo typing/type_immediacy.cmo typing/types.cmo \ typing/btype.cmo typing/oprint.cmo \ typing/subst.cmo typing/predef.cmo \ typing/datarepr.cmo file_formats/cmi_format.cmo \ @@ -121,8 +117,8 @@ COMP=\ bytecomp/meta.cmo bytecomp/opcodes.cmo \ bytecomp/bytesections.cmo bytecomp/dll.cmo \ bytecomp/symtable.cmo \ - driver/pparse.cmo driver/main_args.cmo \ - driver/compenv.cmo driver/compmisc.cmo \ + driver/pparse.cmo driver/compenv.cmo \ + driver/main_args.cmo driver/compmisc.cmo \ driver/makedepend.cmo \ driver/compile_common.cmo @@ -161,6 +157,7 @@ ASMCOMP=\ asmcomp/afl_instrument.cmo \ asmcomp/strmatch.cmo \ asmcomp/cmmgen_state.cmo \ + asmcomp/cmm_helpers.cmo \ asmcomp/cmmgen.cmo \ asmcomp/interval.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo \ @@ -173,7 +170,7 @@ ASMCOMP=\ asmcomp/linscan.cmo \ asmcomp/reloadgen.cmo asmcomp/reload.cmo \ asmcomp/deadcode.cmo \ - asmcomp/printlinear.cmo asmcomp/linearize.cmo \ + asmcomp/linear.cmo asmcomp/printlinear.cmo asmcomp/linearize.cmo \ asmcomp/debug/available_regs.cmo \ asmcomp/debug/compute_ranges_intf.cmo \ asmcomp/debug/compute_ranges.cmo \ @@ -189,7 +186,8 @@ ASMCOMP=\ # the native code compiler is not present for some particular target. MIDDLE_END_CLOSURE=\ - middle_end/closure/closure.cmo + middle_end/closure/closure.cmo \ + middle_end/closure/closure_middle_end.cmo # Owing to dependencies through [Compilenv], which would be # difficult to remove, some of the lower parts of Flambda (anything that is @@ -323,19 +321,25 @@ endif # The configuration file -utils/config.ml: utils/config.mlp Makefile.config utils/Makefile Makefile +utils/config.ml: utils/config.mlp Makefile.config utils/Makefile $(MAKE) -C utils config.ml .PHONY: reconfigure reconfigure: - ./configure $(CONFIGURE_ARGS) + ac_read_git_config=true ./configure $(CONFIGURE_ARGS) + +utils/domainstate.ml: utils/domainstate.ml.c runtime/caml/domain_state.tbl + $(CPP) -I runtime/caml $< > $@ + +utils/domainstate.mli: utils/domainstate.mli.c runtime/caml/domain_state.tbl + $(CPP) -I runtime/caml $< > $@ .PHONY: partialclean partialclean:: - rm -f utils/config.ml + rm -f utils/config.ml utils/domainstate.ml utils/domainstate.mli .PHONY: beforedepend -beforedepend:: utils/config.ml +beforedepend:: utils/config.ml utils/domainstate.ml utils/domainstate.mli # Start up the system from the distribution compiler .PHONY: coldstart @@ -399,7 +403,7 @@ opt-core: runtimeopt $(MAKE) libraryopt .PHONY: opt -opt: +opt: checknative $(MAKE) runtimeopt $(MAKE) ocamlopt $(MAKE) libraryopt @@ -407,7 +411,7 @@ opt: # Native-code versions of the tools .PHONY: opt.opt -opt.opt: +opt.opt: checknative $(MAKE) checkstack $(MAKE) runtime $(MAKE) core @@ -419,6 +423,9 @@ opt.opt: $(MAKE) otherlibrariesopt $(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \ ocamltest.opt +ifneq "$(WITH_OCAMLDOC)" "" + $(MAKE) manpages +endif # Core bootstrapping cycle .PHONY: coreboot @@ -446,6 +453,9 @@ coreboot: all: coreall $(MAKE) ocaml $(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) ocamltest +ifneq "$(WITH_OCAMLDOC)" "" + $(MAKE) manpages +endif # Bootstrap and rebuild the whole system. # The compilation of ocaml will fail if the runtime has changed. @@ -462,7 +472,8 @@ world: coldstart # Compile also native code compiler and libraries, fast .PHONY: world.opt -world.opt: coldstart +world.opt: checknative + $(MAKE) coldstart $(MAKE) opt.opt # FlexDLL sources missing error messages @@ -601,9 +612,9 @@ endif # from an previous installation of OCaml before otherlibs/num was removed. rm -f "$(INSTALL_LIBDIR)"/num.cm? # End transitional - if test -n "$(WITH_OCAMLDOC)"; then \ - $(MAKE) -C ocamldoc install; \ - fi +ifneq "$(WITH_OCAMLDOC)" "" + $(MAKE) -C ocamldoc install +endif if test -n "$(WITH_DEBUGGER)"; then \ $(MAKE) -C debugger install; \ fi @@ -679,9 +690,9 @@ endif $(INSTALL_DATA) \ $(OPTSTART) \ "$(INSTALL_COMPLIBDIR)" - if test -n "$(WITH_OCAMLDOC)"; then \ - $(MAKE) -C ocamldoc installopt; \ - fi +ifneq "$(WITH_OCAMLDOC)" "" + $(MAKE) -C ocamldoc installopt +endif for i in $(OTHERLIBRARIES); do \ $(MAKE) -C otherlibs/$$i installopt || exit $$?; \ done @@ -859,7 +870,7 @@ otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/native/dynlink.ml # The lexer parsing/lexer.ml: parsing/lexer.mll - $(CAMLLEX) $< + $(CAMLLEX) $(OCAMLLEX_FLAGS) $< partialclean:: rm -f parsing/lexer.ml @@ -1026,7 +1037,7 @@ partialclean:: # The lexer and parser generators .PHONY: ocamllex -ocamllex: ocamlyacc ocamlc +ocamllex: ocamlyacc $(MAKE) -C lex all .PHONY: ocamllex.opt @@ -1068,7 +1079,8 @@ include Makefile.menhir parsing/camlinternalMenhirLib.ml: boot/menhir/menhirLib.ml cp $< $@ parsing/camlinternalMenhirLib.mli: boot/menhir/menhirLib.mli - cp $< $@ + echo '[@@@ocaml.warning "-67"]' > $@ + cat $< >> $@ # Copy parsing/parser.ml from boot/ @@ -1079,6 +1091,9 @@ parsing/parser.ml: boot/menhir/parser.ml parsing/parser.mly \ parsing/parser.mli: boot/menhir/parser.mli sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@ +beforedepend:: parsing/camlinternalMenhirLib.ml \ + parsing/camlinternalMenhirLib.mli \ + parsing/parser.ml parsing/parser.mli partialclean:: partialclean-menhir @@ -1095,10 +1110,10 @@ ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex # OCamltest ocamltest: ocamlc ocamlyacc ocamllex - $(MAKE) -C ocamltest + $(MAKE) -C ocamltest all ocamltest.opt: ocamlc.opt ocamlyacc ocamllex - $(MAKE) -C ocamltest ocamltest.opt$(EXE) + $(MAKE) -C ocamltest allopt partialclean:: $(MAKE) -C ocamltest clean @@ -1110,6 +1125,10 @@ html_doc: ocamldoc $(MAKE) -C ocamldoc $@ @echo "documentation is in ./ocamldoc/stdlib_html/" +.PHONY: manpages +manpages: + $(MAKE) -C ocamldoc $@ + partialclean:: $(MAKE) -C ocamldoc clean @@ -1138,6 +1157,16 @@ ocamldebugger: ocamlc ocamlyacc ocamllex otherlibraries partialclean:: $(MAKE) -C debugger clean +# Check that the native-code compiler is supported +.PHONY: checknative +checknative: +ifeq "$(ARCH)" "none" +checknative: + $(error The native-code compiler is not supported on this platform) +else + @ +endif + # Check that the stack limit is reasonable (Unix-only) .PHONY: checkstack checkstack: @@ -1277,7 +1306,7 @@ endif $(CAMLC) $(COMPFLAGS) -c $< .ml.cmx: - $(CAMLOPT) $(COMPFLAGS) -c $< + $(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $< partialclean:: for d in utils parsing typing bytecomp asmcomp middle_end file_formats \ @@ -1307,3 +1336,15 @@ distclean: clean rm -f testsuite/_log* include .depend + +Makefile.config Makefile.common: + @echo "Please refer to the installation instructions:" + @echo "- In file INSTALL for Unix systems." + @echo "- In file README.win32.adoc for Windows systems." + @echo "On Unix systems, if you've just unpacked the distribution," + @echo "something like" + @echo " ./configure" + @echo " make" + @echo " make install" + @echo "should work." + @false diff --git a/Makefile.best_binaries b/Makefile.best_binaries new file mode 100644 index 00000000..d9f4ec7b --- /dev/null +++ b/Makefile.best_binaries @@ -0,0 +1,46 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* Gabriel Scherer, projet Parsifal, INRIA Saclay * +#* * +#* Copyright 2019 Institut National de Recherche en Informatique et * +#* en Automatique. * +#* * +#* All rights reserved. This file is distributed under the terms of * +#* the GNU Lesser General Public License version 2.1, with the * +#* special exception on linking described in the file LICENSE. * +#* * +#************************************************************************** + +# This Makefile should be included. + +# It expects: +# - Makefile.common to be included as well +# - a ROOTDIR variable pointing to the repository root +# relative to the including Makefile + +# It exports definitions of BEST_OCAML{C,OPT,LEX,DEP} commands that +# run to either the bytecode binary built in the repository or the +# native binary, if available. Note that they never use the boot/ +# versions: we assume that ocamlc, ocamlopt, etc. have been run first. + +check_not_stale = \ + $(if $(shell test $(ROOTDIR)/$1 -nt $(ROOTDIR)/$2 && echo stale), \ + $(info Warning: we are not using the native binary $2 \ +because it is older than the bytecode binary $1; \ +you should silence this warning by either removing $2 \ +or rebuilding it (or `touch`-ing it) if you want it used.), \ + ok) + +choose_best = $(strip $(if \ + $(and $(wildcard $(ROOTDIR)/$1.opt),$(strip \ + $(call check_not_stale,$1,$1.opt))), \ + $(ROOTDIR)/$1.opt, \ + $(CAMLRUN) $(ROOTDIR)/$1)) + +BEST_OCAMLC := $(call choose_best,ocamlc) +BEST_OCAMLOPT := $(call choose_best,ocamlopt) +BEST_OCAMLLEX := $(call choose_best,lex/ocamllex) + +BEST_OCAMLDEP := $(BEST_OCAMLC) -depend diff --git a/Makefile.common.in b/Makefile.common.in index 3e0e59c6..f389d5b0 100644 --- a/Makefile.common.in +++ b/Makefile.common.in @@ -1,3 +1,5 @@ +# @configure_input@ + #************************************************************************** #* * #* OCaml * @@ -13,7 +15,8 @@ #* * #************************************************************************** -# This makefile contains common definitions shared by other Makefiles +# This makefile contains common definitions and rules shared by +# other Makefiles # We assume that Makefile.config has already been included INSTALL ?= @INSTALL@ @@ -24,6 +27,7 @@ INSTALL_PROG ?= $(INSTALL) -m u=rwx,g=rwx,o=rx # as some parts of the makefiles change BINDIR, etc. # and expect INSTALL_BINDIR, etc. to stay in synch # (see `shellquote` in tools/Makefile) +DESTDIR ?= INSTALL_BINDIR = $(DESTDIR)$(BINDIR) INSTALL_LIBDIR = $(DESTDIR)$(LIBDIR) INSTALL_STUBLIBDIR = $(DESTDIR)$(STUBLIBDIR) @@ -62,6 +66,9 @@ else ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt) endif +# By default, request ocamllex to be quiet +OCAMLLEX_FLAGS ?= -q + # The rule to compile C files # This rule is similar to GNU make's implicit rule, except that it is more diff --git a/Makefile.config.in b/Makefile.config.in index 95db931f..6d373239 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -56,7 +56,10 @@ LIBRARIES_MAN_SECTION=@libraries_man_section@ ### Beware: on some systems (e.g. SunOS 4), this will work only if ### the string "#!$(BINDIR)/ocamlrun" is less than 32 characters long. ### In doubt, set HASHBANGSCRIPTS to false. -HASHBANGSCRIPTS=@hashbangscripts@ +SHEBANGSCRIPTS=@shebangscripts@ +LONG_SHEBANG=@long_shebang@ +# For compatibility +HASHBANGSCRIPTS:=$(SHEBANGSCRIPTS) ### Path to the libtool script LIBTOOL = $(TOP_BUILDDIR)/libtool @@ -110,6 +113,9 @@ RPATH=@rpath@ ############# Configuration for the native-code compiler +### Whether the native compiler has been enabled or not +NATIVE_COMPILER=@native_compiler@ + ### Name of architecture for the native-code compiler ### Currently supported: ### @@ -229,7 +235,9 @@ WINDOWS_UNICODE=@windows_unicode@ AFL_INSTRUMENT=@afl@ MAX_TESTSUITE_DIR_RETRIES=@max_testsuite_dir_retries@ FLAT_FLOAT_ARRAY=@flat_float_array@ +FUNCTION_SECTIONS=@function_sections@ AWK=@AWK@ +STDLIB_MANPAGES=@stdlib_manpages@ ### Native command to build ocamlrun.exe @@ -251,7 +259,6 @@ endif # ifeq "$(TOOLCHAIN)" "msvc" # in the future their definition may be moved to a more private part of # the compiler's build system ifeq "$(UNIX_OR_WIN32)" "win32" - DISTRIB=$(prefix) OTOPDIR=$(WINTOPDIR) CTOPDIR=$(WINTOPDIR) CYGPATH=cygpath -m @@ -266,4 +273,7 @@ ifeq "$(UNIX_OR_WIN32)" "win32" # (see ocamlmklibconfig.ml in tools/Makefile) FLEXLINK_FLAGS=@flexlink_flags@ FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS) +else # ifeq "$(UNIX_OR_WIN32)" "win32" + # On Unix, make sure FLEXLINK is defined but empty + FLEXLINK = endif # ifeq "$(UNIX_OR_WIN32)" "win32" diff --git a/Makefile.dev b/Makefile.dev index de69a1bf..90a69dec 100644 --- a/Makefile.dev +++ b/Makefile.dev @@ -45,4 +45,4 @@ list-all-asts: @for f in $(AST_FILES); do echo "'$$f'"; done partialclean:: - rm -f $(AST_FILES) + @rm -f $(AST_FILES) diff --git a/Makefile.tools b/Makefile.tools index 0026b2e0..1319b788 100644 --- a/Makefile.tools +++ b/Makefile.tools @@ -16,8 +16,7 @@ # This makefile provides variables for using the in-tree compiler, # interpreter, lexer and other associated tools. It is intended to be # included within other makefiles. -# See testsuite/makefiles/Makefile.common, manual/tools/Makefile and -# manual/manual/tutorials/Makefile as examples. +# See manual/tools/Makefile and manual/manual/tutorials/Makefile as examples. # Note that these makefile should define the $(TOPDIR) variable on their # own. @@ -50,6 +49,9 @@ SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)" include $(TOPDIR)/Makefile.config +# Make sure USE_RUNTIME is defined +USE_RUNTIME ?= + ifneq ($(USE_RUNTIME),) #Check USE_RUNTIME value ifeq ($(findstring $(USE_RUNTIME),d i),) @@ -99,8 +101,6 @@ OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \ OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE) DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo -BYTECODE_ONLY=[ "$(ARCH)" = "none" -o "$(ASM)" = "none" ] -NATIVECODE_ONLY=false #FORTRAN_COMPILER= #FORTRAN_LIBRARY= diff --git a/News b/News index 94371099..79f3f72f 100644 --- a/News +++ b/News @@ -156,7 +156,7 @@ Some highlights include: - Instrumentation support for fuzzing with afl-fuzz. (GPR#504, by Stephen Dolan) -- The compilers now accept new `-args/-args0 ` comand-line +- The compilers now accept new `-args/-args0 ` command-line parameters to provide extra command-line arguments in a file. User programs may implement similar options using the new `Expand` constructor of the `Arg` module. diff --git a/README.win32.adoc b/README.win32.adoc index c8ab81c4..d6da9138 100644 --- a/README.win32.adoc +++ b/README.win32.adoc @@ -191,7 +191,7 @@ the top-level of the OCaml distribution by running: eval $(tools/msvs-promote-path) -If you forget to do this, `make world.opt` will fail relatively +If you forget to do this, `make` will fail relatively quickly as it will be unable to link `ocamlrun`. Now run: @@ -202,13 +202,11 @@ for 32-bit, or: ./configure --build=x86_64-unknown-cygwin --host=x86_64-pc-windows -for 64-bit. Then, edit `Makefile.config` as needed, following the comments in -this file. Normally, the only variable that needs to be changed is `PREFIX`, -which indicates where to install everything. +for 64-bit. Finally, use `make` to build the system, e.g. - make world.opt + make make install After installing, it is not necessary to keep the Cygwin installation (although @@ -269,13 +267,11 @@ for 32-bit, or: ./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32 -for 64-bit. Then, edit `Makefile.config` as needed, following the comments in -this file. Normally, the only variable that needs to be changed is `PREFIX`, -which indicates where to install everything. +for 64-bit. Finally, use `make` to build the system, e.g. - make world.opt + make make install After installing, you will need to ensure that `ocamlopt` (or `ocamlc -custom`) @@ -314,10 +310,10 @@ done in one of three ways: git submodule update --init OCaml is then compiled as normal for the port you require, except that before -compiling `world`, you must compile `flexdll`, i.e.: +building the compiler itself, you must compile `flexdll`, i.e.: make flexdll - make world.opt + make make flexlink.opt make install diff --git a/VERSION b/VERSION index ea176747..98eeedd7 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -4.09.1 +4.10.0 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli diff --git a/aclocal.m4 b/aclocal.m4 index ff12869a..5ac1b729 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -86,6 +86,14 @@ AC_DEFUN([OCAML_CC_HAS_FNO_TREE_VRP], [ CFLAGS="$saved_CFLAGS" ]) +AC_DEFUN([OCAML_CC_SUPPORTS_ALIGNED], [ + AC_MSG_CHECKING([whether the C compiler supports __attribute__((aligned(n)))]) + AC_COMPILE_IFELSE( + [AC_LANG_SOURCE([typedef struct {__attribute__((aligned(8))) int t;} t;])], + [AC_DEFINE([SUPPORTS_ALIGNED_ATTRIBUTE]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])])]) + AC_DEFUN([OCAML_CC_HAS_DEBUG_PREFIX_MAP], [ AC_MSG_CHECKING([whether the C compiler supports -fdebug-prefix-map]) saved_CFLAGS="$CFLAGS" diff --git a/asmcomp/amd64/CSE.ml b/asmcomp/amd64/CSE.ml index 1c2ec7ee..60503d69 100644 --- a/asmcomp/amd64/CSE.ml +++ b/asmcomp/amd64/CSE.ml @@ -27,7 +27,7 @@ method! class_of_operation op = match op with | Ispecific spec -> begin match spec with - | Ilea _ | Isextend32 -> Op_pure + | Ilea _ | Isextend32 | Izextend32 -> Op_pure | Istore_int(_, _, is_asg) -> Op_store is_asg | Ioffset_loc(_, _) -> Op_store true | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load diff --git a/asmcomp/amd64/arch.ml b/asmcomp/amd64/arch.ml index 62ba8808..effe32ed 100644 --- a/asmcomp/amd64/arch.ml +++ b/asmcomp/amd64/arch.ml @@ -44,6 +44,9 @@ type specific_operation = | Ifloatsqrtf of addressing_mode (* Float square root from memory *) | Isextend32 (* 32 to 64 bit conversion with sign extension *) + | Izextend32 (* 32 to 64 bit conversion with zero + extension *) + and float_operation = Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv @@ -130,6 +133,8 @@ let print_specific_operation printreg op ppf arg = fprintf ppf "bswap_%i %a" i printreg arg.(0) | Isextend32 -> fprintf ppf "sextend32 %a" printreg arg.(0) + | Izextend32 -> + fprintf ppf "zextend32 %a" printreg arg.(0) let win64 = match Config.system with diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index e5b42b83..e3ff9653 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -21,7 +21,7 @@ open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux open X86_ast @@ -70,12 +70,17 @@ let fp = Config.with_frame_pointers let fastcode_flag = ref true +(* Layout of the stack frame *) let stack_offset = ref 0 -(* Layout of the stack frame *) +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false + +let frame_required = ref false let frame_size () = (* includes return address *) - if frame_required() then begin + if !frame_required then begin let sz = (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8 + (if fp then 8 else 0)) @@ -154,6 +159,9 @@ let load_symbol_addr s arg = else I.mov (sym (emit_symbol s)) arg +let domain_field f = + mem64 QWORD (Domainstate.idx_of_field f * 8) R14 + (* Output a label *) let emit_label lbl = @@ -273,7 +281,8 @@ let spacetime_before_uninstrumented_call ~node_ptr ~index = (* Record calls to the GC -- we've moved them out of the way *) type gc_call = - { gc_lbl: label; (* Entry label *) + { gc_size: int; (* Allocation size, in bytes *) + gc_lbl: label; (* Entry label *) gc_return_lbl: label; (* Where to branch after GC *) gc_frame: label; (* Label of frame descriptor *) gc_spacetime : (X86_ast.arg * int) option; @@ -290,7 +299,13 @@ let emit_call_gc gc = assert Config.spacetime; spacetime_before_uninstrumented_call ~node_ptr ~index end; - emit_call "caml_call_gc"; + begin match gc.gc_size with + | 16 -> emit_call "caml_call_gc1" + | 24 -> emit_call "caml_call_gc2" + | 32 -> emit_call "caml_call_gc3" + | n -> I.add (int n) r15; + emit_call "caml_call_gc" + end; def_label gc.gc_frame; I.jmp (label gc.gc_return_lbl) @@ -432,7 +447,7 @@ let emit_float_test cmp i lbl = (* Deallocate the stack frame before a return or tail call *) let output_epilogue f = - if frame_required() then begin + if !frame_required then begin let n = frame_size() - 8 - (if fp then 8 else 0) in if n <> 0 then begin @@ -471,6 +486,26 @@ let emit_global_label s = D.global lbl; _label lbl +(* Output .text section directive, or named .text.caml. if enabled and + supported on the target system. *) + +let emit_named_text_section func_name = + if !Clflags.function_sections then + begin match system with + | S_macosx + (* Names of section segments in macosx are restricted to 16 characters, + but function names are often longer, especially anonymous functions. *) + | S_win64 | S_mingw64 | S_cygwin + (* Win systems provide named text sections, but configure on these + systems does not support function sections. *) + -> assert false + | _ -> D.section + [ ".text.caml."^(emit_symbol func_name) ] + (Some "ax") + ["@progbits"] + end + else D.text () + (* Output the assembly code for an instruction *) (* Name of current function *) @@ -484,13 +519,13 @@ let emit_instr fallthrough i = match i.desc with | Lend -> () | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); if fp then begin I.push rbp; cfi_adjust_cfa_offset 8; I.mov rsp rbp; end; - if frame_required() then begin + if !frame_required then begin let n = frame_size() - 8 - (if fp then 8 else 0) in if n <> 0 then begin @@ -509,10 +544,21 @@ let emit_instr fallthrough i = | Lop(Iconst_int n) -> if n = 0n then begin match i.res.(0).loc with - | Reg _ -> I.xor (res i 0) (res i 0) - | _ -> I.mov (int 0) (res i 0) - end - else + | Reg _ -> + (* Clearing the bottom half also clears the top half (except for + 64-bit-only registers where the behaviour is as if the operands + were 64 bit). *) + I.xor (res32 i 0) (res32 i 0) + | _ -> + I.mov (int 0) (res i 0) + end else if n > 0n && n <= 0xFFFF_FFFFn then begin + match i.res.(0).loc with + | Reg _ -> + (* Similarly, setting only the bottom half clears the top half. *) + I.mov (nat n) (res32 i 0) + | _ -> + I.mov (nat n) (res i 0) + end else I.mov (nat n) (res i 0) | Lop(Iconst_float f) -> begin match f with @@ -567,8 +613,7 @@ let emit_instr fallthrough i = If we do the same for Win64, we probably need to change amd64nt.asm accordingly. *) - load_symbol_addr "caml_young_ptr" r11; - I.mov (mem64 QWORD 0 R11) r15 + I.mov (domain_field Domainstate.Domain_young_ptr) r15 end end else begin emit_call func; @@ -627,24 +672,7 @@ let emit_instr fallthrough i = let lbl_redo = new_label() in def_label lbl_redo; I.sub (int n) r15; - let spacetime_node_hole_ptr_is_in_rax = - Config.spacetime && (i.arg.(0).loc = Reg 0) - in - if !Clflags.dlcode then begin - (* When using Spacetime, %rax might be the node pointer, so we - must take care not to clobber it. (Whilst we can tell the - register allocator that %rax is destroyed by Ialloc, we can't - force that the argument (the node pointer) is not in %rax.) *) - if spacetime_node_hole_ptr_is_in_rax then begin - I.push rax - end; - load_symbol_addr "caml_young_limit" rax; - I.cmp (mem64 QWORD 0 RAX) r15; - if spacetime_node_hole_ptr_is_in_rax then begin - I.pop rax (* this does not affect the flags *) - end - end else - I.cmp (mem64_rip QWORD (emit_symbol "caml_young_limit")) r15; + I.cmp (domain_field Domainstate.Domain_young_limit) r15; let lbl_call_gc = new_label() in let dbg = if not Config.spacetime then Debuginfo.none @@ -660,7 +688,8 @@ let emit_instr fallthrough i = else Some (arg i 0, spacetime_index) in call_gc_sites := - { gc_lbl = lbl_call_gc; + { gc_size = n; + gc_lbl = lbl_call_gc; gc_return_lbl = lbl_redo; gc_frame = lbl_frame; gc_spacetime; } :: !call_gc_sites @@ -757,11 +786,16 @@ let emit_instr fallthrough i = | Lop(Ispecific(Ibswap _)) -> assert false | Lop(Ispecific Isqrtf) -> + if arg i 0 <> res i 0 then + I.xorpd (res i 0) (res i 0); (* avoid partial register stall *) I.sqrtsd (arg i 0) (res i 0) | Lop(Ispecific(Ifloatsqrtf addr)) -> + I.xorpd (res i 0) (res i 0); (* avoid partial register stall *) I.sqrtsd (addressing addr REAL8 i 0) (res i 0) | Lop(Ispecific(Isextend32)) -> I.movsxd (arg32 i 0) (res i 0) + | Lop(Ispecific(Izextend32)) -> + I.mov (arg32 i 0) (res32 i 0) | Lop (Iname_for_debugger _) -> () | Lreloadretaddr -> () @@ -813,7 +847,7 @@ let emit_instr fallthrough i = end; begin match lbl2 with | None -> () - | Some lbl -> I.jg (label lbl) + | Some lbl -> I.ja (label lbl) end | Lswitch jumptbl -> let lbl = emit_label (new_label()) in @@ -844,9 +878,14 @@ let emit_instr fallthrough i = D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)), ConstLabel lbl)) done; - D.text () + emit_named_text_section !function_name | Lentertrap -> () + | Ladjust_trap_depth { delta_traps; } -> + (* each trap occupies 16 bytes on the stack *) + let delta = 16 * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> let load_label_addr s arg = if !Clflags.pic_code then @@ -854,15 +893,15 @@ let emit_instr fallthrough i = else I.mov (sym (emit_label s)) arg in - cfi_adjust_cfa_offset 16; - I.sub (int 16) rsp; + load_label_addr lbl_handler r11; + I.push r11; + cfi_adjust_cfa_offset 8; + I.push (domain_field Domainstate.Domain_exception_pointer); + cfi_adjust_cfa_offset 8; + I.mov rsp (domain_field Domainstate.Domain_exception_pointer); stack_offset := !stack_offset + 16; - I.mov r14 (mem64 QWORD 0 RSP); - load_label_addr lbl_handler r14; - I.mov r14 (mem64 QWORD 8 RSP); - I.mov rsp r14 | Lpoptrap -> - I.pop r14; + I.pop (domain_field Domainstate.Domain_exception_pointer); cfi_adjust_cfa_offset (-8); I.add (int 8) rsp; cfi_adjust_cfa_offset (-8); @@ -872,12 +911,16 @@ let emit_instr fallthrough i = [caml_reraise_exn]. The only function called that might affect the trie is [caml_stash_backtrace], and it does not. *) begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular -> + I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos); + emit_call "caml_raise_exn"; + record_frame Reg.Set.empty true i.dbg + | Lambda.Raise_reraise -> emit_call "caml_raise_exn"; record_frame Reg.Set.empty true i.dbg - | Cmm.Raise_notrace -> - I.mov r14 rsp; - I.pop r14; + | Lambda.Raise_notrace -> + I.mov (domain_field Domainstate.Domain_exception_pointer) rsp; + I.pop (domain_field Domainstate.Domain_exception_pointer); I.pop r11; I.jmp r11 end @@ -887,7 +930,7 @@ let rec emit_all fallthrough i = | Lend -> () | _ -> emit_instr fallthrough i; - emit_all (Linearize.has_fallthrough i.desc) i.next + emit_all (Linear.has_fallthrough i.desc) i.next let all_functions = ref [] @@ -901,8 +944,13 @@ let fundecl fundecl = call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + prologue_required := fundecl.fun_prologue_required; + frame_required := fundecl.fun_frame_required; all_functions := fundecl :: !all_functions; - D.text (); + emit_named_text_section !function_name; D.align 16; add_def_symbol fundecl.fun_name; if system = S_macosx @@ -918,7 +966,7 @@ let fundecl fundecl = emit_all true fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; emit_call_bound_errors (); - if frame_required() then begin + if !frame_required then begin let n = frame_size() - 8 - (if fp then 8 else 0) in if n <> 0 then begin @@ -966,10 +1014,10 @@ let begin_assembly() = float_constants := []; all_functions := []; if system = S_win64 then begin - D.extrn "caml_young_ptr" QWORD; - D.extrn "caml_young_limit" QWORD; - D.extrn "caml_exception_pointer" QWORD; D.extrn "caml_call_gc" NEAR; + D.extrn "caml_call_gc1" NEAR; + D.extrn "caml_call_gc2" NEAR; + D.extrn "caml_call_gc3" NEAR; D.extrn "caml_c_call" NEAR; D.extrn "caml_allocN" NEAR; D.extrn "caml_alloc1" NEAR; @@ -1001,7 +1049,7 @@ let begin_assembly() = D.data (); emit_global_label "data_begin"; - D.text (); + emit_named_text_section (Compilenv.make_symbol (Some "code_begin")); emit_global_label "code_begin"; if system = S_macosx then I.nop (); (* PR#4690 *) () @@ -1051,7 +1099,7 @@ let end_assembly() = List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants end; - D.text (); + emit_named_text_section (Compilenv.make_symbol (Some "code_end")); if system = S_macosx then I.nop (); (* suppress "ld warning: atom sorting error" *) diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml index 4c3c636b..c64ad9a0 100644 --- a/asmcomp/amd64/proc.ml +++ b/asmcomp/amd64/proc.ml @@ -44,7 +44,7 @@ let win64 = Arch.win64 r10 10 r11 11 rbp 12 - r14 trap pointer + r14 domain state pointer r15 allocation pointer xmm0 - xmm15 100 - 115 *) @@ -325,6 +325,7 @@ let destroyed_at_oper = function | Iop (Iintop_imm(Icheckbound _, _)) when Config.spacetime -> [| loc_spacetime_node_hole |] | Iswitch(_, _) -> [| rax; rdx |] + | Itrywith _ -> [| r11 |] | _ -> if fp then (* prevent any use of the frame pointer ! *) @@ -368,20 +369,18 @@ let op_is_pure = function | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false - | Ispecific(Ilea _|Isextend32) -> true + | Ispecific(Ilea _|Isextend32|Izextend32) -> true | Ispecific _ -> false | _ -> true (* Layout of the stack frame *) -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false +let frame_required fd = + fp || fd.fun_contains_calls || + fd.fun_num_stack_slots.(0) > 0 || fd.fun_num_stack_slots.(1) > 0 -let frame_required () = - fp || !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0 - -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml index a4070b47..16819c09 100644 --- a/asmcomp/amd64/reload.ml +++ b/asmcomp/amd64/reload.ml @@ -124,5 +124,5 @@ method! reload_test tst arg = end -let fundecl f = - (new reload)#fundecl f +let fundecl f num_stack_slots = + (new reload)#fundecl f num_stack_slots diff --git a/asmcomp/amd64/scheduling.ml b/asmcomp/amd64/scheduling.ml index ad146c50..2c4b072b 100644 --- a/asmcomp/amd64/scheduling.ml +++ b/asmcomp/amd64/scheduling.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -let _ = let module M = Schedgen in () (* to create a dependency *) +open! Schedgen (* to create a dependency *) (* Scheduling is turned off because the processor schedules dynamically much better than what we could do. *) diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml index 3fd47b7b..bd7871cf 100644 --- a/asmcomp/amd64/selection.ml +++ b/asmcomp/amd64/selection.ml @@ -238,6 +238,16 @@ method! select_operation op args dbg = (Ispecific Isextend32, [k]) | _ -> super#select_operation op args dbg end + (* Recognize zero extension *) + | Cand -> + begin match args with + | [arg; Cconst_int (0xffff_ffff, _)] + | [arg; Cconst_natint (0xffff_ffffn, _)] + | [Cconst_int (0xffff_ffff, _); arg] + | [Cconst_natint (0xffff_ffffn, _); arg] -> + Ispecific Izextend32, [arg] + | _ -> super#select_operation op args dbg + end | _ -> super#select_operation op args dbg (* Recognize float arithmetic with mem *) @@ -259,7 +269,7 @@ method select_floatarith commutative regular_op mem_op args = assert false method! mark_c_tailcall = - Proc.contains_calls := true + contains_calls := true (* Deal with register constraints *) diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 00d01748..1393d457 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -23,7 +23,7 @@ open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux (* Tradeoff between code size and code speed *) @@ -60,6 +60,12 @@ let emit_reg = function let stack_offset = ref 0 +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false + +let contains_calls = ref false + let frame_size () = let sz = !stack_offset + @@ -435,6 +441,16 @@ let emit_load_handler_address handler = ` add lr, pc, lr\n`; 2 + +(* Output .text section directive, or named .text.caml. if enabled. *) + +let emit_named_text_section func_name = + if !Clflags.function_sections then begin + ` .section .text.caml.{emit_symbol func_name},{emit_string_literal "ax"},%progbits\n` + end + else + ` .text\n` + (* Output the assembly code for an instruction *) let emit_instr i = @@ -442,7 +458,7 @@ let emit_instr i = match i.desc with | Lend -> 0 | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); let n = frame_size() in let num_instrs = if n > 0 then begin @@ -633,14 +649,22 @@ let emit_instr i = if !fastcode_flag then begin let lbl_redo = new_label() in `{emit_label lbl_redo}:`; - let ninstr = decompose_intconst - (Int32.of_int n) - (fun i -> - ` sub alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in - ` cmp alloc_ptr, alloc_limit\n`; - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; + let first = ref true in + let ninstr = + decompose_intconst (Int32.of_int (n - 4)) (fun a -> + if !first + then ` sub {emit_reg i.res.(0)}, alloc_ptr, #{emit_int32 a}\n` + else ` sub {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #{emit_int32 a}\n`; + first := false) in + let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in + let tmp = if i.res.(0).loc = Reg 8 (* r12 *) then phys_reg 7 (* r7 *) + else phys_reg 8 (* r12 *) + in + ` ldr {emit_reg tmp}, [domain_state_ptr, {emit_int offset}]\n`; + ` cmp {emit_reg i.res.(0)}, {emit_reg tmp}\n`; let lbl_call_gc = new_label() in - ` bcc {emit_label lbl_call_gc}\n`; + ` bls {emit_label lbl_call_gc}\n`; + ` sub alloc_ptr, {emit_reg i.res.(0)}, #4\n`; call_gc_sites := { gc_lbl = lbl_call_gc; gc_return_lbl = lbl_redo; @@ -866,6 +890,11 @@ let emit_instr i = end | Lentertrap -> 0 + | Ladjust_trap_depth { delta_traps } -> + (* each trap occupies 8 bytes on the stack *) + let delta = 8 * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta; 0 | Lpushtrap { lbl_handler; } -> let s = emit_load_handler_address lbl_handler in stack_offset := !stack_offset + 8; @@ -878,10 +907,16 @@ let emit_instr i = stack_offset := !stack_offset - 8; 1 | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular -> + let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in + ` mov r12, #0\n`; + ` str r12, [domain_state_ptr, {emit_int offset}]\n`; + ` {emit_call "caml_raise_exn"}\n`; + `{record_frame Reg.Set.empty true i.dbg}\n`; 3 + | Lambda.Raise_reraise -> ` {emit_call "caml_raise_exn"}\n`; `{record_frame Reg.Set.empty true i.dbg}\n`; 1 - | Cmm.Raise_notrace -> + | Lambda.Raise_notrace -> ` mov sp, trap_ptr\n`; ` pop \{trap_ptr, pc}\n`; 2 end @@ -939,7 +974,12 @@ let fundecl fundecl = stack_offset := 0; call_gc_sites := []; bound_error_sites := []; - ` .text\n`; + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + contains_calls := fundecl.fun_contains_calls; + prologue_required := fundecl.fun_prologue_required; + emit_named_text_section !function_name; ` .align 2\n`; ` .globl {emit_symbol fundecl.fun_name}\n`; if !arch > ARMv6 && !thumb then @@ -1001,19 +1041,19 @@ let begin_assembly() = end; `trap_ptr .req r8\n`; `alloc_ptr .req r10\n`; - `alloc_limit .req r11\n`; + `domain_state_ptr .req r11\n`; let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ` .data\n`; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n`; let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .text\n`; + emit_named_text_section lbl_begin; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n` let end_assembly () = let lbl_end = Compilenv.make_symbol (Some "code_end") in - ` .text\n`; + emit_named_text_section lbl_end; ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; let lbl_end = Compilenv.make_symbol (Some "data_end") in diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml index 8ad7bebc..9ac9cf13 100644 --- a/asmcomp/arm/proc.ml +++ b/asmcomp/arm/proc.ml @@ -34,7 +34,7 @@ let word_addressed = false r8 trap pointer (preserved) r9 platform register, usually reserved r10 allocation pointer (preserved) - r11 allocation limit (preserved) + r11 domain state pointer (preserved) r12 intra-procedural scratch register (not preserved) r13 stack pointer r14 return address @@ -342,17 +342,15 @@ let op_is_pure = function (* Layout of the stack *) -let num_stack_slots = [| 0; 0; 0 |] -let contains_calls = ref false - -let frame_required () = - !contains_calls +let frame_required fd = + let num_stack_slots = fd.fun_num_stack_slots in + fd.fun_contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0 || num_stack_slots.(2) > 0 -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/arm/reload.ml b/asmcomp/arm/reload.ml index 9d4f3973..301ec112 100644 --- a/asmcomp/arm/reload.ml +++ b/asmcomp/arm/reload.ml @@ -53,5 +53,5 @@ method! reload_operation op arg res = argres' end -let fundecl f = - (new reload)#fundecl f +let fundecl f num_stack_slots = + (new reload)#fundecl f num_stack_slots diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index a00cbced..eb8424bf 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -24,7 +24,7 @@ open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux (* Tradeoff between code size and code speed *) @@ -33,6 +33,7 @@ let fastcode_flag = ref true (* Names for special regs *) +let reg_domain_state_ptr = phys_reg 22 let reg_trap_ptr = phys_reg 23 let reg_alloc_ptr = phys_reg 24 let reg_alloc_limit = phys_reg 25 @@ -71,6 +72,12 @@ let emit_wreg = function let stack_offset = ref 0 +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false + +let contains_calls = ref false + let frame_size () = let sz = !stack_offset + @@ -495,12 +502,14 @@ module BR = Branch_relaxation.Make (struct + begin match lbl2 with None -> 0 | Some _ -> 1 end | Lswitch jumptbl -> 3 + Array.length jumptbl | Lentertrap -> 0 + | Ladjust_trap_depth _ -> 0 | Lpushtrap _ -> 4 | Lpoptrap -> 1 | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> 1 - | Cmm.Raise_notrace -> 4 + | Lambda.Raise_regular -> 2 + | Lambda.Raise_reraise -> 1 + | Lambda.Raise_notrace -> 4 end let relax_allocation ~num_bytes ~label_after_call_gc = @@ -527,23 +536,26 @@ let assembly_code_for_allocation ?label_after_call_gc i ~n ~far = if !fastcode_flag then begin let lbl_redo = new_label() in let lbl_call_gc = new_label() in - assert (n < 0x1_000_000); - let nl = n land 0xFFF and nh = n land 0xFFF_000 in + (* n is at most Max_young_whsize * 8, i.e. currently 0x808, + so it is reasonable to assume n < 0x1_000. This makes + the generated code simpler. *) + assert (16 <= n && n < 0x1_000 && n land 0x7 = 0); + (* Instead of checking whether young_ptr - n < young_limit, we check whether + young_ptr - (n - 8) <= young_limit. It's equivalent, but this way around + we can avoid mutating young_ptr on failed allocations, by doing the + calculations in i.res.(0) instead of young_ptr. *) `{emit_label lbl_redo}:`; - if nh <> 0 then - ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int nh}\n`; - if nl <> 0 then - ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int nl}\n`; - ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`; - ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`; + ` sub {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #{emit_int (n - 8)}\n`; + ` cmp {emit_reg i.res.(0)}, {emit_reg reg_alloc_limit}\n`; if not far then begin - ` b.lo {emit_label lbl_call_gc}\n` + ` b.ls {emit_label lbl_call_gc}\n` end else begin let lbl = new_label () in - ` b.cs {emit_label lbl}\n`; + ` b.hi {emit_label lbl}\n`; ` b {emit_label lbl_call_gc}\n`; `{emit_label lbl}:\n` end; + ` sub {emit_reg reg_alloc_ptr}, {emit_reg i.res.(0)}, #8\n`; call_gc_sites := { gc_lbl = lbl_call_gc; gc_return_lbl = lbl_redo; @@ -559,6 +571,15 @@ let assembly_code_for_allocation ?label_after_call_gc i ~n ~far = `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n` end +(* Output .text section directive, or named .text.caml. if enabled. *) + +let emit_named_text_section func_name = + if !Clflags.function_sections then begin + ` .section .text.caml.{emit_symbol func_name},{emit_string_literal "ax"},%progbits\n` + end + else + ` .text\n` + (* Output the assembly code for an instruction *) let emit_instr i = @@ -566,7 +587,7 @@ let emit_instr i = match i.desc with | Lend -> () | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); let n = frame_size() in if n > 0 then emit_stack_adjustment (-n); @@ -863,6 +884,11 @@ let emit_instr i = *) | Lentertrap -> () + | Ladjust_trap_depth { delta_traps } -> + (* each trap occupies 16 bytes on the stack *) + let delta = 16 * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> ` adr {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`; stack_offset := !stack_offset + 16; @@ -876,10 +902,15 @@ let emit_instr i = stack_offset := !stack_offset - 16 | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular -> + let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in + ` str xzr, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n`; + ` bl {emit_symbol "caml_raise_exn"}\n`; + `{record_frame Reg.Set.empty true i.dbg}\n` + | Lambda.Raise_reraise -> ` bl {emit_symbol "caml_raise_exn"}\n`; `{record_frame Reg.Set.empty true i.dbg}\n` - | Cmm.Raise_notrace -> + | Lambda.Raise_notrace -> ` mov sp, {emit_reg reg_trap_ptr}\n`; ` ldr {emit_reg reg_tmp1}, [sp, #8]\n`; ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`; @@ -901,7 +932,12 @@ let fundecl fundecl = stack_offset := 0; call_gc_sites := []; bound_error_sites := []; - ` .text\n`; + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + prologue_required := fundecl.fun_prologue_required; + contains_calls := fundecl.fun_contains_calls; + emit_named_text_section !function_name; ` .align 3\n`; ` .globl {emit_symbol fundecl.fun_name}\n`; ` .type {emit_symbol fundecl.fun_name}, %function\n`; @@ -965,13 +1001,13 @@ let begin_assembly() = ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n`; let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .text\n`; + emit_named_text_section lbl_begin; ` .globl {emit_symbol lbl_begin}\n`; `{emit_symbol lbl_begin}:\n` let end_assembly () = let lbl_end = Compilenv.make_symbol (Some "code_end") in - ` .text\n`; + emit_named_text_section lbl_end; ` .globl {emit_symbol lbl_end}\n`; `{emit_symbol lbl_end}:\n`; let lbl_end = Compilenv.make_symbol (Some "data_end") in diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml index 095f22f2..ff0b785d 100644 --- a/asmcomp/arm64/proc.ml +++ b/asmcomp/arm64/proc.ml @@ -33,7 +33,8 @@ let word_addressed = false x0 - x15 general purpose (caller-save) x16, x17 temporaries (used by call veeners) x18 platform register (reserved) - x19 - x25 general purpose (callee-save) + x19 - x24 general purpose (callee-save) + x25 domain state pointer x26 trap pointer x27 alloc pointer x28 alloc limit @@ -49,8 +50,8 @@ let word_addressed = false let int_reg_name = [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7"; "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; - "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25"; - "x26"; "x27"; "x28"; "x16"; "x17" |] + "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; + "x25"; "x26"; "x27"; "x28"; "x16"; "x17" |] let float_reg_name = [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; @@ -66,7 +67,7 @@ let register_class r = | Float -> 1 let num_available_registers = - [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *) + [| 22; 32 |] (* first 22 int regs allocatable; all float regs allocatable *) let first_available_register = [| 0; 100 |] @@ -177,8 +178,8 @@ let loc_exn_bucket = phys_reg 0 let int_dwarf_reg_numbers = [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; - 19; 20; 21; 22; 23; 24; 25; - 26; 27; 28; 16; 17; + 19; 20; 21; 22; 23; 24; + 25; 26; 27; 28; 16; 17; |] let float_dwarf_reg_numbers = @@ -229,15 +230,15 @@ let destroyed_at_reloadretaddr = [| |] let safe_register_pressure = function | Iextcall _ -> 8 - | Ialloc _ -> 25 - | _ -> 26 + | Ialloc _ -> 24 + | _ -> 25 let max_register_pressure = function | Iextcall _ -> [| 10; 8 |] - | Ialloc _ -> [| 25; 32 |] + | Ialloc _ -> [| 24; 32 |] | Iintoffloat | Ifloatofint - | Iload(Single, _) | Istore(Single, _, _) -> [| 26; 31 |] - | _ -> [| 26; 32 |] + | Iload(Single, _) | Istore(Single, _, _) -> [| 25; 31 |] + | _ -> [| 25; 32 |] (* Pure operations (without any side effect besides updating their result registers). *) @@ -250,17 +251,13 @@ let op_is_pure = function | _ -> true (* Layout of the stack *) +let frame_required fd = + fd.fun_contains_calls + || fd.fun_num_stack_slots.(0) > 0 + || fd.fun_num_stack_slots.(1) > 0 -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -let frame_required () = - !contains_calls - || num_stack_slots.(0) > 0 - || num_stack_slots.(1) > 0 - -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/arm64/reload.ml b/asmcomp/arm64/reload.ml index 0d6cacd0..0c342b64 100644 --- a/asmcomp/arm64/reload.ml +++ b/asmcomp/arm64/reload.ml @@ -15,5 +15,5 @@ (* Reloading for the ARM 64 bits *) -let fundecl f = - (new Reloadgen.reload_generic)#fundecl f +let fundecl f num_stack_slots = + (new Reloadgen.reload_generic)#fundecl f num_stack_slots diff --git a/asmcomp/arm64/scheduling.ml b/asmcomp/arm64/scheduling.ml index 04f514e9..86a3c616 100644 --- a/asmcomp/arm64/scheduling.ml +++ b/asmcomp/arm64/scheduling.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -let _ = let module M = Schedgen in () (* to create a dependency *) +open! Schedgen (* to create a dependency *) (* Scheduling is turned off because the processor schedules dynamically much better than what we could do. *) diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index 46f7b270..1f209a50 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -39,60 +39,27 @@ let pass_dump_linear_if ppf flag message phrase = if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase; phrase -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 || !dump_clambda then - begin - Format.fprintf ppf "@.clambda:@."; - 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_dump round fd = if round > 50 then fatal_error(fd.Mach.fun_name ^ ": function too complex, cannot complete register allocation"); dump_if ppf_dump dump_live "Liveness analysis" fd; - if !use_linscan then begin - (* Linear Scan *) - Interval.build_intervals fd; - if !dump_interval then Printmach.intervals ppf_dump (); - Linscan.allocate_registers() - end else begin - (* Graph Coloring *) - Interf.build_graph fd; - if !dump_interf then Printmach.interferences ppf_dump (); - if !dump_prefer then Printmach.preferences ppf_dump (); - Coloring.allocate_registers() - end; + let num_stack_slots = + if !use_linscan then begin + (* Linear Scan *) + Interval.build_intervals fd; + if !dump_interval then Printmach.intervals ppf_dump (); + Linscan.allocate_registers() + end else begin + (* Graph Coloring *) + Interf.build_graph fd; + if !dump_interf then Printmach.interferences ppf_dump (); + if !dump_prefer then Printmach.preferences ppf_dump (); + Coloring.allocate_registers() + end + in dump_if ppf_dump dump_regalloc "After register allocation" fd; - let (newfd, redo_regalloc) = Reload.fundecl fd in + let (newfd, redo_regalloc) = Reload.fundecl fd num_stack_slots in dump_if ppf_dump dump_reload "After insertion of reloading code" newfd; if redo_regalloc then begin Reg.reinit(); Liveness.fundecl newfd; regalloc ~ppf_dump (round + 1) newfd @@ -102,7 +69,6 @@ let (++) x f = f x let compile_fundecl ~ppf_dump fd_cmm = Proc.init (); - Cmmgen.reset (); Reg.reset(); fd_cmm ++ Profile.record ~accumulate:true "selection" Selection.fundecl @@ -143,10 +109,9 @@ let compile_genfuns ~ppf_dump f = | (Cfunction {fun_name = name}) as ph when f name -> compile_phrase ~ppf_dump ph | _ -> ()) - (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()]) + (Cmm_helpers.generic_functions true [Compilenv.current_unit_infos ()]) -let compile_unit _output_prefix asm_filename keep_asm - obj_filename gen = +let compile_unit asm_filename keep_asm obj_filename gen = let create_asm = keep_asm || not !Emitaux.binary_backend_available in Emitaux.create_asm_file := create_asm; Misc.try_finally @@ -167,109 +132,49 @@ let compile_unit _output_prefix asm_filename keep_asm if create_asm && not keep_asm then remove_file asm_filename ) -let set_export_info (ulambda, prealloc, structured_constants, export) = - Compilenv.set_export_info export; - (ulambda, prealloc, structured_constants) - let end_gen_implementation ?toplevel ~ppf_dump - (clambda:clambda_and_constants) = + (clambda : Clambda.with_constants) = Emit.begin_assembly (); clambda - ++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump) + ++ Profile.record "cmm" Cmmgen.compunit ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump)) ++ (fun () -> ()); (match toplevel with None -> () | Some f -> compile_genfuns ~ppf_dump f); - (* We add explicit references to external primitive symbols. This is to ensure that the object files that define these symbols, when part of a C library, won't be discarded by the linker. This is important if a module that uses such a symbol is later dynlinked. *) - compile_phrase ~ppf_dump - (Cmmgen.reference_symbols - (List.filter (fun s -> s <> "" && s.[0] <> '%') - (List.map Primitive.native_name !Translmod.primitive_declarations)) - ); + (Cmm_helpers.reference_symbols + (List.filter_map (fun prim -> + if not (Primitive.native_name_is_external prim) then None + else Some (Primitive.native_name prim)) + !Translmod.primitive_declarations)); Emit.end_assembly () -let flambda_gen_implementation ?toplevel ~backend ~ppf_dump - (program:Flambda.program) = - let export = Build_export_info.build_transient ~backend program in - let (clambda, preallocated, constants) = - Profile.record_call "backend" (fun () -> - (program, export) - ++ Flambda_to_clambda.convert - ++ flambda_raw_clambda_dump_if ppf_dump - ++ (fun { Flambda_to_clambda. expr; preallocated_blocks; - structured_constants; exported; } -> - (* "init_code" following the name used in - [Cmmgen.compunit_and_constants]. *) - Un_anf.apply ~ppf_dump 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; - provenance = None; - }) - (Symbol.Map.bindings constants) - in - end_gen_implementation ?toplevel ~ppf_dump - (clambda, preallocated, constants) +type middle_end = + backend:(module Backend_intf.S) + -> filename:string + -> prefixname:string + -> ppf_dump:Format.formatter + -> Lambda.program + -> Clambda.with_constants -let lambda_gen_implementation ?toplevel ~backend ~ppf_dump - (lambda:Lambda.program) = - let clambda = - Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code - in - let provenance : Clambda.usymbol_provenance = - { original_idents = []; - module_path = - Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ())); - } - in - let preallocated_block = - Clambda.{ - symbol = Compilenv.make_symbol None; - exported = true; - tag = 0; - fields = List.init lambda.main_module_block_size (fun _ -> None); - provenance = Some provenance; - } - in - let clambda_and_constants = - clambda, [preallocated_block], Compilenv.structured_constants () - in - Compilenv.clear_structured_constants (); - raw_clambda_dump_if ppf_dump clambda_and_constants; - end_gen_implementation ?toplevel ~ppf_dump clambda_and_constants - -let compile_implementation_gen ?toplevel prefixname - ~required_globals ~ppf_dump gen_implementation program = +let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end + ~ppf_dump (program : Lambda.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 prefixname asmfile !keep_asm_file - (prefixname ^ ext_obj) (fun () -> - Ident.Set.iter Compilenv.require_global required_globals; - gen_implementation ?toplevel ~ppf_dump program) - -let compile_implementation_clambda ?toplevel prefixname - ~backend ~ppf_dump (program:Lambda.program) = - compile_implementation_gen ?toplevel prefixname - ~required_globals:program.Lambda.required_globals - ~ppf_dump (lambda_gen_implementation ~backend) program - -let compile_implementation_flambda ?toplevel prefixname - ~required_globals ~backend ~ppf_dump (program:Flambda.program) = - compile_implementation_gen ?toplevel prefixname - ~required_globals ~ppf_dump (flambda_gen_implementation ~backend) program + compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj) + (fun () -> + Ident.Set.iter Compilenv.require_global program.required_globals; + let clambda_with_constants = + middle_end ~backend ~filename ~prefixname ~ppf_dump program + in + end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants) (* Error report *) diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli index 16045621..afbdefd6 100644 --- a/asmcomp/asmgen.mli +++ b/asmcomp/asmgen.mli @@ -13,20 +13,27 @@ (* *) (**************************************************************************) -(* From lambda to assembly code *) +(** From Lambda to assembly code *) -val compile_implementation_flambda : - ?toplevel:(string -> bool) -> - string -> - required_globals:Ident.Set.t -> - backend:(module Backend_intf.S) -> - ppf_dump:Format.formatter -> Flambda.program -> unit +(** The type of converters from Lambda to Clambda. *) +type middle_end = + backend:(module Backend_intf.S) + -> filename:string + -> prefixname:string + -> ppf_dump:Format.formatter + -> Lambda.program + -> Clambda.with_constants -val compile_implementation_clambda : - ?toplevel:(string -> bool) -> - string -> - backend:(module Backend_intf.S) -> - ppf_dump:Format.formatter -> Lambda.program -> unit +(** Compile an implementation from Lambda using the given middle end. *) +val compile_implementation + : ?toplevel:(string -> bool) + -> backend:(module Backend_intf.S) + -> filename:string + -> prefixname:string + -> middle_end:middle_end + -> ppf_dump:Format.formatter + -> Lambda.program + -> unit val compile_phrase : ppf_dump:Format.formatter -> Cmm.phrase -> unit @@ -37,6 +44,5 @@ val report_error: Format.formatter -> error -> unit val compile_unit: - string(*prefixname*) -> string(*asm file*) -> bool(*keep asm*) -> string(*obj file*) -> (unit -> unit) -> unit diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 8c4457c8..d0879339 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -230,21 +230,25 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = Emit.begin_assembly (); let name_list = List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in - compile_phrase (Cmmgen.entry_point name_list); + compile_phrase (Cmm_helpers.entry_point name_list); let units = List.map (fun (info,_,_) -> info) units_list in - List.iter compile_phrase (Cmmgen.generic_functions false units); + List.iter compile_phrase (Cmm_helpers.generic_functions false units); Array.iteri - (fun i name -> compile_phrase (Cmmgen.predef_exception i name)) + (fun i name -> compile_phrase (Cmm_helpers.predef_exception i name)) Runtimedef.builtin_exceptions; - compile_phrase (Cmmgen.global_table name_list); + compile_phrase (Cmm_helpers.global_table name_list); let globals_map = make_globals_map units_list ~crc_interfaces in - compile_phrase (Cmmgen.globals_map globals_map); - compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list)); - compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list)); + compile_phrase (Cmm_helpers.globals_map globals_map); + compile_phrase(Cmm_helpers.data_segment_table ("_startup" :: name_list)); + if !Clflags.function_sections then + compile_phrase + (Cmm_helpers.code_segment_table("_hot" :: "_startup" :: name_list)) + else + compile_phrase(Cmm_helpers.code_segment_table("_startup" :: name_list)); let all_names = "_startup" :: "_system" :: name_list in - compile_phrase (Cmmgen.frame_table all_names); + compile_phrase (Cmm_helpers.frame_table all_names); if Config.spacetime then begin - compile_phrase (Cmmgen.spacetime_shapes all_names); + compile_phrase (Cmm_helpers.spacetime_shapes all_names); end; if !Clflags.output_complete_object then force_linking_of_startup ~ppf_dump; @@ -256,10 +260,10 @@ let make_shared_startup_file ~ppf_dump units = Compilenv.reset "_shared_startup"; Emit.begin_assembly (); List.iter compile_phrase - (Cmmgen.generic_functions true (List.map fst units)); - compile_phrase (Cmmgen.plugin_header units); + (Cmm_helpers.generic_functions true (List.map fst units)); + compile_phrase (Cmm_helpers.plugin_header units); compile_phrase - (Cmmgen.global_table + (Cmm_helpers.global_table (List.map (fun (ui,_) -> ui.ui_symbol) units)); if !Clflags.output_complete_object then force_linking_of_startup ~ppf_dump; @@ -287,7 +291,7 @@ let link_shared ~ppf_dump 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 output_name + Asmgen.compile_unit startup !Clflags.keep_startup_file startup_obj (fun () -> make_shared_startup_file ~ppf_dump @@ -352,7 +356,7 @@ let link ~ppf_dump 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 output_name + Asmgen.compile_unit startup !Clflags.keep_startup_file startup_obj (fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces); Misc.try_finally diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index df9686aa..c074dee5 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -99,29 +99,44 @@ let make_package_object ~ppf_dump members targetobj targetname coercion members in let module_ident = Ident.create_persistent targetname in let prefixname = Filename.remove_extension objtemp in - if Config.flambda then begin - let size, lam = Translmod.transl_package_flambda components coercion in - let lam = Simplif.simplify_lambda lam in - let flam = - Flambda_middle_end.middle_end ~ppf_dump - ~prefixname - ~backend - ~size - ~filename:targetname - ~module_ident - ~module_initializer:lam - in - Asmgen.compile_implementation_flambda - prefixname ~backend ~required_globals:Ident.Set.empty ~ppf_dump flam; - end else begin - let main_module_block_size, code = - Translmod.transl_store_package - components (Ident.create_persistent targetname) coercion in - let code = Simplif.simplify_lambda code in - Asmgen.compile_implementation_clambda - prefixname ~backend ~ppf_dump { Lambda.code; main_module_block_size; - module_ident; required_globals = Ident.Set.empty } - end; + let required_globals = Ident.Set.empty in + let program, middle_end = + if Config.flambda then + let main_module_block_size, code = + Translmod.transl_package_flambda components coercion + in + let code = Simplif.simplify_lambda code in + let program = + { Lambda. + code; + main_module_block_size; + module_ident; + required_globals; + } + in + program, Flambda_middle_end.lambda_to_clambda + else + let main_module_block_size, code = + Translmod.transl_store_package components + (Ident.create_persistent targetname) coercion + in + let code = Simplif.simplify_lambda code in + let program = + { Lambda. + code; + main_module_block_size; + module_ident; + required_globals; + } + in + program, Closure_middle_end.lambda_to_clambda + in + Asmgen.compile_implementation ~backend + ~filename:targetname + ~prefixname + ~middle_end + ~ppf_dump + program; let objfiles = List.map (fun m -> Filename.remove_extension m.pm_file ^ Config.ext_obj) @@ -132,6 +147,7 @@ let make_package_object ~ppf_dump members targetobj targetname coercion remove_file objtemp; if not ok then raise(Error Linking_error) ) + (* Make the .cmx file for the package *) let get_export_info ui = diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml index f8f90719..953c2827 100644 --- a/asmcomp/branch_relaxation.ml +++ b/asmcomp/branch_relaxation.ml @@ -15,7 +15,7 @@ (**************************************************************************) open Mach -open Linearize +open Linear module Make (T : Branch_relaxation_intf.S) = struct let label_map code = @@ -45,7 +45,7 @@ module Make (T : Branch_relaxation_intf.S) = struct | Some branch -> let max_branch_offset = (* Remember to cut some slack for multi-word instructions (in the - [Linearize] sense of the word) where the branch can be anywhere in + [Linear] sense of the word) where the branch can be anywhere in the middle. 12 words of slack is plenty. *) T.Cond_branch.max_displacement branch - 12 in diff --git a/asmcomp/branch_relaxation.mli b/asmcomp/branch_relaxation.mli index 170f306d..7d540198 100644 --- a/asmcomp/branch_relaxation.mli +++ b/asmcomp/branch_relaxation.mli @@ -18,7 +18,7 @@ module Make (T : Branch_relaxation_intf.S) : sig val relax - : Linearize.instruction + : Linear.instruction (* [max_offset_of_out_of_line_code] specifies the furthest distance, measured from the first address immediately after the last instruction of the function, that may be branched to from within the function in diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml index f95ab67d..d5552f83 100644 --- a/asmcomp/branch_relaxation_intf.ml +++ b/asmcomp/branch_relaxation_intf.ml @@ -46,7 +46,7 @@ module type S = sig - Lcondbranch3 (_, _, _) [classify_instr] is expected to return [None] when called on any instruction not in this list. *) - val classify_instr : Linearize.instruction_desc -> t option + val classify_instr : Linear.instruction_desc -> t option end (* The value to be added to the program counter (in [distance] units) @@ -55,7 +55,7 @@ module type S = sig val offset_pc_at_branch : distance (* The maximum size of a given instruction. *) - val instr_size : Linearize.instruction_desc -> distance + val instr_size : Linear.instruction_desc -> distance (* Insertion of target-specific code to relax operations that cannot be relaxed generically. It is assumed that these rewrites do not change @@ -63,13 +63,13 @@ module type S = sig val relax_allocation : num_bytes:int -> label_after_call_gc:Cmm.label option - -> Linearize.instruction_desc + -> Linear.instruction_desc val relax_intop_checkbound : label_after_error:Cmm.label option - -> Linearize.instruction_desc + -> Linear.instruction_desc val relax_intop_imm_checkbound : bound:int -> label_after_error:Cmm.label option - -> Linearize.instruction_desc - val relax_specific_op : Arch.specific_operation -> Linearize.instruction_desc + -> Linear.instruction_desc + val relax_specific_op : Arch.specific_operation -> Linear.instruction_desc end diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml index b2d58d0b..15ec6dbd 100644 --- a/asmcomp/cmm.ml +++ b/asmcomp/cmm.ml @@ -27,11 +27,6 @@ let typ_addr = [|Addr|] let typ_int = [|Int|] let typ_float = [|Float|] -let size_component = function - | Val | Addr -> Arch.size_addr - | Int -> Arch.size_int - | Float -> Arch.size_float - (** [machtype_component]s are partially ordered as follows: Addr Float @@ -82,13 +77,6 @@ let ge_component comp1 comp2 = | Float, (Int | Addr | Val) -> assert false -let size_machtype mty = - let size = ref 0 in - for i = 0 to Array.length mty - 1 do - size := !size + size_component mty.(i) - done; - !size - type integer_comparison = Lambda.integer_comparison = | Ceq | Cne | Clt | Cgt | Cle | Cge @@ -110,10 +98,6 @@ let label_counter = ref 99 let new_label() = incr label_counter; !label_counter -type raise_kind = - | Raise_withtrace - | Raise_notrace - type rec_flag = Nonrecursive | Recursive type phantom_defining_expr = @@ -155,7 +139,7 @@ and operation = | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat | Ccmpf of float_comparison - | Craise of raise_kind + | Craise of Lambda.raise_kind | Ccheckbound type expression = @@ -222,3 +206,112 @@ let ccatch (i, ids, e1, e2, dbg) = let reset () = label_counter := 99 + +let iter_shallow_tail f = function + | Clet(_, _, body) | Cphantom_let (_, _, body) -> + f body; + true + | Cifthenelse(_cond, _ifso_dbg, ifso, _ifnot_dbg, ifnot, _dbg) -> + f ifso; + f ifnot; + true + | Csequence(_e1, e2) -> + f e2; + true + | Cswitch(_e, _tbl, el, _dbg') -> + Array.iter (fun (e, _dbg) -> f e) el; + true + | Ccatch(_rec_flag, handlers, body) -> + List.iter (fun (_, _, h, _dbg) -> f h) handlers; + f body; + true + | Ctrywith(e1, _id, e2, _dbg) -> + f e1; + f e2; + true + | Cexit _ | Cop (Craise _, _, _) -> + true + | Cconst_int _ + | Cconst_natint _ + | Cconst_float _ + | Cconst_symbol _ + | Cconst_pointer _ + | Cconst_natpointer _ + | Cblockheader _ + | Cvar _ + | Cassign _ + | Ctuple _ + | Cop _ -> + false + +let rec map_tail f = function + | Clet(id, exp, body) -> + Clet(id, exp, map_tail f body) + | Cphantom_let(id, exp, body) -> + Cphantom_let (id, exp, map_tail f body) + | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) -> + Cifthenelse + ( + cond, + ifso_dbg, map_tail f ifso, + ifnot_dbg, map_tail f ifnot, + dbg + ) + | Csequence(e1, e2) -> + Csequence(e1, map_tail f e2) + | Cswitch(e, tbl, el, dbg') -> + Cswitch(e, tbl, Array.map (fun (e, dbg) -> map_tail f e, dbg) el, dbg') + | Ccatch(rec_flag, handlers, body) -> + let map_h (n, ids, handler, dbg) = (n, ids, map_tail f handler, dbg) in + Ccatch(rec_flag, List.map map_h handlers, map_tail f body) + | Ctrywith(e1, id, e2, dbg) -> + Ctrywith(map_tail f e1, id, map_tail f e2, dbg) + | Cexit _ | Cop (Craise _, _, _) as cmm -> + cmm + | Cconst_int _ + | Cconst_natint _ + | Cconst_float _ + | Cconst_symbol _ + | Cconst_pointer _ + | Cconst_natpointer _ + | Cblockheader _ + | Cvar _ + | Cassign _ + | Ctuple _ + | Cop _ as c -> + f c + +let map_shallow f = function + | Clet (id, e1, e2) -> + Clet (id, f e1, f e2) + | Cphantom_let (id, de, e) -> + Cphantom_let (id, de, f e) + | Cassign (id, e) -> + Cassign (id, f e) + | Ctuple el -> + Ctuple (List.map f el) + | Cop (op, el, dbg) -> + Cop (op, List.map f el, dbg) + | Csequence (e1, e2) -> + Csequence (f e1, f e2) + | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) -> + Cifthenelse(f cond, ifso_dbg, f ifso, ifnot_dbg, f ifnot, dbg) + | Cswitch (e, ia, ea, dbg) -> + Cswitch (e, ia, Array.map (fun (e, dbg) -> f e, dbg) ea, dbg) + | Ccatch (rf, hl, body) -> + let map_h (n, ids, handler, dbg) = (n, ids, f handler, dbg) in + Ccatch (rf, List.map map_h hl, f body) + | Cexit (n, el) -> + Cexit (n, List.map f el) + | Ctrywith (e1, id, e2, dbg) -> + Ctrywith (f e1, id, f e2, dbg) + | Cconst_int _ + | Cconst_natint _ + | Cconst_float _ + | Cconst_symbol _ + | Cconst_pointer _ + | Cconst_natpointer _ + | Cblockheader _ + | Cvar _ + as c -> + c diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli index a46e6599..84c79a27 100644 --- a/asmcomp/cmm.mli +++ b/asmcomp/cmm.mli @@ -55,8 +55,6 @@ val typ_addr: machtype val typ_int: machtype val typ_float: machtype -val size_component: machtype_component -> int - (** Least upper bound of two [machtype_component]s. *) val lub_component : machtype_component @@ -70,8 +68,6 @@ val ge_component -> machtype_component -> bool -val size_machtype: machtype -> int - type integer_comparison = Lambda.integer_comparison = | Ceq | Cne | Clt | Cgt | Cle | Cge @@ -87,10 +83,6 @@ val swap_float_comparison: float_comparison -> float_comparison type label = int val new_label: unit -> label -type raise_kind = - | Raise_withtrace - | Raise_notrace - type rec_flag = Nonrecursive | Recursive type phantom_defining_expr = @@ -149,8 +141,11 @@ and operation = | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat | Ccmpf of float_comparison - | Craise of raise_kind - | Ccheckbound + | Craise of Lambda.raise_kind + | Ccheckbound (* Takes two arguments : first the bound to check against, + then the index. + It results in a bounds error if the index is greater than + or equal to the bound. *) (** Every basic block should have a corresponding [Debuginfo.t] for its beginning. *) @@ -219,3 +214,21 @@ val ccatch : -> expression val reset : unit -> unit + +val iter_shallow_tail: (expression -> unit) -> expression -> bool + (** Either apply the callback to all immediate sub-expressions that + can produce the final result for the expression and return + [true], or do nothing and return [false]. Note that the notion + of "tail" sub-expression used here does not match the one used + to trigger tail calls; in particular, try...with handlers are + considered to be in tail position (because their result become + the final result for the expression). *) + +val map_tail: (expression -> expression) -> expression -> expression + (** Apply the transformation to an expression, trying to push it + to all inner sub-expressions that can produce the final result. + Same disclaimer as for [iter_shallow_tail] about the notion + of "tail" sub-expression. *) + +val map_shallow: (expression -> expression) -> expression -> expression + (** Apply the transformation to each immediate sub-expression. *) diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml new file mode 100644 index 00000000..c02e2b38 --- /dev/null +++ b/asmcomp/cmm_helpers.ml @@ -0,0 +1,2755 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-4-9-40-41-42-44-45"] + +module V = Backend_var +module VP = Backend_var.With_provenance +open Cmm +open Arch + +(* Local binding of complex expressions *) + +let bind name arg fn = + match arg with + Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _ + | Cconst_pointer _ | Cconst_natpointer _ + | Cblockheader _ -> fn arg + | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id)) + +let bind_load name arg fn = + match arg with + | Cop(Cload _, [Cvar _], _) -> fn arg + | _ -> bind name arg fn + +let bind_nonvar name arg fn = + match arg with + Cconst_int _ | Cconst_natint _ | Cconst_symbol _ + | Cconst_pointer _ | Cconst_natpointer _ + | Cblockheader _ -> fn arg + | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id)) + +let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8 + (* cf. runtime/caml/gc.h *) + +(* Block headers. Meaning of the tag field: see stdlib/obj.ml *) + +let floatarray_tag dbg = Cconst_int (Obj.double_array_tag, dbg) + +let block_header tag sz = + Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10) + (Nativeint.of_int tag) +(* Static data corresponding to "value"s must be marked black in case we are + in no-naked-pointers mode. See [caml_darken] and the code below that emits + structured constants and static module definitions. *) +let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black +let white_closure_header sz = block_header Obj.closure_tag sz +let black_closure_header sz = black_block_header Obj.closure_tag sz +let infix_header ofs = block_header Obj.infix_tag ofs +let float_header = block_header Obj.double_tag (size_float / size_addr) +let floatarray_header len = + (* Zero-sized float arrays have tag zero for consistency with + [caml_alloc_float_array]. *) + assert (len >= 0); + if len = 0 then block_header 0 0 + else block_header Obj.double_array_tag (len * size_float / size_addr) +let string_header len = + block_header Obj.string_tag ((len + size_addr) / size_addr) +let boxedint32_header = block_header Obj.custom_tag 2 +let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr) +let boxedintnat_header = block_header Obj.custom_tag 2 +let caml_nativeint_ops = "caml_nativeint_ops" +let caml_int32_ops = "caml_int32_ops" +let caml_int64_ops = "caml_int64_ops" + + +let alloc_float_header dbg = Cblockheader (float_header, dbg) +let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg) +let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg) +let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg) +let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg) +let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg) +let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg) + +(* Integers *) + +let max_repr_int = max_int asr 1 +let min_repr_int = min_int asr 1 + +let int_const dbg n = + if n <= max_repr_int && n >= min_repr_int + then Cconst_int((n lsl 1) + 1, dbg) + else Cconst_natint + (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, dbg) + +let natint_const_untagged dbg n = + if n > Nativeint.of_int max_int + || n < Nativeint.of_int min_int + then Cconst_natint (n,dbg) + else Cconst_int (Nativeint.to_int n, dbg) + +let cint_const n = + Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) + +let targetint_const n = + Targetint.add (Targetint.shift_left (Targetint.of_int n) 1) + Targetint.one + +let add_no_overflow n x c dbg = + let d = n + x in + if d = 0 then c else Cop(Caddi, [c; Cconst_int (d, dbg)], dbg) + +let rec add_const c n dbg = + if n = 0 then c + else match c with + | Cconst_int (x, _) when Misc.no_overflow_add x n -> Cconst_int (x + n, dbg) + | Cop(Caddi, [Cconst_int (x, _); c], _) + when Misc.no_overflow_add n x -> + add_no_overflow n x c dbg + | Cop(Caddi, [c; Cconst_int (x, _)], _) + when Misc.no_overflow_add n x -> + add_no_overflow n x c dbg + | Cop(Csubi, [Cconst_int (x, _); c], _) when Misc.no_overflow_add n x -> + Cop(Csubi, [Cconst_int (n + x, dbg); c], dbg) + | Cop(Csubi, [c; Cconst_int (x, _)], _) when Misc.no_overflow_sub n x -> + add_const c (n - x) dbg + | c -> Cop(Caddi, [c; Cconst_int (n, dbg)], dbg) + +let incr_int c dbg = add_const c 1 dbg +let decr_int c dbg = add_const c (-1) dbg + +let rec add_int c1 c2 dbg = + match (c1, c2) with + | (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) -> + add_const c n dbg + | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) -> + add_const (add_int c1 c2 dbg) n1 dbg + | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) -> + add_const (add_int c1 c2 dbg) n2 dbg + | (_, _) -> + Cop(Caddi, [c1; c2], dbg) + +let rec sub_int c1 c2 dbg = + match (c1, c2) with + | (c1, Cconst_int (n2, _)) when n2 <> min_int -> + add_const c1 (-n2) dbg + | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) when n2 <> min_int -> + add_const (sub_int c1 c2 dbg) (-n2) dbg + | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) -> + add_const (sub_int c1 c2 dbg) n1 dbg + | (c1, c2) -> + Cop(Csubi, [c1; c2], dbg) + +let rec lsl_int c1 c2 dbg = + match (c1, c2) with + | (Cop(Clsl, [c; Cconst_int (n1, _)], _), Cconst_int (n2, _)) + when n1 > 0 && n2 > 0 && n1 + n2 < size_int * 8 -> + Cop(Clsl, [c; Cconst_int (n1 + n2, dbg)], dbg) + | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), Cconst_int (n2, _)) + when Misc.no_overflow_lsl n1 n2 -> + add_const (lsl_int c1 c2 dbg) (n1 lsl n2) dbg + | (_, _) -> + Cop(Clsl, [c1; c2], dbg) + +let is_power2 n = n = 1 lsl Misc.log2 n + +and mult_power2 c n dbg = lsl_int c (Cconst_int (Misc.log2 n, dbg)) dbg + +let rec mul_int c1 c2 dbg = + match (c1, c2) with + | (c, Cconst_int (0, _)) | (Cconst_int (0, _), c) -> + Csequence (c, Cconst_int (0, dbg)) + | (c, Cconst_int (1, _)) | (Cconst_int (1, _), c) -> + c + | (c, Cconst_int(-1, _)) | (Cconst_int(-1, _), c) -> + sub_int (Cconst_int (0, dbg)) c dbg + | (c, Cconst_int (n, _)) when is_power2 n -> mult_power2 c n dbg + | (Cconst_int (n, _), c) when is_power2 n -> mult_power2 c n dbg + | (Cop(Caddi, [c; Cconst_int (n, _)], _), Cconst_int (k, _)) | + (Cconst_int (k, _), Cop(Caddi, [c; Cconst_int (n, _)], _)) + when Misc.no_overflow_mul n k -> + add_const (mul_int c (Cconst_int (k, dbg)) dbg) (n * k) dbg + | (c1, c2) -> + Cop(Cmuli, [c1; c2], dbg) + + +let ignore_low_bit_int = function + Cop(Caddi, + [(Cop(Clsl, [_; Cconst_int (n, _)], _) as c); Cconst_int (1, _)], _) + when n > 0 + -> c + | Cop(Cor, [c; Cconst_int (1, _)], _) -> c + | c -> c + +(* removes the 1-bit sign-extension left by untag_int (tag_int c) *) +let ignore_high_bit_int = function + Cop(Casr, + [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> c + | c -> c + +let lsr_int c1 c2 dbg = + match c2 with + Cconst_int (0, _) -> + c1 + | Cconst_int (n, _) when n > 0 -> + Cop(Clsr, [ignore_low_bit_int c1; c2], dbg) + | _ -> + Cop(Clsr, [c1; c2], dbg) + +let asr_int c1 c2 dbg = + match c2 with + Cconst_int (0, _) -> + c1 + | Cconst_int (n, _) when n > 0 -> + Cop(Casr, [ignore_low_bit_int c1; c2], dbg) + | _ -> + Cop(Casr, [c1; c2], dbg) + +let tag_int i dbg = + match i with + Cconst_int (n, _) -> + int_const dbg n + | Cop(Casr, [c; Cconst_int (n, _)], _) when n > 0 -> + Cop(Cor, + [asr_int c (Cconst_int (n - 1, dbg)) dbg; Cconst_int (1, dbg)], + dbg) + | c -> + incr_int (lsl_int c (Cconst_int (1, dbg)) dbg) dbg + +let untag_int i dbg = + match i with + Cconst_int (n, _) -> Cconst_int(n asr 1, dbg) + | Cop(Cor, [Cop(Casr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _) + when n > 0 && n < size_int * 8 -> + Cop(Casr, [c; Cconst_int (n+1, dbg)], dbg) + | Cop(Cor, [Cop(Clsr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _) + when n > 0 && n < size_int * 8 -> + Cop(Clsr, [c; Cconst_int (n+1, dbg)], dbg) + | c -> asr_int c (Cconst_int (1, dbg)) dbg + +let mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot = + match cond with + | Cconst_int (0, _) -> ifnot + | Cconst_int (1, _) -> ifso + | _ -> + Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) + +let mk_not dbg cmm = + match cmm with + | Cop(Caddi, + [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') -> + begin + match c with + | Cop(Ccmpi cmp, [c1; c2], dbg'') -> + tag_int + (Cop(Ccmpi (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg' + | Cop(Ccmpa cmp, [c1; c2], dbg'') -> + tag_int + (Cop(Ccmpa (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg' + | Cop(Ccmpf cmp, [c1; c2], dbg'') -> + tag_int + (Cop(Ccmpf (negate_float_comparison cmp), [c1; c2], dbg'')) dbg' + | _ -> + (* 0 -> 3, 1 -> 1 *) + Cop(Csubi, + [Cconst_int (3, dbg); Cop(Clsl, [c; Cconst_int (1, dbg)], dbg)], + dbg) + end + | Cconst_int (3, _) -> Cconst_int (1, dbg) + | Cconst_int (1, _) -> Cconst_int (3, dbg) + | c -> + (* 1 -> 3, 3 -> 1 *) + Cop(Csubi, [Cconst_int (4, dbg); c], dbg) + + +let create_loop body dbg = + let cont = Lambda.next_raise_count () in + let call_cont = Cexit (cont, []) in + let body = Csequence (body, call_cont) in + Ccatch (Recursive, [cont, [], body, dbg], call_cont) + +(* Turning integer divisions into multiply-high then shift. + The [division_parameters] function is used in module Emit for + those target platforms that support this optimization. *) + +(* Unsigned comparison between native integers. *) + +let ucompare x y = Nativeint.(compare (add x min_int) (add y min_int)) + +(* Unsigned division and modulus at type nativeint. + Algorithm: Hacker's Delight section 9.3 *) + +let udivmod n d = Nativeint.( + if d < 0n then + if ucompare n d < 0 then (0n, n) else (1n, sub n d) + else begin + let q = shift_left (div (shift_right_logical n 1) d) 1 in + let r = sub n (mul q d) in + if ucompare r d >= 0 then (succ q, sub r d) else (q, r) + end) + +(* Compute division parameters. + Algorithm: Hacker's Delight chapter 10, fig 10-1. *) + +let divimm_parameters d = Nativeint.( + assert (d > 0n); + let twopsm1 = min_int in (* 2^31 for 32-bit archs, 2^63 for 64-bit archs *) + let nc = sub (pred twopsm1) (snd (udivmod twopsm1 d)) in + let rec loop p (q1, r1) (q2, r2) = + let p = p + 1 in + let q1 = shift_left q1 1 and r1 = shift_left r1 1 in + let (q1, r1) = + if ucompare r1 nc >= 0 then (succ q1, sub r1 nc) else (q1, r1) in + let q2 = shift_left q2 1 and r2 = shift_left r2 1 in + let (q2, r2) = + if ucompare r2 d >= 0 then (succ q2, sub r2 d) else (q2, r2) in + let delta = sub d r2 in + if ucompare q1 delta < 0 || (q1 = delta && r1 = 0n) + then loop p (q1, r1) (q2, r2) + else (succ q2, p - size) + in loop (size - 1) (udivmod twopsm1 nc) (udivmod twopsm1 d)) + +(* The result [(m, p)] of [divimm_parameters d] satisfies the following + inequality: + + 2^(wordsize + p) < m * d <= 2^(wordsize + p) + 2^(p + 1) (i) + + from which it follows that + + floor(n / d) = floor(n * m / 2^(wordsize+p)) + if 0 <= n < 2^(wordsize-1) + ceil(n / d) = floor(n * m / 2^(wordsize+p)) + 1 + if -2^(wordsize-1) <= n < 0 + + The correctness condition (i) above can be checked by the code below. + It was exhaustively tested for values of d from 2 to 10^9 in the + wordsize = 64 case. + +let add2 (xh, xl) (yh, yl) = + let zl = add xl yl and zh = add xh yh in + ((if ucompare zl xl < 0 then succ zh else zh), zl) + +let shl2 (xh, xl) n = + assert (0 < n && n < size + size); + if n < size + then (logor (shift_left xh n) (shift_right_logical xl (size - n)), + shift_left xl n) + else (shift_left xl (n - size), 0n) + +let mul2 x y = + let halfsize = size / 2 in + let halfmask = pred (shift_left 1n halfsize) in + let xl = logand x halfmask and xh = shift_right_logical x halfsize in + let yl = logand y halfmask and yh = shift_right_logical y halfsize in + add2 (mul xh yh, 0n) + (add2 (shl2 (0n, mul xl yh) halfsize) + (add2 (shl2 (0n, mul xh yl) halfsize) + (0n, mul xl yl))) + +let ucompare2 (xh, xl) (yh, yl) = + let c = ucompare xh yh in if c = 0 then ucompare xl yl else c + +let validate d m p = + let md = mul2 m d in + let one2 = (0n, 1n) in + let twoszp = shl2 one2 (size + p) in + let twop1 = shl2 one2 (p + 1) in + ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0 +*) + +let raise_symbol dbg symb = + Cop(Craise Lambda.Raise_regular, [Cconst_symbol (symb, dbg)], dbg) + +let rec div_int c1 c2 is_safe dbg = + match (c1, c2) with + (c1, Cconst_int (0, _)) -> + Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero") + | (c1, Cconst_int (1, _)) -> + c1 + | (Cconst_int (n1, _), Cconst_int (n2, _)) -> + Cconst_int (n1 / n2, dbg) + | (c1, Cconst_int (n, _)) when n <> min_int -> + let l = Misc.log2 n in + if n = 1 lsl l then + (* Algorithm: + t = shift-right-signed(c1, l - 1) + t = shift-right(t, W - l) + t = c1 + t + res = shift-right-signed(c1 + t, l) + *) + Cop(Casr, [bind "dividend" c1 (fun c1 -> + let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in + let t = + lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg + in + add_int c1 t dbg); + Cconst_int (l, dbg)], dbg) + else if n < 0 then + sub_int (Cconst_int (0, dbg)) + (div_int c1 (Cconst_int (-n, dbg)) is_safe dbg) + dbg + else begin + let (m, p) = divimm_parameters (Nativeint.of_int n) in + (* Algorithm: + t = multiply-high-signed(c1, m) + if m < 0, t = t + c1 + if p > 0, t = shift-right-signed(t, p) + res = t + sign-bit(c1) + *) + bind "dividend" c1 (fun c1 -> + let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in + let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in + let t = + if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t + in + add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg) + end + | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe -> + Cop(Cdivi, [c1; c2], dbg) + | (c1, c2) -> + bind "divisor" c2 (fun c2 -> + bind "dividend" c1 (fun c1 -> + Cifthenelse(c2, + dbg, + Cop(Cdivi, [c1; c2], dbg), + dbg, + raise_symbol dbg "caml_exn_Division_by_zero", + dbg))) + +let mod_int c1 c2 is_safe dbg = + match (c1, c2) with + (c1, Cconst_int (0, _)) -> + Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero") + | (c1, Cconst_int ((1 | (-1)), _)) -> + Csequence(c1, Cconst_int (0, dbg)) + | (Cconst_int (n1, _), Cconst_int (n2, _)) -> + Cconst_int (n1 mod n2, dbg) + | (c1, (Cconst_int (n, _) as c2)) when n <> min_int -> + let l = Misc.log2 n in + if n = 1 lsl l then + (* Algorithm: + t = shift-right-signed(c1, l - 1) + t = shift-right(t, W - l) + t = c1 + t + t = bit-and(t, -n) + res = c1 - t + *) + bind "dividend" c1 (fun c1 -> + let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in + let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in + let t = add_int c1 t dbg in + let t = Cop(Cand, [t; Cconst_int (-n, dbg)], dbg) in + sub_int c1 t dbg) + else + bind "dividend" c1 (fun c1 -> + sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg) + | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe -> + (* Flambda already generates that test *) + Cop(Cmodi, [c1; c2], dbg) + | (c1, c2) -> + bind "divisor" c2 (fun c2 -> + bind "dividend" c1 (fun c1 -> + Cifthenelse(c2, + dbg, + Cop(Cmodi, [c1; c2], dbg), + dbg, + raise_symbol dbg "caml_exn_Division_by_zero", + dbg))) + +(* Division or modulo on boxed integers. The overflow case min_int / -1 + can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *) + +let is_different_from x = function + Cconst_int (n, _) -> n <> x + | Cconst_natint (n, _) -> n <> Nativeint.of_int x + | _ -> false + +let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg = + bind "dividend" c1 (fun c1 -> + bind "divisor" c2 (fun c2 -> + let c = mkop c1 c2 is_safe dbg in + if Arch.division_crashes_on_overflow + && (size_int = 4 || bi <> Primitive.Pint32) + && not (is_different_from (-1) c2) + then + Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg), + dbg, c, + dbg, mkm1 c1 dbg, + dbg) + else + c)) + +let safe_div_bi is_safe = + safe_divmod_bi div_int is_safe + (fun c1 dbg -> Cop(Csubi, [Cconst_int (0, dbg); c1], dbg)) + +let safe_mod_bi is_safe = + safe_divmod_bi mod_int is_safe (fun _ dbg -> Cconst_int (0, dbg)) + +(* Bool *) + +let test_bool dbg cmm = + match cmm with + | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> + c + | Cconst_int (n, dbg) -> + if n = 1 then + Cconst_int (0, dbg) + else + Cconst_int (1, dbg) + | c -> Cop(Ccmpi Cne, [c; Cconst_int (1, dbg)], dbg) + +(* Float *) + +let box_float dbg c = Cop(Calloc, [alloc_float_header dbg; c], dbg) + +let unbox_float dbg = + map_tail + (function + | Cop(Calloc, [Cblockheader (hdr, _); c], _) + when Nativeint.equal hdr float_header -> + c + | Cconst_symbol (s, _dbg) as cmm -> + begin match Cmmgen_state.structured_constant_of_sym s with + | Some (Uconst_float x) -> + Cconst_float (x, dbg) (* or keep _dbg? *) + | _ -> + Cop(Cload (Double_u, Immutable), [cmm], dbg) + end + | cmm -> Cop(Cload (Double_u, Immutable), [cmm], dbg) + ) + +(* Complex *) + +let box_complex dbg c_re c_im = + Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg) + +let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg) +let complex_im c dbg = Cop(Cload (Double_u, Immutable), + [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)], + dbg) + +(* Unit *) + +let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg)) + +let rec remove_unit = function + Cconst_pointer (1, _) -> Ctuple [] + | Csequence(c, Cconst_pointer (1, _)) -> c + | Csequence(c1, c2) -> + Csequence(c1, remove_unit c2) + | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) -> + Cifthenelse(cond, + ifso_dbg, remove_unit ifso, + ifnot_dbg, + remove_unit ifnot, dbg) + | Cswitch(sel, index, cases, dbg) -> + Cswitch(sel, index, + Array.map (fun (case, dbg) -> remove_unit case, dbg) cases, + dbg) + | Ccatch(rec_flag, handlers, body) -> + let map_h (n, ids, handler, dbg) = (n, ids, remove_unit handler, dbg) in + Ccatch(rec_flag, List.map map_h handlers, remove_unit body) + | Ctrywith(body, exn, handler, dbg) -> + Ctrywith(remove_unit body, exn, remove_unit handler, dbg) + | Clet(id, c1, c2) -> + Clet(id, c1, remove_unit c2) + | Cop(Capply _mty, args, dbg) -> + Cop(Capply typ_void, args, dbg) + | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) -> + Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg) + | Cexit (_,_) as c -> c + | Ctuple [] as c -> c + | c -> Csequence(c, Ctuple []) + +(* Access to block fields *) + +let field_address ptr n dbg = + if n = 0 + then ptr + else Cop(Cadda, [ptr; Cconst_int(n * size_addr, dbg)], dbg) + +let get_field_gen mut ptr n dbg = + Cop(Cload (Word_val, mut), [field_address ptr n dbg], dbg) + +let set_field ptr n newval init dbg = + Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg) + +let non_profinfo_mask = + if Config.profinfo + then (1 lsl (64 - Config.profinfo_width)) - 1 + else 0 (* [non_profinfo_mask] is unused in this case *) + +let get_header ptr dbg = + (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate] + and [Obj.set_tag]. *) + Cop(Cload (Word_int, Mutable), + [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg) + +let get_header_without_profinfo ptr dbg = + if Config.profinfo then + Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg) + else + get_header ptr dbg + +let tag_offset = + if big_endian then -1 else -size_int + +let get_tag ptr dbg = + if Proc.word_addressed then (* If byte loads are slow *) + Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg) + else (* If byte loads are efficient *) + (* Same comment as [get_header] above *) + Cop(Cload (Byte_unsigned, Mutable), + [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg) + +let get_size ptr dbg = + Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg) + +(* Array indexing *) + +let log2_size_addr = Misc.log2 size_addr +let log2_size_float = Misc.log2 size_float + +let wordsize_shift = 9 +let numfloat_shift = 9 + log2_size_float - log2_size_addr + +let is_addr_array_hdr hdr dbg = + Cop(Ccmpi Cne, + [Cop(Cand, [hdr; Cconst_int (255, dbg)], dbg); floatarray_tag dbg], + dbg) + +let is_addr_array_ptr ptr dbg = + Cop(Ccmpi Cne, [get_tag ptr dbg; floatarray_tag dbg], dbg) + +let addr_array_length_shifted hdr dbg = + Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg) +let float_array_length_shifted hdr dbg = + Cop(Clsr, [hdr; Cconst_int (numfloat_shift, dbg)], dbg) + +let lsl_const c n dbg = + if n = 0 then c + else Cop(Clsl, [c; Cconst_int (n, dbg)], dbg) + +(* Produces a pointer to the element of the array [ptr] on the position [ofs] + with the given element [log2size] log2 element size. [ofs] is given as a + tagged int expression. + The optional ?typ argument is the C-- type of the result. + By default, it is Addr, meaning we are constructing a derived pointer + into the heap. If we know the pointer is outside the heap + (this is the case for bigarray indexing), we give type Int instead. *) + +let array_indexing ?typ log2size ptr ofs dbg = + let add = + match typ with + | None | Some Addr -> Cadda + | Some Int -> Caddi + | _ -> assert false in + match ofs with + | Cconst_int (n, _) -> + let i = n asr 1 in + if i = 0 then ptr + else Cop(add, [ptr; Cconst_int(i lsl log2size, dbg)], dbg) + | Cop(Caddi, + [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') -> + Cop(add, [ptr; lsl_const c log2size dbg], dbg') + | Cop(Caddi, [c; Cconst_int (n, _)], dbg') when log2size = 0 -> + Cop(add, + [Cop(add, [ptr; untag_int c dbg], dbg); Cconst_int (n asr 1, dbg)], + dbg') + | Cop(Caddi, [c; Cconst_int (n, _)], _) -> + Cop(add, [Cop(add, [ptr; lsl_const c (log2size - 1) dbg], dbg); + Cconst_int((n-1) lsl (log2size - 1), dbg)], dbg) + | _ when log2size = 0 -> + Cop(add, [ptr; untag_int ofs dbg], dbg) + | _ -> + Cop(add, [Cop(add, [ptr; lsl_const ofs (log2size - 1) dbg], dbg); + Cconst_int((-1) lsl (log2size - 1), dbg)], dbg) + +let addr_array_ref arr ofs dbg = + Cop(Cload (Word_val, Mutable), + [array_indexing log2_size_addr arr ofs dbg], dbg) +let int_array_ref arr ofs dbg = + Cop(Cload (Word_int, Mutable), + [array_indexing log2_size_addr arr ofs dbg], dbg) +let unboxed_float_array_ref arr ofs dbg = + Cop(Cload (Double_u, Mutable), + [array_indexing log2_size_float arr ofs dbg], dbg) +let float_array_ref arr ofs dbg = + box_float dbg (unboxed_float_array_ref arr ofs dbg) + +let addr_array_set arr ofs newval dbg = + Cop(Cextcall("caml_modify", typ_void, false, None), + [array_indexing log2_size_addr arr ofs dbg; newval], dbg) +let addr_array_initialize arr ofs newval dbg = + Cop(Cextcall("caml_initialize", typ_void, false, None), + [array_indexing log2_size_addr arr ofs dbg; newval], dbg) +let int_array_set arr ofs newval dbg = + Cop(Cstore (Word_int, Lambda.Assignment), + [array_indexing log2_size_addr arr ofs dbg; newval], dbg) +let float_array_set arr ofs newval dbg = + Cop(Cstore (Double_u, Lambda.Assignment), + [array_indexing log2_size_float arr ofs dbg; newval], dbg) + +(* String length *) + +(* Length of string block *) + +let string_length exp dbg = + bind "str" exp (fun str -> + let tmp_var = V.create_local "tmp" in + Clet(VP.create tmp_var, + Cop(Csubi, + [Cop(Clsl, + [get_size str dbg; + Cconst_int (log2_size_addr, dbg)], + dbg); + Cconst_int (1, dbg)], + dbg), + Cop(Csubi, + [Cvar tmp_var; + Cop(Cload (Byte_unsigned, Mutable), + [Cop(Cadda, [str; Cvar tmp_var], dbg)], dbg)], dbg))) + +let bigstring_length ba dbg = + Cop(Cload (Word_int, Mutable), [field_address ba 5 dbg], dbg) + +(* Message sending *) + +let lookup_tag obj tag dbg = + bind "tag" tag (fun tag -> + Cop(Cextcall("caml_get_public_method", typ_val, false, None), + [obj; tag], + dbg)) + +let lookup_label obj lab dbg = + bind "lab" lab (fun lab -> + let table = Cop (Cload (Word_val, Mutable), [obj], dbg) in + addr_array_ref table lab dbg) + +let call_cached_method obj tag cache pos args dbg = + let arity = List.length args in + let cache = array_indexing log2_size_addr cache pos dbg in + Compilenv.need_send_fun arity; + Cop(Capply typ_val, + Cconst_symbol("caml_send" ^ Int.to_string arity, dbg) :: + obj :: tag :: cache :: args, + dbg) + +(* Allocation *) + +let make_alloc_generic set_fn dbg tag wordsize args = + if wordsize <= Config.max_young_wosize then + Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg) + else begin + let id = V.create_local "*alloc*" in + let rec fill_fields idx = function + [] -> Cvar id + | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg, + fill_fields (idx + 2) el) in + Clet(VP.create id, + Cop(Cextcall("caml_alloc", typ_val, true, None), + [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg), + fill_fields 1 args) + end + +let make_alloc dbg tag args = + let addr_array_init arr ofs newval dbg = + Cop(Cextcall("caml_initialize", typ_void, false, None), + [array_indexing log2_size_addr arr ofs dbg; newval], dbg) + in + make_alloc_generic addr_array_init dbg tag (List.length args) args + +let make_float_alloc dbg tag args = + make_alloc_generic float_array_set dbg tag + (List.length args * size_float / size_addr) args + +(* Bounds checking *) + +let make_checkbound dbg = function + | [Cop(Clsr, [a1; Cconst_int (n, _)], _); Cconst_int (m, _)] + when (m lsl n) > n -> + Cop(Ccheckbound, [a1; Cconst_int(m lsl n + 1 lsl n - 1, dbg)], dbg) + | args -> + Cop(Ccheckbound, args, dbg) + +(* Record application and currying functions *) + +let apply_function_sym n = + Compilenv.need_apply_fun n; "caml_apply" ^ Int.to_string n +let curry_function_sym n = + Compilenv.need_curry_fun n; + if n >= 0 + then "caml_curry" ^ Int.to_string n + else "caml_tuplify" ^ Int.to_string (-n) + +(* Big arrays *) + +let bigarray_elt_size : Lambda.bigarray_kind -> int = function + Pbigarray_unknown -> assert false + | Pbigarray_float32 -> 4 + | Pbigarray_float64 -> 8 + | Pbigarray_sint8 -> 1 + | Pbigarray_uint8 -> 1 + | Pbigarray_sint16 -> 2 + | Pbigarray_uint16 -> 2 + | Pbigarray_int32 -> 4 + | Pbigarray_int64 -> 8 + | Pbigarray_caml_int -> size_int + | Pbigarray_native_int -> size_int + | Pbigarray_complex32 -> 8 + | Pbigarray_complex64 -> 16 + +(* Produces a pointer to the element of the bigarray [b] on the position + [args]. [args] is given as a list of tagged int expressions, one per array + dimension. *) +let bigarray_indexing unsafe elt_kind layout b args dbg = + let check_ba_bound bound idx v = + Csequence(make_checkbound dbg [bound;idx], v) in + (* Validates the given multidimensional offset against the array bounds and + transforms it into a one dimensional offset. The offsets are expressions + evaluating to tagged int. *) + let rec ba_indexing dim_ofs delta_ofs = function + [] -> assert false + | [arg] -> + if unsafe then arg + else + bind "idx" arg (fun idx -> + (* Load the untagged int bound for the given dimension *) + let bound = + Cop(Cload (Word_int, Mutable), + [field_address b dim_ofs dbg], dbg) + in + let idxn = untag_int idx dbg in + check_ba_bound bound idxn idx) + | arg1 :: argl -> + (* The remainder of the list is transformed into a one dimensional offset + *) + let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in + (* Load the untagged int bound for the given dimension *) + let bound = + Cop(Cload (Word_int, Mutable), + [field_address b dim_ofs dbg], dbg) + in + if unsafe then add_int (mul_int (decr_int rem dbg) bound dbg) arg1 dbg + else + bind "idx" arg1 (fun idx -> + bind "bound" bound (fun bound -> + let idxn = untag_int idx dbg in + (* [offset = rem * (tag_int bound) + idx] *) + let offset = + add_int (mul_int (decr_int rem dbg) bound dbg) idx dbg + in + check_ba_bound bound idxn offset)) in + (* The offset as an expression evaluating to int *) + let offset = + match (layout : Lambda.bigarray_layout) with + Pbigarray_unknown_layout -> + assert false + | Pbigarray_c_layout -> + ba_indexing (4 + List.length args) (-1) (List.rev args) + | Pbigarray_fortran_layout -> + ba_indexing 5 1 + (List.map (fun idx -> sub_int idx (Cconst_int (2, dbg)) dbg) args) + and elt_size = + bigarray_elt_size elt_kind in + (* [array_indexing] can simplify the given expressions *) + array_indexing ~typ:Addr (Misc.log2 elt_size) + (Cop(Cload (Word_int, Mutable), + [field_address b 1 dbg], dbg)) offset dbg + +let bigarray_word_kind : Lambda.bigarray_kind -> memory_chunk = function + Pbigarray_unknown -> assert false + | Pbigarray_float32 -> Single + | Pbigarray_float64 -> Double + | Pbigarray_sint8 -> Byte_signed + | Pbigarray_uint8 -> Byte_unsigned + | Pbigarray_sint16 -> Sixteen_signed + | Pbigarray_uint16 -> Sixteen_unsigned + | Pbigarray_int32 -> Thirtytwo_signed + | Pbigarray_int64 -> Word_int + | Pbigarray_caml_int -> Word_int + | Pbigarray_native_int -> Word_int + | Pbigarray_complex32 -> Single + | Pbigarray_complex64 -> Double + +let bigarray_get unsafe elt_kind layout b args dbg = + bind "ba" b (fun b -> + match (elt_kind : Lambda.bigarray_kind) with + Pbigarray_complex32 | Pbigarray_complex64 -> + let kind = bigarray_word_kind elt_kind in + let sz = bigarray_elt_size elt_kind / 2 in + bind "addr" + (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> + bind "reval" + (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval -> + bind "imval" + (Cop(Cload (kind, Mutable), + [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg)], dbg)) + (fun imval -> box_complex dbg reval imval))) + | _ -> + Cop(Cload (bigarray_word_kind elt_kind, Mutable), + [bigarray_indexing unsafe elt_kind layout b args dbg], + dbg)) + +let bigarray_set unsafe elt_kind layout b args newval dbg = + bind "ba" b (fun b -> + match (elt_kind : Lambda.bigarray_kind) with + Pbigarray_complex32 | Pbigarray_complex64 -> + let kind = bigarray_word_kind elt_kind in + let sz = bigarray_elt_size elt_kind / 2 in + bind "newval" newval (fun newv -> + bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) + (fun addr -> + Csequence( + Cop(Cstore (kind, Assignment), [addr; complex_re newv dbg], dbg), + Cop(Cstore (kind, Assignment), + [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg); + complex_im newv dbg], + dbg)))) + | _ -> + Cop(Cstore (bigarray_word_kind elt_kind, Assignment), + [bigarray_indexing unsafe elt_kind layout b args dbg; newval], + dbg)) + +(* the three functions below assume either 32-bit or 64-bit words *) +let () = assert (size_int = 4 || size_int = 8) + +(* low_32 x is a value which agrees with x on at least the low 32 bits *) +let rec low_32 dbg = function + | x when size_int = 4 -> x + (* Ignore sign and zero extensions, which do not affect the low bits *) + | Cop(Casr, [Cop(Clsl, [x; Cconst_int (32, _)], _); + Cconst_int (32, _)], _) + | Cop(Cand, [x; Cconst_natint (0xFFFFFFFFn, _)], _) -> + low_32 dbg x + | Clet(id, e, body) -> + Clet(id, e, low_32 dbg body) + | x -> x + +(* sign_extend_32 sign-extends values from 32 bits to the word size. + (if the word size is 32, this is a no-op) *) +let sign_extend_32 dbg e = + if size_int = 4 then e else + Cop(Casr, [Cop(Clsl, [low_32 dbg e; Cconst_int(32, dbg)], dbg); + Cconst_int(32, dbg)], dbg) + +(* zero_extend_32 zero-extends values from 32 bits to the word size. + (if the word size is 32, this is a no-op) *) +let zero_extend_32 dbg e = + if size_int = 4 then e else + Cop(Cand, [low_32 dbg e; Cconst_natint(0xFFFFFFFFn, dbg)], dbg) + +(* Boxed integers *) + +let operations_boxed_int (bi : Primitive.boxed_integer) = + match bi with + Pnativeint -> caml_nativeint_ops + | Pint32 -> caml_int32_ops + | Pint64 -> caml_int64_ops + +let alloc_header_boxed_int (bi : Primitive.boxed_integer) = + match bi with + Pnativeint -> alloc_boxedintnat_header + | Pint32 -> alloc_boxedint32_header + | Pint64 -> alloc_boxedint64_header + +let box_int_gen dbg (bi : Primitive.boxed_integer) arg = + let arg' = + if bi = Primitive.Pint32 && size_int = 8 then + if big_endian + then Cop(Clsl, [arg; Cconst_int (32, dbg)], dbg) + else sign_extend_32 dbg arg + else arg + in + Cop(Calloc, [alloc_header_boxed_int bi dbg; + Cconst_symbol(operations_boxed_int bi, dbg); + arg'], dbg) + +let split_int64_for_32bit_target arg dbg = + bind "split_int64" arg (fun arg -> + let first = Cop (Cadda, [Cconst_int (size_int, dbg); arg], dbg) in + let second = Cop (Cadda, [Cconst_int (2 * size_int, dbg); arg], dbg) in + Ctuple [Cop (Cload (Thirtytwo_unsigned, Mutable), [first], dbg); + Cop (Cload (Thirtytwo_unsigned, Mutable), [second], dbg)]) + +let alloc_matches_boxed_int bi ~hdr ~ops = + match (bi : Primitive.boxed_integer), hdr, ops with + | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> + Nativeint.equal hdr boxedintnat_header + && String.equal sym caml_nativeint_ops + | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> + Nativeint.equal hdr boxedint32_header + && String.equal sym caml_int32_ops + | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> + Nativeint.equal hdr boxedint64_header + && String.equal sym caml_int64_ops + | (Pnativeint | Pint32 | Pint64), _, _ -> false + +let unbox_int dbg bi = + let default arg = + if size_int = 4 && bi = Primitive.Pint64 then + split_int64_for_32bit_target arg dbg + else + Cop( + Cload((if bi = Primitive.Pint32 then Thirtytwo_signed else Word_int), + Immutable), + [Cop(Cadda, [arg; Cconst_int (size_addr, dbg)], dbg)], dbg) + in + map_tail + (function + | Cop(Calloc, + [hdr; ops; + Cop(Clsl, [contents; Cconst_int (32, _)], _dbg')], _dbg) + when bi = Primitive.Pint32 && size_int = 8 && big_endian + && alloc_matches_boxed_int bi ~hdr ~ops -> + (* Force sign-extension of low 32 bits *) + sign_extend_32 dbg contents + | Cop(Calloc, + [hdr; ops; contents], _dbg) + when bi = Primitive.Pint32 && size_int = 8 && not big_endian + && alloc_matches_boxed_int bi ~hdr ~ops -> + (* Force sign-extension of low 32 bits *) + sign_extend_32 dbg contents + | Cop(Calloc, [hdr; ops; contents], _dbg) + when alloc_matches_boxed_int bi ~hdr ~ops -> + contents + | Cconst_symbol (s, _dbg) as cmm -> + begin match Cmmgen_state.structured_constant_of_sym s, bi with + | Some (Uconst_nativeint n), Primitive.Pnativeint -> + Cconst_natint (n, dbg) + | Some (Uconst_int32 n), Primitive.Pint32 -> + Cconst_natint (Nativeint.of_int32 n, dbg) + | Some (Uconst_int64 n), Primitive.Pint64 -> + if size_int = 8 then + Cconst_natint (Int64.to_nativeint n, dbg) + else + let low = Int64.to_nativeint n in + let high = + Int64.to_nativeint (Int64.shift_right_logical n 32) + in + if big_endian then + Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)] + else + Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)] + | _ -> + default cmm + end + | cmm -> + default cmm + ) + +let make_unsigned_int bi arg dbg = + if bi = Primitive.Pint32 && size_int = 8 + then zero_extend_32 dbg arg + else arg + +let unaligned_load_16 ptr idx dbg = + if Arch.allow_unaligned_access + then Cop(Cload (Sixteen_unsigned, Mutable), [add_int ptr idx dbg], dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in + let v2 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in + let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in + Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg) + +let unaligned_set_16 ptr idx newval dbg = + if Arch.allow_unaligned_access + then + Cop(Cstore (Sixteen_unsigned, Assignment), + [add_int ptr idx dbg; newval], dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); + cconst_int 0xFF], dbg) + in + let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in + let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg)) + +let unaligned_load_32 ptr idx dbg = + if Arch.allow_unaligned_access + then Cop(Cload (Thirtytwo_unsigned, Mutable), [add_int ptr idx dbg], dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in + let v2 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) + in + let v3 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) + in + let v4 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) + in + let b1, b2, b3, b4 = + if Arch.big_endian + then v1, v2, v3, v4 + else v4, v3, v2, v1 in + Cop(Cor, + [Cop(Cor, [lsl_int b1 (cconst_int 24) dbg; + lsl_int b2 (cconst_int 16) dbg], dbg); + Cop(Cor, [lsl_int b3 (cconst_int 8) dbg; b4], dbg)], + dbg) + +let unaligned_set_32 ptr idx newval dbg = + if Arch.allow_unaligned_access + then + Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval], + dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg) + in + let v2 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg) + in + let v3 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg) + in + let v4 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in + let b1, b2, b3, b4 = + if Arch.big_endian + then v1, v2, v3, v4 + else v4, v3, v2, v1 in + Csequence( + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int ptr idx dbg; b1], dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], + dbg)), + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3], + dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4], + dbg))) + +let unaligned_load_64 ptr idx dbg = + assert(size_int = 8); + if Arch.allow_unaligned_access + then Cop(Cload (Word_int, Mutable), [add_int ptr idx dbg], dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in + let v2 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in + let v3 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) in + let v4 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) in + let v5 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) in + let v6 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) in + let v7 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) in + let v8 = Cop(Cload (Byte_unsigned, Mutable), + [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) in + let b1, b2, b3, b4, b5, b6, b7, b8 = + if Arch.big_endian + then v1, v2, v3, v4, v5, v6, v7, v8 + else v8, v7, v6, v5, v4, v3, v2, v1 in + Cop(Cor, + [Cop(Cor, + [Cop(Cor, [lsl_int b1 (cconst_int (8*7)) dbg; + lsl_int b2 (cconst_int (8*6)) dbg], dbg); + Cop(Cor, [lsl_int b3 (cconst_int (8*5)) dbg; + lsl_int b4 (cconst_int (8*4)) dbg], dbg)], + dbg); + Cop(Cor, + [Cop(Cor, [lsl_int b5 (cconst_int (8*3)) dbg; + lsl_int b6 (cconst_int (8*2)) dbg], dbg); + Cop(Cor, [lsl_int b7 (cconst_int 8) dbg; + b8], dbg)], + dbg)], dbg) + +let unaligned_set_64 ptr idx newval dbg = + assert(size_int = 8); + if Arch.allow_unaligned_access + then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg) + else + let cconst_int i = Cconst_int (i, dbg) in + let v1 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*7)], dbg); cconst_int 0xFF], + dbg) + in + let v2 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*6)], dbg); cconst_int 0xFF], + dbg) + in + let v3 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*5)], dbg); cconst_int 0xFF], + dbg) + in + let v4 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*4)], dbg); cconst_int 0xFF], + dbg) + in + let v5 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*3)], dbg); cconst_int 0xFF], + dbg) + in + let v6 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*2)], dbg); cconst_int 0xFF], + dbg) + in + let v7 = + Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], + dbg) + in + let v8 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in + let b1, b2, b3, b4, b5, b6, b7, b8 = + if Arch.big_endian + then v1, v2, v3, v4, v5, v6, v7, v8 + else v8, v7, v6, v5, v4, v3, v2, v1 in + Csequence( + Csequence( + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int ptr idx dbg; b1], + dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], + dbg)), + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3], + dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4], + dbg))), + Csequence( + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5], + dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6], + dbg)), + Csequence( + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7], + dbg), + Cop(Cstore (Byte_unsigned, Assignment), + [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8], + dbg)))) + +let max_or_zero a dbg = + bind "size" a (fun a -> + (* equivalent to + Cifthenelse(Cop(Ccmpi Cle, [a; cconst_int 0]), cconst_int 0, a) + + if a is positive, sign is 0 hence sign_negation is full of 1 + so sign_negation&a = a + if a is negative, sign is full of 1 hence sign_negation is 0 + so sign_negation&a = 0 *) + let sign = Cop(Casr, [a; Cconst_int (size_int * 8 - 1, dbg)], dbg) in + let sign_negation = Cop(Cxor, [sign; Cconst_int (-1, dbg)], dbg) in + Cop(Cand, [sign_negation; a], dbg)) + +let check_bound safety access_size dbg length a2 k = + match (safety : Lambda.is_safe) with + | Unsafe -> k + | Safe -> + let offset = + match (access_size : Clambda_primitives.memory_access_size) with + | Sixteen -> 1 + | Thirty_two -> 3 + | Sixty_four -> 7 + in + let a1 = + sub_int length (Cconst_int (offset, dbg)) dbg + in + Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k) + +let unaligned_set size ptr idx newval dbg = + match (size : Clambda_primitives.memory_access_size) with + | Sixteen -> unaligned_set_16 ptr idx newval dbg + | Thirty_two -> unaligned_set_32 ptr idx newval dbg + | Sixty_four -> unaligned_set_64 ptr idx newval dbg + +let unaligned_load size ptr idx dbg = + match (size : Clambda_primitives.memory_access_size) with + | Sixteen -> unaligned_load_16 ptr idx dbg + | Thirty_two -> unaligned_load_32 ptr idx dbg + | Sixty_four -> unaligned_load_64 ptr idx dbg + +let box_sized size dbg exp = + match (size : Clambda_primitives.memory_access_size) with + | Sixteen -> tag_int exp dbg + | Thirty_two -> box_int_gen dbg Pint32 exp + | Sixty_four -> box_int_gen dbg Pint64 exp + +(* Simplification of some primitives into C calls *) + +let default_prim name = + Primitive.simple ~name ~arity:0(*ignored*) ~alloc:true + + +let int64_native_prim name arity ~alloc = + let u64 = Primitive.Unboxed_integer Primitive.Pint64 in + let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in + Primitive.make ~name ~native_name:(name ^ "_native") + ~alloc + ~native_repr_args:(make_args arity) + ~native_repr_res:u64 + +let simplif_primitive_32bits : + Clambda_primitives.primitive -> Clambda_primitives.primitive = function + Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int") + | Pintofbint Pint64 -> Pccall (default_prim "caml_int64_to_int") + | Pcvtbint(Pint32, Pint64) -> Pccall (default_prim "caml_int64_of_int32") + | Pcvtbint(Pint64, Pint32) -> Pccall (default_prim "caml_int64_to_int32") + | Pcvtbint(Pnativeint, Pint64) -> + Pccall (default_prim "caml_int64_of_nativeint") + | Pcvtbint(Pint64, Pnativeint) -> + Pccall (default_prim "caml_int64_to_nativeint") + | Pnegbint Pint64 -> Pccall (int64_native_prim "caml_int64_neg" 1 + ~alloc:false) + | Paddbint Pint64 -> Pccall (int64_native_prim "caml_int64_add" 2 + ~alloc:false) + | Psubbint Pint64 -> Pccall (int64_native_prim "caml_int64_sub" 2 + ~alloc:false) + | Pmulbint Pint64 -> Pccall (int64_native_prim "caml_int64_mul" 2 + ~alloc:false) + | Pdivbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_div" 2 + ~alloc:true) + | Pmodbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_mod" 2 + ~alloc:true) + | Pandbint Pint64 -> Pccall (int64_native_prim "caml_int64_and" 2 + ~alloc:false) + | Porbint Pint64 -> Pccall (int64_native_prim "caml_int64_or" 2 + ~alloc:false) + | Pxorbint Pint64 -> Pccall (int64_native_prim "caml_int64_xor" 2 + ~alloc:false) + | Plslbint Pint64 -> Pccall (default_prim "caml_int64_shift_left") + | Plsrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right_unsigned") + | Pasrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right") + | Pbintcomp(Pint64, Lambda.Ceq) -> Pccall (default_prim "caml_equal") + | Pbintcomp(Pint64, Lambda.Cne) -> Pccall (default_prim "caml_notequal") + | Pbintcomp(Pint64, Lambda.Clt) -> Pccall (default_prim "caml_lessthan") + | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan") + | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal") + | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal") + | Pbigarrayref(_unsafe, n, Pbigarray_int64, _layout) -> + Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n)) + | Pbigarrayset(_unsafe, n, Pbigarray_int64, _layout) -> + Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n)) + | Pstring_load(Sixty_four, _) -> Pccall (default_prim "caml_string_get64") + | Pbytes_load(Sixty_four, _) -> Pccall (default_prim "caml_bytes_get64") + | Pbytes_set(Sixty_four, _) -> Pccall (default_prim "caml_bytes_set64") + | Pbigstring_load(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_get64") + | Pbigstring_set(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_set64") + | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap") + | p -> p + +let simplif_primitive p : Clambda_primitives.primitive = + match (p : Clambda_primitives.primitive) with + | Pduprecord _ -> + Pccall (default_prim "caml_obj_dup") + | Pbigarrayref(_unsafe, n, Pbigarray_unknown, _layout) -> + Pccall (default_prim ("caml_ba_get_" ^ string_of_int n)) + | Pbigarrayset(_unsafe, n, Pbigarray_unknown, _layout) -> + Pccall (default_prim ("caml_ba_set_" ^ string_of_int n)) + | Pbigarrayref(_unsafe, n, _kind, Pbigarray_unknown_layout) -> + Pccall (default_prim ("caml_ba_get_" ^ string_of_int n)) + | Pbigarrayset(_unsafe, n, _kind, Pbigarray_unknown_layout) -> + Pccall (default_prim ("caml_ba_set_" ^ string_of_int n)) + | p -> + if size_int = 8 then p else simplif_primitive_32bits p + +(* Build switchers both for constants and blocks *) + +let transl_isout h arg dbg = tag_int (Cop(Ccmpa Clt, [h ; arg], dbg)) dbg + +(* Build an actual switch (ie jump table) *) + +let make_switch arg cases actions dbg = + let extract_uconstant = + function + (* Constant integers loaded from a table should end in 1, + so that Cload never produces untagged integers *) + | Cconst_int (n, _), _dbg + | Cconst_pointer (n, _), _dbg when (n land 1) = 1 -> + Some (Cint (Nativeint.of_int n)) + | Cconst_natint (n, _), _dbg + | Cconst_natpointer (n, _), _dbg + when Nativeint.(to_int (logand n one) = 1) -> + Some (Cint n) + | Cconst_symbol (s,_), _dbg -> + Some (Csymbol_address s) + | _ -> None + in + let extract_affine ~cases ~const_actions = + let length = Array.length cases in + if length >= 2 + then begin + match const_actions.(cases.(0)), const_actions.(cases.(1)) with + | Cint v0, Cint v1 -> + let slope = Nativeint.sub v1 v0 in + let check i = function + | Cint v -> v = Nativeint.(add (mul (of_int i) slope) v0) + | _ -> false + in + if Misc.Stdlib.Array.for_alli + (fun i idx -> check i const_actions.(idx)) cases + then Some (v0, slope) + else None + | _, _ -> + None + end + else None + in + let make_table_lookup ~cases ~const_actions arg dbg = + let table = Compilenv.new_const_symbol () in + Cmmgen_state.add_constant table (Const_table (Local, + Array.to_list (Array.map (fun act -> + const_actions.(act)) cases))); + addr_array_ref (Cconst_symbol (table, dbg)) (tag_int arg dbg) dbg + in + let make_affine_computation ~offset ~slope arg dbg = + (* In case the resulting integers are an affine function of the index, we + don't emit a table, and just compute the result directly *) + add_int + (mul_int arg (natint_const_untagged dbg slope) dbg) + (natint_const_untagged dbg offset) + dbg + in + match Misc.Stdlib.Array.all_somes (Array.map extract_uconstant actions) with + | None -> + Cswitch (arg,cases,actions,dbg) + | Some const_actions -> + match extract_affine ~cases ~const_actions with + | Some (offset, slope) -> + make_affine_computation ~offset ~slope arg dbg + | None -> make_table_lookup ~cases ~const_actions arg dbg + +module SArgBlocks = +struct + type primitive = operation + + let eqint = Ccmpi Ceq + let neint = Ccmpi Cne + let leint = Ccmpi Cle + let ltint = Ccmpi Clt + let geint = Ccmpi Cge + let gtint = Ccmpi Cgt + + type act = expression + + (* CR mshinwell: GPR#2294 will fix the Debuginfo here *) + + let make_const i = Cconst_int (i, Debuginfo.none) + let make_prim p args = Cop (p,args, Debuginfo.none) + let make_offset arg n = add_const arg n Debuginfo.none + let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none) + let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none) + let make_if cond ifso ifnot = + Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot, + Debuginfo.none) + let make_switch loc arg cases actions = + let dbg = Debuginfo.from_location loc in + let actions = Array.map (fun expr -> expr, dbg) actions in + make_switch arg cases actions dbg + let bind arg body = bind "switcher" arg body + + let make_catch handler = match handler with + | Cexit (i,[]) -> i,fun e -> e + | _ -> + let dbg = Debuginfo.none in + let i = Lambda.next_raise_count () in +(* + Printf.eprintf "SHARE CMM: %i\n" i ; + Printcmm.expression Format.str_formatter handler ; + Printf.eprintf "%s\n" (Format.flush_str_formatter ()) ; +*) + i, + (fun body -> match body with + | Cexit (j,_) -> + if i=j then handler + else body + | _ -> ccatch (i,[],body,handler, dbg)) + + let make_exit i = Cexit (i,[]) + +end + +(* cmm store, as sharing as normally been detected in previous + phases, we only share exits *) +(* Some specific patterns can lead to switches where several cases + point to the same action, but this action is not an exit (see GPR#1370). + The addition of the index in the action array as context allows to + share them correctly without duplication. *) +module StoreExpForSwitch = + Switch.CtxStore + (struct + type t = expression + type key = int option * int + type context = int + let make_key index expr = + let continuation = + match expr with + | Cexit (i,[]) -> Some i + | _ -> None + in + Some (continuation, index) + let compare_key (cont, index) (cont', index') = + match cont, cont' with + | Some i, Some i' when i = i' -> 0 + | _, _ -> Stdlib.compare index index' + end) + +(* For string switches, we can use a generic store *) +module StoreExp = + Switch.Store + (struct + type t = expression + type key = int + let make_key = function + | Cexit (i,[]) -> Some i + | _ -> None + let compare_key = Stdlib.compare + end) + +module SwitcherBlocks = Switch.Make(SArgBlocks) + +(* Int switcher, arg in [low..high], + cases is list of individual cases, and is sorted by first component *) + +let transl_int_switch loc arg low high cases default = match cases with +| [] -> assert false +| _::_ -> + let store = StoreExp.mk_store () in + assert (store.Switch.act_store () default = 0) ; + let cases = + List.map + (fun (i,act) -> i,store.Switch.act_store () act) + cases in + let rec inters plow phigh pact = function + | [] -> + if phigh = high then [plow,phigh,pact] + else [(plow,phigh,pact); (phigh+1,high,0) ] + | (i,act)::rem -> + if i = phigh+1 then + if pact = act then + inters plow i pact rem + else + (plow,phigh,pact)::inters i i act rem + else (* insert default *) + if pact = 0 then + if act = 0 then + inters plow i 0 rem + else + (plow,i-1,pact):: + inters i i act rem + else (* pact <> 0 *) + (plow,phigh,pact):: + begin + if act = 0 then inters (phigh+1) i 0 rem + else (phigh+1,i-1,0)::inters i i act rem + end in + let inters = match cases with + | [] -> assert false + | (k0,act0)::rem -> + if k0 = low then inters k0 k0 act0 rem + else inters low (k0-1) 0 cases in + bind "switcher" arg + (fun a -> + SwitcherBlocks.zyva + loc + (low,high) + a + (Array.of_list inters) store) + + +let transl_switch_clambda loc arg index cases = + let store = StoreExpForSwitch.mk_store () in + let index = + Array.map + (fun j -> store.Switch.act_store j cases.(j)) + index in + let n_index = Array.length index in + let inters = ref [] + and this_high = ref (n_index-1) + and this_low = ref (n_index-1) + and this_act = ref index.(n_index-1) in + for i = n_index-2 downto 0 do + let act = index.(i) in + if act = !this_act then + decr this_low + else begin + inters := (!this_low, !this_high, !this_act) :: !inters ; + this_high := i ; + this_low := i ; + this_act := act + end + done ; + inters := (0, !this_high, !this_act) :: !inters ; + match !inters with + | [_] -> cases.(0) + | inters -> + bind "switcher" arg + (fun a -> + SwitcherBlocks.zyva + loc + (0,n_index-1) + a + (Array.of_list inters) store) + +let strmatch_compile = + let module S = + Strmatch.Make + (struct + let string_block_length ptr = get_size ptr Debuginfo.none + let transl_switch = transl_int_switch + end) in + S.compile + +let ptr_offset ptr offset dbg = + if offset = 0 + then ptr + else Cop(Caddv, [ptr; Cconst_int(offset * size_addr, dbg)], dbg) + +let direct_apply lbl args dbg = + Cop(Capply typ_val, Cconst_symbol (lbl, dbg) :: args, dbg) + +let generic_apply mut clos args dbg = + match args with + | [arg] -> + bind "fun" clos (fun clos -> + Cop(Capply typ_val, [get_field_gen mut clos 0 dbg; arg; clos], + dbg)) + | _ -> + let arity = List.length args in + let cargs = + Cconst_symbol(apply_function_sym arity, dbg) :: args @ [clos] + in + Cop(Capply typ_val, cargs, dbg) + +let send kind met obj args dbg = + let call_met obj args clos = + (* met is never a simple expression, so it never gets turned into an + Immutable load *) + generic_apply Asttypes.Mutable clos (obj :: args) dbg + in + bind "obj" obj (fun obj -> + match (kind : Lambda.meth_kind), args with + Self, _ -> + bind "met" (lookup_label obj met dbg) + (call_met obj args) + | Cached, cache :: pos :: args -> + call_cached_method obj met cache pos args dbg + | _ -> + bind "met" (lookup_tag obj met dbg) + (call_met obj args)) + +(* +CAMLprim value caml_cache_public_method (value meths, value tag, value *cache) +{ + int li = 3, hi = Field(meths,0), mi; + while (li < hi) { // no need to check the 1st time + mi = ((li+hi) >> 1) | 1; + if (tag < Field(meths,mi)) hi = mi-2; + else li = mi; + } + *cache = (li-3)*sizeof(value)+1; + return Field (meths, li-1); +} +*) + +let cache_public_method meths tag cache dbg = + let raise_num = Lambda.next_raise_count () in + let cconst_int i = Cconst_int (i, dbg) in + let li = V.create_local "*li*" and hi = V.create_local "*hi*" + and mi = V.create_local "*mi*" and tagged = V.create_local "*tagged*" in + Clet ( + VP.create li, cconst_int 3, + Clet ( + VP.create hi, Cop(Cload (Word_int, Mutable), [meths], dbg), + Csequence( + ccatch + (raise_num, [], + create_loop + (Clet( + VP.create mi, + Cop(Cor, + [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1], + dbg); + cconst_int 1], + dbg), + Csequence( + Cifthenelse + (Cop (Ccmpi Clt, + [tag; + Cop(Cload (Word_int, Mutable), + [Cop(Cadda, + [meths; lsl_const (Cvar mi) log2_size_addr dbg], + dbg)], + dbg)], dbg), + dbg, Cassign(hi, Cop(Csubi, [Cvar mi; cconst_int 2], dbg)), + dbg, Cassign(li, Cvar mi), + dbg), + Cifthenelse + (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg), + dbg, Cexit (raise_num, []), + dbg, Ctuple [], + dbg)))) + dbg, + Ctuple [], + dbg), + Clet ( + VP.create tagged, + Cop(Cadda, [lsl_const (Cvar li) log2_size_addr dbg; + cconst_int(1 - 3 * size_addr)], dbg), + Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg), + Cvar tagged))))) + +(* CR mshinwell: These will be filled in by later pull requests. *) +let placeholder_dbg () = Debuginfo.none +let placeholder_fun_dbg ~human_name:_ = Debuginfo.none + +(* Generate an application function: + (defun caml_applyN (a1 ... aN clos) + (if (= clos.arity N) + (app clos.direct a1 ... aN clos) + (let (clos1 (app clos.code a1 clos) + clos2 (app clos1.code a2 clos) + ... + closN-1 (app closN-2.code aN-1 closN-2)) + (app closN-1.code aN closN-1)))) +*) + +let apply_function_body arity = + let dbg = placeholder_dbg in + let arg = Array.make arity (V.create_local "arg") in + for i = 1 to arity - 1 do arg.(i) <- V.create_local "arg" done; + let clos = V.create_local "clos" in + let rec app_fun clos n = + if n = arity-1 then + Cop(Capply typ_val, + [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ()); + Cvar arg.(n); + Cvar clos], + dbg ()) + else begin + let newclos = V.create_local "clos" in + Clet(VP.create newclos, + Cop(Capply typ_val, + [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ()); + Cvar arg.(n); Cvar clos], dbg ()), + app_fun newclos (n+1)) + end in + let args = Array.to_list arg in + let all_args = args @ [clos] in + (args, clos, + if arity = 1 then app_fun clos 0 else + Cifthenelse( + Cop(Ccmpi Ceq, [get_field_gen Asttypes.Mutable (Cvar clos) 1 (dbg ()); + int_const (dbg ()) arity], dbg ()), + dbg (), + Cop(Capply typ_val, + get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) + :: List.map (fun s -> Cvar s) all_args, + dbg ()), + dbg (), + app_fun clos 0, + dbg ())) + +let send_function arity = + let dbg = placeholder_dbg in + let cconst_int i = Cconst_int (i, dbg ()) in + let (args, clos', body) = apply_function_body (1+arity) in + let cache = V.create_local "cache" + and obj = List.hd args + and tag = V.create_local "tag" in + let clos = + let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in + let meths = V.create_local "meths" and cached = V.create_local "cached" in + let real = V.create_local "real" in + let mask = get_field_gen Asttypes.Mutable (Cvar meths) 1 (dbg ()) in + let cached_pos = Cvar cached in + let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths], dbg ()); + cconst_int(3*size_addr-1)], dbg ()) in + let tag' = Cop(Cload (Word_int, Mutable), [tag_pos], dbg ()) in + Clet ( + VP.create meths, Cop(Cload (Word_val, Mutable), [obj], dbg ()), + Clet ( + VP.create cached, + Cop(Cand, [Cop(Cload (Word_int, Mutable), [cache], dbg ()); mask], + dbg ()), + Clet ( + VP.create real, + Cifthenelse(Cop(Ccmpa Cne, [tag'; tag], dbg ()), + dbg (), + cache_public_method (Cvar meths) tag cache (dbg ()), + dbg (), + cached_pos, + dbg ()), + Cop(Cload (Word_val, Mutable), + [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths], dbg ()); + cconst_int(2*size_addr-1)], dbg ())], dbg ())))) + + in + let body = Clet(VP.create clos', clos, body) in + let cache = cache in + let fun_name = "caml_send" ^ Int.to_string arity in + let fun_args = + [obj, typ_val; tag, typ_int; cache, typ_val] + @ List.map (fun id -> (id, typ_val)) (List.tl args) in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + Cfunction + {fun_name; + fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args; + fun_body = body; + fun_codegen_options = []; + fun_dbg; + } + +let apply_function arity = + let (args, clos, body) = apply_function_body arity in + let all_args = args @ [clos] in + let fun_name = "caml_apply" ^ Int.to_string arity in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + Cfunction + {fun_name; + fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args; + fun_body = body; + fun_codegen_options = []; + fun_dbg; + } + +(* Generate tuplifying functions: + (defun caml_tuplifyN (arg clos) + (app clos.direct #0(arg) ... #N-1(arg) clos)) *) + +let tuplify_function arity = + let dbg = placeholder_dbg in + let arg = V.create_local "arg" in + let clos = V.create_local "clos" in + let rec access_components i = + if i >= arity + then [] + else get_field_gen Asttypes.Mutable (Cvar arg) i (dbg ()) + :: access_components(i+1) + in + let fun_name = "caml_tuplify" ^ Int.to_string arity in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + Cfunction + {fun_name; + fun_args = [VP.create arg, typ_val; VP.create clos, typ_val]; + fun_body = + Cop(Capply typ_val, + get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) + :: access_components 0 @ [Cvar clos], + (dbg ())); + fun_codegen_options = []; + fun_dbg; + } + +(* Generate currying functions: + (defun caml_curryN (arg clos) + (alloc HDR caml_curryN_1 caml_curry_N_1_app arg clos)) + (defun caml_curryN_1 (arg clos) + (alloc HDR caml_curryN_2 caml_curry_N_2_app arg clos)) + ... + (defun caml_curryN_N-1 (arg clos) + (let (closN-2 clos.vars[1] + closN-3 closN-2.vars[1] + ... + clos1 clos2.vars[1] + clos clos1.vars[1]) + (app clos.direct + clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos))) + + Special "shortcut" functions are also generated to handle the + case where a partially applied function is applied to all remaining + arguments in one go. For instance: + (defun caml_curry_N_1_app (arg2 ... argN clos) + (let clos' clos.vars[1] + (app clos'.direct clos.vars[0] arg2 ... argN clos'))) + + Those shortcuts may lead to a quadratic number of application + primitives being generated in the worst case, which resulted in + linking time blowup in practice (PR#5933), so we only generate and + use them when below a fixed arity 'max_arity_optimized'. +*) + +let max_arity_optimized = 15 +let final_curry_function arity = + let dbg = placeholder_dbg in + let last_arg = V.create_local "arg" in + let last_clos = V.create_local "clos" in + let rec curry_fun args clos n = + if n = 0 then + Cop(Capply typ_val, + get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) :: + args @ [Cvar last_arg; Cvar clos], + dbg ()) + else + if n = arity - 1 || arity > max_arity_optimized then + begin + let newclos = V.create_local "clos" in + Clet(VP.create newclos, + get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()), + curry_fun (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) + :: args) + newclos (n-1)) + end else + begin + let newclos = V.create_local "clos" in + Clet(VP.create newclos, + get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()), + curry_fun + (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()) :: args) + newclos (n-1)) + end in + let fun_name = + "caml_curry" ^ Int.to_string arity ^ "_" ^ Int.to_string (arity-1) + in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + Cfunction + {fun_name; + fun_args = [VP.create last_arg, typ_val; VP.create last_clos, typ_val]; + fun_body = curry_fun [] last_clos (arity-1); + fun_codegen_options = []; + fun_dbg; + } + +let rec intermediate_curry_functions arity num = + let dbg = placeholder_dbg in + if num = arity - 1 then + [final_curry_function arity] + else begin + let name1 = "caml_curry" ^ Int.to_string arity in + let name2 = if num = 0 then name1 else name1 ^ "_" ^ Int.to_string num in + let arg = V.create_local "arg" and clos = V.create_local "clos" in + let fun_dbg = placeholder_fun_dbg ~human_name:name2 in + Cfunction + {fun_name = name2; + fun_args = [VP.create arg, typ_val; VP.create clos, typ_val]; + fun_body = + if arity - num > 2 && arity <= max_arity_optimized then + Cop(Calloc, + [alloc_closure_header 5 (dbg ()); + Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ()); + int_const (dbg ()) (arity - num - 1); + Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app", + dbg ()); + Cvar arg; Cvar clos], + dbg ()) + else + Cop(Calloc, + [alloc_closure_header 4 (dbg ()); + Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ()); + int_const (dbg ()) 1; Cvar arg; Cvar clos], + dbg ()); + fun_codegen_options = []; + fun_dbg; + } + :: + (if arity <= max_arity_optimized && arity - num > 2 then + let rec iter i = + if i <= arity then + let arg = V.create_local (Printf.sprintf "arg%d" i) in + (arg, typ_val) :: iter (i+1) + else [] + in + let direct_args = iter (num+2) in + let rec iter i args clos = + if i = 0 then + Cop(Capply typ_val, + (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())) + :: args @ [Cvar clos], + dbg ()) + else + let newclos = V.create_local "clos" in + Clet(VP.create newclos, + get_field_gen Asttypes.Mutable (Cvar clos) 4 (dbg ()), + iter (i-1) + (get_field_gen Asttypes.Mutable (Cvar clos) 3 (dbg ()) + :: args) + newclos) + in + let fun_args = + List.map (fun (arg, ty) -> VP.create arg, ty) + (direct_args @ [clos, typ_val]) + in + let fun_name = name1 ^ "_" ^ Int.to_string (num+1) ^ "_app" in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + let cf = + Cfunction + {fun_name; + fun_args; + fun_body = iter (num+1) + (List.map (fun (arg,_) -> Cvar arg) direct_args) clos; + fun_codegen_options = []; + fun_dbg; + } + in + cf :: intermediate_curry_functions arity (num+1) + else + intermediate_curry_functions arity (num+1)) + end + +let curry_function arity = + assert(arity <> 0); + (* Functions with arity = 0 does not have a curry_function *) + if arity > 0 + then intermediate_curry_functions arity 0 + else [tuplify_function (-arity)] + +module Int = Numbers.Int + +let default_apply = Int.Set.add 2 (Int.Set.add 3 Int.Set.empty) + (* These apply funs are always present in the main program because + the run-time system needs them (cf. runtime/.S) . *) + +let generic_functions shared units = + let (apply,send,curry) = + List.fold_left + (fun (apply,send,curry) (ui : Cmx_format.unit_infos) -> + List.fold_right Int.Set.add ui.ui_apply_fun apply, + List.fold_right Int.Set.add ui.ui_send_fun send, + List.fold_right Int.Set.add ui.ui_curry_fun curry) + (Int.Set.empty,Int.Set.empty,Int.Set.empty) + units in + let apply = if shared then apply else Int.Set.union apply default_apply in + let accu = Int.Set.fold (fun n accu -> apply_function n :: accu) apply [] in + let accu = Int.Set.fold (fun n accu -> send_function n :: accu) send accu in + Int.Set.fold (fun n accu -> curry_function n @ accu) curry accu + +(* Primitives *) + +type unary_primitive = expression -> Debuginfo.t -> expression + +let floatfield n ptr dbg = + Cop(Cload (Double_u, Mutable), + [if n = 0 then ptr + else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)], + dbg) + +let int_as_pointer arg dbg = + Cop(Caddi, [arg; Cconst_int (-1, dbg)], dbg) + (* always a pointer outside the heap *) + +let raise_prim raise_kind arg dbg = + if !Clflags.debug then + Cop (Craise raise_kind, [arg], dbg) + else + Cop (Craise Lambda.Raise_notrace, [arg], dbg) + +let negint arg dbg = + Cop(Csubi, [Cconst_int (2, dbg); arg], dbg) + +(* [offsetint] moved down to reuse add_int_caml *) + +let offsetref n arg dbg = + return_unit dbg + (bind "ref" arg (fun arg -> + Cop(Cstore (Word_int, Assignment), + [arg; + add_const (Cop(Cload (Word_int, Mutable), [arg], dbg)) + (n lsl 1) dbg], + dbg))) + +let arraylength kind arg dbg = + let hdr = get_header_without_profinfo arg dbg in + match (kind : Lambda.array_kind) with + Pgenarray -> + let len = + if wordsize_shift = numfloat_shift then + Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg) + else + bind "header" hdr (fun hdr -> + Cifthenelse(is_addr_array_hdr hdr dbg, + dbg, + Cop(Clsr, + [hdr; Cconst_int (wordsize_shift, dbg)], dbg), + dbg, + Cop(Clsr, + [hdr; Cconst_int (numfloat_shift, dbg)], dbg), + dbg)) + in + Cop(Cor, [len; Cconst_int (1, dbg)], dbg) + | Paddrarray | Pintarray -> + Cop(Cor, [addr_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg) + | Pfloatarray -> + Cop(Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg) + +let bbswap bi arg dbg = + let prim = match (bi : Primitive.boxed_integer) with + | Pnativeint -> "nativeint" + | Pint32 -> "int32" + | Pint64 -> "int64" + in + Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim, + typ_int, false, None), + [arg], + dbg) + +let bswap16 arg dbg = + (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None), + [arg], + dbg)) + +type binary_primitive = expression -> expression -> Debuginfo.t -> expression + +(* let pfield_computed = addr_array_ref *) + +(* Helper for compilation of initialization and assignment operations *) + +type assignment_kind = Caml_modify | Caml_initialize | Simple + +let assignment_kind + (ptr: Lambda.immediate_or_pointer) + (init: Lambda.initialization_or_assignment) = + match init, ptr with + | Assignment, Pointer -> Caml_modify + | Heap_initialization, Pointer -> Caml_initialize + | Assignment, Immediate + | Heap_initialization, Immediate + | Root_initialization, (Immediate | Pointer) -> Simple + +let setfield n ptr init arg1 arg2 dbg = + match assignment_kind ptr init with + | Caml_modify -> + return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None), + [field_address arg1 n dbg; + arg2], + dbg)) + | Caml_initialize -> + return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None), + [field_address arg1 n dbg; + arg2], + dbg)) + | Simple -> + return_unit dbg (set_field arg1 n arg2 init dbg) + +let setfloatfield n init arg1 arg2 dbg = + return_unit dbg ( + Cop(Cstore (Double_u, init), + [if n = 0 then arg1 + else Cop(Cadda, [arg1; Cconst_int(n * size_float, dbg)], dbg); + arg2], dbg)) + +let add_int_caml arg1 arg2 dbg = + decr_int (add_int arg1 arg2 dbg) dbg + +(* Unary primitive delayed to reuse add_int_caml *) +let offsetint n arg dbg = + if Misc.no_overflow_lsl n 1 then + add_const arg (n lsl 1) dbg + else + add_int_caml arg (int_const dbg n) dbg + +let sub_int_caml arg1 arg2 dbg = + incr_int (sub_int arg1 arg2 dbg) dbg + +let mul_int_caml arg1 arg2 dbg = + (* decrementing the non-constant part helps when the multiplication is + followed by an addition; + for example, using this trick compiles (100 * a + 7) into + (+ ( * a 100) -85) + rather than + (+ ( * 200 (>>s a 1)) 15) + *) + match arg1, arg2 with + | Cconst_int _ as c1, c2 -> + incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg + | c1, c2 -> + incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg + +let div_int_caml is_safe arg1 arg2 dbg = + tag_int(div_int (untag_int arg1 dbg) + (untag_int arg2 dbg) is_safe dbg) dbg + +let mod_int_caml is_safe arg1 arg2 dbg = + tag_int(mod_int (untag_int arg1 dbg) + (untag_int arg2 dbg) is_safe dbg) dbg + +let and_int_caml arg1 arg2 dbg = + Cop(Cand, [arg1; arg2], dbg) + +let or_int_caml arg1 arg2 dbg = + Cop(Cor, [arg1; arg2], dbg) + +let xor_int_caml arg1 arg2 dbg = + Cop(Cor, [Cop(Cxor, [ignore_low_bit_int arg1; + ignore_low_bit_int arg2], dbg); + Cconst_int (1, dbg)], dbg) + +let lsl_int_caml arg1 arg2 dbg = + incr_int(lsl_int (decr_int arg1 dbg) + (untag_int arg2 dbg) dbg) dbg + +let lsr_int_caml arg1 arg2 dbg = + Cop(Cor, [lsr_int arg1 (untag_int arg2 dbg) dbg; + Cconst_int (1, dbg)], dbg) + +let asr_int_caml arg1 arg2 dbg = + Cop(Cor, [asr_int arg1 (untag_int arg2 dbg) dbg; + Cconst_int (1, dbg)], dbg) + +let int_comp_caml cmp arg1 arg2 dbg = + tag_int(Cop(Ccmpi cmp, + [arg1; arg2], dbg)) dbg + +let stringref_unsafe arg1 arg2 dbg = + tag_int(Cop(Cload (Byte_unsigned, Mutable), + [add_int arg1 (untag_int arg2 dbg) dbg], + dbg)) dbg + +let stringref_safe arg1 arg2 dbg = + tag_int + (bind "str" arg1 (fun str -> + bind "index" (untag_int arg2 dbg) (fun idx -> + Csequence( + make_checkbound dbg [string_length str dbg; idx], + Cop(Cload (Byte_unsigned, Mutable), + [add_int str idx dbg], dbg))))) dbg + +let string_load size unsafe arg1 arg2 dbg = + box_sized size dbg + (bind "str" arg1 (fun str -> + bind "index" (untag_int arg2 dbg) (fun idx -> + check_bound unsafe size dbg + (string_length str dbg) + idx (unaligned_load size str idx dbg)))) + +let bigstring_load size unsafe arg1 arg2 dbg = + box_sized size dbg + (bind "ba" arg1 (fun ba -> + bind "index" (untag_int arg2 dbg) (fun idx -> + bind "ba_data" + (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg)) + (fun ba_data -> + check_bound unsafe size dbg + (bigstring_length ba dbg) + idx + (unaligned_load size ba_data idx dbg))))) + +let arrayref_unsafe kind arg1 arg2 dbg = + match (kind : Lambda.array_kind) with + | Pgenarray -> + bind "arr" arg1 (fun arr -> + bind "index" arg2 (fun idx -> + Cifthenelse(is_addr_array_ptr arr dbg, + dbg, + addr_array_ref arr idx dbg, + dbg, + float_array_ref arr idx dbg, + dbg))) + | Paddrarray -> + addr_array_ref arg1 arg2 dbg + | Pintarray -> + (* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *) + int_array_ref arg1 arg2 dbg + | Pfloatarray -> + float_array_ref arg1 arg2 dbg + +let arrayref_safe kind arg1 arg2 dbg = + match (kind : Lambda.array_kind) with + | Pgenarray -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + bind "header" (get_header_without_profinfo arr dbg) (fun hdr -> + if wordsize_shift = numfloat_shift then + Csequence( + make_checkbound dbg [addr_array_length_shifted hdr dbg; idx], + Cifthenelse(is_addr_array_hdr hdr dbg, + dbg, + addr_array_ref arr idx dbg, + dbg, + float_array_ref arr idx dbg, + dbg)) + else + Cifthenelse(is_addr_array_hdr hdr dbg, + dbg, + Csequence( + make_checkbound dbg [addr_array_length_shifted hdr dbg; idx], + addr_array_ref arr idx dbg), + dbg, + Csequence( + make_checkbound dbg [float_array_length_shifted hdr dbg; idx], + float_array_ref arr idx dbg), + dbg)))) + | Paddrarray -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + addr_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; idx], + addr_array_ref arr idx dbg))) + | Pintarray -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + addr_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; idx], + int_array_ref arr idx dbg))) + | Pfloatarray -> + box_float dbg ( + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + float_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; + idx], + unboxed_float_array_ref arr idx dbg)))) + +type ternary_primitive = + expression -> expression -> expression -> Debuginfo.t -> expression + +let setfield_computed ptr init arg1 arg2 arg3 dbg = + match assignment_kind ptr init with + | Caml_modify -> + return_unit dbg (addr_array_set arg1 arg2 arg3 dbg) + | Caml_initialize -> + return_unit dbg (addr_array_initialize arg1 arg2 arg3 dbg) + | Simple -> + return_unit dbg (int_array_set arg1 arg2 arg3 dbg) + +let bytesset_unsafe arg1 arg2 arg3 dbg = + return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment), + [add_int arg1 (untag_int arg2 dbg) dbg; + ignore_high_bit_int (untag_int arg3 dbg)], dbg)) + +let bytesset_safe arg1 arg2 arg3 dbg = + return_unit dbg + (bind "str" arg1 (fun str -> + bind "index" (untag_int arg2 dbg) (fun idx -> + Csequence( + make_checkbound dbg [string_length str dbg; idx], + Cop(Cstore (Byte_unsigned, Assignment), + [add_int str idx dbg; + ignore_high_bit_int (untag_int arg3 dbg)], + dbg))))) + +let arrayset_unsafe kind arg1 arg2 arg3 dbg = + return_unit dbg (match (kind: Lambda.array_kind) with + | Pgenarray -> + bind "newval" arg3 (fun newval -> + bind "index" arg2 (fun index -> + bind "arr" arg1 (fun arr -> + Cifthenelse(is_addr_array_ptr arr dbg, + dbg, + addr_array_set arr index newval dbg, + dbg, + float_array_set arr index (unbox_float dbg newval) + dbg, + dbg)))) + | Paddrarray -> + addr_array_set arg1 arg2 arg3 dbg + | Pintarray -> + int_array_set arg1 arg2 arg3 dbg + | Pfloatarray -> + float_array_set arg1 arg2 arg3 dbg + ) + +let arrayset_safe kind arg1 arg2 arg3 dbg = + return_unit dbg (match (kind: Lambda.array_kind) with + | Pgenarray -> + bind "newval" arg3 (fun newval -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + bind "header" (get_header_without_profinfo arr dbg) (fun hdr -> + if wordsize_shift = numfloat_shift then + Csequence( + make_checkbound dbg [addr_array_length_shifted hdr dbg; idx], + Cifthenelse(is_addr_array_hdr hdr dbg, + dbg, + addr_array_set arr idx newval dbg, + dbg, + float_array_set arr idx + (unbox_float dbg newval) + dbg, + dbg)) + else + Cifthenelse( + is_addr_array_hdr hdr dbg, + dbg, + Csequence( + make_checkbound dbg [addr_array_length_shifted hdr dbg; idx], + addr_array_set arr idx newval dbg), + dbg, + Csequence( + make_checkbound dbg [float_array_length_shifted hdr dbg; idx], + float_array_set arr idx + (unbox_float dbg newval) dbg), + dbg))))) + | Paddrarray -> + bind "newval" arg3 (fun newval -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + addr_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; + idx], + addr_array_set arr idx newval dbg)))) + | Pintarray -> + bind "newval" arg3 (fun newval -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + addr_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; + idx], + int_array_set arr idx newval dbg)))) + | Pfloatarray -> + bind_load "newval" arg3 (fun newval -> + bind "index" arg2 (fun idx -> + bind "arr" arg1 (fun arr -> + Csequence( + make_checkbound dbg [ + float_array_length_shifted + (get_header_without_profinfo arr dbg) dbg; + idx], + float_array_set arr idx newval dbg)))) + ) + +let bytes_set size unsafe arg1 arg2 arg3 dbg = + return_unit dbg + (bind "str" arg1 (fun str -> + bind "index" (untag_int arg2 dbg) (fun idx -> + bind "newval" arg3 (fun newval -> + check_bound unsafe size dbg (string_length str dbg) + idx (unaligned_set size str idx newval dbg))))) + +let bigstring_set size unsafe arg1 arg2 arg3 dbg = + return_unit dbg + (bind "ba" arg1 (fun ba -> + bind "index" (untag_int arg2 dbg) (fun idx -> + bind "newval" arg3 (fun newval -> + bind "ba_data" + (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg)) + (fun ba_data -> + check_bound unsafe size dbg (bigstring_length ba dbg) + idx (unaligned_set size ba_data idx newval dbg)))))) + +(* Symbols *) + +let cdefine_symbol (symb, (global: Cmmgen_state.is_global)) = + match global with + | Global -> [Cglobal_symbol symb; Cdefine_symbol symb] + | Local -> [Cdefine_symbol symb] + +let emit_block symb white_header cont = + (* Headers for structured constants must be marked black in case we + are in no-naked-pointers mode. See [caml_darken]. *) + let black_header = Nativeint.logor white_header caml_black in + Cint black_header :: cdefine_symbol symb @ cont + +let emit_string_constant_fields s cont = + let n = size_int - 1 - (String.length s) mod size_int in + Cstring s :: Cskip n :: Cint8 n :: cont + +let emit_boxed_int32_constant_fields n cont = + let n = Nativeint.of_int32 n in + if size_int = 8 then + Csymbol_address caml_int32_ops :: Cint32 n :: Cint32 0n :: cont + else + Csymbol_address caml_int32_ops :: Cint n :: cont + +let emit_boxed_int64_constant_fields n cont = + let lo = Int64.to_nativeint n in + if size_int = 8 then + Csymbol_address caml_int64_ops :: Cint lo :: cont + else begin + let hi = Int64.to_nativeint (Int64.shift_right n 32) in + if big_endian then + Csymbol_address caml_int64_ops :: Cint hi :: Cint lo :: cont + else + Csymbol_address caml_int64_ops :: Cint lo :: Cint hi :: cont + end + +let emit_boxed_nativeint_constant_fields n cont = + Csymbol_address caml_nativeint_ops :: Cint n :: cont + +let emit_float_constant symb f cont = + emit_block symb float_header (Cdouble f :: cont) + +let emit_string_constant symb s cont = + emit_block symb (string_header (String.length s)) + (emit_string_constant_fields s cont) + +let emit_int32_constant symb n cont = + emit_block symb boxedint32_header + (emit_boxed_int32_constant_fields n cont) + +let emit_int64_constant symb n cont = + emit_block symb boxedint64_header + (emit_boxed_int64_constant_fields n cont) + +let emit_nativeint_constant symb n cont = + emit_block symb boxedintnat_header + (emit_boxed_nativeint_constant_fields n cont) + +let emit_float_array_constant symb fields cont = + emit_block symb (floatarray_header (List.length fields)) + (Misc.map_end (fun f -> Cdouble f) fields cont) + +(* Generate the entry point *) + +let entry_point namelist = + let dbg = placeholder_dbg in + let cconst_int i = Cconst_int (i, dbg ()) in + let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in + let incr_global_inited () = + Cop(Cstore (Word_int, Assignment), + [cconst_symbol "caml_globals_inited"; + Cop(Caddi, [Cop(Cload (Word_int, Mutable), + [cconst_symbol "caml_globals_inited"], dbg ()); + cconst_int 1], dbg ())], dbg ()) in + let body = + List.fold_right + (fun name next -> + let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in + Csequence(Cop(Capply typ_void, + [cconst_symbol entry_sym], dbg ()), + Csequence(incr_global_inited (), next))) + namelist (cconst_int 1) in + let fun_name = "caml_program" in + let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in + Cfunction {fun_name; + fun_args = []; + fun_body = body; + fun_codegen_options = [Reduce_code_size]; + fun_dbg; + } + +(* Generate the table of globals *) + +let cint_zero = Cint 0n + +let global_table namelist = + let mksym name = + Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots")) + in + Cdata(Cglobal_symbol "caml_globals" :: + Cdefine_symbol "caml_globals" :: + List.map mksym namelist @ + [cint_zero]) + +let reference_symbols namelist = + let mksym name = Csymbol_address name in + Cdata(List.map mksym namelist) + +let global_data name v = + Cdata(emit_string_constant (name, Global) + (Marshal.to_string v []) []) + +let globals_map v = global_data "caml_globals_map" v + +(* Generate the master table of frame descriptors *) + +let frame_table namelist = + let mksym name = + Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable")) + in + Cdata(Cglobal_symbol "caml_frametable" :: + Cdefine_symbol "caml_frametable" :: + List.map mksym namelist + @ [cint_zero]) + +(* Generate the master table of Spacetime shapes *) + +let spacetime_shapes namelist = + let mksym name = + Csymbol_address ( + Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes")) + in + Cdata(Cglobal_symbol "caml_spacetime_shapes" :: + Cdefine_symbol "caml_spacetime_shapes" :: + List.map mksym namelist + @ [cint_zero]) + +(* Generate the table of module data and code segments *) + +let segment_table namelist symbol begname endname = + let addsyms name lst = + Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) :: + Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) :: + lst + in + Cdata(Cglobal_symbol symbol :: + Cdefine_symbol symbol :: + List.fold_right addsyms namelist [cint_zero]) + +let data_segment_table namelist = + segment_table namelist "caml_data_segments" "data_begin" "data_end" + +let code_segment_table namelist = + segment_table namelist "caml_code_segments" "code_begin" "code_end" + +(* Initialize a predefined exception *) + +let predef_exception i name = + let name_sym = Compilenv.new_const_symbol () in + let data_items = + emit_string_constant (name_sym, Local) name [] + in + let exn_sym = "caml_exn_" ^ name in + let tag = Obj.object_tag in + let size = 2 in + let fields = + (Csymbol_address name_sym) + :: (cint_const (-i - 1)) + :: data_items + in + let data_items = + emit_block (exn_sym, Global) (block_header tag size) fields + in + Cdata data_items + +(* Header for a plugin *) + +let plugin_header units = + let mk ((ui : Cmx_format.unit_infos),crc) : Cmxs_format.dynunit = + { dynu_name = ui.ui_name; + dynu_crc = crc; + dynu_imports_cmi = ui.ui_imports_cmi; + dynu_imports_cmx = ui.ui_imports_cmx; + dynu_defines = ui.ui_defines + } in + global_data "caml_plugin_header" + ({ dynu_magic = Config.cmxs_magic_number; + dynu_units = List.map mk units } + : Cmxs_format.dynheader) + +(* To compile "let rec" over values *) + +let fundecls_size fundecls = + let sz = ref (-1) in + List.iter + (fun (f : Clambda.ufunction) -> + let indirect_call_code_pointer_size = + match f.arity with + | 0 | 1 -> 0 + (* arity 1 does not need an indirect call handler. + arity 0 cannot be indirect called *) + | _ -> 1 + (* For other arities there is an indirect call handler. + if arity >= 2 it is caml_curry... + if arity < 0 it is caml_tuplify... *) + in + sz := !sz + 1 + 2 + indirect_call_code_pointer_size) + fundecls; + !sz + +(* Emit constant closures *) + +let emit_constant_closure ((_, global_symb) as symb) fundecls clos_vars cont = + let closure_symbol (f : Clambda.ufunction) = + if Config.flambda then + cdefine_symbol (f.label ^ "_closure", global_symb) + else + [] + in + match (fundecls : Clambda.ufunction list) with + [] -> + (* 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 @ clos_vars @ cont + | f1 :: remainder -> + let rec emit_others pos = function + [] -> clos_vars @ cont + | (f2 : Clambda.ufunction) :: 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_sym f2.arity) :: + cint_const f2.arity :: + Csymbol_address f2.label :: + emit_others (pos + 4) rem in + 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 :: + emit_others 3 remainder + else + Csymbol_address(curry_function_sym f1.arity) :: + cint_const f1.arity :: + Csymbol_address f1.label :: + emit_others 4 remainder + +(* Build the NULL terminated array of gc roots *) + +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 :: + List.map (fun s -> Csymbol_address s) symbols @ + [Cint 0n]) + :: cont + +(* Build preallocated blocks (used for Flambda [Initialize_symbol] + constructs, and Clambda global module) *) + +let preallocate_block cont { Clambda.symbol; exported; tag; fields } = + let space = + (* These words will be registered as roots and as such must contain + valid values, in case we are in no-naked-pointers mode. Likewise + the block header must be black, below (see [caml_darken]), since + the overall record may be referenced. *) + List.map (fun field -> + match field with + | None -> + Cint (Nativeint.of_int 1 (* Val_unit *)) + | Some (Clambda.Uconst_field_int n) -> + cint_const n + | Some (Clambda.Uconst_field_ref label) -> + Csymbol_address label) + fields + in + let global = Cmmgen_state.(if exported then Global else Local) in + let symb = (symbol, global) in + let data = + emit_block symb (block_header tag (List.length fields)) space + in + Cdata data :: cont + +let emit_preallocated_blocks preallocated_blocks cont = + let symbols = + List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol) + preallocated_blocks + in + let c1 = emit_gc_roots_table ~symbols cont in + List.fold_left preallocate_block c1 preallocated_blocks diff --git a/asmcomp/cmm_helpers.mli b/asmcomp/cmm_helpers.mli new file mode 100644 index 00000000..3503ab2b --- /dev/null +++ b/asmcomp/cmm_helpers.mli @@ -0,0 +1,648 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Cmm + +(** [bind name arg fn] is equivalent to [let name = arg in fn name], + or simply [fn arg] if [arg] is simple enough *) +val bind : + string -> expression -> (expression -> expression) -> expression + +(** Same as [bind], but also treats loads from a variable as simple *) +val bind_load : + string -> expression -> (expression -> expression) -> expression + +(** Same as [bind], but does not treat variables as simple *) +val bind_nonvar : + string -> expression -> (expression -> expression) -> expression + +(** Headers *) + +(** A null header with GC bits set to black *) +val caml_black : nativeint + +(** A constant equal to the tag for float arrays *) +val floatarray_tag : Debuginfo.t -> expression + +(** [block_header tag size] creates a header with tag [tag] for a + block of size [size] *) +val block_header : int -> int -> nativeint + +(** Same as block_header, but with GC bits set to black *) +val black_block_header : int -> int -> nativeint + +(** Closure headers of the given size *) +val white_closure_header : int -> nativeint +val black_closure_header : int -> nativeint + +(** Infix header at the given offset *) +val infix_header : int -> nativeint + +(** Header for a boxed float value *) +val float_header : nativeint + +(** Header for an unboxed float array of the given size *) +val floatarray_header : int -> nativeint + +(** Header for a string (or bytes) of the given length *) +val string_header : int -> nativeint + +(** Boxed integer headers *) +val boxedint32_header : nativeint +val boxedint64_header : nativeint +val boxedintnat_header : nativeint + +(** Wrappers *) +val alloc_float_header : Debuginfo.t -> expression +val alloc_floatarray_header : int -> Debuginfo.t -> expression +val alloc_closure_header : int -> Debuginfo.t -> expression +val alloc_infix_header : int -> Debuginfo.t -> expression +val alloc_boxedint32_header : Debuginfo.t -> expression +val alloc_boxedint64_header : Debuginfo.t -> expression +val alloc_boxedintnat_header : Debuginfo.t -> expression + +(** Integers *) + +(** Minimal/maximal OCaml integer values whose backend representation fits + in a regular OCaml integer *) +val max_repr_int : int +val min_repr_int : int + +(** Make an integer constant from the given integer (tags the integer) *) +val int_const : Debuginfo.t -> int -> expression +val cint_const : int -> data_item +val targetint_const : int -> Targetint.t + +(** Make a Cmm constant holding the given nativeint value. + Uses [Cconst_int] instead of [Cconst_nativeint] when possible + to preserve peephole optimisations. *) +val natint_const_untagged : Debuginfo.t -> Nativeint.t -> expression + +(** Add an integer to the given expression *) +val add_const : expression -> int -> Debuginfo.t -> expression + +(** Increment/decrement of integers *) +val incr_int : expression -> Debuginfo.t -> expression +val decr_int : expression -> Debuginfo.t -> expression + +(** Simplify the given expression knowing its last bit will be + irrelevant *) +val ignore_low_bit_int : expression -> expression + +(** Simplify the given expression knowing its first bit will be + irrelevant *) +val ignore_high_bit_int : expression -> expression + +(** Arithmetical operations on integers *) +val add_int : expression -> expression -> Debuginfo.t -> expression +val sub_int : expression -> expression -> Debuginfo.t -> expression +val lsl_int : expression -> expression -> Debuginfo.t -> expression +val mul_int : expression -> expression -> Debuginfo.t -> expression +val lsr_int : expression -> expression -> Debuginfo.t -> expression +val asr_int : expression -> expression -> Debuginfo.t -> expression +val div_int : + expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression +val mod_int : + expression -> expression -> Lambda.is_safe -> Debuginfo.t -> expression + +(** Integer tagging. [tag_int x = (x lsl 1) + 1] *) +val tag_int : expression -> Debuginfo.t -> expression + +(** Integer untagging. [untag_int x = (x asr 1)] *) +val untag_int : expression -> Debuginfo.t -> expression + +(** Specific division operations for boxed integers *) +val safe_div_bi : + Lambda.is_safe -> + expression -> + expression -> + Primitive.boxed_integer -> + Debuginfo.t -> + expression +val safe_mod_bi : + Lambda.is_safe -> + expression -> + expression -> + Primitive.boxed_integer -> + Debuginfo.t -> + expression + +(** If-Then-Else expression + [mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot] associates + [dbg] to the global if-then-else expression, [ifso_dbg] to the + then branch [ifso], and [ifnot_dbg] to the else branch [ifnot] *) +val mk_if_then_else : + Debuginfo.t -> + expression -> + Debuginfo.t -> expression -> + Debuginfo.t -> expression -> + expression + +(** Boolean negation *) +val mk_not : Debuginfo.t -> expression -> expression + +(** Loop construction (while true do expr done). + Used to be represented as Cloop. *) +val create_loop : expression -> Debuginfo.t -> expression + +(** Exception raising *) +val raise_symbol : Debuginfo.t -> string -> expression + +(** Convert a tagged integer into a raw integer with boolean meaning *) +val test_bool : Debuginfo.t -> expression -> expression + +(** Float boxing and unboxing *) +val box_float : Debuginfo.t -> expression -> expression +val unbox_float : Debuginfo.t -> expression -> expression + +(** Complex number creation and access *) +val box_complex : Debuginfo.t -> expression -> expression -> expression +val complex_re : expression -> Debuginfo.t -> expression +val complex_im : expression -> Debuginfo.t -> expression + +(** Make the given expression return a unit value *) +val return_unit : Debuginfo.t -> expression -> expression + +(** Remove a trailing unit return if any *) +val remove_unit : expression -> expression + +(** Blocks *) + +(** [field_address ptr n dbg] returns an expression for the address of the + [n]th field of the block pointed to by [ptr] *) +val field_address : expression -> int -> Debuginfo.t -> expression + +(** [get_field_gen mut ptr n dbg] returns an expression for the access to the + [n]th field of the block pointed to by [ptr] *) +val get_field_gen : + Asttypes.mutable_flag -> expression -> int -> Debuginfo.t -> expression + +(** [set_field ptr n newval init dbg] returns an expression for setting the + [n]th field of the block pointed to by [ptr] to [newval] *) +val set_field : + expression -> int -> expression -> Lambda.initialization_or_assignment -> + Debuginfo.t -> expression + +(** Load a block's header *) +val get_header : expression -> Debuginfo.t -> expression + +(** Same as [get_header], but also set all profiling bits of the header + are to 0 (if profiling is enabled) *) +val get_header_without_profinfo : expression -> Debuginfo.t -> expression + +(** Load a block's tag *) +val get_tag : expression -> Debuginfo.t -> expression + +(** Load a block's size *) +val get_size : expression -> Debuginfo.t -> expression + +(** Arrays *) + +val wordsize_shift : int +val numfloat_shift : int + +(** Check whether the given array is an array of regular OCaml values + (as opposed to unboxed floats), from its header or pointer *) +val is_addr_array_hdr : expression -> Debuginfo.t -> expression +val is_addr_array_ptr : expression -> Debuginfo.t -> expression + +(** Get the length of an array from its header + Shifts by one bit less than necessary, keeping one of the GC colour bits, + to save an operation when returning the length as a caml integer or when + comparing it to a caml integer. + Assumes the header does not have any profiling info + (as returned by get_header_without_profinfo) *) +val addr_array_length_shifted : expression -> Debuginfo.t -> expression +val float_array_length_shifted : expression -> Debuginfo.t -> expression + +(** For [array_indexing ?typ log2size ptr ofs dbg] : + Produces a pointer to the element of the array [ptr] on the position [ofs] + with the given element [log2size] log2 element size. [ofs] is given as a + tagged int expression. + The optional ?typ argument is the C-- type of the result. + By default, it is Addr, meaning we are constructing a derived pointer + into the heap. If we know the pointer is outside the heap + (this is the case for bigarray indexing), we give type Int instead. *) +val array_indexing : + ?typ:machtype_component -> int -> expression -> expression -> Debuginfo.t -> + expression + +(** Array loads and stores + [unboxed_float_array_ref] and [float_array_ref] differ in the + boxing of the result; [float_array_set] takes an unboxed float *) +val addr_array_ref : expression -> expression -> Debuginfo.t -> expression +val int_array_ref : expression -> expression -> Debuginfo.t -> expression +val unboxed_float_array_ref : + expression -> expression -> Debuginfo.t -> expression +val float_array_ref : expression -> expression -> Debuginfo.t -> expression +val addr_array_set : + expression -> expression -> expression -> Debuginfo.t -> expression +val addr_array_initialize : + expression -> expression -> expression -> Debuginfo.t -> expression +val int_array_set : + expression -> expression -> expression -> Debuginfo.t -> expression +val float_array_set : + expression -> expression -> expression -> Debuginfo.t -> expression + +(** Strings *) + +val string_length : expression -> Debuginfo.t -> expression +val bigstring_length : expression -> Debuginfo.t -> expression + +(** Objects *) + +(** Lookup a method by its hash, using [caml_get_public_method] + Arguments : + - obj : the object from which to lookup + - tag : the hash of the method name, as a tagged integer *) +val lookup_tag : expression -> expression -> Debuginfo.t -> expression + +(** Lookup a method by its offset in the method table + Arguments : + - obj : the object from which to lookup + - lab : the position of the required method in the object's + method array, as a tagged integer *) +val lookup_label : expression -> expression -> Debuginfo.t -> expression + +(** Lookup and call a method using the method cache + Arguments : + - obj : the object from which to lookup + - tag : the hash of the method name, as a tagged integer + - cache : the method cache array + - pos : the position of the cache entry in the cache array + - args : the additional arguments to the method call *) +val call_cached_method : + expression -> expression -> expression -> expression -> expression list -> + Debuginfo.t -> expression + +(** Allocations *) + +(** Allocate a block of regular values with the given tag *) +val make_alloc : Debuginfo.t -> int -> expression list -> expression + +(** Allocate a block of unboxed floats with the given tag *) +val make_float_alloc : Debuginfo.t -> int -> expression list -> expression + +(** Bounds checking *) + +(** Generate a [Ccheckbound] term *) +val make_checkbound : Debuginfo.t -> expression list -> expression + +(** [check_bound safety access_size dbg length a2 k] prefixes expression [k] + with a check that reading [access_size] bits starting at position [a2] + in a string/bytes value of length [length] is within bounds, unless + [safety] is [Unsafe]. *) +val check_bound : + Lambda.is_safe -> Clambda_primitives.memory_access_size -> Debuginfo.t -> + expression -> expression -> expression -> + expression + +(** Generic application functions *) + +(** Get the symbol for the generic application with [n] arguments, and + ensure its presence in the set of defined symbols *) +val apply_function_sym : int -> string + +(** If [n] is positive, get the symbol for the generic currying wrapper with + [n] arguments, and ensure its presence in the set of defined symbols. + Otherwise, do the same for the generic tuple wrapper with [-n] arguments. *) +val curry_function_sym : int -> string + +(** Bigarrays *) + +(** [bigarray_get unsafe kind layout b args dbg] + - unsafe : if true, do not insert bound checks + - kind : see [Lambda.bigarray_kind] + - layout : see [Lambda.bigarray_layout] + - b : the bigarray to load from + - args : a list of tagged integer expressions, corresponding to the + indices in the respective dimensions + - dbg : debugging information *) +val bigarray_get : + bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout -> + expression -> expression list -> Debuginfo.t -> + expression + +(** [bigarray_set unsafe kind layout b args newval dbg] + Same as [bigarray_get], with [newval] the value being assigned *) +val bigarray_set : + bool -> Lambda.bigarray_kind -> Lambda.bigarray_layout -> + expression -> expression list -> expression -> Debuginfo.t -> + expression + +(** Operations on 32-bit integers *) + +(** [low_32 _ x] is a value which agrees with x on at least the low 32 bits *) +val low_32 : Debuginfo.t -> expression -> expression + +(** Sign extend from 32 bits to the word size *) +val sign_extend_32 : Debuginfo.t -> expression -> expression + +(** Zero extend from 32 bits to the word size *) +val zero_extend_32 : Debuginfo.t -> expression -> expression + +(** Boxed numbers *) + +(** Global symbols for the ops field of boxed integers *) +val caml_nativeint_ops : string +val caml_int32_ops : string +val caml_int64_ops : string + +(** Box a given integer, without sharing of constants *) +val box_int_gen : + Debuginfo.t -> Primitive.boxed_integer -> expression -> expression + +(** Unbox a given boxed integer *) +val unbox_int : + Debuginfo.t -> Primitive.boxed_integer -> expression -> expression + +(** Used to prepare 32-bit integers on 64-bit platforms for a lsr operation *) +val make_unsigned_int : + Primitive.boxed_integer -> expression -> Debuginfo.t -> expression + +val unaligned_load_16 : expression -> expression -> Debuginfo.t -> expression +val unaligned_set_16 : + expression -> expression -> expression -> Debuginfo.t -> expression +val unaligned_load_32 : expression -> expression -> Debuginfo.t -> expression +val unaligned_set_32 : + expression -> expression -> expression -> Debuginfo.t -> expression +val unaligned_load_64 : expression -> expression -> Debuginfo.t -> expression +val unaligned_set_64 : + expression -> expression -> expression -> Debuginfo.t -> expression + +(** Raw memory accesses *) + +(** [unaligned_set size ptr idx newval dbg] *) +val unaligned_set : + Clambda_primitives.memory_access_size -> + expression -> expression -> expression -> Debuginfo.t -> expression + +(** [unaligned_load size ptr idx dbg] *) +val unaligned_load : + Clambda_primitives.memory_access_size -> + expression -> expression -> Debuginfo.t -> expression + +(** [box_sized size dbg exp] *) +val box_sized : + Clambda_primitives.memory_access_size -> + Debuginfo.t -> expression -> expression + +(** Primitives *) + +val simplif_primitive : + Clambda_primitives.primitive -> Clambda_primitives.primitive + +type unary_primitive = expression -> Debuginfo.t -> expression + +(** Return the n-th field of a float array (or float-only record), as an + unboxed float *) +val floatfield : int -> unary_primitive + +(** Int_as_pointer primitive *) +val int_as_pointer : unary_primitive + +(** Raise primitive *) +val raise_prim : Lambda.raise_kind -> unary_primitive + +(** Unary negation of an OCaml integer *) +val negint : unary_primitive + +(** Add a constant number to an OCaml integer *) +val offsetint : int -> unary_primitive + +(** Add a constant number to an OCaml integer reference *) +val offsetref : int -> unary_primitive + +(** Return the length of the array argument, as an OCaml integer *) +val arraylength : Lambda.array_kind -> unary_primitive + +(** Byte swap primitive + Operates on Cmm integers (unboxed values) *) +val bbswap : Primitive.boxed_integer -> unary_primitive + +(** 16-bit byte swap primitive + Operates on Cmm integers (untagged integers) *) +val bswap16 : unary_primitive + +type binary_primitive = expression -> expression -> Debuginfo.t -> expression + +type assignment_kind = Caml_modify | Caml_initialize | Simple + +(** [setfield offset value_is_ptr init ptr value dbg] *) +val setfield : + int -> Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment -> + binary_primitive + +(** [setfloatfield offset init ptr value dbg] + [value] is expected to be an unboxed floating point number *) +val setfloatfield : + int -> Lambda.initialization_or_assignment -> binary_primitive + +(** Operations on OCaml integers *) +val add_int_caml : binary_primitive +val sub_int_caml : binary_primitive +val mul_int_caml : binary_primitive +val div_int_caml : Lambda.is_safe -> binary_primitive +val mod_int_caml : Lambda.is_safe -> binary_primitive +val and_int_caml : binary_primitive +val or_int_caml : binary_primitive +val xor_int_caml : binary_primitive +val lsl_int_caml : binary_primitive +val lsr_int_caml : binary_primitive +val asr_int_caml : binary_primitive +val int_comp_caml : Lambda.integer_comparison -> binary_primitive + +(** Strings, Bytes and Bigstrings *) + +(** Regular string/bytes access. Args: string/bytes, index *) +val stringref_unsafe : binary_primitive +val stringref_safe : binary_primitive + +(** Load by chunk from string/bytes, bigstring. Args: string, index *) +val string_load : + Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive +val bigstring_load : + Clambda_primitives.memory_access_size -> Lambda.is_safe -> binary_primitive + +(** Arrays *) + +(** Array access. Args: array, index *) +val arrayref_unsafe : Lambda.array_kind -> binary_primitive +val arrayref_safe : Lambda.array_kind -> binary_primitive + +type ternary_primitive = + expression -> expression -> expression -> Debuginfo.t -> expression + +(** Same as setfield, except the offset is one of the arguments. + Args: pointer (structure/array/...), index, value *) +val setfield_computed : + Lambda.immediate_or_pointer -> Lambda.initialization_or_assignment -> + ternary_primitive + +(** Set the byte at the given offset to the given value. + Args: bytes, index, value *) +val bytesset_unsafe : ternary_primitive +val bytesset_safe : ternary_primitive + +(** Set the element at the given index in the given array to the given value. + WARNING: if [kind] is [Pfloatarray], then [value] is expected to be an + _unboxed_ float. Otherwise, it is expected to be a regular caml value, + including in the case where the array contains floats. + Args: array, index, value *) +val arrayset_unsafe : Lambda.array_kind -> ternary_primitive +val arrayset_safe : Lambda.array_kind -> ternary_primitive + +(** Set a chunk of data in the given bytes or bigstring structure. + See also [string_load] and [bigstring_load]. + Note: [value] is expected to be an unboxed number of the given size. + Args: pointer, index, value *) +val bytes_set : + Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive +val bigstring_set : + Clambda_primitives.memory_access_size -> Lambda.is_safe -> ternary_primitive + +(** Switch *) + +(** [transl_isout h arg dbg] *) +val transl_isout : expression -> expression -> Debuginfo.t -> expression + +(** [make_switch arg cases actions dbg] : Generate a Cswitch construct, + or optimize as a static table lookup when possible. *) +val make_switch : + expression -> int array -> (expression * Debuginfo.t) array -> Debuginfo.t -> + expression + +(** [transl_int_switch loc arg low high cases default] *) +val transl_int_switch : + Location.t -> expression -> int -> int -> + (int * expression) list -> expression -> expression + +(** [transl_switch_clambda loc arg index cases] *) +val transl_switch_clambda : + Location.t -> expression -> int array -> expression array -> expression + +(** [strmatch_compile dbg arg default cases] *) +val strmatch_compile : + Debuginfo.t -> expression -> expression option -> + (string * expression) list -> expression + +(** Closures and function applications *) + +(** Adds a constant offset to a pointer (for infix access) *) +val ptr_offset : expression -> int -> Debuginfo.t -> expression + +(** Direct application of a function via a symbol *) +val direct_apply : string -> expression list -> Debuginfo.t -> expression + +(** Generic application of a function to one or several arguments. + The mutable_flag argument annotates the loading of the code pointer + from the closure. The Cmmgen code uses a mutable load by + default, with a special case when the load is from (the first function of) + the currently defined closure. *) +val generic_apply : + Asttypes.mutable_flag -> + expression -> expression list -> Debuginfo.t -> expression + +(** Method call : [send kind met obj args dbg] + - [met] is a method identifier, which can be a hashed variant or an index + in [obj]'s method table, depending on [kind] + - [obj] is the object whose method is being called + - [args] is the extra arguments to the method call (Note: I'm not aware + of any way for the frontend to generate any arguments other than the + cache and cache position) *) +val send : + Lambda.meth_kind -> expression -> expression -> expression list -> + Debuginfo.t -> expression + +(** Generic Cmm fragments *) + +(** Generate generic functions *) +val generic_functions : bool -> Cmx_format.unit_infos list -> Cmm.phrase list + +val placeholder_dbg : unit -> Debuginfo.t +val placeholder_fun_dbg : human_name:string -> Debuginfo.t + +(** Entry point *) +val entry_point : string list -> phrase + +(** Generate the caml_globals table *) +val global_table: string list -> phrase + +(** Add references to the given symbols *) +val reference_symbols: string list -> phrase + +(** Generate the caml_globals_map structure, as a marshalled string constant *) +val globals_map: + (string * Digest.t option * Digest.t option * string list) list -> phrase + +(** Generate the caml_frametable table, referencing the frametables + from the given compilation units *) +val frame_table: string list -> phrase + +(** Generate the caml_spacetime_shapes table, referencing the spacetime shapes + from the given compilation units *) +val spacetime_shapes: string list -> phrase + +(** Generate the tables for data and code positions respectively of the given + compilation units *) +val data_segment_table: string list -> phrase +val code_segment_table: string list -> phrase + +(** Generate data for a predefined exception *) +val predef_exception: int -> string -> phrase + +val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> phrase + +(** Emit constant symbols *) + +(** Produce the data_item list corresponding to a symbol definition *) +val cdefine_symbol : (string * Cmmgen_state.is_global) -> data_item list + +(** [emit_block symb white_header cont] prepends to [cont] the header and symbol + for the block. + [cont] must already contain the fields of the block (and may contain + additional data items afterwards). *) +val emit_block : + (string * Cmmgen_state.is_global) -> nativeint -> data_item list -> + data_item list + +(** Emit specific kinds of constant blocks as data items *) +val emit_float_constant : + (string * Cmmgen_state.is_global) -> float -> data_item list -> + data_item list +val emit_string_constant : + (string * Cmmgen_state.is_global) -> string -> data_item list -> + data_item list +val emit_int32_constant : + (string * Cmmgen_state.is_global) -> int32 -> data_item list -> + data_item list +val emit_int64_constant : + (string * Cmmgen_state.is_global) -> int64 -> data_item list -> + data_item list +val emit_nativeint_constant : + (string * Cmmgen_state.is_global) -> nativeint -> data_item list -> + data_item list +val emit_float_array_constant : + (string * Cmmgen_state.is_global) -> float list -> data_item list -> + data_item list + +val fundecls_size : Clambda.ufunction list -> int + +val emit_constant_closure : + (string * Cmmgen_state.is_global) -> Clambda.ufunction list -> + data_item list -> data_item list -> data_item list + +val emit_preallocated_blocks : + Clambda.preallocated_block list -> phrase list -> phrase list diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 598debb6..fd42fc5d 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -26,12 +26,12 @@ open Lambda open Clambda open Clambda_primitives open Cmm -open Cmx_format -open Cmxs_format module String = Misc.Stdlib.String +module IntMap = Map.Make(Int) module V = Backend_var module VP = Backend_var.With_provenance +open Cmm_helpers (* Environments used for translation to Cmm. *) @@ -41,17 +41,34 @@ type boxed_number = type env = { unboxed_ids : (V.t * boxed_number) V.tbl; + notify_catch : (Cmm.expression list -> unit) IntMap.t; environment_param : V.t option; } +(* notify_catch associates to each catch handler a callback + which will be passed the list of arguments of each + staticfail instruction pointing to that handler. This + allows transl_catch to observe concrete arguments passed to each + handler parameter and decide whether to unbox them accordingly. + + Other ways to achieve the same result would be to either (1) traverse + the body of the catch block after translation (this would be costly + and could easily lead to quadratric behavior) or (2) return + a description of arguments passed to each catch handler as an extra + value to be threaded through all transl_* functions (this would be + quite heavy, and probably less efficient that the callback approach). +*) + + let empty_env = { - unboxed_ids =V.empty; + unboxed_ids = V.empty; + notify_catch = IntMap.empty; environment_param = None; } let create_env ~environment_param = - { unboxed_ids = V.empty; + { empty_env with environment_param; } @@ -64,232 +81,15 @@ let add_unboxed_id id unboxed_id bn env = unboxed_ids = V.add id (unboxed_id, bn) env.unboxed_ids; } -(* Local binding of complex expressions *) - -let bind name arg fn = - match arg with - Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _ - | Cconst_pointer _ | Cconst_natpointer _ - | Cblockheader _ -> fn arg - | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id)) - -let bind_load name arg fn = - match arg with - | Cop(Cload _, [Cvar _], _) -> fn arg - | _ -> bind name arg fn - -let bind_nonvar name arg fn = - match arg with - Cconst_int _ | Cconst_natint _ | Cconst_symbol _ - | Cconst_pointer _ | Cconst_natpointer _ - | Cblockheader _ -> fn arg - | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id)) - -let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8 - (* cf. runtime/caml/gc.h *) - -(* Block headers. Meaning of the tag field: see stdlib/obj.ml *) - -let floatarray_tag dbg = Cconst_int (Obj.double_array_tag, dbg) - -let block_header tag sz = - Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10) - (Nativeint.of_int tag) -(* Static data corresponding to "value"s must be marked black in case we are - in no-naked-pointers mode. See [caml_darken] and the code below that emits - structured constants and static module definitions. *) -let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black -let white_closure_header sz = block_header Obj.closure_tag sz -let black_closure_header sz = black_block_header Obj.closure_tag sz -let infix_header ofs = block_header Obj.infix_tag ofs -let float_header = block_header Obj.double_tag (size_float / size_addr) -let floatarray_header len = - (* Zero-sized float arrays have tag zero for consistency with - [caml_alloc_float_array]. *) - assert (len >= 0); - if len = 0 then block_header 0 0 - else block_header Obj.double_array_tag (len * size_float / size_addr) -let string_header len = - block_header Obj.string_tag ((len + size_addr) / size_addr) -let boxedint32_header = block_header Obj.custom_tag 2 -let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr) -let boxedintnat_header = block_header Obj.custom_tag 2 -let caml_nativeint_ops = "caml_nativeint_ops" -let caml_int32_ops = "caml_int32_ops" -let caml_int64_ops = "caml_int64_ops" - - -let alloc_float_header dbg = Cblockheader (float_header, dbg) -let alloc_floatarray_header len dbg = Cblockheader (floatarray_header len, dbg) -let alloc_closure_header sz dbg = Cblockheader (white_closure_header sz, dbg) -let alloc_infix_header ofs dbg = Cblockheader (infix_header ofs, dbg) -let alloc_boxedint32_header dbg = Cblockheader (boxedint32_header, dbg) -let alloc_boxedint64_header dbg = Cblockheader (boxedint64_header, dbg) -let alloc_boxedintnat_header dbg = Cblockheader (boxedintnat_header, dbg) - -(* Integers *) - -let max_repr_int = max_int asr 1 -let min_repr_int = min_int asr 1 - -let int_const dbg n = - if n <= max_repr_int && n >= min_repr_int - then Cconst_int((n lsl 1) + 1, dbg) - else Cconst_natint - (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n, dbg) - -let natint_const_untagged dbg n = - if n > Nativeint.of_int max_int - || n < Nativeint.of_int min_int - then Cconst_natint (n,dbg) - else Cconst_int (Nativeint.to_int n, dbg) - -let cint_const n = - Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) - -let targetint_const n = - Targetint.add (Targetint.shift_left (Targetint.of_int n) 1) - Targetint.one - -let add_no_overflow n x c dbg = - let d = n + x in - if d = 0 then c else Cop(Caddi, [c; Cconst_int (d, dbg)], dbg) - -let rec add_const c n dbg = - if n = 0 then c - else match c with - | Cconst_int (x, _) when no_overflow_add x n -> Cconst_int (x + n, dbg) - | Cop(Caddi, [Cconst_int (x, _); c], _) - when no_overflow_add n x -> - add_no_overflow n x c dbg - | Cop(Caddi, [c; Cconst_int (x, _)], _) - when no_overflow_add n x -> - add_no_overflow n x c dbg - | Cop(Csubi, [Cconst_int (x, _); c], _) when no_overflow_add n x -> - Cop(Csubi, [Cconst_int (n + x, dbg); c], dbg) - | Cop(Csubi, [c; Cconst_int (x, _)], _) when no_overflow_sub n x -> - add_const c (n - x) dbg - | c -> Cop(Caddi, [c; Cconst_int (n, dbg)], dbg) - -let incr_int c dbg = add_const c 1 dbg -let decr_int c dbg = add_const c (-1) dbg - -let rec add_int c1 c2 dbg = - match (c1, c2) with - | (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) -> - add_const c n dbg - | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) -> - add_const (add_int c1 c2 dbg) n1 dbg - | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) -> - add_const (add_int c1 c2 dbg) n2 dbg - | (_, _) -> - Cop(Caddi, [c1; c2], dbg) - -let rec sub_int c1 c2 dbg = - match (c1, c2) with - | (c1, Cconst_int (n2, _)) when n2 <> min_int -> - add_const c1 (-n2) dbg - | (c1, Cop(Caddi, [c2; Cconst_int (n2, _)], _)) when n2 <> min_int -> - add_const (sub_int c1 c2 dbg) (-n2) dbg - | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), c2) -> - add_const (sub_int c1 c2 dbg) n1 dbg - | (c1, c2) -> - Cop(Csubi, [c1; c2], dbg) - -let rec lsl_int c1 c2 dbg = - match (c1, c2) with - | (Cop(Clsl, [c; Cconst_int (n1, _)], _), Cconst_int (n2, _)) - when n1 > 0 && n2 > 0 && n1 + n2 < size_int * 8 -> - Cop(Clsl, [c; Cconst_int (n1 + n2, dbg)], dbg) - | (Cop(Caddi, [c1; Cconst_int (n1, _)], _), Cconst_int (n2, _)) - when no_overflow_lsl n1 n2 -> - add_const (lsl_int c1 c2 dbg) (n1 lsl n2) dbg - | (_, _) -> - Cop(Clsl, [c1; c2], dbg) - -let is_power2 n = n = 1 lsl Misc.log2 n - -and mult_power2 c n dbg = lsl_int c (Cconst_int (Misc.log2 n, dbg)) dbg - -let rec mul_int c1 c2 dbg = - match (c1, c2) with - | (c, Cconst_int (0, _)) | (Cconst_int (0, _), c) -> - Csequence (c, Cconst_int (0, dbg)) - | (c, Cconst_int (1, _)) | (Cconst_int (1, _), c) -> - c - | (c, Cconst_int(-1, _)) | (Cconst_int(-1, _), c) -> - sub_int (Cconst_int (0, dbg)) c dbg - | (c, Cconst_int (n, _)) when is_power2 n -> mult_power2 c n dbg - | (Cconst_int (n, _), c) when is_power2 n -> mult_power2 c n dbg - | (Cop(Caddi, [c; Cconst_int (n, _)], _), Cconst_int (k, _)) | - (Cconst_int (k, _), Cop(Caddi, [c; Cconst_int (n, _)], _)) - when no_overflow_mul n k -> - add_const (mul_int c (Cconst_int (k, dbg)) dbg) (n * k) dbg - | (c1, c2) -> - Cop(Cmuli, [c1; c2], dbg) - - -let ignore_low_bit_int = function - Cop(Caddi, - [(Cop(Clsl, [_; Cconst_int (n, _)], _) as c); Cconst_int (1, _)], _) - when n > 0 - -> c - | Cop(Cor, [c; Cconst_int (1, _)], _) -> c - | c -> c - -let lsr_int c1 c2 dbg = - match c2 with - Cconst_int (0, _) -> - c1 - | Cconst_int (n, _) when n > 0 -> - Cop(Clsr, [ignore_low_bit_int c1; c2], dbg) - | _ -> - Cop(Clsr, [c1; c2], dbg) - -let asr_int c1 c2 dbg = - match c2 with - Cconst_int (0, _) -> - c1 - | Cconst_int (n, _) when n > 0 -> - Cop(Casr, [ignore_low_bit_int c1; c2], dbg) - | _ -> - Cop(Casr, [c1; c2], dbg) +let add_notify_catch n f env = + { env with + notify_catch = IntMap.add n f env.notify_catch + } -let tag_int i dbg = - match i with - | Cconst_int (n, _) -> - int_const dbg n - | Cop(Casr, [c; Cconst_int (n, _)], _) when n > 0 -> - Cop(Cor, - [asr_int c (Cconst_int (n - 1, dbg)) dbg; Cconst_int (1, dbg)], - dbg) - | c -> - incr_int (lsl_int c (Cconst_int (1, dbg)) dbg) dbg - -let force_tag_int i dbg = - match i with - Cconst_int (n, _) -> - int_const dbg n - | Cop(Casr, [c; Cconst_int (n, _)], dbg') when n > 0 -> - Cop(Cor, [asr_int c (Cconst_int (n - 1, dbg)) dbg'; Cconst_int (1, dbg)], - dbg) - | c -> - Cop(Cor, [lsl_int c (Cconst_int (1, dbg)) dbg; Cconst_int (1, dbg)], dbg) - -let untag_int i dbg = - match i with - Cconst_int (n, _) -> Cconst_int(n asr 1, dbg) - | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> - c - | Cop(Cor, [Cop(Casr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _) - when n > 0 && n < size_int * 8 -> - Cop(Casr, [c; Cconst_int (n+1, dbg)], dbg) - | Cop(Cor, [Cop(Clsr, [c; Cconst_int (n, _)], _); Cconst_int (1, _)], _) - when n > 0 && n < size_int * 8 -> - Cop(Clsr, [c; Cconst_int (n+1, dbg)], dbg) - | Cop(Cor, [c; Cconst_int (1, _)], _) -> - Cop(Casr, [c; Cconst_int (1, dbg)], dbg) - | c -> Cop(Casr, [c; Cconst_int (1, dbg)], dbg) +let notify_catch i env l = + match IntMap.find_opt i env.notify_catch with + | Some f -> f l + | None -> () (* Description of the "then" and "else" continuations in [transl_if]. If the "then" continuation is true and the "else" continuation is false then @@ -306,596 +106,20 @@ let invert_then_else = function | Then_false_else_true -> Then_true_else_false | Unknown -> Unknown -let mk_if_then_else dbg cond ifso_dbg ifso ifnot_dbg ifnot = - match cond with - | Cconst_int (0, _) -> ifnot - | Cconst_int (1, _) -> ifso - | _ -> - Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) - -let mk_not dbg cmm = - match cmm with - | Cop(Caddi, - [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') -> - begin - match c with - | Cop(Ccmpi cmp, [c1; c2], dbg'') -> - tag_int - (Cop(Ccmpi (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg' - | Cop(Ccmpa cmp, [c1; c2], dbg'') -> - tag_int - (Cop(Ccmpa (negate_integer_comparison cmp), [c1; c2], dbg'')) dbg' - | Cop(Ccmpf cmp, [c1; c2], dbg'') -> - tag_int - (Cop(Ccmpf (negate_float_comparison cmp), [c1; c2], dbg'')) dbg' - | _ -> - (* 0 -> 3, 1 -> 1 *) - Cop(Csubi, - [Cconst_int (3, dbg); Cop(Clsl, [c; Cconst_int (1, dbg)], dbg)], dbg) - end - | Cconst_int (3, _) -> Cconst_int (1, dbg) - | Cconst_int (1, _) -> Cconst_int (3, dbg) - | c -> - (* 1 -> 3, 3 -> 1 *) - Cop(Csubi, [Cconst_int (4, dbg); c], dbg) - - -let create_loop body dbg = - let cont = next_raise_count () in - let call_cont = Cexit (cont, []) in - let body = Csequence (body, call_cont) in - Ccatch (Recursive, [cont, [], body, dbg], call_cont) - -(* Turning integer divisions into multiply-high then shift. - The [division_parameters] function is used in module Emit for - those target platforms that support this optimization. *) - -(* Unsigned comparison between native integers. *) - -let ucompare x y = Nativeint.(compare (add x min_int) (add y min_int)) - -(* Unsigned division and modulus at type nativeint. - Algorithm: Hacker's Delight section 9.3 *) - -let udivmod n d = Nativeint.( - if d < 0n then - if ucompare n d < 0 then (0n, n) else (1n, sub n d) - else begin - let q = shift_left (div (shift_right_logical n 1) d) 1 in - let r = sub n (mul q d) in - if ucompare r d >= 0 then (succ q, sub r d) else (q, r) - end) - -(* Compute division parameters. - Algorithm: Hacker's Delight chapter 10, fig 10-1. *) - -let divimm_parameters d = Nativeint.( - assert (d > 0n); - let twopsm1 = min_int in (* 2^31 for 32-bit archs, 2^63 for 64-bit archs *) - let nc = sub (pred twopsm1) (snd (udivmod twopsm1 d)) in - let rec loop p (q1, r1) (q2, r2) = - let p = p + 1 in - let q1 = shift_left q1 1 and r1 = shift_left r1 1 in - let (q1, r1) = - if ucompare r1 nc >= 0 then (succ q1, sub r1 nc) else (q1, r1) in - let q2 = shift_left q2 1 and r2 = shift_left r2 1 in - let (q2, r2) = - if ucompare r2 d >= 0 then (succ q2, sub r2 d) else (q2, r2) in - let delta = sub d r2 in - if ucompare q1 delta < 0 || (q1 = delta && r1 = 0n) - then loop p (q1, r1) (q2, r2) - else (succ q2, p - size) - in loop (size - 1) (udivmod twopsm1 nc) (udivmod twopsm1 d)) - -(* The result [(m, p)] of [divimm_parameters d] satisfies the following - inequality: - - 2^(wordsize + p) < m * d <= 2^(wordsize + p) + 2^(p + 1) (i) - - from which it follows that - - floor(n / d) = floor(n * m / 2^(wordsize+p)) - if 0 <= n < 2^(wordsize-1) - ceil(n / d) = floor(n * m / 2^(wordsize+p)) + 1 - if -2^(wordsize-1) <= n < 0 - - The correctness condition (i) above can be checked by the code below. - It was exhaustively tested for values of d from 2 to 10^9 in the - wordsize = 64 case. - -let add2 (xh, xl) (yh, yl) = - let zl = add xl yl and zh = add xh yh in - ((if ucompare zl xl < 0 then succ zh else zh), zl) - -let shl2 (xh, xl) n = - assert (0 < n && n < size + size); - if n < size - then (logor (shift_left xh n) (shift_right_logical xl (size - n)), - shift_left xl n) - else (shift_left xl (n - size), 0n) - -let mul2 x y = - let halfsize = size / 2 in - let halfmask = pred (shift_left 1n halfsize) in - let xl = logand x halfmask and xh = shift_right_logical x halfsize in - let yl = logand y halfmask and yh = shift_right_logical y halfsize in - add2 (mul xh yh, 0n) - (add2 (shl2 (0n, mul xl yh) halfsize) - (add2 (shl2 (0n, mul xh yl) halfsize) - (0n, mul xl yl))) - -let ucompare2 (xh, xl) (yh, yl) = - let c = ucompare xh yh in if c = 0 then ucompare xl yl else c - -let validate d m p = - let md = mul2 m d in - let one2 = (0n, 1n) in - let twoszp = shl2 one2 (size + p) in - let twop1 = shl2 one2 (p + 1) in - ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0 -*) - -let raise_regular dbg exc = - Csequence( - Cop(Cstore (Thirtytwo_signed, Assignment), - [(Cconst_symbol ("caml_backtrace_pos", dbg)); - Cconst_int (0, dbg)], dbg), - Cop(Craise Raise_withtrace,[exc], dbg)) - -let raise_symbol dbg symb = - raise_regular dbg (Cconst_symbol (symb, dbg)) - -let rec div_int c1 c2 is_safe dbg = - match (c1, c2) with - (c1, Cconst_int (0, _)) -> - Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero") - | (c1, Cconst_int (1, _)) -> - c1 - | (Cconst_int (n1, _), Cconst_int (n2, _)) -> - Cconst_int (n1 / n2, dbg) - | (c1, Cconst_int (n, _)) when n <> min_int -> - let l = Misc.log2 n in - if n = 1 lsl l then - (* Algorithm: - t = shift-right-signed(c1, l - 1) - t = shift-right(t, W - l) - t = c1 + t - res = shift-right-signed(c1 + t, l) - *) - Cop(Casr, [bind "dividend" c1 (fun c1 -> - let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in - let t = - lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg - in - add_int c1 t dbg); - Cconst_int (l, dbg)], dbg) - else if n < 0 then - sub_int (Cconst_int (0, dbg)) - (div_int c1 (Cconst_int (-n, dbg)) is_safe dbg) - dbg - else begin - let (m, p) = divimm_parameters (Nativeint.of_int n) in - (* Algorithm: - t = multiply-high-signed(c1, m) - if m < 0, t = t + c1 - if p > 0, t = shift-right-signed(t, p) - res = t + sign-bit(c1) - *) - bind "dividend" c1 (fun c1 -> - let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in - let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in - let t = - if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t - in - add_int t (lsr_int c1 (Cconst_int (Nativeint.size - 1, dbg)) dbg) dbg) - end - | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe -> - Cop(Cdivi, [c1; c2], dbg) - | (c1, c2) -> - bind "divisor" c2 (fun c2 -> - bind "dividend" c1 (fun c1 -> - Cifthenelse(c2, - dbg, - Cop(Cdivi, [c1; c2], dbg), - dbg, - raise_symbol dbg "caml_exn_Division_by_zero", - dbg))) - -let mod_int c1 c2 is_safe dbg = - match (c1, c2) with - (c1, Cconst_int (0, _)) -> - Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero") - | (c1, Cconst_int ((1 | (-1)), _)) -> - Csequence(c1, Cconst_int (0, dbg)) - | (Cconst_int (n1, _), Cconst_int (n2, _)) -> - Cconst_int (n1 mod n2, dbg) - | (c1, (Cconst_int (n, _) as c2)) when n <> min_int -> - let l = Misc.log2 n in - if n = 1 lsl l then - (* Algorithm: - t = shift-right-signed(c1, l - 1) - t = shift-right(t, W - l) - t = c1 + t - t = bit-and(t, -n) - res = c1 - t - *) - bind "dividend" c1 (fun c1 -> - let t = asr_int c1 (Cconst_int (l - 1, dbg)) dbg in - let t = lsr_int t (Cconst_int (Nativeint.size - l, dbg)) dbg in - let t = add_int c1 t dbg in - let t = Cop(Cand, [t; Cconst_int (-n, dbg)], dbg) in - sub_int c1 t dbg) - else - bind "dividend" c1 (fun c1 -> - sub_int c1 (mul_int (div_int c1 c2 is_safe dbg) c2 dbg) dbg) - | (c1, c2) when !Clflags.unsafe || is_safe = Lambda.Unsafe -> - (* Flambda already generates that test *) - Cop(Cmodi, [c1; c2], dbg) - | (c1, c2) -> - bind "divisor" c2 (fun c2 -> - bind "dividend" c1 (fun c1 -> - Cifthenelse(c2, - dbg, - Cop(Cmodi, [c1; c2], dbg), - dbg, - raise_symbol dbg "caml_exn_Division_by_zero", - dbg))) - -(* Division or modulo on boxed integers. The overflow case min_int / -1 - can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *) - -let is_different_from x = function - Cconst_int (n, _) -> n <> x - | Cconst_natint (n, _) -> n <> Nativeint.of_int x - | _ -> false - -let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg = - bind "dividend" c1 (fun c1 -> - bind "divisor" c2 (fun c2 -> - let c = mkop c1 c2 is_safe dbg in - if Arch.division_crashes_on_overflow - && (size_int = 4 || bi <> Pint32) - && not (is_different_from (-1) c2) - then - Cifthenelse(Cop(Ccmpi Cne, [c2; Cconst_int (-1, dbg)], dbg), - dbg, c, - dbg, mkm1 c1 dbg, - dbg) - else - c)) - -let safe_div_bi is_safe = - safe_divmod_bi div_int is_safe - (fun c1 dbg -> Cop(Csubi, [Cconst_int (0, dbg); c1], dbg)) - -let safe_mod_bi is_safe = - safe_divmod_bi mod_int is_safe (fun _ dbg -> Cconst_int (0, dbg)) - -(* Bool *) - -let test_bool dbg cmm = - match cmm with - | Cop(Caddi, [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], _) -> - c - | Cconst_int (n, dbg) -> - if n = 1 then - Cconst_int (0, dbg) - else - Cconst_int (1, dbg) - | c -> Cop(Ccmpi Cne, [c; Cconst_int (1, dbg)], dbg) - -(* Float *) - -let box_float dbg c = Cop(Calloc, [alloc_float_header dbg; c], dbg) - -let map_ccatch f rec_flag handlers body = - let handlers = List.map - (fun (n, ids, handler, dbg) -> (n, ids, f handler, dbg)) - handlers in - Ccatch(rec_flag, handlers, f body) - -let rec unbox_float dbg cmm = - match cmm with - | Cop(Calloc, [Cblockheader (header, _); c], _) when header = float_header -> - c - | Clet(id, exp, body) -> Clet(id, exp, unbox_float dbg body) - | Cifthenelse(cond, ifso_dbg, e1, ifnot_dbg, e2, dbg) -> - Cifthenelse(cond, - ifso_dbg, unbox_float dbg e1, - ifnot_dbg, unbox_float dbg e2, - dbg) - | Csequence(e1, e2) -> Csequence(e1, unbox_float dbg e2) - | Cswitch(e, tbl, el, dbg') -> - Cswitch(e, tbl, - Array.map (fun (expr, dbg) -> unbox_float dbg expr, dbg) el, dbg') - | Ccatch(rec_flag, handlers, body) -> - map_ccatch (unbox_float dbg) rec_flag handlers body - | Ctrywith(e1, id, e2, dbg) -> - Ctrywith(unbox_float dbg e1, id, unbox_float dbg e2, dbg) - | c -> Cop(Cload (Double_u, Immutable), [c], dbg) - -(* Complex *) - -let box_complex dbg c_re c_im = - Cop(Calloc, [alloc_floatarray_header 2 dbg; c_re; c_im], dbg) - -let complex_re c dbg = Cop(Cload (Double_u, Immutable), [c], dbg) -let complex_im c dbg = Cop(Cload (Double_u, Immutable), - [Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)], - dbg) - -(* Unit *) - -let return_unit dbg c = Csequence(c, Cconst_pointer (1, dbg)) - -let rec remove_unit = function - Cconst_pointer (1, _) -> Ctuple [] - | Csequence(c, Cconst_pointer (1, _)) -> c - | Csequence(c1, c2) -> - Csequence(c1, remove_unit c2) - | Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) -> - Cifthenelse(cond, - ifso_dbg, remove_unit ifso, - ifnot_dbg, - remove_unit ifnot, dbg) - | Cswitch(sel, index, cases, dbg) -> - Cswitch(sel, index, - Array.map (fun (case, dbg) -> remove_unit case, dbg) cases, - dbg) - | Ccatch(rec_flag, handlers, body) -> - map_ccatch remove_unit rec_flag handlers body - | Ctrywith(body, exn, handler, dbg) -> - Ctrywith(remove_unit body, exn, remove_unit handler, dbg) - | Clet(id, c1, c2) -> - Clet(id, c1, remove_unit c2) - | Cop(Capply _mty, args, dbg) -> - Cop(Capply typ_void, args, dbg) - | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) -> - Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg) - | Cexit (_,_) as c -> c - | Ctuple [] as c -> c - | c -> Csequence(c, Ctuple []) - -(* Access to block fields *) - -let field_address ptr n dbg = - if n = 0 - then ptr - else Cop(Cadda, [ptr; Cconst_int(n * size_addr, dbg)], dbg) +let mut_from_env env ptr = + match env.environment_param with + | None -> Mutable + | Some environment_param -> + match ptr with + | Cvar ptr -> + (* Loads from the current function's closure are immutable. *) + if V.same environment_param ptr then Immutable + else Mutable + | _ -> Mutable let get_field env ptr n dbg = - let mut = - match env.environment_param with - | None -> Mutable - | Some environment_param -> - match ptr with - | Cvar ptr -> - (* Loads from the current function's closure are immutable. *) - if V.same environment_param ptr then Immutable - else Mutable - | _ -> Mutable - in - Cop(Cload (Word_val, mut), [field_address ptr n dbg], dbg) - -let set_field ptr n newval init dbg = - Cop(Cstore (Word_val, init), [field_address ptr n dbg; newval], dbg) - -let non_profinfo_mask = - if Config.profinfo - then (1 lsl (64 - Config.profinfo_width)) - 1 - else 0 (* [non_profinfo_mask] is unused in this case *) - -let get_header ptr dbg = - (* We cannot deem this as [Immutable] due to the presence of [Obj.truncate] - and [Obj.set_tag]. *) - Cop(Cload (Word_int, Mutable), - [Cop(Cadda, [ptr; Cconst_int(-size_int, dbg)], dbg)], dbg) - -let get_header_without_profinfo ptr dbg = - if Config.profinfo then - Cop(Cand, [get_header ptr dbg; Cconst_int (non_profinfo_mask, dbg)], dbg) - else - get_header ptr dbg - -let tag_offset = - if big_endian then -1 else -size_int - -let get_tag ptr dbg = - if Proc.word_addressed then (* If byte loads are slow *) - Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg) - else (* If byte loads are efficient *) - Cop(Cload (Byte_unsigned, Mutable), (* Same comment as [get_header] above *) - [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg) - -let get_size ptr dbg = - Cop(Clsr, [get_header_without_profinfo ptr dbg; Cconst_int (10, dbg)], dbg) - -(* Array indexing *) - -let log2_size_addr = Misc.log2 size_addr -let log2_size_float = Misc.log2 size_float - -let wordsize_shift = 9 -let numfloat_shift = 9 + log2_size_float - log2_size_addr - -let is_addr_array_hdr hdr dbg = - Cop(Ccmpi Cne, - [Cop(Cand, [hdr; Cconst_int (255, dbg)], dbg); floatarray_tag dbg], - dbg) - -let is_addr_array_ptr ptr dbg = - Cop(Ccmpi Cne, [get_tag ptr dbg; floatarray_tag dbg], dbg) - -let addr_array_length hdr dbg = - Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg) -let float_array_length hdr dbg = - Cop(Clsr, [hdr; Cconst_int (numfloat_shift, dbg)], dbg) - -let lsl_const c n dbg = - if n = 0 then c - else Cop(Clsl, [c; Cconst_int (n, dbg)], dbg) - -(* Produces a pointer to the element of the array [ptr] on the position [ofs] - with the given element [log2size] log2 element size. [ofs] is given as a - tagged int expression. - The optional ?typ argument is the C-- type of the result. - By default, it is Addr, meaning we are constructing a derived pointer - into the heap. If we know the pointer is outside the heap - (this is the case for bigarray indexing), we give type Int instead. *) - -let array_indexing ?typ log2size ptr ofs dbg = - let add = - match typ with - | None | Some Addr -> Cadda - | Some Int -> Caddi - | _ -> assert false in - match ofs with - | Cconst_int (n, _) -> - let i = n asr 1 in - if i = 0 then ptr - else Cop(add, [ptr; Cconst_int(i lsl log2size, dbg)], dbg) - | Cop(Caddi, - [Cop(Clsl, [c; Cconst_int (1, _)], _); Cconst_int (1, _)], dbg') -> - Cop(add, [ptr; lsl_const c log2size dbg], dbg') - | Cop(Caddi, [c; Cconst_int (n, _)], dbg') when log2size = 0 -> - Cop(add, - [Cop(add, [ptr; untag_int c dbg], dbg); Cconst_int (n asr 1, dbg)], - dbg') - | Cop(Caddi, [c; Cconst_int (n, _)], _) -> - Cop(add, [Cop(add, [ptr; lsl_const c (log2size - 1) dbg], dbg); - Cconst_int((n-1) lsl (log2size - 1), dbg)], dbg) - | _ when log2size = 0 -> - Cop(add, [ptr; untag_int ofs dbg], dbg) - | _ -> - Cop(add, [Cop(add, [ptr; lsl_const ofs (log2size - 1) dbg], dbg); - Cconst_int((-1) lsl (log2size - 1), dbg)], dbg) - -let addr_array_ref arr ofs dbg = - Cop(Cload (Word_val, Mutable), - [array_indexing log2_size_addr arr ofs dbg], dbg) -let int_array_ref arr ofs dbg = - Cop(Cload (Word_int, Mutable), - [array_indexing log2_size_addr arr ofs dbg], dbg) -let unboxed_float_array_ref arr ofs dbg = - Cop(Cload (Double_u, Mutable), - [array_indexing log2_size_float arr ofs dbg], dbg) -let float_array_ref dbg arr ofs = - box_float dbg (unboxed_float_array_ref arr ofs dbg) - -let addr_array_set arr ofs newval dbg = - Cop(Cextcall("caml_modify", typ_void, false, None), - [array_indexing log2_size_addr arr ofs dbg; newval], dbg) -let addr_array_initialize arr ofs newval dbg = - Cop(Cextcall("caml_initialize", typ_void, false, None), - [array_indexing log2_size_addr arr ofs dbg; newval], dbg) -let int_array_set arr ofs newval dbg = - Cop(Cstore (Word_int, Assignment), - [array_indexing log2_size_addr arr ofs dbg; newval], dbg) -let float_array_set arr ofs newval dbg = - Cop(Cstore (Double_u, Assignment), - [array_indexing log2_size_float arr ofs dbg; newval], dbg) - -(* String length *) - -(* Length of string block *) - -let string_length exp dbg = - bind "str" exp (fun str -> - let tmp_var = V.create_local "*tmp*" in - Clet(VP.create tmp_var, - Cop(Csubi, - [Cop(Clsl, - [get_size str dbg; - Cconst_int (log2_size_addr, dbg)], - dbg); - Cconst_int (1, dbg)], - dbg), - Cop(Csubi, - [Cvar tmp_var; - Cop(Cload (Byte_unsigned, Mutable), - [Cop(Cadda, [str; Cvar tmp_var], dbg)], dbg)], dbg))) - -let bigstring_length ba dbg = - Cop(Cload (Word_int, Mutable), [field_address ba 5 dbg], dbg) - -(* Message sending *) - -let lookup_tag obj tag dbg = - bind "tag" tag (fun tag -> - Cop(Cextcall("caml_get_public_method", typ_val, false, None), - [obj; tag], - dbg)) - -let lookup_label obj lab dbg = - bind "lab" lab (fun lab -> - let table = Cop (Cload (Word_val, Mutable), [obj], dbg) in - addr_array_ref table lab dbg) - -let call_cached_method obj tag cache pos args dbg = - let arity = List.length args in - let cache = array_indexing log2_size_addr cache pos dbg in - Compilenv.need_send_fun arity; - Cop(Capply typ_val, - Cconst_symbol("caml_send" ^ Int.to_string arity, dbg) :: - obj :: tag :: cache :: args, - dbg) - -(* Allocation *) - -let make_alloc_generic set_fn dbg tag wordsize args = - if wordsize <= Config.max_young_wosize then - Cop(Calloc, Cblockheader(block_header tag wordsize, dbg) :: args, dbg) - else begin - let id = V.create_local "*alloc*" in - let rec fill_fields idx = function - [] -> Cvar id - | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg, - fill_fields (idx + 2) el) in - Clet(VP.create id, - Cop(Cextcall("caml_alloc", typ_val, true, None), - [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg), - fill_fields 1 args) - end - -let make_alloc dbg tag args = - let addr_array_init arr ofs newval dbg = - Cop(Cextcall("caml_initialize", typ_void, false, None), - [array_indexing log2_size_addr arr ofs dbg; newval], dbg) - in - make_alloc_generic addr_array_init dbg tag (List.length args) args - -let make_float_alloc dbg tag args = - make_alloc_generic float_array_set dbg tag - (List.length args * size_float / size_addr) args - -(* Bounds checking *) - -let make_checkbound dbg = function - | [Cop(Clsr, [a1; Cconst_int (n, _)], _); Cconst_int (m, _)] - when (m lsl n) > n -> - Cop(Ccheckbound, [a1; Cconst_int(m lsl n + 1 lsl n - 1, dbg)], dbg) - | args -> - Cop(Ccheckbound, args, dbg) - -(* To compile "let rec" over values *) - -let fundecls_size fundecls = - let sz = ref (-1) in - List.iter - (fun f -> - let indirect_call_code_pointer_size = - match f.arity with - | 0 | 1 -> 0 - (* arity 1 does not need an indirect call handler. - arity 0 cannot be indirect called *) - | _ -> 1 - (* For other arities there is an indirect call handler. - if arity >= 2 it is caml_curry... - if arity < 0 it is caml_tuplify... *) - in - sz := !sz + 1 + 2 + indirect_call_code_pointer_size) - fundecls; - !sz + let mut = mut_from_env env ptr in + get_field_gen mut ptr n dbg type rhs_kind = | RHS_block of int @@ -903,6 +127,7 @@ type rhs_kind = | RHS_floatblock of int | RHS_nonrec ;; + let rec expr_size env = function | Uvar id -> begin try V.find_same id env with Not_found -> RHS_nonrec end @@ -948,22 +173,6 @@ let rec expr_size env = function | _ -> assert false) | _ -> RHS_nonrec -(* Record application and currying functions *) - -let apply_function n = - Compilenv.need_apply_fun n; "caml_apply" ^ Int.to_string n -let curry_function n = - Compilenv.need_curry_fun n; - if n >= 0 - then "caml_curry" ^ Int.to_string n - else "caml_tuplify" ^ Int.to_string (-n) - -(* Comparisons *) - -let transl_int_comparison cmp = cmp - -let transl_float_comparison cmp = cmp - (* Translate structured constants to Cmm data items *) let transl_constant dbg = function @@ -978,105 +187,48 @@ let transl_constant dbg = function | Uconst_ref (label, _) -> Cconst_symbol (label, dbg) -let cdefine_symbol (symb, (global : Cmmgen_state.is_global)) = - match global with - | Global -> [Cglobal_symbol symb; Cdefine_symbol symb] - | Local -> [Cdefine_symbol symb] - -let emit_block symb is_global white_header cont = - (* Headers for structured constants must be marked black in case we - are in no-naked-pointers mode. See [caml_darken]. *) - let black_header = Nativeint.logor white_header caml_black in - Cint black_header :: cdefine_symbol (symb, is_global) @ cont +let emit_constant cst cont = + match cst with + | Uconst_int n | Uconst_ptr n -> + cint_const n + :: cont + | Uconst_ref (sym, _) -> + Csymbol_address sym :: cont -let rec emit_structured_constant (sym, is_global) cst cont = +let emit_structured_constant ((_sym, is_global) as symb) cst cont = match cst with | Uconst_float s -> - emit_block sym is_global float_header (Cdouble s :: cont) + emit_float_constant symb s cont | Uconst_string s -> - emit_block sym is_global (string_header (String.length s)) - (emit_string_constant s cont) + emit_string_constant symb s cont | Uconst_int32 n -> - emit_block sym is_global boxedint32_header - (emit_boxed_int32_constant n cont) + emit_int32_constant symb n cont | Uconst_int64 n -> - emit_block sym is_global boxedint64_header - (emit_boxed_int64_constant n cont) + emit_int64_constant symb n cont | Uconst_nativeint n -> - emit_block sym is_global boxedintnat_header - (emit_boxed_nativeint_constant n cont) + emit_nativeint_constant symb n cont | Uconst_block (tag, csts) -> let cont = List.fold_right emit_constant csts cont in - emit_block sym is_global (block_header tag (List.length csts)) cont + emit_block symb (block_header tag (List.length csts)) cont | Uconst_float_array fields -> - emit_block sym is_global (floatarray_header (List.length fields)) - (Misc.map_end (fun f -> Cdouble f) fields cont) + emit_float_array_constant symb fields cont | Uconst_closure(fundecls, lbl, fv) -> Cmmgen_state.add_constant lbl (Const_closure (is_global, fundecls, fv)); List.iter (fun f -> Cmmgen_state.add_function f) fundecls; cont -and emit_constant cst cont = - match cst with - | Uconst_int n | Uconst_ptr n -> - cint_const n - :: cont - | Uconst_ref (sym, _) -> - Csymbol_address sym :: cont - -and emit_string_constant s cont = - let n = size_int - 1 - (String.length s) mod size_int in - Cstring s :: Cskip n :: Cint8 n :: cont - -and emit_boxed_int32_constant n cont = - let n = Nativeint.of_int32 n in - if size_int = 8 then - Csymbol_address caml_int32_ops :: Cint32 n :: Cint32 0n :: cont - else - Csymbol_address caml_int32_ops :: Cint n :: cont - -and emit_boxed_nativeint_constant n cont = - Csymbol_address caml_nativeint_ops :: Cint n :: cont - -and emit_boxed_int64_constant n cont = - let lo = Int64.to_nativeint n in - if size_int = 8 then - Csymbol_address caml_int64_ops :: Cint lo :: cont - else begin - let hi = Int64.to_nativeint (Int64.shift_right n 32) in - if big_endian then - Csymbol_address caml_int64_ops :: Cint hi :: Cint lo :: cont - else - Csymbol_address caml_int64_ops :: Cint lo :: Cint hi :: cont - end - (* Boxed integers *) let box_int_constant sym bi n = match bi with Pnativeint -> - emit_block sym Local boxedintnat_header - (emit_boxed_nativeint_constant n []) + emit_nativeint_constant (sym, Local) n [] | Pint32 -> let n = Nativeint.to_int32 n in - emit_block sym Local boxedint32_header - (emit_boxed_int32_constant n []) + emit_int32_constant (sym, Local) n [] | Pint64 -> let n = Int64.of_nativeint n in - emit_block sym Local boxedint64_header - (emit_boxed_int64_constant n []) - -let operations_boxed_int bi = - match bi with - Pnativeint -> caml_nativeint_ops - | Pint32 -> caml_int32_ops - | Pint64 -> caml_int64_ops - -let alloc_header_boxed_int bi = - match bi with - Pnativeint -> alloc_boxedintnat_header - | Pint32 -> alloc_boxedint32_header - | Pint64 -> alloc_boxedint64_header + emit_int64_constant (sym, Local) n [] let box_int dbg bi arg = match arg with @@ -1091,82 +243,7 @@ let box_int dbg bi arg = Cmmgen_state.add_data_items data_items; Cconst_symbol (sym, dbg) | _ -> - let arg' = - if bi = Pint32 && size_int = 8 && big_endian - then Cop(Clsl, [arg; Cconst_int (32, dbg)], dbg) - else arg in - Cop(Calloc, [alloc_header_boxed_int bi dbg; - Cconst_symbol(operations_boxed_int bi, dbg); - arg'], dbg) - -let split_int64_for_32bit_target arg dbg = - bind "split_int64" arg (fun arg -> - let first = Cop (Cadda, [Cconst_int (size_int, dbg); arg], dbg) in - let second = Cop (Cadda, [Cconst_int (2 * size_int, dbg); arg], dbg) in - Ctuple [Cop (Cload (Thirtytwo_unsigned, Mutable), [first], dbg); - Cop (Cload (Thirtytwo_unsigned, Mutable), [second], dbg)]) - -let alloc_matches_boxed_int bi ~hdr ~ops = - match bi, hdr, ops with - | Pnativeint, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> - Nativeint.equal hdr boxedintnat_header - && String.equal sym caml_nativeint_ops - | Pint32, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> - Nativeint.equal hdr boxedint32_header - && String.equal sym caml_int32_ops - | Pint64, Cblockheader (hdr, _dbg), Cconst_symbol (sym, _) -> - Nativeint.equal hdr boxedint64_header - && String.equal sym caml_int64_ops - | (Pnativeint | Pint32 | Pint64), _, _ -> false - -let rec unbox_int bi arg dbg = - match arg with - Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int (32, _)], dbg')], - _dbg) - when bi = Pint32 && size_int = 8 && big_endian - && alloc_matches_boxed_int bi ~hdr ~ops -> - (* Force sign-extension of low 32 bits *) - Cop(Casr, [Cop(Clsl, [contents; Cconst_int (32, dbg)], dbg'); - Cconst_int (32, dbg)], - dbg) - | Cop(Calloc, [hdr; ops; contents], _dbg) - when bi = Pint32 && size_int = 8 && not big_endian - && alloc_matches_boxed_int bi ~hdr ~ops -> - (* Force sign-extension of low 32 bits *) - Cop(Casr, [Cop(Clsl, [contents; Cconst_int (32, dbg)], dbg); - Cconst_int (32, dbg)], - dbg) - | Cop(Calloc, [hdr; ops; contents], _dbg) - when alloc_matches_boxed_int bi ~hdr ~ops -> - contents - | Clet(id, exp, body) -> Clet(id, exp, unbox_int bi body dbg) - | Cifthenelse(cond, ifso_dbg, e1, ifnot_dbg, e2, dbg) -> - Cifthenelse(cond, - ifso_dbg, unbox_int bi e1 ifso_dbg, - ifnot_dbg, unbox_int bi e2 ifnot_dbg, - dbg) - | Csequence(e1, e2) -> Csequence(e1, unbox_int bi e2 dbg) - | Cswitch(e, tbl, el, dbg') -> - Cswitch(e, tbl, - Array.map (fun (e, dbg) -> unbox_int bi e dbg, dbg) el, - dbg') - | Ccatch(rec_flag, handlers, body) -> - map_ccatch (fun e -> unbox_int bi e dbg) rec_flag handlers body - | Ctrywith(e1, id, e2, handler_dbg) -> - Ctrywith(unbox_int bi e1 dbg, id, - unbox_int bi e2 handler_dbg, handler_dbg) - | _ -> - if size_int = 4 && bi = Pint64 then - split_int64_for_32bit_target arg dbg - else - Cop( - Cload((if bi = Pint32 then Thirtytwo_signed else Word_int), Mutable), - [Cop(Cadda, [arg; Cconst_int (size_addr, dbg)], dbg)], dbg) - -let make_unsigned_int bi arg dbg = - if bi = Pint32 && size_int = 8 - then Cop(Cand, [arg; Cconst_natint (0xFFFFFFFFn, dbg)], dbg) - else arg + box_int_gen dbg bi arg (* Boxed numbers *) @@ -1189,666 +266,16 @@ let box_number bn arg = | Boxed_float dbg -> box_float dbg arg | Boxed_integer (bi, dbg) -> box_int dbg bi arg -(* Big arrays *) - -let bigarray_elt_size = function - Pbigarray_unknown -> assert false - | Pbigarray_float32 -> 4 - | Pbigarray_float64 -> 8 - | Pbigarray_sint8 -> 1 - | Pbigarray_uint8 -> 1 - | Pbigarray_sint16 -> 2 - | Pbigarray_uint16 -> 2 - | Pbigarray_int32 -> 4 - | Pbigarray_int64 -> 8 - | Pbigarray_caml_int -> size_int - | Pbigarray_native_int -> size_int - | Pbigarray_complex32 -> 8 - | Pbigarray_complex64 -> 16 - -(* Produces a pointer to the element of the bigarray [b] on the position - [args]. [args] is given as a list of tagged int expressions, one per array - dimension. *) -let bigarray_indexing unsafe elt_kind layout b args dbg = - let check_ba_bound bound idx v = - Csequence(make_checkbound dbg [bound;idx], v) in - (* Validates the given multidimensional offset against the array bounds and - transforms it into a one dimensional offset. The offsets are expressions - evaluating to tagged int. *) - let rec ba_indexing dim_ofs delta_ofs = function - [] -> assert false - | [arg] -> - if unsafe then arg - else - bind "idx" arg (fun idx -> - (* Load the untagged int bound for the given dimension *) - let bound = - Cop(Cload (Word_int, Mutable),[field_address b dim_ofs dbg], dbg) - in - let idxn = untag_int idx dbg in - check_ba_bound bound idxn idx) - | arg1 :: argl -> - (* The remainder of the list is transformed into a one dimensional offset - *) - let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in - (* Load the untagged int bound for the given dimension *) - let bound = - Cop(Cload (Word_int, Mutable), [field_address b dim_ofs dbg], dbg) - in - if unsafe then add_int (mul_int (decr_int rem dbg) bound dbg) arg1 dbg - else - bind "idx" arg1 (fun idx -> - bind "bound" bound (fun bound -> - let idxn = untag_int idx dbg in - (* [offset = rem * (tag_int bound) + idx] *) - let offset = - add_int (mul_int (decr_int rem dbg) bound dbg) idx dbg - in - check_ba_bound bound idxn offset)) in - (* The offset as an expression evaluating to int *) - let offset = - match layout with - Pbigarray_unknown_layout -> - assert false - | Pbigarray_c_layout -> - ba_indexing (4 + List.length args) (-1) (List.rev args) - | Pbigarray_fortran_layout -> - ba_indexing 5 1 - (List.map (fun idx -> sub_int idx (Cconst_int (2, dbg)) dbg) args) - and elt_size = - bigarray_elt_size elt_kind in - (* [array_indexing] can simplify the given expressions *) - array_indexing ~typ:Addr (log2 elt_size) - (Cop(Cload (Word_int, Mutable), - [field_address b 1 dbg], dbg)) offset dbg - -let bigarray_word_kind = function - Pbigarray_unknown -> assert false - | Pbigarray_float32 -> Single - | Pbigarray_float64 -> Double - | Pbigarray_sint8 -> Byte_signed - | Pbigarray_uint8 -> Byte_unsigned - | Pbigarray_sint16 -> Sixteen_signed - | Pbigarray_uint16 -> Sixteen_unsigned - | Pbigarray_int32 -> Thirtytwo_signed - | Pbigarray_int64 -> Word_int - | Pbigarray_caml_int -> Word_int - | Pbigarray_native_int -> Word_int - | Pbigarray_complex32 -> Single - | Pbigarray_complex64 -> Double - -let bigarray_get unsafe elt_kind layout b args dbg = - bind "ba" b (fun b -> - match elt_kind with - Pbigarray_complex32 | Pbigarray_complex64 -> - let kind = bigarray_word_kind elt_kind in - let sz = bigarray_elt_size elt_kind / 2 in - bind "addr" - (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr -> - bind "reval" - (Cop(Cload (kind, Mutable), [addr], dbg)) (fun reval -> - bind "imval" - (Cop(Cload (kind, Mutable), - [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg)], dbg)) - (fun imval -> box_complex dbg reval imval))) - | _ -> - Cop(Cload (bigarray_word_kind elt_kind, Mutable), - [bigarray_indexing unsafe elt_kind layout b args dbg], - dbg)) - -let bigarray_set unsafe elt_kind layout b args newval dbg = - bind "ba" b (fun b -> - match elt_kind with - Pbigarray_complex32 | Pbigarray_complex64 -> - let kind = bigarray_word_kind elt_kind in - let sz = bigarray_elt_size elt_kind / 2 in - bind "newval" newval (fun newv -> - bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) - (fun addr -> - Csequence( - Cop(Cstore (kind, Assignment), [addr; complex_re newv dbg], dbg), - Cop(Cstore (kind, Assignment), - [Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg); - complex_im newv dbg], - dbg)))) - | _ -> - Cop(Cstore (bigarray_word_kind elt_kind, Assignment), - [bigarray_indexing unsafe elt_kind layout b args dbg; newval], - dbg)) - -let unaligned_load_16 ptr idx dbg = - if Arch.allow_unaligned_access - then Cop(Cload (Sixteen_unsigned, Mutable), [add_int ptr idx dbg], dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in - let v2 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) - in - let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in - Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg) - -let unaligned_set_16 ptr idx newval dbg = - if Arch.allow_unaligned_access - then - Cop(Cstore (Sixteen_unsigned, Assignment), - [add_int ptr idx dbg; newval], dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); - cconst_int 0xFF], dbg) - in - let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in - let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg)) - -let unaligned_load_32 ptr idx dbg = - if Arch.allow_unaligned_access - then Cop(Cload (Thirtytwo_unsigned, Mutable), [add_int ptr idx dbg], dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in - let v2 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) - in - let v3 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) - in - let v4 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) - in - let b1, b2, b3, b4 = - if Arch.big_endian - then v1, v2, v3, v4 - else v4, v3, v2, v1 in - Cop(Cor, - [Cop(Cor, [lsl_int b1 (cconst_int 24) dbg; - lsl_int b2 (cconst_int 16) dbg], dbg); - Cop(Cor, [lsl_int b3 (cconst_int 8) dbg; b4], dbg)], - dbg) - -let unaligned_set_32 ptr idx newval dbg = - if Arch.allow_unaligned_access - then - Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval], - dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg) - in - let v2 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg) - in - let v3 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg) - in - let v4 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in - let b1, b2, b3, b4 = - if Arch.big_endian - then v1, v2, v3, v4 - else v4, v3, v2, v1 in - Csequence( - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int ptr idx dbg; b1], dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], - dbg)), - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3], - dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4], - dbg))) - -let unaligned_load_64 ptr idx dbg = - assert(size_int = 8); - if Arch.allow_unaligned_access - then Cop(Cload (Word_int, Mutable), [add_int ptr idx dbg], dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = Cop(Cload (Byte_unsigned, Mutable), [add_int ptr idx dbg], dbg) in - let v2 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) - in - let v3 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) - in - let v4 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) - in - let v5 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) - in - let v6 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) - in - let v7 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) - in - let v8 = Cop(Cload (Byte_unsigned, Mutable), - [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) - in - let b1, b2, b3, b4, b5, b6, b7, b8 = - if Arch.big_endian - then v1, v2, v3, v4, v5, v6, v7, v8 - else v8, v7, v6, v5, v4, v3, v2, v1 in - Cop(Cor, - [Cop(Cor, - [Cop(Cor, [lsl_int b1 (cconst_int (8*7)) dbg; - lsl_int b2 (cconst_int (8*6)) dbg], dbg); - Cop(Cor, [lsl_int b3 (cconst_int (8*5)) dbg; - lsl_int b4 (cconst_int (8*4)) dbg], dbg)], - dbg); - Cop(Cor, - [Cop(Cor, [lsl_int b5 (cconst_int (8*3)) dbg; - lsl_int b6 (cconst_int (8*2)) dbg], dbg); - Cop(Cor, [lsl_int b7 (cconst_int 8) dbg; - b8], dbg)], - dbg)], dbg) - -let unaligned_set_64 ptr idx newval dbg = - assert(size_int = 8); - if Arch.allow_unaligned_access - then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg) - else - let cconst_int i = Cconst_int (i, dbg) in - let v1 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*7)], dbg); cconst_int 0xFF], - dbg) - in - let v2 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*6)], dbg); cconst_int 0xFF], - dbg) - in - let v3 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*5)], dbg); cconst_int 0xFF], - dbg) - in - let v4 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*4)], dbg); cconst_int 0xFF], - dbg) - in - let v5 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*3)], dbg); cconst_int 0xFF], - dbg) - in - let v6 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int (8*2)], dbg); cconst_int 0xFF], - dbg) - in - let v7 = - Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], - dbg) - in - let v8 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in - let b1, b2, b3, b4, b5, b6, b7, b8 = - if Arch.big_endian - then v1, v2, v3, v4, v5, v6, v7, v8 - else v8, v7, v6, v5, v4, v3, v2, v1 in - Csequence( - Csequence( - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int ptr idx dbg; b1], - dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], - dbg)), - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3], - dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4], - dbg))), - Csequence( - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5], - dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6], - dbg)), - Csequence( - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7], - dbg), - Cop(Cstore (Byte_unsigned, Assignment), - [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8], - dbg)))) - -let max_or_zero a dbg = - bind "size" a (fun a -> - (* equivalent to - Cifthenelse(Cop(Ccmpi Cle, [a; cconst_int 0]), cconst_int 0, a) - - if a is positive, sign is 0 hence sign_negation is full of 1 - so sign_negation&a = a - if a is negative, sign is full of 1 hence sign_negation is 0 - so sign_negation&a = 0 *) - let sign = Cop(Casr, [a; Cconst_int (size_int * 8 - 1, dbg)], dbg) in - let sign_negation = Cop(Cxor, [sign; Cconst_int (-1, dbg)], dbg) in - Cop(Cand, [sign_negation; a], dbg)) - -let check_bound safety access_size dbg length a2 k = - match safety with - | Unsafe -> k - | Safe -> - let offset = - match access_size with - | Sixteen -> 1 - | Thirty_two -> 3 - | Sixty_four -> 7 - in - let a1 = - sub_int length (Cconst_int (offset, dbg)) dbg - in - Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k) - -let unaligned_set size ptr idx newval dbg = - match size with - | Sixteen -> unaligned_set_16 ptr idx newval dbg - | Thirty_two -> unaligned_set_32 ptr idx newval dbg - | Sixty_four -> unaligned_set_64 ptr idx newval dbg - -let unaligned_load size ptr idx dbg = - match size with - | Sixteen -> unaligned_load_16 ptr idx dbg - | Thirty_two -> unaligned_load_32 ptr idx dbg - | Sixty_four -> unaligned_load_64 ptr idx dbg - -let box_sized size dbg exp = - match size with - | Sixteen -> tag_int exp dbg - | Thirty_two -> box_int dbg Pint32 exp - | Sixty_four -> box_int dbg Pint64 exp - -(* Simplification of some primitives into C calls *) - -let default_prim name = - Primitive.simple ~name ~arity:0(*ignored*) ~alloc:true - -let int64_native_prim name arity ~alloc = - let u64 = Unboxed_integer Pint64 in - let rec make_args = function 0 -> [] | n -> u64 :: make_args (n - 1) in - Primitive.make ~name ~native_name:(name ^ "_native") - ~alloc - ~native_repr_args:(make_args arity) - ~native_repr_res:u64 - -let simplif_primitive_32bits = function - Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int") - | Pintofbint Pint64 -> Pccall (default_prim "caml_int64_to_int") - | Pcvtbint(Pint32, Pint64) -> Pccall (default_prim "caml_int64_of_int32") - | Pcvtbint(Pint64, Pint32) -> Pccall (default_prim "caml_int64_to_int32") - | Pcvtbint(Pnativeint, Pint64) -> - Pccall (default_prim "caml_int64_of_nativeint") - | Pcvtbint(Pint64, Pnativeint) -> - Pccall (default_prim "caml_int64_to_nativeint") - | Pnegbint Pint64 -> Pccall (int64_native_prim "caml_int64_neg" 1 - ~alloc:false) - | Paddbint Pint64 -> Pccall (int64_native_prim "caml_int64_add" 2 - ~alloc:false) - | Psubbint Pint64 -> Pccall (int64_native_prim "caml_int64_sub" 2 - ~alloc:false) - | Pmulbint Pint64 -> Pccall (int64_native_prim "caml_int64_mul" 2 - ~alloc:false) - | Pdivbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_div" 2 - ~alloc:true) - | Pmodbint {size=Pint64} -> Pccall (int64_native_prim "caml_int64_mod" 2 - ~alloc:true) - | Pandbint Pint64 -> Pccall (int64_native_prim "caml_int64_and" 2 - ~alloc:false) - | Porbint Pint64 -> Pccall (int64_native_prim "caml_int64_or" 2 - ~alloc:false) - | Pxorbint Pint64 -> Pccall (int64_native_prim "caml_int64_xor" 2 - ~alloc:false) - | Plslbint Pint64 -> Pccall (default_prim "caml_int64_shift_left") - | Plsrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right_unsigned") - | Pasrbint Pint64 -> Pccall (default_prim "caml_int64_shift_right") - | Pbintcomp(Pint64, Lambda.Ceq) -> Pccall (default_prim "caml_equal") - | Pbintcomp(Pint64, Lambda.Cne) -> Pccall (default_prim "caml_notequal") - | Pbintcomp(Pint64, Lambda.Clt) -> Pccall (default_prim "caml_lessthan") - | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan") - | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal") - | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal") - | Pbigarrayref(_unsafe, n, Pbigarray_int64, _layout) -> - Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n)) - | Pbigarrayset(_unsafe, n, Pbigarray_int64, _layout) -> - Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n)) - | Pstring_load(Sixty_four, _) -> Pccall (default_prim "caml_string_get64") - | Pbytes_load(Sixty_four, _) -> Pccall (default_prim "caml_bytes_get64") - | Pbytes_set(Sixty_four, _) -> Pccall (default_prim "caml_bytes_set64") - | Pbigstring_load(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_get64") - | Pbigstring_set(Sixty_four,_) -> Pccall (default_prim "caml_ba_uint8_set64") - | Pbbswap Pint64 -> Pccall (default_prim "caml_int64_bswap") - | p -> p - -let simplif_primitive p = - match p with - | Pduprecord _ -> - Pccall (default_prim "caml_obj_dup") - | Pbigarrayref(_unsafe, n, Pbigarray_unknown, _layout) -> - Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n)) - | Pbigarrayset(_unsafe, n, Pbigarray_unknown, _layout) -> - Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n)) - | Pbigarrayref(_unsafe, n, _kind, Pbigarray_unknown_layout) -> - Pccall (default_prim ("caml_ba_get_" ^ Int.to_string n)) - | Pbigarrayset(_unsafe, n, _kind, Pbigarray_unknown_layout) -> - Pccall (default_prim ("caml_ba_set_" ^ Int.to_string n)) - | p -> - if size_int = 8 then p else simplif_primitive_32bits p - -(* Build switchers both for constants and blocks *) - -let transl_isout h arg dbg = tag_int (Cop(Ccmpa Clt, [h ; arg], dbg)) dbg - -(* Build an actual switch (ie jump table) *) - -let make_switch arg cases actions dbg = - let extract_uconstant = - function - (* Constant integers loaded from a table should end in 1, - so that Cload never produces untagged integers *) - | Cconst_int (n, _), _dbg - | Cconst_pointer (n, _), _dbg when (n land 1) = 1 -> - Some (Cint (Nativeint.of_int n)) - | Cconst_natint (n, _), _dbg - | Cconst_natpointer (n, _), _dbg - when Nativeint.(to_int (logand n one) = 1) -> - Some (Cint n) - | Cconst_symbol (s,_), _dbg -> - Some (Csymbol_address s) - | _ -> None - in - let extract_affine ~cases ~const_actions = - let length = Array.length cases in - if length >= 2 - then begin - match const_actions.(cases.(0)), const_actions.(cases.(1)) with - | Cint v0, Cint v1 -> - let slope = Nativeint.sub v1 v0 in - let check i = function - | Cint v -> v = Nativeint.(add (mul (of_int i) slope) v0) - | _ -> false - in - if Misc.Stdlib.Array.for_alli - (fun i idx -> check i const_actions.(idx)) cases - then Some (v0, slope) - else None - | _, _ -> - None - end - else None - in - let make_table_lookup ~cases ~const_actions arg dbg = - let table = Compilenv.new_const_symbol () in - Cmmgen_state.add_constant table (Const_table (Local, - Array.to_list (Array.map (fun act -> - const_actions.(act)) cases))); - addr_array_ref (Cconst_symbol (table, dbg)) (tag_int arg dbg) dbg - in - let make_affine_computation ~offset ~slope arg dbg = - (* In case the resulting integers are an affine function of the index, we - don't emit a table, and just compute the result directly *) - add_int - (mul_int arg (natint_const_untagged dbg slope) dbg) - (natint_const_untagged dbg offset) - dbg - in - match Misc.Stdlib.Array.all_somes (Array.map extract_uconstant actions) with - | None -> - Cswitch (arg,cases,actions,dbg) - | Some const_actions -> - match extract_affine ~cases ~const_actions with - | Some (offset, slope) -> - make_affine_computation ~offset ~slope arg dbg - | None -> make_table_lookup ~cases ~const_actions arg dbg - -module SArgBlocks = -struct - type primitive = operation - - let eqint = Ccmpi Ceq - let neint = Ccmpi Cne - let leint = Ccmpi Cle - let ltint = Ccmpi Clt - let geint = Ccmpi Cge - let gtint = Ccmpi Cgt - - type act = expression - - (* CR mshinwell: GPR#2294 will fix the Debuginfo here *) - - let make_const i = Cconst_int (i, Debuginfo.none) - let make_prim p args = Cop (p,args, Debuginfo.none) - let make_offset arg n = add_const arg n Debuginfo.none - let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none) - let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none) - let make_if cond ifso ifnot = - Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot, - Debuginfo.none) - let make_switch loc arg cases actions = - let dbg = Debuginfo.from_location loc in - let actions = Array.map (fun expr -> expr, dbg) actions in - make_switch arg cases actions dbg - let bind arg body = bind "switcher" arg body - - let make_catch handler = - match handler with - | Cexit (i,[]) -> i,fun e -> e - | _ -> - let dbg = Debuginfo.none in - let i = next_raise_count () in -(* - Printf.eprintf "SHARE CMM: %i\n" i ; - Printcmm.expression Format.str_formatter handler ; - Printf.eprintf "%s\n" (Format.flush_str_formatter ()) ; -*) - i, - (fun body -> match body with - | Cexit (j,_) -> - if i=j then handler - else body - | _ -> ccatch (i,[],body,handler, dbg)) - - let make_exit i = Cexit (i,[]) - -end - -(* cmm store, as sharing as normally been detected in previous - phases, we only share exits *) -(* Some specific patterns can lead to switches where several cases - point to the same action, but this action is not an exit (see GPR#1370). - The addition of the index in the action array as context allows - sharing them correctly without duplication. *) -module StoreExpForSwitch = - Switch.CtxStore - (struct - type t = expression - type key = int option * int - type context = int - let make_key index expr = - let continuation = - match expr with - | Cexit (i,[]) -> Some i - | _ -> None - in - Some (continuation, index) - let compare_key (cont, index) (cont', index') = - match cont, cont' with - | Some i, Some i' when i = i' -> 0 - | _, _ -> Stdlib.compare index index' - end) - -(* For string switches, we can use a generic store *) -module StoreExp = - Switch.Store - (struct - type t = expression - type key = int - let make_key = function - | Cexit (i,[]) -> Some i - | _ -> None - let compare_key = Stdlib.compare - end) - -module SwitcherBlocks = Switch.Make(SArgBlocks) - -(* Int switcher, arg in [low..high], - cases is list of individual cases, and is sorted by first component *) - -let transl_int_switch loc arg low high cases default = match cases with -| [] -> assert false -| _::_ -> - let store = StoreExp.mk_store () in - assert (store.Switch.act_store () default = 0) ; - let cases = - List.map - (fun (i,act) -> i,store.Switch.act_store () act) - cases in - let rec inters plow phigh pact = function - | [] -> - if phigh = high then [plow,phigh,pact] - else [(plow,phigh,pact); (phigh+1,high,0) ] - | (i,act)::rem -> - if i = phigh+1 then - if pact = act then - inters plow i pact rem - else - (plow,phigh,pact)::inters i i act rem - else (* insert default *) - if pact = 0 then - if act = 0 then - inters plow i 0 rem - else - (plow,i-1,pact):: - inters i i act rem - else (* pact <> 0 *) - (plow,phigh,pact):: - begin - if act = 0 then inters (phigh+1) i 0 rem - else (phigh+1,i-1,0)::inters i i act rem - end in - let inters = match cases with - | [] -> assert false - | (k0,act0)::rem -> - if k0 = low then inters k0 k0 act0 rem - else inters low (k0-1) 0 cases in - bind "switcher" arg - (fun a -> - SwitcherBlocks.zyva - loc - (low,high) - a - (Array.of_list inters) store) +(* Returns the unboxed representation of a boxed float or integer. + For Pint32 on 64-bit archs, the high 32 bits of the result are undefined. *) +let unbox_number dbg bn arg = + match bn with + | Boxed_float dbg -> + unbox_float dbg arg + | Boxed_integer (Pint32, _) -> + low_32 dbg (unbox_int dbg Pint32 arg) + | Boxed_integer (bi, _) -> + unbox_int dbg bi arg (* Auxiliary functions for optimizing "let" of boxed numbers (floats and @@ -1859,142 +286,75 @@ type unboxed_number_kind = | Boxed of boxed_number * bool (* true: boxed form available at no cost *) | No_result (* expression never returns a result *) -let unboxed_number_kind_of_unbox dbg = function - | Same_as_ocaml_repr -> No_unboxing - | Unboxed_float -> Boxed (Boxed_float dbg, false) - | Unboxed_integer bi -> Boxed (Boxed_integer (bi, dbg), false) - | Untagged_int -> No_unboxing - -let rec is_unboxed_number ~strict env e = - (* Given unboxed_number_kind from two branches of the code, returns the - resulting unboxed_number_kind. - - If [strict=false], one knows that the type of the expression - is an unboxable number, and we decide to return an unboxed value - if this indeed eliminates at least one allocation. - - If [strict=true], we need to ensure that all possible branches - return an unboxable number (of the same kind). This could not - be the case in presence of GADTs. - *) - let join k1 e = - match k1, is_unboxed_number ~strict env e with - | Boxed (b1, c1), Boxed (b2, c2) when equal_boxed_number b1 b2 -> - Boxed (b1, c1 && c2) - | No_result, k | k, No_result -> - k (* if a branch never returns, it is safe to unbox it *) - | No_unboxing, k | k, No_unboxing when not strict -> - k - | _, _ -> No_unboxing - in - match e with - | Uvar id -> - begin match is_unboxed_id id env with - | None -> No_unboxing - | Some (_, bn) -> Boxed (bn, false) - end - - (* CR mshinwell: Changes to [Clambda] will provide the [Debuginfo] here *) - | Uconst(Uconst_ref(_, Some (Uconst_float _))) -> - let dbg = Debuginfo.none in - Boxed (Boxed_float dbg, true) - | Uconst(Uconst_ref(_, Some (Uconst_int32 _))) -> - let dbg = Debuginfo.none in - Boxed (Boxed_integer (Pint32, dbg), true) - | Uconst(Uconst_ref(_, Some (Uconst_int64 _))) -> - let dbg = Debuginfo.none in - Boxed (Boxed_integer (Pint64, dbg), true) - | Uconst(Uconst_ref(_, Some (Uconst_nativeint _))) -> - let dbg = Debuginfo.none in - Boxed (Boxed_integer (Pnativeint, dbg), true) - | Uprim(p, _, dbg) -> - begin match simplif_primitive p with - | Pccall p -> unboxed_number_kind_of_unbox dbg p.prim_native_repr_res - | Pfloatfield _ - | Pfloatofint - | Pnegfloat - | Pabsfloat - | Paddfloat - | Psubfloat - | Pmulfloat - | Pdivfloat - | Parrayrefu Pfloatarray - | Parrayrefs Pfloatarray -> Boxed (Boxed_float dbg, false) - | Pbintofint bi - | Pcvtbint(_, bi) - | Pnegbint bi - | Paddbint bi - | Psubbint bi - | Pmulbint bi - | Pdivbint {size=bi} - | Pmodbint {size=bi} - | Pandbint bi - | Porbint bi - | Pxorbint bi - | Plslbint bi - | Plsrbint bi - | Pasrbint bi - | Pbbswap bi -> Boxed (Boxed_integer (bi, dbg), false) - | Pbigarrayref(_, _, (Pbigarray_float32 | Pbigarray_float64), _) -> - Boxed (Boxed_float dbg, false) - | Pbigarrayref(_, _, Pbigarray_int32, _) -> - Boxed (Boxed_integer (Pint32, dbg), false) - | Pbigarrayref(_, _, Pbigarray_int64, _) -> - Boxed (Boxed_integer (Pint64, dbg), false) - | Pbigarrayref(_, _, Pbigarray_native_int,_) -> - Boxed (Boxed_integer (Pnativeint, dbg), false) - | Pstring_load(Thirty_two,_) - | Pbytes_load(Thirty_two,_) -> - Boxed (Boxed_integer (Pint32, dbg), false) - | Pstring_load(Sixty_four,_) - | Pbytes_load(Sixty_four,_) -> - Boxed (Boxed_integer (Pint64, dbg), false) - | Pbigstring_load(Thirty_two,_) -> - Boxed (Boxed_integer (Pint32, dbg), false) - | Pbigstring_load(Sixty_four,_) -> - Boxed (Boxed_integer (Pint64, dbg), false) - | Praise _ -> No_result - | _ -> No_unboxing - end - | Ulet (_, _, _, _, e) | Uletrec (_, e) | Usequence (_, e) -> - is_unboxed_number ~strict env e - | Uswitch (_, switch, _dbg) -> - let k = Array.fold_left join No_result switch.us_actions_consts in - Array.fold_left join k switch.us_actions_blocks - | Ustringswitch (_, actions, default_opt) -> - let k = List.fold_left (fun k (_, e) -> join k e) No_result actions in - begin match default_opt with - None -> k - | Some default -> join k default - end - | Ustaticfail _ -> No_result - | Uifthenelse (_, e1, e2) | Ucatch (_, _, e1, e2) | Utrywith (e1, _, e2) -> - join (is_unboxed_number ~strict env e1) e2 - | _ -> No_unboxing +(* Given unboxed_number_kind from two branches of the code, returns the + resulting unboxed_number_kind. -(* Helper for compilation of initialization and assignment operations *) + If [strict=false], one knows that the type of the expression + is an unboxable number, and we decide to return an unboxed value + if this indeed eliminates at least one allocation. -type assignment_kind = Caml_modify | Caml_initialize | Simple - -let assignment_kind ptr init = - match init, ptr with - | Assignment, Pointer -> Caml_modify - | Heap_initialization, Pointer -> Caml_initialize - | Assignment, Immediate - | Heap_initialization, Immediate - | Root_initialization, (Immediate | Pointer) -> Simple + If [strict=true], we need to ensure that all possible branches + return an unboxable number (of the same kind). This could not + be the case in presence of GADTs. +*) +let join_unboxed_number_kind ~strict k1 k2 = + match k1, k2 with + | Boxed (b1, c1), Boxed (b2, c2) when equal_boxed_number b1 b2 -> + Boxed (b1, c1 && c2) + | No_result, k | k, No_result -> + k (* if a branch never returns, it is safe to unbox it *) + | No_unboxing, k | k, No_unboxing when not strict -> + k + | _, _ -> No_unboxing + +let is_unboxed_number_cmm ~strict cmm = + let r = ref No_result in + let notify k = + r := join_unboxed_number_kind ~strict !r k + in + let rec aux = function + | Cop(Calloc, [Cblockheader (hdr, _); _], dbg) + when Nativeint.equal hdr float_header -> + notify (Boxed (Boxed_float dbg, false)) + | Cop(Calloc, [Cblockheader (hdr, _); Cconst_symbol (ops, _); _], dbg) -> + if Nativeint.equal hdr boxedintnat_header + && String.equal ops caml_nativeint_ops + then + notify (Boxed (Boxed_integer (Pnativeint, dbg), false)) + else + if Nativeint.equal hdr boxedint32_header + && String.equal ops caml_int32_ops + then + notify (Boxed (Boxed_integer (Pint32, dbg), false)) + else + if Nativeint.equal hdr boxedint64_header + && String.equal ops caml_int64_ops + then + notify (Boxed (Boxed_integer (Pint64, dbg), false)) + else + notify No_unboxing + | Cconst_symbol (s, _) -> + begin match Cmmgen_state.structured_constant_of_sym s with + | Some (Uconst_float _) -> + notify (Boxed (Boxed_float Debuginfo.none, true)) + | Some (Uconst_nativeint _) -> + notify (Boxed (Boxed_integer (Pnativeint, Debuginfo.none), true)) + | Some (Uconst_int32 _) -> + notify (Boxed (Boxed_integer (Pint32, Debuginfo.none), true)) + | Some (Uconst_int64 _) -> + notify (Boxed (Boxed_integer (Pint64, Debuginfo.none), true)) + | _ -> + notify No_unboxing + end + | l -> + if not (Cmm.iter_shallow_tail aux l) then + notify No_unboxing + in + aux cmm; + !r (* Translate an expression *) -let strmatch_compile = - let module S = - Strmatch.Make - (struct - let string_block_length ptr = get_size ptr Debuginfo.none - let transl_switch = transl_int_switch - end) in - S.compile - let rec transl env e = match e with Uvar id -> @@ -2027,7 +387,7 @@ let rec transl env e = int_const dbg f.arity :: transl_fundecls (pos + 3) rem else - Cconst_symbol (curry_function f.arity, dbg) :: + Cconst_symbol (curry_function_sym f.arity, dbg) :: int_const dbg f.arity :: Cconst_symbol (f.label, dbg) :: transl_fundecls (pos + 4) rem @@ -2045,46 +405,19 @@ let rec transl env e = (* produces a valid Caml value, pointing just after an infix header *) let ptr = transl env arg in let dbg = Debuginfo.none in - if offset = 0 - then ptr - else Cop(Caddv, [ptr; Cconst_int(offset * size_addr, dbg)], dbg) + ptr_offset ptr offset dbg | Udirect_apply(lbl, args, dbg) -> - Cop(Capply typ_val, - Cconst_symbol (lbl, dbg) :: List.map (transl env) args, - dbg) - | Ugeneric_apply(clos, [arg], dbg) -> - bind "fun" (transl env clos) (fun clos -> - Cop(Capply typ_val, - [get_field env clos 0 dbg; transl env arg; clos], - dbg)) + let args = List.map (transl env) args in + direct_apply lbl args dbg | Ugeneric_apply(clos, args, dbg) -> - let arity = List.length args in - let cargs = Cconst_symbol(apply_function arity, dbg) :: - List.map (transl env) (args @ [clos]) in - Cop(Capply typ_val, cargs, dbg) + let clos = transl env clos in + let args = List.map (transl env) args in + generic_apply (mut_from_env env clos) clos args dbg | Usend(kind, met, obj, args, dbg) -> - let call_met obj args clos = - if args = [] then - Cop(Capply typ_val, - [get_field env clos 0 dbg; obj; clos], dbg) - else - let arity = List.length args + 1 in - let cargs = Cconst_symbol(apply_function arity, dbg) :: obj :: - (List.map (transl env) args) @ [clos] in - Cop(Capply typ_val, cargs, dbg) - in - bind "obj" (transl env obj) (fun obj -> - match kind, args with - Self, _ -> - bind "met" (lookup_label obj (transl env met) dbg) - (call_met obj args) - | Cached, cache :: pos :: args -> - call_cached_method obj - (transl env met) (transl env cache) (transl env pos) - (List.map (transl env) args) dbg - | _ -> - bind "met" (lookup_tag obj (transl env met) dbg) - (call_met obj args)) + let met = transl env met in + let obj = transl env obj in + let args = List.map (transl env) args in + send kind met obj args dbg | Ulet(str, kind, id, exp, body) -> transl_let env str kind id exp body | Uphantom_let (var, defining_expr, body) -> @@ -2156,8 +489,10 @@ let rec transl env e = | Pbigarray_int32 -> box_int dbg Pint32 elt | Pbigarray_int64 -> box_int dbg Pint64 elt | Pbigarray_native_int -> box_int dbg Pnativeint elt - | Pbigarray_caml_int -> force_tag_int elt dbg - | _ -> tag_int elt dbg + | Pbigarray_caml_int -> tag_int elt dbg + | Pbigarray_sint8 | Pbigarray_uint8 + | Pbigarray_sint16 | Pbigarray_uint16 -> tag_int elt dbg + | Pbigarray_unknown -> assert false end | (Pbigarrayset(unsafe, _num_dims, elt_kind, layout), arg1 :: argl) -> let (argidx, argnewval) = split_last argl in @@ -2172,7 +507,12 @@ let rec transl env e = | Pbigarray_int64 -> transl_unbox_int dbg env Pint64 argnewval | Pbigarray_native_int -> transl_unbox_int dbg env Pnativeint argnewval - | _ -> untag_int (transl env argnewval) dbg) + | Pbigarray_caml_int -> + untag_int (transl env argnewval) dbg + | Pbigarray_sint8 | Pbigarray_uint8 + | Pbigarray_sint16 | Pbigarray_uint16 -> + ignore_high_bit_int (untag_int (transl env argnewval) dbg) + | Pbigarray_unknown -> assert false) dbg) | (Pbigarraydim(n), [b]) -> let dim_ofs = 4 + n in @@ -2245,20 +585,18 @@ let rec transl env e = let dbg = Debuginfo.none in bind "switch" (transl env arg) (fun arg -> - strmatch_compile dbg arg (Misc.may_map (transl env) d) + strmatch_compile dbg arg (Option.map (transl env) d) (List.map (fun (s,act) -> s,transl env act) sw)) | Ustaticfail (nfail, args) -> - Cexit (nfail, List.map (transl env) args) + let cargs = List.map (transl env) args in + notify_catch nfail env cargs; + Cexit (nfail, cargs) | Ucatch(nfail, [], body, handler) -> let dbg = Debuginfo.none in make_catch nfail (transl env body) (transl env handler) dbg | Ucatch(nfail, ids, body, handler) -> let dbg = Debuginfo.none in - (* CR-someday mshinwell: consider how we can do better than - [typ_val] when appropriate. *) - let ids_with_types = - List.map (fun (i, _) -> (i, Cmm.typ_val)) ids in - ccatch(nfail, ids_with_types, transl env body, transl env handler, dbg) + transl_catch env nfail ids body handler dbg | Utrywith(body, exn, handler) -> let dbg = Debuginfo.none in Ctrywith(transl env body, exn, transl env handler, dbg) @@ -2319,17 +657,75 @@ let rec transl env e = dbg)))) | Uassign(id, exp) -> let dbg = Debuginfo.none in + let cexp = transl env exp in begin match is_unboxed_id id env with | None -> - return_unit dbg (Cassign(id, transl env exp)) + return_unit dbg (Cassign(id, cexp)) | Some (unboxed_id, bn) -> - return_unit dbg (Cassign(unboxed_id, - transl_unbox_number dbg env bn exp)) + return_unit dbg (Cassign(unboxed_id, unbox_number dbg bn cexp)) end | Uunreachable -> let dbg = Debuginfo.none in Cop(Cload (Word_int, Mutable), [Cconst_int (0, dbg)], dbg) +and transl_catch env nfail ids body handler dbg = + let ids = List.map (fun (id, kind) -> (id, kind, ref No_result)) ids in + (* Translate the body, and while doing so, collect the "unboxing type" for + each argument. *) + let report args = + List.iter2 + (fun (_id, kind, u) c -> + let strict = + match kind with + | Pfloatval | Pboxedintval _ -> false + | Pintval | Pgenval -> true + in + u := join_unboxed_number_kind ~strict !u + (is_unboxed_number_cmm ~strict c) + ) + ids args + in + let env_body = add_notify_catch nfail report env in + let body = transl env_body body in + let typ_of_bn = function + | Boxed_float _ -> Cmm.typ_float + | Boxed_integer (Pint64, _) when size_int = 4 -> [|Int;Int|] + | Boxed_integer _ -> Cmm.typ_int + in + let new_env, rewrite, ids = + List.fold_right + (fun (id, _kind, u) (env, rewrite, ids) -> + match !u with + | No_unboxing | Boxed (_, true) | No_result -> + env, + (fun x -> x) :: rewrite, + (id, Cmm.typ_val) :: ids + | Boxed (bn, false) -> + let unboxed_id = V.create_local (VP.name id) in + add_unboxed_id (VP.var id) unboxed_id bn env, + (unbox_number Debuginfo.none bn) :: rewrite, + (VP.create unboxed_id, typ_of_bn bn) :: ids + ) + ids (env, [], []) + in + if env == new_env then + (* No unboxing *) + ccatch (nfail, ids, body, transl env handler, dbg) + else + (* allocate new "nfail" to catch errors more easily *) + let new_nfail = next_raise_count () in + let body = + (* Rewrite the body to unbox the call sites *) + let rec aux e = + match Cmm.map_shallow aux e with + | Cexit (n, el) when n = nfail -> + Cexit (new_nfail, List.map2 (fun f e -> f e) rewrite el) + | c -> c + in + aux body + in + ccatch (new_nfail, ids, body, transl new_env handler, dbg) + and transl_make_array dbg env kind args = match kind with | Pgenarray -> @@ -2383,40 +779,19 @@ and transl_prim_1 env p arg dbg = get_field env (transl env arg) n dbg | Pfloatfield n -> let ptr = transl env arg in - box_float dbg ( - Cop(Cload (Double_u, Mutable), - [if n = 0 - then ptr - else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)], - dbg)) + box_float dbg (floatfield n ptr dbg) | Pint_as_pointer -> - Cop(Caddi, [transl env arg; Cconst_int (-1, dbg)], dbg) - (* always a pointer outside the heap *) + int_as_pointer (transl env arg) dbg (* Exceptions *) - | Praise _ when not (!Clflags.debug) -> - Cop(Craise Cmm.Raise_notrace, [transl env arg], dbg) - | Praise Lambda.Raise_notrace -> - Cop(Craise Cmm.Raise_notrace, [transl env arg], dbg) - | Praise Lambda.Raise_reraise -> - Cop(Craise Cmm.Raise_withtrace, [transl env arg], dbg) - | Praise Lambda.Raise_regular -> - raise_regular dbg (transl env arg) + | Praise rkind -> + raise_prim rkind (transl env arg) dbg (* Integer operations *) | Pnegint -> - Cop(Csubi, [Cconst_int (2, dbg); transl env arg], dbg) + negint (transl env arg) dbg | Poffsetint n -> - if no_overflow_lsl n 1 then - add_const (transl env arg) (n lsl 1) dbg - else - transl_prim_2 env Paddint arg (Uconst (Uconst_int n)) dbg + offsetint n (transl env arg) dbg | Poffsetref n -> - return_unit dbg - (bind "ref" (transl env arg) (fun arg -> - Cop(Cstore (Word_int, Assignment), - [arg; - add_const (Cop(Cload (Word_int, Mutable), [arg], dbg)) - (n lsl 1) dbg], - dbg))) + offsetref n (transl env arg) dbg (* Floating-point operations *) | Pfloatofint -> box_float dbg (Cop(Cfloatofint, [untag_int(transl env arg) dbg], dbg)) @@ -2431,29 +806,7 @@ and transl_prim_1 env p arg dbg = tag_int(string_length (transl env arg) dbg) dbg (* Array operations *) | Parraylength kind -> - let hdr = get_header_without_profinfo (transl env arg) dbg in - begin match kind with - Pgenarray -> - let len = - if wordsize_shift = numfloat_shift then - Cop(Clsr, [hdr; Cconst_int (wordsize_shift, dbg)], dbg) - else - bind "header" hdr (fun hdr -> - Cifthenelse(is_addr_array_hdr hdr dbg, - dbg, - Cop(Clsr, - [hdr; Cconst_int (wordsize_shift, dbg)], dbg), - dbg, - Cop(Clsr, - [hdr; Cconst_int (numfloat_shift, dbg)], dbg), - dbg)) - in - Cop(Cor, [len; Cconst_int (1, dbg)], dbg) - | Paddrarray | Pintarray -> - Cop(Cor, [addr_array_length hdr dbg; Cconst_int (1, dbg)], dbg) - | Pfloatarray -> - Cop(Cor, [float_array_length hdr dbg; Cconst_int (1, dbg)], dbg) - end + arraylength kind (transl env arg) dbg (* Boolean operations *) | Pnot -> transl_if env Then_false_else_true @@ -2467,7 +820,7 @@ and transl_prim_1 env p arg dbg = | Pbintofint bi -> box_int dbg bi (untag_int (transl env arg) dbg) | Pintofbint bi -> - force_tag_int (transl_unbox_int dbg env bi arg) dbg + tag_int (transl_unbox_int dbg env bi arg) dbg | Pcvtbint(bi1, bi2) -> box_int dbg bi2 (transl_unbox_int dbg env bi1 arg) | Pnegbint bi -> @@ -2475,19 +828,10 @@ and transl_prim_1 env p arg dbg = (Cop(Csubi, [Cconst_int (0, dbg); transl_unbox_int dbg env bi arg], dbg)) | Pbbswap bi -> - let prim = match bi with - | Pnativeint -> "nativeint" - | Pint32 -> "int32" - | Pint64 -> "int64" in - box_int dbg bi (Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim, - typ_int, false, None), - [transl_unbox_int dbg env bi arg], - dbg)) + box_int dbg bi (bbswap bi (transl_unbox_int dbg env bi arg) dbg) | Pbswap16 -> - tag_int (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None), - [untag_int (transl env arg) dbg], - dbg)) - dbg + tag_int (bswap16 (ignore_high_bit_int (untag_int + (transl env arg) dbg)) dbg) dbg | (Pfield_computed | Psequand | Psequor | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint | Plsrint | Pasrint @@ -2514,29 +858,11 @@ and transl_prim_2 env p arg1 arg2 dbg = | Pfield_computed -> addr_array_ref (transl env arg1) (transl env arg2) dbg | Psetfield(n, ptr, init) -> - begin match assignment_kind ptr init with - | Caml_modify -> - return_unit dbg (Cop(Cextcall("caml_modify", typ_void, false, None), - [field_address (transl env arg1) n dbg; - transl env arg2], - dbg)) - | Caml_initialize -> - return_unit dbg (Cop(Cextcall("caml_initialize", typ_void, false, None), - [field_address (transl env arg1) n dbg; - transl env arg2], - dbg)) - | Simple -> - return_unit dbg - (set_field (transl env arg1) n (transl env arg2) init dbg) - end + setfield n ptr init (transl env arg1) (transl env arg2) dbg | Psetfloatfield (n, init) -> let ptr = transl env arg1 in - return_unit dbg ( - Cop(Cstore (Double_u, init), - [if n = 0 then ptr - else - Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg); - transl_unbox_float dbg env arg2], dbg)) + let float_val = transl_unbox_float dbg env arg2 in + setfloatfield n init ptr float_val dbg (* Boolean operations *) | Psequand -> @@ -2558,50 +884,29 @@ and transl_prim_2 env p arg1 arg2 dbg = dbg' (Cconst_pointer (1, dbg)) (* Integer operations *) | Paddint -> - decr_int(add_int (transl env arg1) (transl env arg2) dbg) dbg + add_int_caml (transl env arg1) (transl env arg2) dbg | Psubint -> - incr_int(sub_int (transl env arg1) (transl env arg2) dbg) dbg + sub_int_caml (transl env arg1) (transl env arg2) dbg | Pmulint -> - begin - (* decrementing the non-constant part helps when the multiplication is - followed by an addition; - for example, using this trick compiles (100 * a + 7) into - (+ ( * a 100) -85) - rather than - (+ ( * 200 (>>s a 1)) 15) - *) - match transl env arg1, transl env arg2 with - | Cconst_int _ as c1, c2 -> - incr_int (mul_int (untag_int c1 dbg) (decr_int c2 dbg) dbg) dbg - | c1, c2 -> - incr_int (mul_int (decr_int c1 dbg) (untag_int c2 dbg) dbg) dbg - end + mul_int_caml (transl env arg1) (transl env arg2) dbg | Pdivint is_safe -> - tag_int(div_int (untag_int(transl env arg1) dbg) - (untag_int(transl env arg2) dbg) is_safe dbg) dbg + div_int_caml is_safe (transl env arg1) (transl env arg2) dbg | Pmodint is_safe -> - tag_int(mod_int (untag_int(transl env arg1) dbg) - (untag_int(transl env arg2) dbg) is_safe dbg) dbg + mod_int_caml is_safe (transl env arg1) (transl env arg2) dbg | Pandint -> - Cop(Cand, [transl env arg1; transl env arg2], dbg) + and_int_caml (transl env arg1) (transl env arg2) dbg | Porint -> - Cop(Cor, [transl env arg1; transl env arg2], dbg) + or_int_caml (transl env arg1) (transl env arg2) dbg | Pxorint -> - Cop(Cor, [Cop(Cxor, [ignore_low_bit_int(transl env arg1); - ignore_low_bit_int(transl env arg2)], dbg); - Cconst_int (1, dbg)], dbg) + xor_int_caml (transl env arg1) (transl env arg2) dbg | Plslint -> - incr_int(lsl_int (decr_int(transl env arg1) dbg) - (untag_int(transl env arg2) dbg) dbg) dbg + lsl_int_caml (transl env arg1) (transl env arg2) dbg | Plsrint -> - Cop(Cor, [lsr_int (transl env arg1) (untag_int(transl env arg2) dbg) dbg; - Cconst_int (1, dbg)], dbg) + lsr_int_caml (transl env arg1) (transl env arg2) dbg | Pasrint -> - Cop(Cor, [asr_int (transl env arg1) (untag_int(transl env arg2) dbg) dbg; - Cconst_int (1, dbg)], dbg) + asr_int_caml (transl env arg1) (transl env arg2) dbg | Pintcomp cmp -> - tag_int(Cop(Ccmpi(transl_int_comparison cmp), - [transl env arg1; transl env arg2], dbg)) dbg + int_comp_caml cmp (transl env arg1) (transl env arg2) dbg | Pisout -> transl_isout (transl env arg1) (transl env arg2) dbg (* Float operations *) @@ -2626,124 +931,40 @@ and transl_prim_2 env p arg1 arg2 dbg = transl_unbox_float dbg env arg2], dbg)) | Pfloatcomp cmp -> - tag_int(Cop(Ccmpf(transl_float_comparison cmp), + tag_int(Cop(Ccmpf cmp, [transl_unbox_float dbg env arg1; transl_unbox_float dbg env arg2], dbg)) dbg (* String operations *) | Pstringrefu | Pbytesrefu -> - tag_int(Cop(Cload (Byte_unsigned, Mutable), - [add_int (transl env arg1) (untag_int(transl env arg2) dbg) - dbg], - dbg)) dbg + stringref_unsafe (transl env arg1) (transl env arg2) dbg | Pstringrefs | Pbytesrefs -> - tag_int - (bind "str" (transl env arg1) (fun str -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - Csequence( - make_checkbound dbg [string_length str dbg; idx], - Cop(Cload (Byte_unsigned, Mutable), - [add_int str idx dbg], dbg))))) dbg - + stringref_safe (transl env arg1) (transl env arg2) dbg | Pstring_load(size, unsafe) | Pbytes_load(size, unsafe) -> - box_sized size dbg - (bind "str" (transl env arg1) (fun str -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - check_bound unsafe size dbg - (string_length str dbg) - idx (unaligned_load size str idx dbg)))) - + string_load size unsafe (transl env arg1) (transl env arg2) dbg | Pbigstring_load(size, unsafe) -> - box_sized size dbg - (bind "ba" (transl env arg1) (fun ba -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - bind "ba_data" - (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg)) - (fun ba_data -> - check_bound unsafe size dbg - (bigstring_length ba dbg) - idx - (unaligned_load size ba_data idx dbg))))) + bigstring_load size unsafe (transl env arg1) (transl env arg2) dbg (* Array operations *) | Parrayrefu kind -> - begin match kind with - Pgenarray -> - bind "arr" (transl env arg1) (fun arr -> - bind "index" (transl env arg2) (fun idx -> - Cifthenelse(is_addr_array_ptr arr dbg, - dbg, - addr_array_ref arr idx dbg, - dbg, - float_array_ref dbg arr idx, - dbg))) - | Paddrarray -> - addr_array_ref (transl env arg1) (transl env arg2) dbg - | Pintarray -> - (* CR mshinwell: for int/addr_array_ref move "dbg" to first arg *) - int_array_ref (transl env arg1) (transl env arg2) dbg - | Pfloatarray -> - float_array_ref dbg (transl env arg1) (transl env arg2) - end + arrayref_unsafe kind (transl env arg1) (transl env arg2) dbg | Parrayrefs kind -> - begin match kind with - | Pgenarray -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - bind "header" (get_header_without_profinfo arr dbg) (fun hdr -> - if wordsize_shift = numfloat_shift then - Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx], - Cifthenelse(is_addr_array_hdr hdr dbg, - dbg, - addr_array_ref arr idx dbg, - dbg, - float_array_ref dbg arr idx, - dbg)) - else - Cifthenelse(is_addr_array_hdr hdr dbg, - dbg, - Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx], - addr_array_ref arr idx dbg), - dbg, - Csequence(make_checkbound dbg [float_array_length hdr dbg; idx], - float_array_ref dbg arr idx), - dbg)))) - | Paddrarray -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg [ - addr_array_length(get_header_without_profinfo arr dbg) dbg; idx], - addr_array_ref arr idx dbg))) - | Pintarray -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg [ - addr_array_length(get_header_without_profinfo arr dbg) dbg; idx], - int_array_ref arr idx dbg))) - | Pfloatarray -> - box_float dbg ( - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg - [float_array_length(get_header_without_profinfo arr dbg) dbg; - idx], - unboxed_float_array_ref arr idx dbg)))) - end + arrayref_safe kind (transl env arg1) (transl env arg2) dbg (* Boxed integers *) | Paddbint bi -> box_int dbg bi (Cop(Caddi, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Psubbint bi -> box_int dbg bi (Cop(Csubi, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Pmulbint bi -> box_int dbg bi (Cop(Cmuli, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Pdivbint { size = bi; is_safe } -> box_int dbg bi (safe_div_bi is_safe (transl_unbox_int dbg env bi arg1) @@ -2756,19 +977,19 @@ and transl_prim_2 env p arg1 arg2 dbg = bi dbg) | Pandbint bi -> box_int dbg bi (Cop(Cand, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Porbint bi -> box_int dbg bi (Cop(Cor, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Pxorbint bi -> box_int dbg bi (Cop(Cxor, - [transl_unbox_int dbg env bi arg1; - transl_unbox_int dbg env bi arg2], dbg)) + [transl_unbox_int_low dbg env bi arg1; + transl_unbox_int_low dbg env bi arg2], dbg)) | Plslbint bi -> box_int dbg bi (Cop(Clsl, - [transl_unbox_int dbg env bi arg1; + [transl_unbox_int_low dbg env bi arg1; untag_int(transl env arg2) dbg], dbg)) | Plsrbint bi -> box_int dbg bi (Cop(Clsr, @@ -2780,7 +1001,7 @@ and transl_prim_2 env p arg1 arg2 dbg = [transl_unbox_int dbg env bi arg1; untag_int(transl env arg2) dbg], dbg)) | Pbintcomp(bi, cmp) -> - tag_int (Cop(Ccmpi(transl_int_comparison cmp), + tag_int (Cop(Ccmpi cmp, [transl_unbox_int dbg env bi arg1; transl_unbox_int dbg env bi arg2], dbg)) dbg | Pnot | Pnegint | Pintoffloat | Pfloatofint | Pnegfloat @@ -2800,130 +1021,39 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg = match p with (* Heap operations *) | Psetfield_computed(ptr, init) -> - begin match assignment_kind ptr init with - | Caml_modify -> - return_unit dbg ( - addr_array_set (transl env arg1) (transl env arg2) (transl env arg3) - dbg) - | Caml_initialize -> - return_unit dbg ( - addr_array_initialize (transl env arg1) (transl env arg2) - (transl env arg3) dbg) - | Simple -> - return_unit dbg ( - int_array_set (transl env arg1) (transl env arg2) (transl env arg3) - dbg) - end + setfield_computed ptr init + (transl env arg1) (transl env arg2) (transl env arg3) dbg (* String operations *) | Pbytessetu -> - return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment), - [add_int (transl env arg1) - (untag_int(transl env arg2) dbg) - dbg; - untag_int(transl env arg3) dbg], dbg)) + bytesset_unsafe + (transl env arg1) (transl env arg2) (transl env arg3) dbg | Pbytessets -> - return_unit dbg - (bind "str" (transl env arg1) (fun str -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - Csequence( - make_checkbound dbg [string_length str dbg; idx], - Cop(Cstore (Byte_unsigned, Assignment), - [add_int str idx dbg; untag_int(transl env arg3) dbg], - dbg))))) + bytesset_safe + (transl env arg1) (transl env arg2) (transl env arg3) dbg (* Array operations *) | Parraysetu kind -> - return_unit dbg (begin match kind with - Pgenarray -> - bind "newval" (transl env arg3) (fun newval -> - bind "index" (transl env arg2) (fun index -> - bind "arr" (transl env arg1) (fun arr -> - Cifthenelse(is_addr_array_ptr arr dbg, - dbg, - addr_array_set arr index newval dbg, - dbg, - float_array_set arr index (unbox_float dbg newval) - dbg, - dbg)))) - | Paddrarray -> - addr_array_set (transl env arg1) (transl env arg2) (transl env arg3) - dbg - | Pintarray -> - int_array_set (transl env arg1) (transl env arg2) (transl env arg3) - dbg - | Pfloatarray -> - float_array_set (transl env arg1) (transl env arg2) - (transl_unbox_float dbg env arg3) - dbg - end) + let newval = + match kind with + | Pfloatarray -> transl_unbox_float dbg env arg3 + | _ -> transl env arg3 + in + arrayset_unsafe kind (transl env arg1) (transl env arg2) newval dbg | Parraysets kind -> - return_unit dbg (begin match kind with - | Pgenarray -> - bind "newval" (transl env arg3) (fun newval -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - bind "header" (get_header_without_profinfo arr dbg) (fun hdr -> - if wordsize_shift = numfloat_shift then - Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx], - Cifthenelse(is_addr_array_hdr hdr dbg, - dbg, - addr_array_set arr idx newval dbg, - dbg, - float_array_set arr idx - (unbox_float dbg newval) - dbg, - dbg)) - else - Cifthenelse(is_addr_array_hdr hdr dbg, - dbg, - Csequence(make_checkbound dbg [addr_array_length hdr dbg; idx], - addr_array_set arr idx newval dbg), - dbg, - Csequence(make_checkbound dbg [float_array_length hdr dbg; idx], - float_array_set arr idx - (unbox_float dbg newval) dbg), - dbg))))) - | Paddrarray -> - bind "newval" (transl env arg3) (fun newval -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg [ - addr_array_length(get_header_without_profinfo arr dbg) dbg; idx], - addr_array_set arr idx newval dbg)))) - | Pintarray -> - bind "newval" (transl env arg3) (fun newval -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg [ - addr_array_length(get_header_without_profinfo arr dbg) dbg; idx], - int_array_set arr idx newval dbg)))) - | Pfloatarray -> - bind_load "newval" (transl_unbox_float dbg env arg3) (fun newval -> - bind "index" (transl env arg2) (fun idx -> - bind "arr" (transl env arg1) (fun arr -> - Csequence(make_checkbound dbg [ - float_array_length (get_header_without_profinfo arr dbg) dbg;idx], - float_array_set arr idx newval dbg)))) - end) + let newval = + match kind with + | Pfloatarray -> transl_unbox_float dbg env arg3 + | _ -> transl env arg3 + in + arrayset_safe kind (transl env arg1) (transl env arg2) newval dbg | Pbytes_set(size, unsafe) -> - return_unit dbg - (bind "str" (transl env arg1) (fun str -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - bind "newval" (transl_unbox_sized size dbg env arg3) (fun newval -> - check_bound unsafe size dbg (string_length str dbg) - idx (unaligned_set size str idx newval dbg))))) + bytes_set size unsafe (transl env arg1) (transl env arg2) + (transl_unbox_sized size dbg env arg3) dbg | Pbigstring_set(size, unsafe) -> - return_unit dbg - (bind "ba" (transl env arg1) (fun ba -> - bind "index" (untag_int (transl env arg2) dbg) (fun idx -> - bind "newval" (transl_unbox_sized size dbg env arg3) (fun newval -> - bind "ba_data" - (Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg)) - (fun ba_data -> - check_bound unsafe size dbg (bigstring_length ba dbg) - idx (unaligned_set size ba_data idx newval dbg)))))) + bigstring_set size unsafe (transl env arg1) (transl env arg2) + (transl_unbox_sized size dbg env arg3) dbg | Pfield_computed | Psequand | Psequor | Pnot | Pnegint | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint | Plsrint | Pasrint @@ -2944,43 +1074,27 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg = fatal_errorf "Cmmgen.transl_prim_3: %a" Printclambda_primitives.primitive p -and transl_unbox_float dbg env = function - Uconst(Uconst_ref(_, Some (Uconst_float f))) -> Cconst_float (f, dbg) - | exp -> unbox_float dbg (transl env exp) - -and transl_unbox_int dbg env bi = function - Uconst(Uconst_ref(_, Some (Uconst_int32 n))) -> - Cconst_natint (Nativeint.of_int32 n, dbg) - | Uconst(Uconst_ref(_, Some (Uconst_nativeint n))) -> - Cconst_natint (n, dbg) - | Uconst(Uconst_ref(_, Some (Uconst_int64 n))) -> - if size_int = 8 then - Cconst_natint (Int64.to_nativeint n, dbg) - else begin - let low = Int64.to_nativeint n in - let high = Int64.to_nativeint (Int64.shift_right_logical n 32) in - if big_endian then - Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)] - else - Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)] - end - | Uprim(Pbintofint bi',[Uconst(Uconst_int i)],_) when bi = bi' -> - Cconst_int (i, dbg) - | exp -> unbox_int bi (transl env exp) dbg +and transl_unbox_float dbg env exp = + unbox_float dbg (transl env exp) -and transl_unbox_number dbg env bn arg = - match bn with - | Boxed_float _ -> transl_unbox_float dbg env arg - | Boxed_integer (bi, _) -> transl_unbox_int dbg env bi arg +and transl_unbox_int dbg env bi exp = + unbox_int dbg bi (transl env exp) + +(* transl_unbox_int, but may return garbage in upper bits *) +and transl_unbox_int_low dbg env bi e = + let e = transl_unbox_int dbg env bi e in + if bi = Pint32 then low_32 dbg e else e and transl_unbox_sized size dbg env exp = match size with - | Sixteen -> untag_int (transl env exp) dbg + | Sixteen -> + ignore_high_bit_int (untag_int (transl env exp) dbg) | Thirty_two -> transl_unbox_int dbg env Pint32 exp | Sixty_four -> transl_unbox_int dbg env Pint64 exp and transl_let env str kind id exp body = let dbg = Debuginfo.none in + let cexp = transl env exp in let unboxing = (* If [id] is a mutable variable (introduced to eliminate a local reference) and it contains a type of unboxable numbers, then @@ -2996,14 +1110,14 @@ and transl_let env str kind id exp body = (* It would be safe to always unbox in this case, but we do it only if this indeed allows us to get rid of some allocations in the bound expression. *) - is_unboxed_number ~strict:false env exp + is_unboxed_number_cmm ~strict:false cexp | _, Pgenval -> (* Here we don't know statically that the bound expression evaluates to an unboxable number type. We need to be stricter and ensure that all possible branches in the expression return a boxed value (of the same kind). Indeed, with GADTs, different branches could return different types. *) - is_unboxed_number ~strict:true env exp + is_unboxed_number_cmm ~strict:true cexp | _, Pintval -> No_unboxing in @@ -3011,10 +1125,10 @@ and transl_let env str kind id exp body = | No_unboxing | Boxed (_, true) | No_result -> (* N.B. [body] must still be traversed even if [exp] will never return: there may be constant closures inside that need lifting out. *) - Clet(id, transl env exp, transl env body) + Clet(id, cexp, transl env body) | Boxed (boxed_number, _false) -> let unboxed_id = V.create_local (VP.name id) in - Clet(VP.create unboxed_id, transl_unbox_number dbg env boxed_number exp, + Clet(VP.create unboxed_id, unbox_number dbg boxed_number cexp, transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body) and make_catch ncatch body handler dbg = match body with @@ -3161,38 +1275,7 @@ and transl_switch loc env arg index cases = match Array.length cases with | 1 -> transl env cases.(0) | _ -> let cases = Array.map (transl env) cases in - let store = StoreExpForSwitch.mk_store () in - let index = - Array.map - (fun j -> store.Switch.act_store j cases.(j)) - index in - let n_index = Array.length index in - let inters = ref [] - and this_high = ref (n_index-1) - and this_low = ref (n_index-1) - and this_act = ref index.(n_index-1) in - for i = n_index-2 downto 0 do - let act = index.(i) in - if act = !this_act then - decr this_low - else begin - inters := (!this_low, !this_high, !this_act) :: !inters ; - this_high := i ; - this_low := i ; - this_act := act - end - done ; - inters := (0, !this_high, !this_act) :: !inters ; - match !inters with - | [_] -> cases.(0) - | inters -> - bind "switcher" arg - (fun a -> - SwitcherBlocks.zyva - loc - (0,n_index-1) - a - (Array.of_list inters) store) + transl_switch_clambda loc arg index cases and transl_letrec env bindings cont = let dbg = Debuginfo.none in @@ -3236,13 +1319,8 @@ and transl_letrec env bindings cont = (* Translate a function definition *) -let transl_function ~ppf_dump f = - let body = - if Config.flambda then - Un_anf.apply ~ppf_dump f.body ~what:f.label - else - f.body - in +let transl_function f = + let body = f.body in let cmm_body = let env = create_env ~environment_param:f.env in if !Clflags.afl_instrument then @@ -3263,68 +1341,19 @@ let transl_function ~ppf_dump f = (* Translate all function definitions *) -let rec transl_all_functions ~ppf_dump already_translated cont = +let rec transl_all_functions already_translated cont = match Cmmgen_state.next_function () with | None -> cont, already_translated | Some f -> let sym = f.label in if String.Set.mem sym already_translated then - transl_all_functions ~ppf_dump already_translated cont + transl_all_functions already_translated cont else begin - transl_all_functions ~ppf_dump + transl_all_functions (String.Set.add sym already_translated) - ((f.dbg, transl_function ~ppf_dump f) :: cont) + ((f.dbg, transl_function f) :: cont) end -(* Emit constant closures *) - -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 - [] -> - (* 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 - [] -> - List.fold_right emit_constant 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 :: - emit_others (pos + 4) rem in - 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 :: - emit_others 3 remainder - else - Csymbol_address(curry_function f1.arity) :: - cint_const f1.arity :: - Csymbol_address f1.label :: - emit_others 4 remainder - (* Emit constant blocks *) let emit_constant_table symb elems = @@ -3355,21 +1384,22 @@ let emit_cmm_data_items_for_constants cont = match cst with | Const_closure (global, fundecls, clos_vars) -> let cmm = - emit_constant_closure (symbol, global) fundecls clos_vars [] + emit_constant_closure (symbol, global) fundecls + (List.fold_right emit_constant clos_vars []) [] in c := (Cdata cmm) :: !c | Const_table (global, elems) -> c := (Cdata (emit_constant_table (symbol, global) elems)) :: !c) - (Cmmgen_state.constants ()); - Cdata (Cmmgen_state.data_items ()) :: !c + (Cmmgen_state.get_and_clear_constants ()); + Cdata (Cmmgen_state.get_and_clear_data_items ()) :: !c -let transl_all_functions ~ppf_dump cont = +let transl_all_functions cont = let rec aux already_translated cont translated_functions = if Cmmgen_state.no_more_functions () then cont, translated_functions else let translated_functions, already_translated = - transl_all_functions ~ppf_dump already_translated translated_functions + transl_all_functions already_translated translated_functions in aux already_translated cont translated_functions in @@ -3384,57 +1414,12 @@ let transl_all_functions ~ppf_dump cont = in translated_functions @ cont -(* Build the NULL terminated array of gc roots *) - -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 :: - List.map (fun s -> Csymbol_address s) symbols @ - [Cint 0n]) - :: cont - -(* Build preallocated blocks (used for Flambda [Initialize_symbol] - constructs, and Clambda global module) *) - -let preallocate_block cont { Clambda.symbol; exported; tag; fields } = - let space = - (* These words will be registered as roots and as such must contain - valid values, in case we are in no-naked-pointers mode. Likewise - the block header must be black, below (see [caml_darken]), since - the overall record may be referenced. *) - List.map (fun field -> - match field with - | None -> - Cint (Nativeint.of_int 1 (* Val_unit *)) - | Some (Uconst_field_int n) -> - cint_const n - | Some (Uconst_field_ref label) -> - Csymbol_address label) - fields - in - let data = - Cint(black_block_header tag (List.length fields)) :: - if exported then - Cglobal_symbol symbol :: - Cdefine_symbol symbol :: space - else - Cdefine_symbol symbol :: space - in - Cdata data :: cont - -let emit_preallocated_blocks preallocated_blocks cont = - let symbols = - List.map (fun ({ Clambda.symbol }:Clambda.preallocated_block) -> symbol) - preallocated_blocks - in - let c1 = emit_gc_roots_table ~symbols cont in - List.fold_left preallocate_block c1 preallocated_blocks - (* Translate a compilation unit *) -let compunit ~ppf_dump (ulam, preallocated_blocks, constants) = +let compunit (ulam, preallocated_blocks, constants) = + assert (Cmmgen_state.no_more_functions ()); let dbg = Debuginfo.none in + Cmmgen_state.set_structured_constants constants; let init_code = if !Clflags.afl_instrument then Afl_instrument.instrument_initialiser (transl empty_env ulam) @@ -3455,505 +1440,7 @@ let compunit ~ppf_dump (ulam, preallocated_blocks, constants) = else [ Reduce_code_size ]; fun_dbg = Debuginfo.none }] in let c2 = transl_clambda_constants constants c1 in - let c3 = transl_all_functions ~ppf_dump c2 in + let c3 = transl_all_functions c2 in + Cmmgen_state.set_structured_constants []; let c4 = emit_preallocated_blocks preallocated_blocks c3 in emit_cmm_data_items_for_constants c4 - -(* -CAMLprim value caml_cache_public_method (value meths, value tag, value *cache) -{ - int li = 3, hi = Field(meths,0), mi; - while (li < hi) { // no need to check the 1st time - mi = ((li+hi) >> 1) | 1; - if (tag < Field(meths,mi)) hi = mi-2; - else li = mi; - } - *cache = (li-3)*sizeof(value)+1; - return Field (meths, li-1); -} -*) - -let cache_public_method meths tag cache dbg = - let raise_num = next_raise_count () in - let cconst_int i = Cconst_int (i, dbg) in - let li = V.create_local "*li*" and hi = V.create_local "*hi*" - and mi = V.create_local "*mi*" and tagged = V.create_local "*tagged*" in - Clet ( - VP.create li, cconst_int 3, - Clet ( - VP.create hi, Cop(Cload (Word_int, Mutable), [meths], dbg), - Csequence( - ccatch - (raise_num, [], - create_loop - (Clet( - VP.create mi, - Cop(Cor, - [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1], - dbg); - cconst_int 1], - dbg), - Csequence( - Cifthenelse - (Cop (Ccmpi Clt, - [tag; - Cop(Cload (Word_int, Mutable), - [Cop(Cadda, - [meths; lsl_const (Cvar mi) log2_size_addr dbg], - dbg)], - dbg)], dbg), - dbg, Cassign(hi, Cop(Csubi, [Cvar mi; cconst_int 2], dbg)), - dbg, Cassign(li, Cvar mi), - dbg), - Cifthenelse - (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg), - dbg, Cexit (raise_num, []), - dbg, Ctuple [], - dbg)))) - dbg, - Ctuple [], - dbg), - Clet ( - VP.create tagged, - Cop(Cadda, [lsl_const (Cvar li) log2_size_addr dbg; - cconst_int(1 - 3 * size_addr)], dbg), - Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg), - Cvar tagged))))) - -(* CR mshinwell: These will be filled in by later pull requests. *) -let placeholder_dbg () = Debuginfo.none -let placeholder_fun_dbg ~human_name:_ = Debuginfo.none - -(* Generate an application function: - (defun caml_applyN (a1 ... aN clos) - (if (= clos.arity N) - (app clos.direct a1 ... aN clos) - (let (clos1 (app clos.code a1 clos) - clos2 (app clos1.code a2 clos) - ... - closN-1 (app closN-2.code aN-1 closN-2)) - (app closN-1.code aN closN-1)))) -*) - -let apply_function_body arity = - let dbg = placeholder_dbg in - let arg = Array.make arity (V.create_local "arg") in - for i = 1 to arity - 1 do arg.(i) <- V.create_local "arg" done; - let clos = V.create_local "clos" in - let env = empty_env in - let rec app_fun clos n = - if n = arity-1 then - Cop(Capply typ_val, - [get_field env (Cvar clos) 0 (dbg ()); Cvar arg.(n); Cvar clos], - dbg ()) - else begin - let newclos = V.create_local "clos" in - Clet(VP.create newclos, - Cop(Capply typ_val, - [get_field env (Cvar clos) 0 (dbg ()); Cvar arg.(n); Cvar clos], - dbg ()), - app_fun newclos (n+1)) - end in - let args = Array.to_list arg in - let all_args = args @ [clos] in - (args, clos, - if arity = 1 then app_fun clos 0 else - Cifthenelse( - Cop(Ccmpi Ceq, - [get_field env (Cvar clos) 1 (dbg ()); int_const (dbg ()) arity], dbg ()), - dbg (), - Cop(Capply typ_val, - get_field env (Cvar clos) 2 (dbg ()) - :: List.map (fun s -> Cvar s) all_args, - dbg ()), - dbg (), - app_fun clos 0, - dbg ())) - -let send_function arity = - let dbg = placeholder_dbg in - let cconst_int i = Cconst_int (i, dbg ()) in - let (args, clos', body) = apply_function_body (1+arity) in - let cache = V.create_local "cache" - and obj = List.hd args - and tag = V.create_local "tag" in - let env = empty_env in - let clos = - let cache = Cvar cache and obj = Cvar obj and tag = Cvar tag in - let meths = V.create_local "meths" and cached = V.create_local "cached" in - let real = V.create_local "real" in - let mask = get_field env (Cvar meths) 1 (dbg ()) in - let cached_pos = Cvar cached in - let tag_pos = Cop(Cadda, [Cop (Cadda, [cached_pos; Cvar meths], dbg ()); - cconst_int(3*size_addr-1)], dbg ()) in - let tag' = Cop(Cload (Word_int, Mutable), [tag_pos], dbg ()) in - Clet ( - VP.create meths, Cop(Cload (Word_val, Mutable), [obj], dbg ()), - Clet ( - VP.create cached, - Cop(Cand, [Cop(Cload (Word_int, Mutable), [cache], dbg ()); mask], - dbg ()), - Clet ( - VP.create real, - Cifthenelse(Cop(Ccmpa Cne, [tag'; tag], dbg ()), - dbg (), - cache_public_method (Cvar meths) tag cache (dbg ()), - dbg (), - cached_pos, - dbg ()), - Cop(Cload (Word_val, Mutable), - [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths], dbg ()); - cconst_int(2*size_addr-1)], dbg ())], dbg ())))) - - in - let body = Clet(VP.create clos', clos, body) in - let cache = cache in - let fun_name = "caml_send" ^ Int.to_string arity in - let fun_args = - [obj, typ_val; tag, typ_int; cache, typ_val] - @ List.map (fun id -> (id, typ_val)) (List.tl args) in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - Cfunction - {fun_name; - fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args; - fun_body = body; - fun_codegen_options = []; - fun_dbg; - } - -let apply_function arity = - let (args, clos, body) = apply_function_body arity in - let all_args = args @ [clos] in - let fun_name = "caml_apply" ^ Int.to_string arity in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - Cfunction - {fun_name; - fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args; - fun_body = body; - fun_codegen_options = []; - fun_dbg; - } - -(* Generate tuplifying functions: - (defun caml_tuplifyN (arg clos) - (app clos.direct #0(arg) ... #N-1(arg) clos)) *) - -let tuplify_function arity = - let dbg = placeholder_dbg in - let arg = V.create_local "arg" in - let clos = V.create_local "clos" in - let env = empty_env in - let rec access_components i = - if i >= arity - then [] - else get_field env (Cvar arg) i (dbg ()) :: access_components(i+1) in - let fun_name = "caml_tuplify" ^ Int.to_string arity in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - Cfunction - {fun_name; - fun_args = [VP.create arg, typ_val; VP.create clos, typ_val]; - fun_body = - Cop(Capply typ_val, - get_field env (Cvar clos) 2 (dbg ()) - :: access_components 0 @ [Cvar clos], - dbg ()); - fun_codegen_options = []; - fun_dbg; - } - -(* Generate currying functions: - (defun caml_curryN (arg clos) - (alloc HDR caml_curryN_1 caml_curry_N_1_app arg clos)) - (defun caml_curryN_1 (arg clos) - (alloc HDR caml_curryN_2 caml_curry_N_2_app arg clos)) - ... - (defun caml_curryN_N-1 (arg clos) - (let (closN-2 clos.vars[1] - closN-3 closN-2.vars[1] - ... - clos1 clos2.vars[1] - clos clos1.vars[1]) - (app clos.direct - clos1.vars[0] ... closN-2.vars[0] clos.vars[0] arg clos))) - - Special "shortcut" functions are also generated to handle the - case where a partially applied function is applied to all remaining - arguments in one go. For instance: - (defun caml_curry_N_1_app (arg2 ... argN clos) - (let clos' clos.vars[1] - (app clos'.direct clos.vars[0] arg2 ... argN clos'))) - - Those shortcuts may lead to a quadratic number of application - primitives being generated in the worst case, which resulted in - linking time blowup in practice (PR#5933), so we only generate and - use them when below a fixed arity 'max_arity_optimized'. -*) - -let max_arity_optimized = 15 -let final_curry_function arity = - let dbg = placeholder_dbg in - let last_arg = V.create_local "arg" in - let last_clos = V.create_local "clos" in - let env = empty_env in - let rec curry_fun args clos n = - if n = 0 then - Cop(Capply typ_val, - get_field env (Cvar clos) 2 (dbg ()) :: - args @ [Cvar last_arg; Cvar clos], - dbg ()) - else - if n = arity - 1 || arity > max_arity_optimized then - begin - let newclos = V.create_local "clos" in - Clet(VP.create newclos, - get_field env (Cvar clos) 3 (dbg ()), - curry_fun (get_field env (Cvar clos) 2 (dbg ()) :: args) - newclos (n-1)) - end else - begin - let newclos = V.create_local "clos" in - Clet(VP.create newclos, - get_field env (Cvar clos) 4 (dbg ()), - curry_fun (get_field env (Cvar clos) 3 (dbg ()) :: args) - newclos (n-1)) - end in - let fun_name = - "caml_curry" ^ Int.to_string arity ^ "_" ^ Int.to_string (arity-1) - in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - Cfunction - {fun_name; - fun_args = [VP.create last_arg, typ_val; VP.create last_clos, typ_val]; - fun_body = curry_fun [] last_clos (arity-1); - fun_codegen_options = []; - fun_dbg; - } - -let rec intermediate_curry_functions arity num = - let dbg = placeholder_dbg in - let env = empty_env in - if num = arity - 1 then - [final_curry_function arity] - else begin - let name1 = "caml_curry" ^ Int.to_string arity in - let name2 = if num = 0 then name1 else name1 ^ "_" ^ Int.to_string num in - let arg = V.create_local "arg" and clos = V.create_local "clos" in - let fun_dbg = placeholder_fun_dbg ~human_name:name2 in - Cfunction - {fun_name = name2; - fun_args = [VP.create arg, typ_val; VP.create clos, typ_val]; - fun_body = - if arity - num > 2 && arity <= max_arity_optimized then - Cop(Calloc, - [alloc_closure_header 5 Debuginfo.none; - Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ()); - int_const (dbg ()) (arity - num - 1); - Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1) ^ "_app", - dbg ()); - Cvar arg; Cvar clos], - dbg ()) - else - Cop(Calloc, - [alloc_closure_header 4 (dbg ()); - Cconst_symbol(name1 ^ "_" ^ Int.to_string (num+1), dbg ()); - int_const (dbg ()) 1; Cvar arg; Cvar clos], - dbg ()); - fun_codegen_options = []; - fun_dbg; - } - :: - (if arity <= max_arity_optimized && arity - num > 2 then - let rec iter i = - if i <= arity then - let arg = V.create_local (Printf.sprintf "arg%d" i) in - (arg, typ_val) :: iter (i+1) - else [] - in - let direct_args = iter (num+2) in - let rec iter i args clos = - if i = 0 then - Cop(Capply typ_val, - (get_field env (Cvar clos) 2 (dbg ())) :: args @ [Cvar clos], - dbg ()) - else - let newclos = V.create_local "clos" in - Clet(VP.create newclos, - get_field env (Cvar clos) 4 (dbg ()), - iter (i-1) (get_field env (Cvar clos) 3 (dbg ()) :: args) - newclos) - in - let fun_args = - List.map (fun (arg, ty) -> VP.create arg, ty) - (direct_args @ [clos, typ_val]) - in - let fun_name = name1 ^ "_" ^ Int.to_string (num+1) ^ "_app" in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - let cf = - Cfunction - {fun_name; - fun_args; - fun_body = iter (num+1) - (List.map (fun (arg,_) -> Cvar arg) direct_args) clos; - fun_codegen_options = []; - fun_dbg; - } - in - cf :: intermediate_curry_functions arity (num+1) - else - intermediate_curry_functions arity (num+1)) - end - -let curry_function arity = - assert(arity <> 0); - (* Functions with arity = 0 does not have a curry_function *) - if arity > 0 - then intermediate_curry_functions arity 0 - else [tuplify_function (-arity)] - -module Int = Numbers.Int - -let default_apply = Int.Set.add 2 (Int.Set.add 3 Int.Set.empty) - (* These apply funs are always present in the main program because - the run-time system needs them (cf. runtime/.S) . *) - -let generic_functions shared units = - let (apply,send,curry) = - List.fold_left - (fun (apply,send,curry) ui -> - List.fold_right Int.Set.add ui.ui_apply_fun apply, - List.fold_right Int.Set.add ui.ui_send_fun send, - List.fold_right Int.Set.add ui.ui_curry_fun curry) - (Int.Set.empty,Int.Set.empty,Int.Set.empty) - units in - let apply = if shared then apply else Int.Set.union apply default_apply in - let accu = Int.Set.fold (fun n accu -> apply_function n :: accu) apply [] in - let accu = Int.Set.fold (fun n accu -> send_function n :: accu) send accu in - Int.Set.fold (fun n accu -> curry_function n @ accu) curry accu - -(* Generate the entry point *) - -let entry_point namelist = - let dbg = placeholder_dbg in - let cconst_int i = Cconst_int (i, dbg ()) in - let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in - let incr_global_inited () = - Cop(Cstore (Word_int, Assignment), - [cconst_symbol "caml_globals_inited"; - Cop(Caddi, [Cop(Cload (Word_int, Mutable), - [cconst_symbol "caml_globals_inited"], dbg ()); - cconst_int 1], dbg ())], dbg ()) in - let body = - List.fold_right - (fun name next -> - let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in - Csequence(Cop(Capply typ_void, - [cconst_symbol entry_sym], dbg ()), - Csequence(incr_global_inited (), next))) - namelist (cconst_int 1) in - let fun_name = "caml_program" in - let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in - Cfunction {fun_name; - fun_args = []; - fun_body = body; - fun_codegen_options = [Reduce_code_size]; - fun_dbg; - } - -(* Generate the table of globals *) - -let cint_zero = Cint 0n - -let global_table namelist = - let mksym name = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "gc_roots")) - in - Cdata(Cglobal_symbol "caml_globals" :: - Cdefine_symbol "caml_globals" :: - List.map mksym namelist @ - [cint_zero]) - -let reference_symbols namelist = - let mksym name = Csymbol_address name in - Cdata(List.map mksym namelist) - -let global_data name v = - Cdata(emit_structured_constant (name, Global) - (Uconst_string (Marshal.to_string v [])) []) - -let globals_map v = global_data "caml_globals_map" v - -(* Generate the master table of frame descriptors *) - -let frame_table namelist = - let mksym name = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some "frametable")) - in - Cdata(Cglobal_symbol "caml_frametable" :: - Cdefine_symbol "caml_frametable" :: - List.map mksym namelist - @ [cint_zero]) - -(* Generate the master table of Spacetime shapes *) - -let spacetime_shapes namelist = - let mksym name = - Csymbol_address ( - Compilenv.make_symbol ~unitname:name (Some "spacetime_shapes")) - in - Cdata(Cglobal_symbol "caml_spacetime_shapes" :: - Cdefine_symbol "caml_spacetime_shapes" :: - List.map mksym namelist - @ [cint_zero]) - -(* Generate the table of module data and code segments *) - -let segment_table namelist symbol begname endname = - let addsyms name lst = - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some begname)) :: - Csymbol_address (Compilenv.make_symbol ~unitname:name (Some endname)) :: - lst - in - Cdata(Cglobal_symbol symbol :: - Cdefine_symbol symbol :: - List.fold_right addsyms namelist [cint_zero]) - -let data_segment_table namelist = - segment_table namelist "caml_data_segments" "data_begin" "data_end" - -let code_segment_table namelist = - segment_table namelist "caml_code_segments" "code_begin" "code_end" - -(* Initialize a predefined exception *) - -let predef_exception i name = - let name_sym = Compilenv.new_const_symbol () in - let data_items = - emit_block name_sym Local (string_header (String.length name)) - (emit_string_constant name []) - in - let exn_sym = "caml_exn_" ^ name in - let tag = Obj.object_tag in - let size = 2 in - let fields = - (Csymbol_address name_sym) - :: (cint_const (-i - 1)) - :: data_items - in - let data_items = emit_block exn_sym Global (block_header tag size) fields in - Cdata data_items - -(* Header for a plugin *) - -let plugin_header units = - let mk (ui,crc) = - { dynu_name = ui.ui_name; - dynu_crc = crc; - dynu_imports_cmi = ui.ui_imports_cmi; - dynu_imports_cmx = ui.ui_imports_cmx; - dynu_defines = ui.ui_defines - } in - global_data "caml_plugin_header" - { dynu_magic = Config.cmxs_magic_number; dynu_units = List.map mk units } - -let reset () = - Cmmgen_state.reset () diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli index b7388a3f..a954a284 100644 --- a/asmcomp/cmmgen.mli +++ b/asmcomp/cmmgen.mli @@ -15,28 +15,8 @@ (* Translation from closed lambda to C-- *) -val compunit: - ppf_dump:Format.formatter - -> Clambda.ulambda +val compunit + : Clambda.ulambda * Clambda.preallocated_block list * Clambda.preallocated_constant list -> Cmm.phrase list - -val apply_function: int -> Cmm.phrase -val send_function: int -> Cmm.phrase -val curry_function: int -> Cmm.phrase list -val generic_functions: bool -> Cmx_format.unit_infos list -> Cmm.phrase list -val entry_point: string list -> Cmm.phrase -val global_table: string list -> Cmm.phrase -val reference_symbols: string list -> Cmm.phrase -val globals_map: - (string * Digest.t option * Digest.t option * string list) list -> Cmm.phrase -val frame_table: string list -> Cmm.phrase -val spacetime_shapes: string list -> Cmm.phrase -val data_segment_table: string list -> Cmm.phrase -val code_segment_table: string list -> Cmm.phrase -val predef_exception: int -> string -> Cmm.phrase -val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> Cmm.phrase -val black_block_header: (*tag:*)int -> (*size:*)int -> nativeint - -val reset : unit -> unit diff --git a/asmcomp/cmmgen_state.ml b/asmcomp/cmmgen_state.ml index b40375a6..595aba4d 100644 --- a/asmcomp/cmmgen_state.ml +++ b/asmcomp/cmmgen_state.ml @@ -28,6 +28,7 @@ type constant = type t = { mutable constants : constant S.Map.t; mutable data_items : Cmm.data_item list list; + structured_constants : (string, Clambda.ustructured_constant) Hashtbl.t; functions : Clambda.ufunction Queue.t; } @@ -35,15 +36,11 @@ let empty = { constants = S.Map.empty; data_items = []; functions = Queue.create (); + structured_constants = Hashtbl.create 16; } let state = empty -let reset () = - state.constants <- S.Map.empty; - state.data_items <- []; - Queue.clear state.functions - let add_constant sym cst = state.constants <- S.Map.add sym cst state.constants @@ -53,9 +50,15 @@ let add_data_items items = let add_function func = Queue.add func state.functions -let constants () = state.constants +let get_and_clear_constants () = + let constants = state.constants in + state.constants <- S.Map.empty; + constants -let data_items () = List.concat (List.rev state.data_items) +let get_and_clear_data_items () = + let data_items = List.concat (List.rev state.data_items) in + state.data_items <- []; + data_items let next_function () = match Queue.take state.functions with @@ -64,3 +67,19 @@ let next_function () = let no_more_functions () = Queue.is_empty state.functions + +let set_structured_constants l = + Hashtbl.clear state.structured_constants; + List.iter + (fun (c : Clambda.preallocated_constant) -> + Hashtbl.add state.structured_constants c.symbol c.definition + ) + l + +let get_structured_constant s = + Hashtbl.find_opt state.structured_constants s + +let structured_constant_of_sym s = + match Compilenv.structured_constant_of_symbol s with + | None -> get_structured_constant s + | Some _ as r -> r diff --git a/asmcomp/cmmgen_state.mli b/asmcomp/cmmgen_state.mli index aa9de814..306f55d5 100644 --- a/asmcomp/cmmgen_state.mli +++ b/asmcomp/cmmgen_state.mli @@ -19,8 +19,6 @@ [@@@ocaml.warning "+a-4-30-40-41-42"] -val reset : unit -> unit - type is_global = Global | Local type constant = @@ -33,10 +31,15 @@ val add_data_items : Cmm.data_item list -> unit val add_function : Clambda.ufunction -> unit -val constants : unit -> constant Misc.Stdlib.String.Map.t +val get_and_clear_constants : unit -> constant Misc.Stdlib.String.Map.t -val data_items : unit -> Cmm.data_item list +val get_and_clear_data_items : unit -> Cmm.data_item list val next_function : unit -> Clambda.ufunction option val no_more_functions : unit -> bool + +val set_structured_constants : Clambda.preallocated_constant list -> unit + +(* Also looks up using Compilenv.structured_constant_of_symbol *) +val structured_constant_of_sym : string -> Clambda.ustructured_constant option diff --git a/asmcomp/coloring.ml b/asmcomp/coloring.ml index 62a9b0da..ffcd71b7 100644 --- a/asmcomp/coloring.ml +++ b/asmcomp/coloring.ml @@ -43,13 +43,16 @@ let allocate_registers() = (* Unconstrained regs with degree < number of available registers *) let unconstrained = ref [] in + (* Reset the stack slot counts *) + let num_stack_slots = Array.make Proc.num_register_classes 0 in + (* Preallocate the spilled registers in the stack. Split the remaining registers into constrained and unconstrained. *) let remove_reg reg = let cl = Proc.register_class reg in if reg.spill then begin (* Preallocate the registers in the stack *) - let nslots = Proc.num_stack_slots.(cl) in + let nslots = num_stack_slots.(cl) in let conflict = Array.make nslots false in List.iter (fun r -> @@ -61,7 +64,7 @@ let allocate_registers() = let slot = ref 0 in while !slot < nslots && conflict.(!slot) do incr slot done; reg.loc <- Stack(Local !slot); - if !slot >= nslots then Proc.num_stack_slots.(cl) <- !slot + 1 + if !slot >= nslots then num_stack_slots.(cl) <- !slot + 1 end else if reg.degree < Proc.num_available_registers.(cl) then unconstrained := reg :: !unconstrained else begin @@ -163,7 +166,7 @@ let allocate_registers() = if start >= num_regs then 0 else start) end else begin (* Sorry, we must put the pseudoreg in a stack location *) - let nslots = Proc.num_stack_slots.(cl) in + let nslots = num_stack_slots.(cl) in let score = Array.make nslots 0 in (* Compute the scores as for registers *) List.iter @@ -206,21 +209,17 @@ let allocate_registers() = else begin (* Allocate a new stack slot *) reg.loc <- Stack(Local nslots); - Proc.num_stack_slots.(cl) <- nslots + 1 + num_stack_slots.(cl) <- nslots + 1 end end; (* Cancel the preferences of this register so that they don't influence transitively the allocation of registers that prefer this reg. *) reg.prefer <- [] in - (* Reset the stack slot counts *) - for i = 0 to Proc.num_register_classes - 1 do - Proc.num_stack_slots.(i) <- 0; - done; - (* First pass: preallocate spill registers and split remaining regs Second pass: assign locations to constrained regs Third pass: assign locations to unconstrained regs *) List.iter remove_reg (Reg.all_registers()); OrderedRegSet.iter assign_location !constrained; - List.iter assign_location !unconstrained + List.iter assign_location !unconstrained; + num_stack_slots diff --git a/asmcomp/coloring.mli b/asmcomp/coloring.mli index 874a6f98..83439b90 100644 --- a/asmcomp/coloring.mli +++ b/asmcomp/coloring.mli @@ -15,4 +15,4 @@ (* Register allocation by coloring of the interference graph *) -val allocate_registers: unit -> unit +val allocate_registers: unit -> int array diff --git a/asmcomp/deadcode.ml b/asmcomp/deadcode.ml index d803a008..2550639d 100644 --- a/asmcomp/deadcode.ml +++ b/asmcomp/deadcode.ml @@ -18,8 +18,23 @@ open Mach -(* [deadcode i] returns a pair of an optimized instruction [i'] - and a set of registers live "before" instruction [i]. *) +module Int = Numbers.Int + +type d = { + i : instruction; (* optimized instruction *) + regs : Reg.Set.t; (* a set of registers live "before" instruction [i] *) + exits : Int.Set.t; (* indexes of Iexit instructions "live before" [i] *) +} + +let append a b = + let rec append a b = + match a.desc with + | Iend -> b + | _ -> { a with next = append a.next b } + in + match b.desc with + | Iend -> a + | _ -> append a b let rec deadcode i = let arg = @@ -30,48 +45,104 @@ let rec deadcode i = in match i.desc with | Iend | Ireturn | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) | Iraise _ -> - (i, Reg.add_set_array i.live arg) + let regs = Reg.add_set_array i.live arg in + { i; regs; exits = Int.Set.empty; } | Iop op -> - let (s, before) = deadcode i.next in + let s = deadcode i.next in if Proc.op_is_pure op (* no side effects *) - && Reg.disjoint_set_array before i.res (* results are not used after *) + && Reg.disjoint_set_array s.regs i.res (* results are not used after *) && not (Proc.regs_are_volatile arg) (* no stack-like hard reg *) && not (Proc.regs_are_volatile i.res) (* is involved *) then begin assert (Array.length i.res > 0); (* sanity check *) - (s, before) + s end else begin - ({i with next = s}, Reg.add_set_array i.live arg) + { i = {i with next = s.i}; + regs = Reg.add_set_array i.live arg; + exits = s.exits; + } end | Iifthenelse(test, ifso, ifnot) -> - let (ifso', _) = deadcode ifso in - let (ifnot', _) = deadcode ifnot in - let (s, _) = deadcode i.next in - ({i with desc = Iifthenelse(test, ifso', ifnot'); next = s}, - Reg.add_set_array i.live arg) + let ifso' = deadcode ifso in + let ifnot' = deadcode ifnot in + let s = deadcode i.next in + { i = {i with desc = Iifthenelse(test, ifso'.i, ifnot'.i); next = s.i}; + regs = Reg.add_set_array i.live arg; + exits = Int.Set.union s.exits + (Int.Set.union ifso'.exits ifnot'.exits); + } | Iswitch(index, cases) -> - let cases' = Array.map (fun c -> fst (deadcode c)) cases in - let (s, _) = deadcode i.next in - ({i with desc = Iswitch(index, cases'); next = s}, - Reg.add_set_array i.live arg) + let dc = Array.map deadcode cases in + let cases' = Array.map (fun c -> c.i) dc in + let s = deadcode i.next in + { i = {i with desc = Iswitch(index, cases'); next = s.i}; + regs = Reg.add_set_array i.live arg; + exits = Array.fold_left + (fun acc c -> Int.Set.union acc c.exits) s.exits dc; + } | Icatch(rec_flag, handlers, body) -> - let (body', _) = deadcode body in - let handlers' = - List.map (fun (nfail, handler) -> - let (handler', _) = deadcode handler in - nfail, handler') - handlers - in - let (s, _) = deadcode i.next in - ({i with desc = Icatch(rec_flag, handlers', body'); next = s}, i.live) - | Iexit _nfail -> - (i, i.live) + let body' = deadcode body in + let s = deadcode i.next in + let handlers' = Int.Map.map deadcode (Int.Map.of_list handlers) in + (* Previous passes guarantee that indexes of handlers are unique + across the entire function and Iexit instructions refer + to the correctly scoped handlers. + We do not rely on it here, for safety. *) + let rec add_live nfail (live_exits, used_handlers) = + if Int.Set.mem nfail live_exits then + (live_exits, used_handlers) + else + let live_exits = Int.Set.add nfail live_exits in + match Int.Map.find_opt nfail handlers' with + | None -> (live_exits, used_handlers) + | Some handler -> + let used_handlers = (nfail, handler) :: used_handlers in + match rec_flag with + | Cmm.Nonrecursive -> (live_exits, used_handlers) + | Cmm.Recursive -> + Int.Set.fold add_live handler.exits (live_exits, used_handlers) + in + let live_exits, used_handlers = + Int.Set.fold add_live body'.exits (Int.Set.empty, []) + in + (* Remove exits that are going out of scope. *) + let used_handler_indexes = Int.Set.of_list (List.map fst used_handlers) in + let live_exits = Int.Set.diff live_exits used_handler_indexes in + (* For non-recursive catch, live exits referenced in handlers are free. *) + let live_exits = + match rec_flag with + | Cmm.Recursive -> live_exits + | Cmm.Nonrecursive -> + List.fold_left (fun exits (_,h) -> Int.Set.union h.exits exits) + live_exits + used_handlers + in + let exits = Int.Set.union s.exits live_exits in + begin match used_handlers with + | [] -> (* Simplify catch without handlers *) + { i = append body'.i s.i; + regs = body'.regs; + exits; + } + | _ -> + let handlers = List.map (fun (n,h) -> (n,h.i)) used_handlers in + { i = { i with desc = Icatch(rec_flag, handlers, body'.i); next = s.i }; + regs = i.live; + exits; + } + end + | Iexit nfail -> + { i; regs = i.live; exits = Int.Set.singleton nfail; } | Itrywith(body, handler) -> - let (body', _) = deadcode body in - let (handler', _) = deadcode handler in - let (s, _) = deadcode i.next in - ({i with desc = Itrywith(body', handler'); next = s}, i.live) + let body' = deadcode body in + let handler' = deadcode handler in + let s = deadcode i.next in + { i = {i with desc = Itrywith(body'.i, handler'.i); next = s.i}; + regs = i.live; + exits = Int.Set.union s.exits + (Int.Set.union body'.exits handler'.exits); + } let fundecl f = - let (new_body, _) = deadcode f.fun_body in - {f with fun_body = new_body} + let new_body = deadcode f.fun_body in + {f with fun_body = new_body.i} diff --git a/asmcomp/debug/compute_ranges.ml b/asmcomp/debug/compute_ranges.ml index 734eca50..7d40194d 100644 --- a/asmcomp/debug/compute_ranges.ml +++ b/asmcomp/debug/compute_ranges.ml @@ -16,7 +16,7 @@ open! Int_replace_polymorphic_compare -module L = Linearize +module L = Linear module Make (S : Compute_ranges_intf.S_functor) = struct module Subrange_state = S.Subrange_state @@ -39,7 +39,7 @@ module Make (S : Compute_ranges_intf.S_functor) = struct subrange_info : Subrange_info.t; } - let create ~(start_insn : Linearize.instruction) + let create ~(start_insn : L.instruction) ~start_pos ~start_pos_offset ~end_pos ~end_pos_offset ~subrange_info = @@ -456,7 +456,8 @@ module Make (S : Compute_ranges_intf.S_functor) = struct | Lend -> first_insn | Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _ | Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _ - | Lentertrap | Lpushtrap _ | Lpoptrap | Lraise _ -> + | Lentertrap | Lpushtrap _ | Lpoptrap | Ladjust_trap_depth _ + | Lraise _ -> let subrange_state = Subrange_state.advance_over_instruction subrange_state insn in diff --git a/asmcomp/debug/compute_ranges_intf.ml b/asmcomp/debug/compute_ranges_intf.ml index 69d82069..1fb4bdb6 100644 --- a/asmcomp/debug/compute_ranges_intf.ml +++ b/asmcomp/debug/compute_ranges_intf.ml @@ -28,7 +28,7 @@ the documentation on module type [S], below. *) -module L = Linearize +module L = Linear (** The type of caller-defined contextual state associated with subranges. This may be used to track information throughout the range-computing @@ -81,7 +81,7 @@ module type S_functor = sig module Index : Identifiable.S (** The module [Key] corresponds to the identifiers that define the ranges in - [Linearize] instructions. Each instruction should have two sets of keys, + [Linear] instructions. Each instruction should have two sets of keys, [available_before] and [available_across], with accessor functions of these names being provided to retrieve them. The notion of "availability" is not prescribed. The availability sets are used to compute subranges @@ -158,7 +158,7 @@ end (** This module type is the result type of the [Compute_ranges.Make] functor. The _ranges_ being computed are composed of contiguous _subranges_ delimited - by two labels (of type [Linearize.label]). These labels will be added by + by two labels (of type [Linear.label]). These labels will be added by this pass to the code being inspected, which is why the [create] function in the result of the functor returns not only the ranges but also the updated function with the labels added. The [start_pos_offset] and [end_pos_offset] @@ -199,7 +199,7 @@ module type S = sig val info : t -> Subrange_info.t (** The label at the start of the range. *) - val start_pos : t -> Linearize.label + val start_pos : t -> Linear.label (** How many bytes from the label at [start_pos] the range actually commences. If this value is zero, then the first byte of the range @@ -207,7 +207,7 @@ module type S = sig val start_pos_offset : t -> int (** The label at the end of the range. *) - val end_pos : t -> Linearize.label + val end_pos : t -> Linear.label (** Like [start_pos_offset], but analogously for the end of the range. (The sense is not inverted; a positive [end_pos_offset] means the range ends @@ -232,7 +232,7 @@ module type S = sig cross an extremity of any other range. (This should be satisfied in typical uses because the offsets are typically zero or one.) If there are no ranges supplied then [None] is returned. *) - val estimate_lowest_address : t -> (Linearize.label * int) option + val estimate_lowest_address : t -> (Linear.label * int) option (** Fold over all subranges within the given range. *) val fold @@ -251,7 +251,7 @@ module type S = sig (** Compute ranges for the code in the given linearized function declaration, returning the ranges as a value of type [t] and the rewritten code that must go forward for emission. *) - val create : Linearize.fundecl -> t * Linearize.fundecl + val create : Linear.fundecl -> t * Linear.fundecl (** Iterate through ranges. Each range is associated with an index. *) val iter : t -> f:(Index.t -> Range.t -> unit) -> unit diff --git a/asmcomp/emit.mli b/asmcomp/emit.mli index cab50833..ad7ede8d 100644 --- a/asmcomp/emit.mli +++ b/asmcomp/emit.mli @@ -15,7 +15,7 @@ (* Generation of assembly code *) -val fundecl: Linearize.fundecl -> unit +val fundecl: Linear.fundecl -> unit val data: Cmm.data_item list -> unit val begin_assembly: unit -> unit val end_assembly: unit -> unit diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index 9f55cd29..9c1ca30a 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -22,7 +22,7 @@ open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux module String = Misc.Stdlib.String @@ -56,6 +56,9 @@ let fastcode_flag = ref true let stack_offset = ref 0 (* Layout of the stack frame *) +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false let frame_size () = (* includes return address *) let sz = @@ -137,6 +140,12 @@ let register_name r = let sym32 ?ofs s = mem_sym ?ofs DWORD (emit_symbol s) +let domain_field f r = + mem32 DWORD (Domainstate.idx_of_field f * 8) r + +let load_domain_state r = + I.mov (sym32 "Caml_state") r + let reg = function | { loc = Reg r } -> register_name r | { loc = Stack(Incoming n | Outgoing n) } when n < 0 -> @@ -461,6 +470,17 @@ let emit_global_label s = D.global lbl; _label lbl +(* Output .text section directive, or named .text.caml. if enabled. *) + +let emit_named_text_section func_name = + if !Clflags.function_sections then + begin match system with + | S_macosx | S_mingw | S_cygwin | S_win32 -> D.text () + | _ -> D.section [ ".text.caml."^(emit_symbol func_name) ] + (Some "ax") ["@progbits"] + end + else D.text () + (* Output the assembly code for an instruction *) (* Name of current function *) @@ -473,7 +493,7 @@ let emit_instr fallthrough i = match i.desc with | Lend -> () | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); let n = frame_size() - 4 in if n > 0 then begin I.sub (int n) esp; @@ -598,13 +618,14 @@ let emit_instr fallthrough i = if !fastcode_flag then begin let lbl_redo = new_label() in def_label lbl_redo; - I.mov (sym32 "caml_young_ptr") eax; + load_domain_state ebx; + I.mov (domain_field Domain_young_ptr RBX) eax; I.sub (int n) eax; - I.mov eax (sym32 "caml_young_ptr"); - I.cmp (sym32 "caml_young_limit") eax; + I.cmp (domain_field Domain_young_limit RBX) eax; let lbl_call_gc = new_label() in let lbl_frame = record_frame_label i.live false Debuginfo.none in I.jb (label lbl_call_gc); + I.mov eax (domain_field Domain_young_ptr RBX); I.lea (mem32 NONE 4 RAX) (reg i.res.(0)); call_gc_sites := { gc_lbl = lbl_call_gc; @@ -833,7 +854,7 @@ let emit_instr fallthrough i = end; begin match lbl2 with None -> () - | Some lbl -> I.jg (label lbl) + | Some lbl -> I.ja (label lbl) end | Lswitch jumptbl -> let lbl = new_label() in @@ -843,30 +864,45 @@ let emit_instr fallthrough i = for i = 0 to Array.length jumptbl - 1 do D.long (ConstLabel (emit_label jumptbl.(i))) done; - D.text () + emit_named_text_section !function_name | Lentertrap -> () + | Ladjust_trap_depth { delta_traps } -> + let delta = trap_frame_size * delta_traps in + cfi_adjust_cfa_offset delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> I.push (label lbl_handler); if trap_frame_size > 8 then I.sub (int (trap_frame_size - 8)) esp; - I.push (sym32 "caml_exception_pointer"); + load_domain_state edx; + I.push (domain_field Domain_exception_pointer RDX); cfi_adjust_cfa_offset trap_frame_size; - I.mov esp (sym32 "caml_exception_pointer"); + I.mov esp (domain_field Domain_exception_pointer RDX); stack_offset := !stack_offset + trap_frame_size | Lpoptrap -> - I.pop (sym32 "caml_exception_pointer"); - I.add (int (trap_frame_size - 4)) esp; + I.mov edx (mem32 DWORD 4 RSP); + load_domain_state edx; + I.pop (domain_field Domain_exception_pointer RDX); + I.pop edx; + if trap_frame_size > 8 then + I.add (int (trap_frame_size - 8)) esp; cfi_adjust_cfa_offset (-trap_frame_size); stack_offset := !stack_offset - trap_frame_size | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular -> + load_domain_state ebx; + I.mov (int 0) (domain_field Domain_backtrace_pos RBX); + emit_call "caml_raise_exn"; + record_frame Reg.Set.empty true i.dbg + | Lambda.Raise_reraise -> emit_call "caml_raise_exn"; record_frame Reg.Set.empty true i.dbg - | Cmm.Raise_notrace -> - I.mov (sym32 "caml_exception_pointer") esp; - I.pop (sym32 "caml_exception_pointer"); + | Lambda.Raise_notrace -> + load_domain_state ebx; + I.mov (domain_field Domain_exception_pointer RBX) esp; + I.pop (domain_field Domain_exception_pointer RBX); if trap_frame_size > 8 then I.add (int (trap_frame_size - 8)) esp; I.pop ebx; @@ -879,7 +915,7 @@ let rec emit_all fallthrough i = | _ -> emit_instr fallthrough i; emit_all - (system = S_win32 || Linearize.has_fallthrough i.desc) + (system = S_win32 || Linear.has_fallthrough i.desc) i.next (* Emission of a function declaration *) @@ -892,7 +928,11 @@ let fundecl fundecl = call_gc_sites := []; bound_error_sites := []; bound_error_call := 0; - D.text (); + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + prologue_required := fundecl.fun_prologue_required; + emit_named_text_section !function_name; add_def_symbol fundecl.fun_name; D.align (if system = S_win32 then 4 else 16); D.global (emit_symbol fundecl.fun_name); @@ -943,9 +983,6 @@ let begin_assembly() = if system = S_win32 then begin D.mode386 (); D.model "FLAT"; - D.extrn "_caml_young_ptr" DWORD; - D.extrn "_caml_young_limit" DWORD; - D.extrn "_caml_exception_pointer" DWORD; D.extrn "_caml_extra_params" DWORD; D.extrn "_caml_call_gc" PROC; D.extrn "_caml_c_call" PROC; @@ -955,12 +992,12 @@ let begin_assembly() = D.extrn "_caml_alloc3" PROC; D.extrn "_caml_ml_array_bound_error" PROC; D.extrn "_caml_raise_exn" PROC; + D.extrn "_Caml_state" DWORD; end; D.data (); emit_global_label "data_begin"; - - D.text (); + emit_named_text_section (Compilenv.make_symbol (Some "code_begin")); emit_global_label "code_begin" let end_assembly() = @@ -969,8 +1006,7 @@ let end_assembly() = List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants end; - D.text (); - + emit_named_text_section (Compilenv.make_symbol (Some "code_end")); emit_global_label "code_end"; D.data (); diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml index 0b333af4..e3e114a6 100644 --- a/asmcomp/i386/proc.ml +++ b/asmcomp/i386/proc.ml @@ -88,6 +88,7 @@ let phys_reg n = if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) let eax = phys_reg 0 +let ebx = phys_reg 1 let ecx = phys_reg 2 let edx = phys_reg 3 @@ -204,10 +205,12 @@ let destroyed_at_oper = function all_phys_regs | Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call | Iop(Iintop(Idiv | Imod)) -> [| eax; edx |] - | Iop(Ialloc _ | Iintop Imulh) -> [| eax |] + | Iop(Ialloc _) -> [| eax; ebx |] + | Iop(Iintop Imulh) -> [| eax |] | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |] | Iop(Iintoffloat) -> [| eax |] | Iifthenelse(Ifloattest _, _, _) -> [| eax |] + | Itrywith _ -> [| edx |] | _ -> [||] let destroyed_at_raise = all_phys_regs @@ -238,19 +241,16 @@ let op_is_pure = function (* Layout of the stack frame *) -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - -let frame_required () = +let frame_required fd = let frame_size_at_top_of_function = (* cf. [frame_size] in emit.mlp. *) - Misc.align (4*num_stack_slots.(0) + 8*num_stack_slots.(1) + 4) + Misc.align (4*fd.fun_num_stack_slots.(0) + 8*fd.fun_num_stack_slots.(1) + 4) stack_alignment in frame_size_at_top_of_function > 4 -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/i386/reload.ml b/asmcomp/i386/reload.ml index 511b7f1b..a95e67c6 100644 --- a/asmcomp/i386/reload.ml +++ b/asmcomp/i386/reload.ml @@ -82,5 +82,5 @@ method! reload_test tst arg = end -let fundecl f = - (new reload)#fundecl f +let fundecl f num_stack_slots = + (new reload)#fundecl f num_stack_slots diff --git a/asmcomp/i386/scheduling.ml b/asmcomp/i386/scheduling.ml index 05627b04..c6c9a324 100644 --- a/asmcomp/i386/scheduling.ml +++ b/asmcomp/i386/scheduling.ml @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -let () = let module M = Schedgen in () (* to create a dependency *) +open! Schedgen (* to create a dependency *) (* Scheduling is turned off because our model does not fit the 486 nor the Pentium very well. In particular, it messes up with the diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml index 9e4e949a..59b5e2e2 100644 --- a/asmcomp/i386/selection.ml +++ b/asmcomp/i386/selection.ml @@ -302,7 +302,7 @@ method select_push exp = | _ -> (Ispecific(Ipush), exp) method! mark_c_tailcall = - Proc.contains_calls := true + contains_calls := true method! emit_extcall_args env args = let rec size_pushes = function diff --git a/asmcomp/interf.ml b/asmcomp/interf.ml index a1cdb921..8c848849 100644 --- a/asmcomp/interf.ml +++ b/asmcomp/interf.ml @@ -124,15 +124,14 @@ let build_graph fundecl = float arguments in integer registers, PR#6227.) *) let add_pref weight r1 r2 = - if weight > 0 then begin - let i = r1.stamp and j = r2.stamp in - if i <> j - && r1.loc = Unknown - && Proc.register_class r1 = Proc.register_class r2 - && (let p = if i < j then (i, j) else (j, i) in - not (IntPairSet.mem p !mat)) - then r1.prefer <- (r2, weight) :: r1.prefer - end in + let i = r1.stamp and j = r2.stamp in + if i <> j + && r1.loc = Unknown + && Proc.register_class r1 = Proc.register_class r2 + && (let p = if i < j then (i, j) else (j, i) in + not (IntPairSet.mem p !mat)) + then r1.prefer <- (r2, weight) :: r1.prefer + in (* Add a mutual preference between two regs *) let add_mutual_pref weight r1 r2 = @@ -148,6 +147,7 @@ let build_graph fundecl = (* Compute preferences and spill costs *) let rec prefer weight i = + assert (weight > 0); add_spill_cost weight i.arg; add_spill_cost weight i.res; match i.desc with @@ -167,25 +167,24 @@ let build_graph fundecl = | Iop _ -> prefer weight i.next | Iifthenelse(_tst, ifso, ifnot) -> - prefer (weight / 2) ifso; - prefer (weight / 2) ifnot; + prefer weight ifso; + prefer weight ifnot; prefer weight i.next | Iswitch(_index, cases) -> for i = 0 to Array.length cases - 1 do - prefer (weight / 2) cases.(i) + prefer weight cases.(i) done; prefer weight i.next | Icatch(rec_flag, handlers, body) -> prefer weight body; - List.iter (fun (_nfail, handler) -> - let weight = - match rec_flag with - | Cmm.Recursive -> - (* Avoid overflow of weight and spill_cost *) - if weight < 1000 then 8 * weight else weight - | Cmm.Nonrecursive -> - weight in - prefer weight handler) handlers; + let weight_h = + match rec_flag with + | Cmm.Recursive -> + (* Avoid overflow of weight and spill_cost *) + if weight < 1000 then 8 * weight else weight + | Cmm.Nonrecursive -> + weight in + List.iter (fun (_nfail, handler) -> prefer weight_h handler) handlers; prefer weight i.next | Iexit _ -> () diff --git a/asmcomp/linear.ml b/asmcomp/linear.ml new file mode 100644 index 00000000..37cf9200 --- /dev/null +++ b/asmcomp/linear.ml @@ -0,0 +1,92 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +open Mach + +(* Transformation of Mach code into a list of pseudo-instructions. *) +type label = Cmm.label + +type instruction = + { mutable desc: instruction_desc; + mutable next: instruction; + arg: Reg.t array; + res: Reg.t array; + dbg: Debuginfo.t; + live: Reg.Set.t } + +and instruction_desc = + | Lprologue + | Lend + | Lop of Mach.operation + | Lreloadretaddr + | Lreturn + | Llabel of label + | Lbranch of label + | Lcondbranch of Mach.test * label + | Lcondbranch3 of label option * label option * label option + | Lswitch of label array + | Lentertrap + | Ladjust_trap_depth of { delta_traps : int; } + | Lpushtrap of { lbl_handler : label; } + | Lpoptrap + | Lraise of Lambda.raise_kind + +let has_fallthrough = function + | Lreturn | Lbranch _ | Lswitch _ | Lraise _ + | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false + | _ -> true + +type fundecl = + { fun_name: string; + fun_body: instruction; + fun_fast: bool; + fun_dbg : Debuginfo.t; + fun_spacetime_shape : Mach.spacetime_shape option; + fun_tailrec_entry_point_label : label; + fun_contains_calls: bool; + fun_num_stack_slots: int array; + fun_frame_required: bool; + fun_prologue_required: bool; + } + +(* Invert a test *) + +let invert_integer_test = function + Isigned cmp -> Isigned(Cmm.negate_integer_comparison cmp) + | Iunsigned cmp -> Iunsigned(Cmm.negate_integer_comparison cmp) + +let invert_test = function + Itruetest -> Ifalsetest + | Ifalsetest -> Itruetest + | Iinttest(cmp) -> Iinttest(invert_integer_test cmp) + | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n) + | Ifloattest(cmp) -> Ifloattest(Cmm.negate_float_comparison cmp) + | Ieventest -> Ioddtest + | Ioddtest -> Ieventest + +(* The "end" instruction *) + +let rec end_instr = + { desc = Lend; + next = end_instr; + arg = [||]; + res = [||]; + dbg = Debuginfo.none; + live = Reg.Set.empty } + +(* Cons an instruction (live, debug empty) *) + +let instr_cons d a r n = + { desc = d; next = n; arg = a; res = r; + dbg = Debuginfo.none; live = Reg.Set.empty } diff --git a/asmcomp/linear.mli b/asmcomp/linear.mli new file mode 100644 index 00000000..2d1ce943 --- /dev/null +++ b/asmcomp/linear.mli @@ -0,0 +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 GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Transformation of Mach code into a list of pseudo-instructions. *) + +type label = Cmm.label + +type instruction = + { mutable desc: instruction_desc; + mutable next: instruction; + arg: Reg.t array; + res: Reg.t array; + dbg: Debuginfo.t; + live: Reg.Set.t } + +and instruction_desc = + | Lprologue + | Lend + | Lop of Mach.operation + | Lreloadretaddr + | Lreturn + | Llabel of label + | Lbranch of label + | Lcondbranch of Mach.test * label + | Lcondbranch3 of label option * label option * label option + | Lswitch of label array + | Lentertrap + | Ladjust_trap_depth of { delta_traps : int; } + | Lpushtrap of { lbl_handler : label; } + | Lpoptrap + | Lraise of Lambda.raise_kind + +val has_fallthrough : instruction_desc -> bool +val end_instr: instruction +val instr_cons: + instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction +val invert_test: Mach.test -> Mach.test + +type fundecl = + { fun_name: string; + fun_body: instruction; + fun_fast: bool; + fun_dbg : Debuginfo.t; + fun_spacetime_shape : Mach.spacetime_shape option; + fun_tailrec_entry_point_label : label; + fun_contains_calls: bool; + fun_num_stack_slots: int array; + fun_frame_required: bool; + fun_prologue_required: bool; + } diff --git a/asmcomp/linearize.ml b/asmcomp/linearize.ml index 38d3d6ac..31b992a4 100644 --- a/asmcomp/linearize.ml +++ b/asmcomp/linearize.ml @@ -14,80 +14,7 @@ (**************************************************************************) (* Transformation of Mach code into a list of pseudo-instructions. *) - -open Reg -open Mach - -type label = Cmm.label - -type instruction = - { mutable desc: instruction_desc; - mutable next: instruction; - arg: Reg.t array; - res: Reg.t array; - dbg: Debuginfo.t; - live: Reg.Set.t } - -and instruction_desc = - | Lprologue - | Lend - | Lop of operation - | Lreloadretaddr - | Lreturn - | Llabel of label - | Lbranch of label - | Lcondbranch of test * label - | Lcondbranch3 of label option * label option * label option - | Lswitch of label array - | Lentertrap - | Lpushtrap of { lbl_handler : label; } - | Lpoptrap - | Lraise of Cmm.raise_kind - -let has_fallthrough = function - | Lreturn | Lbranch _ | Lswitch _ | Lraise _ - | Lop Itailcall_ind _ | Lop (Itailcall_imm _) -> false - | _ -> true - -type fundecl = - { fun_name: string; - fun_body: instruction; - fun_fast: bool; - fun_dbg : Debuginfo.t; - fun_spacetime_shape : Mach.spacetime_shape option; - fun_tailrec_entry_point_label : label; - } - -(* Invert a test *) - -let invert_integer_test = function - Isigned cmp -> Isigned(Cmm.negate_integer_comparison cmp) - | Iunsigned cmp -> Iunsigned(Cmm.negate_integer_comparison cmp) - -let invert_test = function - Itruetest -> Ifalsetest - | Ifalsetest -> Itruetest - | Iinttest(cmp) -> Iinttest(invert_integer_test cmp) - | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n) - | Ifloattest(cmp) -> Ifloattest(Cmm.negate_float_comparison cmp) - | Ieventest -> Ioddtest - | Ioddtest -> Ieventest - -(* The "end" instruction *) - -let rec end_instr = - { desc = Lend; - next = end_instr; - arg = [||]; - res = [||]; - dbg = Debuginfo.none; - live = Reg.Set.empty } - -(* Cons an instruction (live, debug empty) *) - -let instr_cons d a r n = - { desc = d; next = n; arg = a; res = r; - dbg = Debuginfo.none; live = Reg.Set.empty } +open Linear (* Cons a simple instruction (arg, res, live empty) *) @@ -121,18 +48,48 @@ let check_label n = match n.desc with | Llabel lbl -> lbl | _ -> -1 + +(* Add pseudo-instruction Ladjust_trap_depth in front of a continuation + to notify assembler generation about updates to the stack as a result + of differences in exception trap depths. + The argument delta is the number of trap frames (not bytes). *) + +let rec adjust_trap_depth delta_traps next = + (* Simplify by merging and eliminating Ladjust_trap_depth instructions + whenever possible. *) + match next.desc with + | Ladjust_trap_depth { delta_traps = k } -> + adjust_trap_depth (delta_traps + k) next.next + | _ -> + if delta_traps = 0 then next + else cons_instr (Ladjust_trap_depth { delta_traps }) next + (* Discard all instructions up to the next label. This function is to be called before adding a non-terminating instruction. *) let rec discard_dead_code n = + let adjust trap_depth = + adjust_trap_depth trap_depth (discard_dead_code n.next) + in match n.desc with Lend -> n | Llabel _ -> n -(* Do not discard Lpoptrap/Lpushtrap or Istackoffset instructions, - as this may cause a stack imbalance later during assembler generation. *) - | Lpoptrap | Lpushtrap _ -> n - | Lop(Istackoffset _) -> n + (* Do not discard Lpoptrap/Lpushtrap/Ladjust_trap_depth + or Istackoffset instructions, as this may cause a stack imbalance + later during assembler generation. Replace them + with pseudo-instruction Ladjust_trap_depth with the corresponding + stack offset and eliminate dead instructions after them. *) + | Lpoptrap -> adjust (-1) + | Lpushtrap _ -> adjust (+1) + | Ladjust_trap_depth { delta_traps } -> adjust delta_traps + | Lop(Istackoffset _) -> + (* This dead instruction cannot be replaced by Ladjust_trap_depth, + because the units don't match: the argument of Istackoffset is in bytes, + whereas the argument of Ladjust_trap_depth is in trap frames, + and the size of trap frames is machine-dependant and therefore not + available here. *) + { n with next = discard_dead_code n.next; } | _ -> discard_dead_code n.next (* @@ -176,144 +133,135 @@ let local_exit k = snd (find_exit_label_try_depth k) = !try_depth (* Linearize an instruction [i]: add it in front of the continuation [n] *) - -let rec linear i n = - match i.Mach.desc with - Iend -> n - | Iop(Itailcall_ind _ | Itailcall_imm _ as op) -> - if not Config.spacetime then - copy_instr (Lop op) i (discard_dead_code n) - else - copy_instr (Lop op) i (linear i.Mach.next n) - | Iop(Imove | Ireload | Ispill) - when i.Mach.arg.(0).loc = i.Mach.res.(0).loc -> - linear i.Mach.next n - | Iop op -> - copy_instr (Lop op) i (linear i.Mach.next n) - | Ireturn -> - let n1 = copy_instr Lreturn i (discard_dead_code n) in - if !Proc.contains_calls - then cons_instr Lreloadretaddr n1 - else n1 - | Iifthenelse(test, ifso, ifnot) -> - let n1 = linear i.Mach.next n in - begin match (ifso.Mach.desc, ifnot.Mach.desc, n1.desc) with - Iend, _, Lbranch lbl -> - copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1) - | _, Iend, Lbranch lbl -> - copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1) - | Iexit nfail1, Iexit nfail2, _ - when is_next_catch nfail1 && local_exit nfail2 -> - let lbl2 = find_exit_label nfail2 in - copy_instr - (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1) - | Iexit nfail, _, _ when local_exit nfail -> - let n2 = linear ifnot n1 - and lbl = find_exit_label nfail in - copy_instr (Lcondbranch(test, lbl)) i n2 - | _, Iexit nfail, _ when local_exit nfail -> - let n2 = linear ifso n1 in - let lbl = find_exit_label nfail in - copy_instr (Lcondbranch(invert_test test, lbl)) i n2 - | Iend, _, _ -> - let (lbl_end, n2) = get_label n1 in - copy_instr (Lcondbranch(test, lbl_end)) i (linear ifnot n2) - | _, Iend, _ -> - let (lbl_end, n2) = get_label n1 in - copy_instr (Lcondbranch(invert_test test, lbl_end)) i - (linear ifso n2) - | _, _, _ -> - (* Should attempt branch prediction here *) - let (lbl_end, n2) = get_label n1 in - let (lbl_else, nelse) = get_label (linear ifnot n2) in - copy_instr (Lcondbranch(invert_test test, lbl_else)) i - (linear ifso (add_branch lbl_end nelse)) - end - | Iswitch(index, cases) -> - let lbl_cases = Array.make (Array.length cases) 0 in - let (lbl_end, n1) = get_label(linear i.Mach.next n) in - let n2 = ref (discard_dead_code n1) in - for i = Array.length cases - 1 downto 0 do - let (lbl_case, ncase) = - get_label(linear cases.(i) (add_branch lbl_end !n2)) in - lbl_cases.(i) <- lbl_case; - n2 := discard_dead_code ncase - done; - (* Switches with 1 and 2 branches have been eliminated earlier. - Here, we do something for switches with 3 branches. *) - if Array.length index = 3 then begin - let fallthrough_lbl = check_label !n2 in - let find_label n = - let lbl = lbl_cases.(index.(n)) in - if lbl = fallthrough_lbl then None else Some lbl in - copy_instr (Lcondbranch3(find_label 0, find_label 1, find_label 2)) - i !n2 - end else - copy_instr (Lswitch(Array.map (fun n -> lbl_cases.(n)) index)) i !n2 - | Icatch(_rec_flag, handlers, body) -> - let (lbl_end, n1) = get_label(linear i.Mach.next n) in - (* CR mshinwell for pchambart: - 1. rename "io" - 2. Make sure the test cases cover the "Iend" cases too *) - let labels_at_entry_to_handlers = List.map (fun (_nfail, handler) -> - match handler.Mach.desc with - | Iend -> lbl_end - | _ -> Cmm.new_label ()) - handlers in - let exit_label_add = List.map2 - (fun (nfail, _) lbl -> (nfail, (lbl, !try_depth))) - handlers labels_at_entry_to_handlers in - let previous_exit_label = !exit_label in - exit_label := exit_label_add @ !exit_label; - let n2 = List.fold_left2 (fun n (_nfail, handler) lbl_handler -> - match handler.Mach.desc with - | Iend -> n - | _ -> cons_instr (Llabel lbl_handler) - (linear handler (add_branch lbl_end n))) - n1 handlers labels_at_entry_to_handlers - in - let n3 = linear body (add_branch lbl_end n2) in - exit_label := previous_exit_label; - n3 - | Iexit nfail -> - let lbl, t = find_exit_label_try_depth nfail in - (* We need to re-insert dummy pushtrap (which won't be executed), - so as to preserve stack offset during assembler generation. - It would make sense to have a special pseudo-instruction - only to inform the later pass about this stack offset - (corresponding to N traps). - *) - let lbl_dummy = lbl in - let rec loop i tt = - if t = tt then i +let linear i n contains_calls = + let rec linear i n = + match i.Mach.desc with + Iend -> n + | Iop(Itailcall_ind _ | Itailcall_imm _ as op) -> + if not Config.spacetime then + copy_instr (Lop op) i (discard_dead_code n) else - loop (cons_instr (Lpushtrap { lbl_handler = lbl_dummy; }) i) (tt - 1) - in - let n1 = loop (linear i.Mach.next n) !try_depth in - let rec loop i tt = - if t = tt then i - else loop (cons_instr Lpoptrap i) (tt - 1) - in - loop (add_branch lbl n1) !try_depth - | Itrywith(body, handler) -> - let (lbl_join, n1) = get_label (linear i.Mach.next n) in - let (lbl_handler, n2) = - get_label (cons_instr Lentertrap (linear handler n1)) - in - incr try_depth; - assert (i.Mach.arg = [| |] || Config.spacetime); - let n3 = cons_instr (Lpushtrap { lbl_handler; }) - (linear body - (cons_instr - Lpoptrap - (add_branch lbl_join n2))) in - decr try_depth; - n3 - - | Iraise k -> - copy_instr (Lraise k) i (discard_dead_code n) - -let add_prologue first_insn = + copy_instr (Lop op) i (linear i.Mach.next n) + | Iop(Imove | Ireload | Ispill) + when i.Mach.arg.(0).loc = i.Mach.res.(0).loc -> + linear i.Mach.next n + | Iop op -> + copy_instr (Lop op) i (linear i.Mach.next n) + | Ireturn -> + let n1 = copy_instr Lreturn i (discard_dead_code n) in + if contains_calls + then cons_instr Lreloadretaddr n1 + else n1 + | Iifthenelse(test, ifso, ifnot) -> + let n1 = linear i.Mach.next n in + begin match (ifso.Mach.desc, ifnot.Mach.desc, n1.desc) with + Iend, _, Lbranch lbl -> + copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1) + | _, Iend, Lbranch lbl -> + copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1) + | Iexit nfail1, Iexit nfail2, _ + when is_next_catch nfail1 && local_exit nfail2 -> + let lbl2 = find_exit_label nfail2 in + copy_instr + (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1) + | Iexit nfail, _, _ when local_exit nfail -> + let n2 = linear ifnot n1 + and lbl = find_exit_label nfail in + copy_instr (Lcondbranch(test, lbl)) i n2 + | _, Iexit nfail, _ when local_exit nfail -> + let n2 = linear ifso n1 in + let lbl = find_exit_label nfail in + copy_instr (Lcondbranch(invert_test test, lbl)) i n2 + | Iend, _, _ -> + let (lbl_end, n2) = get_label n1 in + copy_instr (Lcondbranch(test, lbl_end)) i (linear ifnot n2) + | _, Iend, _ -> + let (lbl_end, n2) = get_label n1 in + copy_instr (Lcondbranch(invert_test test, lbl_end)) i + (linear ifso n2) + | _, _, _ -> + (* Should attempt branch prediction here *) + let (lbl_end, n2) = get_label n1 in + let (lbl_else, nelse) = get_label (linear ifnot n2) in + copy_instr (Lcondbranch(invert_test test, lbl_else)) i + (linear ifso (add_branch lbl_end nelse)) + end + | Iswitch(index, cases) -> + let lbl_cases = Array.make (Array.length cases) 0 in + let (lbl_end, n1) = get_label(linear i.Mach.next n) in + let n2 = ref (discard_dead_code n1) in + for i = Array.length cases - 1 downto 0 do + let (lbl_case, ncase) = + get_label(linear cases.(i) (add_branch lbl_end !n2)) in + lbl_cases.(i) <- lbl_case; + n2 := discard_dead_code ncase + done; + (* Switches with 1 and 2 branches have been eliminated earlier. + Here, we do something for switches with 3 branches. *) + if Array.length index = 3 then begin + let fallthrough_lbl = check_label !n2 in + let find_label n = + let lbl = lbl_cases.(index.(n)) in + if lbl = fallthrough_lbl then None else Some lbl in + copy_instr (Lcondbranch3(find_label 0, find_label 1, find_label 2)) + i !n2 + end else + copy_instr (Lswitch(Array.map (fun n -> lbl_cases.(n)) index)) i !n2 + | Icatch(_rec_flag, handlers, body) -> + let (lbl_end, n1) = get_label(linear i.Mach.next n) in + (* CR mshinwell for pchambart: + 1. rename "io" + 2. Make sure the test cases cover the "Iend" cases too *) + let labels_at_entry_to_handlers = List.map (fun (_nfail, handler) -> + match handler.Mach.desc with + | Iend -> lbl_end + | _ -> Cmm.new_label ()) + handlers in + let exit_label_add = List.map2 + (fun (nfail, _) lbl -> (nfail, (lbl, !try_depth))) + handlers labels_at_entry_to_handlers in + let previous_exit_label = !exit_label in + exit_label := exit_label_add @ !exit_label; + let n2 = List.fold_left2 (fun n (_nfail, handler) lbl_handler -> + match handler.Mach.desc with + | Iend -> n + | _ -> cons_instr (Llabel lbl_handler) + (linear handler (add_branch lbl_end n))) + n1 handlers labels_at_entry_to_handlers + in + let n3 = linear body (add_branch lbl_end n2) in + exit_label := previous_exit_label; + n3 + | Iexit nfail -> + let lbl, t = find_exit_label_try_depth nfail in + assert (i.Mach.next.desc = Mach.Iend); + let delta_traps = !try_depth - t in + let n1 = adjust_trap_depth delta_traps n in + let rec loop i tt = + if t = tt then i + else loop (cons_instr Lpoptrap i) (tt - 1) + in + loop (add_branch lbl n1) !try_depth + | Itrywith(body, handler) -> + let (lbl_join, n1) = get_label (linear i.Mach.next n) in + let (lbl_handler, n2) = + get_label (cons_instr Lentertrap (linear handler n1)) + in + incr try_depth; + assert (i.Mach.arg = [| |] || Config.spacetime); + let n3 = cons_instr (Lpushtrap { lbl_handler; }) + (linear body + (cons_instr + Lpoptrap + (add_branch lbl_join n2))) in + decr try_depth; + n3 + + | Iraise k -> + copy_instr (Lraise k) i (discard_dead_code n) + in linear i n + +let add_prologue first_insn prologue_required = (* The prologue needs to come after any [Iname_for_debugger] operations that refer to parameters. (Such operations always come in a contiguous block, cf. [Selectgen].) *) @@ -356,7 +304,7 @@ let add_prologue first_insn = (which is encoded with two zero words), then complaining about a "hole in location list" (as it ignores any remaining list entries after the misinterpreted entry). *) - if Proc.prologue_required () then + if prologue_required then let prologue = { desc = Lprologue; next = tailrec_entry_point; @@ -373,8 +321,11 @@ let add_prologue first_insn = skip_naming_ops first_insn let fundecl f = + let fun_prologue_required = Proc.prologue_required f in + let contains_calls = f.Mach.fun_contains_calls in let fun_tailrec_entry_point_label, fun_body = - add_prologue (linear f.Mach.fun_body end_instr) + add_prologue (linear f.Mach.fun_body end_instr contains_calls) + fun_prologue_required in { fun_name = f.Mach.fun_name; fun_body; @@ -382,4 +333,8 @@ let fundecl f = fun_dbg = f.Mach.fun_dbg; fun_spacetime_shape = f.Mach.fun_spacetime_shape; fun_tailrec_entry_point_label; + fun_contains_calls = contains_calls; + fun_num_stack_slots = f.Mach.fun_num_stack_slots; + fun_frame_required = Proc.frame_required f; + fun_prologue_required; } diff --git a/asmcomp/linearize.mli b/asmcomp/linearize.mli index d1662295..080b304b 100644 --- a/asmcomp/linearize.mli +++ b/asmcomp/linearize.mli @@ -14,46 +14,4 @@ (**************************************************************************) (* Transformation of Mach code into a list of pseudo-instructions. *) - -type label = Cmm.label - -type instruction = - { mutable desc: instruction_desc; - mutable next: instruction; - arg: Reg.t array; - res: Reg.t array; - dbg: Debuginfo.t; - live: Reg.Set.t } - -and instruction_desc = - | Lprologue - | Lend - | Lop of Mach.operation - | Lreloadretaddr - | Lreturn - | Llabel of label - | Lbranch of label - | Lcondbranch of Mach.test * label - | Lcondbranch3 of label option * label option * label option - | Lswitch of label array - | Lentertrap - | Lpushtrap of { lbl_handler : label; } - | Lpoptrap - | Lraise of Cmm.raise_kind - -val has_fallthrough : instruction_desc -> bool -val end_instr: instruction -val instr_cons: - instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction -val invert_test: Mach.test -> Mach.test - -type fundecl = - { fun_name: string; - fun_body: instruction; - fun_fast: bool; - fun_dbg : Debuginfo.t; - fun_spacetime_shape : Mach.spacetime_shape option; - fun_tailrec_entry_point_label : label; - } - -val fundecl: Mach.fundecl -> fundecl +val fundecl: Mach.fundecl -> Linear.fundecl diff --git a/asmcomp/linscan.ml b/asmcomp/linscan.ml index d1bfbe54..21416be2 100644 --- a/asmcomp/linscan.ml +++ b/asmcomp/linscan.ml @@ -71,10 +71,10 @@ let rec release_expired_inactive ci pos = function (* Allocate a new stack slot to the interval. *) -let allocate_stack_slot i = +let allocate_stack_slot num_stack_slots i = let cl = Proc.register_class i.reg in - let ss = Proc.num_stack_slots.(cl) in - Proc.num_stack_slots.(cl) <- succ ss; + let ss = num_stack_slots.(cl) in + num_stack_slots.(cl) <- succ ss; i.reg.loc <- Stack(Local ss); i.reg.spill <- true @@ -82,11 +82,11 @@ let allocate_stack_slot i = The interval is added to active. Raises Not_found if no free registers left. *) -let allocate_free_register i = +let allocate_free_register num_stack_slots i = begin match i.reg.loc, i.reg.spill with Unknown, true -> (* Allocate a stack slot for the already spilled interval *) - allocate_stack_slot i + allocate_stack_slot num_stack_slots i | Unknown, _ -> (* We need to allocate a register to this interval somehow *) let cl = Proc.register_class i.reg in @@ -136,7 +136,7 @@ let allocate_free_register i = | _ -> () end -let allocate_blocked_register i = +let allocate_blocked_register num_stack_slots i = let cl = Proc.register_class i.reg in let ci = active.(cl) in match ci.ci_active with @@ -154,14 +154,14 @@ let allocate_blocked_register i = (* Remove the last interval from active and insert the current *) ci.ci_active <- insert_interval_sorted i il; (* Now get a new stack slot for the spilled register *) - allocate_stack_slot ilast + allocate_stack_slot num_stack_slots ilast | _ -> (* Either the current interval is last and we have to spill it, or there are no registers at all in the register class (i.e. floating point class on i386). *) - allocate_stack_slot i + allocate_stack_slot num_stack_slots i -let walk_interval i = +let walk_interval num_stack_slots i = let pos = i.ibegin land (lnot 0x01) in (* Release all intervals that have been expired at the current position *) Array.iter @@ -172,11 +172,11 @@ let walk_interval i = active; try (* Allocate free register (if any) *) - allocate_free_register i + allocate_free_register num_stack_slots i with Not_found -> (* No free register, need to decide which interval to spill *) - allocate_blocked_register i + allocate_blocked_register num_stack_slots i let allocate_registers() = (* Initialize the stack slots and interval lists *) @@ -187,8 +187,9 @@ let allocate_registers() = ci_active = []; ci_inactive = [] }; - Proc.num_stack_slots.(cl) <- 0 done; + (* Reset the stack slot counts *) + let num_stack_slots = Array.make Proc.num_register_classes 0 in (* Add all fixed intervals (sorted by end position) *) List.iter (fun i -> @@ -196,4 +197,5 @@ let allocate_registers() = ci.ci_fixed <- insert_interval_sorted i ci.ci_fixed) (Interval.all_fixed_intervals()); (* Walk all the intervals within the list *) - List.iter walk_interval (Interval.all_intervals()) + List.iter (walk_interval num_stack_slots) (Interval.all_intervals()); + num_stack_slots diff --git a/asmcomp/linscan.mli b/asmcomp/linscan.mli index b978eeb5..650e4139 100644 --- a/asmcomp/linscan.mli +++ b/asmcomp/linscan.mli @@ -16,4 +16,4 @@ (* Linear scan register allocation. *) -val allocate_registers: unit -> unit +val allocate_registers: unit -> int array diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml index bfed9f7e..ab69e0ca 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -84,7 +84,7 @@ and instruction_desc = | Icatch of Cmm.rec_flag * (int * instruction) list * instruction | Iexit of int | Itrywith of instruction * instruction - | Iraise of Cmm.raise_kind + | Iraise of Lambda.raise_kind type spacetime_part_of_shape = | Direct_call_point of { callee : string; } @@ -100,6 +100,8 @@ type fundecl = fun_codegen_options : Cmm.codegen_option list; fun_dbg : Debuginfo.t; fun_spacetime_shape : spacetime_shape option; + fun_num_stack_slots: int array; + fun_contains_calls: bool; } let rec dummy_instr = diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli index 6ad4cda4..5df79585 100644 --- a/asmcomp/mach.mli +++ b/asmcomp/mach.mli @@ -100,7 +100,7 @@ and instruction_desc = | Icatch of Cmm.rec_flag * (int * instruction) list * instruction | Iexit of int | Itrywith of instruction * instruction - | Iraise of Cmm.raise_kind + | Iraise of Lambda.raise_kind type spacetime_part_of_shape = | Direct_call_point of { callee : string; (* the symbol *) } @@ -122,6 +122,8 @@ type fundecl = fun_codegen_options : Cmm.codegen_option list; fun_dbg : Debuginfo.t; fun_spacetime_shape : spacetime_shape option; + fun_num_stack_slots: int array; + fun_contains_calls: bool; } val dummy_instr: instruction diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 558d1a1e..4c577d0b 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -16,13 +16,12 @@ (* Emission of PowerPC assembly code *) -open Misc open Cmm open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux (* Reserved space at bottom of stack *) @@ -37,6 +36,12 @@ let reserved_stack_space = let stack_offset = ref 0 +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false + +let contains_calls = ref false + let frame_size () = let size = reserved_stack_space + @@ -124,7 +129,7 @@ let emit_gpr = emit_int let emit_reg r = match r.loc with | Reg r -> emit_string (register_name r) - | _ -> fatal_error "Emit.emit_reg" + | _ -> Misc.fatal_error "Emit.emit_reg" (* Output a stack reference *) @@ -132,7 +137,7 @@ let emit_stack r = match r.loc with | Stack s -> let ofs = slot_offset s (register_class r) in `{emit_int ofs}(1)` - | _ -> fatal_error "Emit.emit_stack" + | _ -> Misc.fatal_error "Emit.emit_stack" (* Output the name of a symbol plus an optional offset *) @@ -393,8 +398,38 @@ let name_for_specific = function let function_name = ref "" (* Entry point for tail recursive calls *) let tailrec_entry_point = ref 0 -(* Label of glue code for calling the GC *) -let call_gc_label = ref 0 + +module IntSet = Stdlib.Set.Make(Stdlib.Int) +module IntMap = Stdlib.Map.Make(Stdlib.Int) + +(* Labels of glue code for calling the GC. + There is one label per size allocated. *) +let call_gc_labels : label IntMap.t ref = ref IntMap.empty + (* size -> label *) + +(* Return the label of the call GC point for the given size *) + +let label_for_call_gc ?label_after_call_gc sz = + match IntMap.find_opt sz !call_gc_labels with + | Some lbl -> lbl + | None -> + let lbl = + match label_after_call_gc with Some l -> l | None -> new_label() in + call_gc_labels := IntMap.add sz lbl !call_gc_labels; + lbl + +(* Number of call GC points *) + +let num_call_gc instr = + let rec loop i cg = + match i.desc with + | Lend -> IntSet.cardinal cg + | Lop (Ialloc {bytes = sz}) -> loop i.next (IntSet.add sz cg) + (* The following should never be seen, since this function is run + before branch relaxation. *) + | Lop (Ispecific (Ialloc_far _)) -> assert false + | _ -> loop i.next cg + in loop instr IntSet.empty (* Relaxation of branches that exceed the span of a relative branch. *) @@ -506,6 +541,7 @@ module BR = Branch_relaxation.Make (struct + (if lbl2 = None then 0 else 1) | Lswitch _ -> size 7 (5 + tocload_size()) (5 + tocload_size()) | Lentertrap -> size 0 (tocload_size()) (tocload_size()) + | Ladjust_trap_depth _ -> 0 | Lpushtrap _ -> size 5 (4 + tocload_size()) (4 + tocload_size()) | Lpoptrap -> 2 | Lraise _ -> 6 @@ -527,7 +563,7 @@ let emit_instr i = match i.desc with | Lend -> () | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); let n = frame_size() in if n > 0 then begin ` addi 1, 1, {emit_int(-n)}\n`; @@ -560,7 +596,7 @@ let emit_instr i = | {loc = Stack _; typ = Float}, {loc = Reg _} -> ` lfd {emit_reg dst}, {emit_stack src}\n` | (_, _) -> - fatal_error "Emit: Imove" + Misc.fatal_error "Emit: Imove" end | Lop(Iconst_int n) -> if is_native_immediate n then @@ -712,12 +748,12 @@ let emit_instr i = end else begin match abi with | ELF32 -> - ` addis 28, 0, {emit_upper emit_symbol func}\n`; - ` addi 28, 28, {emit_lower emit_symbol func}\n`; + ` addis 25, 0, {emit_upper emit_symbol func}\n`; + ` addi 25, 25, {emit_lower emit_symbol func}\n`; emit_call "caml_c_call"; record_frame i.live false i.dbg | ELF64v1 | ELF64v2 -> - emit_tocload emit_gpr 28 (TocSym func); + emit_tocload emit_gpr 25 (TocSym func); emit_call "caml_c_call"; record_frame i.live false i.dbg; ` nop\n` @@ -751,28 +787,20 @@ let emit_instr i = | Double | Double_u -> "stfd" in emit_load_store storeinstr addr i.arg 1 i.arg.(0) | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> - if !call_gc_label = 0 then begin - match label_after_call_gc with - | None -> call_gc_label := new_label () - | Some label -> call_gc_label := label - end; + let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in ` addi 31, 31, {emit_int(-n)}\n`; ` {emit_string cmplg} 31, 30\n`; ` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`; - ` bltl {emit_label !call_gc_label}\n`; + ` bltl {emit_label call_gc_lbl}\n`; (* Exactly 4 instructions after the beginning of the alloc sequence *) record_frame i.live false Debuginfo.none | Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; })) -> - if !call_gc_label = 0 then begin - match label_after_call_gc with - | None -> call_gc_label := new_label () - | Some label -> call_gc_label := label - end; + let call_gc_lbl = label_for_call_gc ?label_after_call_gc n in let lbl = new_label() in ` addi 31, 31, {emit_int(-n)}\n`; ` {emit_string cmplg} 31, 30\n`; ` bge {emit_label lbl}\n`; - ` bl {emit_label !call_gc_label}\n`; + ` bl {emit_label call_gc_lbl}\n`; (* Exactly 4 instructions after the beginning of the alloc sequence *) record_frame i.live false Debuginfo.none; `{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n` @@ -960,6 +988,8 @@ let emit_instr i = | ELF32 -> () | ELF64v1 | ELF64v2 -> emit_reload_toc() end + | Ladjust_trap_depth { delta_traps } -> + adjust_stack_offset (trap_size * delta_traps) | Lpushtrap { lbl_handler; } -> begin match abi with | ELF32 -> @@ -983,11 +1013,23 @@ let emit_instr i = adjust_stack_offset (-trap_size) | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular -> + ` li 0, 0\n`; + let backtrace_pos = + Domainstate.(idx_of_field Domain_backtrace_pos) + in + begin match abi with + | ELF32 -> ` stw 0, {emit_int (backtrace_pos * 8)}(28)\n` + | _ -> ` std 0, {emit_int (backtrace_pos * 8)}(28)\n` + end; emit_call "caml_raise_exn"; record_frame Reg.Set.empty true i.dbg; emit_call_nop() - | Cmm.Raise_notrace -> + | Lambda.Raise_reraise -> + emit_call "caml_raise_exn"; + record_frame Reg.Set.empty true i.dbg; + emit_call_nop() + | Lambda.Raise_notrace -> ` {emit_string lg} 0, {emit_int trap_handler_offset}(29)\n`; ` mr 1, 29\n`; ` mtctr 0\n`; @@ -1009,9 +1051,14 @@ let fundecl fundecl = function_name := fundecl.fun_name; tailrec_entry_point := fundecl.fun_tailrec_entry_point_label; stack_offset := 0; - call_gc_label := 0; + call_gc_labels := IntMap.empty; float_literals := []; jumptables := []; jumptables_lbl := -1; + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + prologue_required := fundecl.fun_prologue_required; + contains_calls := fundecl.fun_contains_calls; begin match abi with | ELF32 -> emit_string code_space; @@ -1041,14 +1088,30 @@ let fundecl fundecl = end; emit_debug_info fundecl.fun_dbg; cfi_startproc(); - (* On this target, there is at most one "out of line" code block per - function: a single "call GC" point. It comes immediately after the - function's body. *) - BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0; + let num_call_gc = num_call_gc fundecl.fun_body in + let max_out_of_line_code_offset = max (num_call_gc - 1) 0 in + BR.relax fundecl.fun_body ~max_out_of_line_code_offset; emit_all fundecl.fun_body; (* Emit the glue code to call the GC *) - if !call_gc_label > 0 then begin - `{emit_label !call_gc_label}:\n`; + assert (IntMap.cardinal !call_gc_labels = num_call_gc); + if num_call_gc > 0 then begin + (* Replace sizes by deltas with next size *) + let rec delta_encode = function + | (sz1, lbl1) :: ((sz2, _) :: _ as l) -> + (sz1 - sz2, lbl1) :: delta_encode l + | ([] | [(_,_)]) as l -> l in + (* Enumerate the GC call points by decreasing size. This is not + necessary for correctness, but it is nice for two reasons: + 1- all deltas are positive, making the generated code + easier to read, and + 2- smaller allocation sizes, which are more frequent, execute + fewer instructions before calling the GC. *) + let delta_lbl_list = + delta_encode (List.rev (IntMap.bindings !call_gc_labels)) in + List.iter + (fun (delta, lbl) -> + `{emit_label lbl}: addi 31, 31, {emit_int delta}\n`) + delta_lbl_list; match abi with | ELF32 -> ` b {emit_symbol "caml_call_gc"}\n` diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml index 86b4476c..3bcd12fc 100644 --- a/asmcomp/power/proc.ml +++ b/asmcomp/power/proc.ml @@ -34,7 +34,8 @@ let word_addressed = false 3 - 10 function arguments and results 11 - 12 temporaries 13 pointer to small data area - 14 - 28 general purpose, preserved by C + 14 - 27 general purpose, preserved by C + 28 domain state pointer 29 trap pointer 30 allocation limit 31 allocation pointer @@ -47,7 +48,7 @@ let word_addressed = false let int_reg_name = [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21"; - "22"; "23"; "24"; "25"; "26"; "27"; "28" |] + "22"; "23"; "24"; "25"; "26"; "27" |] let float_reg_name = [| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; @@ -62,7 +63,7 @@ let register_class r = | Val | Int | Addr -> 0 | Float -> 1 -let num_available_registers = [| 23; 31 |] +let num_available_registers = [| 22; 31 |] let first_available_register = [| 0; 100 |] @@ -74,8 +75,8 @@ let rotate_registers = true (* Representation of hard registers by pseudo-registers *) let hard_int_reg = - let v = Array.make 23 Reg.dummy in - for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v + let v = Array.make 22 Reg.dummy in + for i = 0 to 21 do v.(i) <- Reg.at_location Int (Reg i) done; v let hard_float_reg = let v = Array.make 31 Reg.dummy in @@ -276,7 +277,7 @@ let loc_exn_bucket = phys_reg 0 let int_dwarf_reg_numbers = [| 3; 4; 5; 6; 7; 8; 9; 10; 14; 15; 16; 17; 18; 19; 20; 21; - 22; 23; 24; 25; 26; 27; 28; + 22; 23; 24; 25; 26; 27; |] let float_dwarf_reg_numbers = @@ -318,12 +319,12 @@ let destroyed_at_reloadretaddr = [| phys_reg 11 |] (* Maximal register pressure *) let safe_register_pressure = function - Iextcall _ -> 15 - | _ -> 23 + Iextcall _ -> 14 + | _ -> 22 let max_register_pressure = function - Iextcall _ -> [| 15; 18 |] - | _ -> [| 23; 30 |] + Iextcall _ -> [| 14; 18 |] + | _ -> [| 22; 30 |] (* Pure operations (without any side effect besides updating their result registers). *) @@ -338,28 +339,25 @@ let op_is_pure = function (* Layout of the stack *) -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false - (* See [reserved_stack_space] in emit.mlp. *) let reserved_stack_space_required () = match abi with | ELF32 -> false | ELF64v1 | ELF64v2 -> true -let frame_required () = +let frame_required fd = let is_elf32 = match abi with | ELF32 -> true | ELF64v1 | ELF64v2 -> false in reserved_stack_space_required () - || num_stack_slots.(0) > 0 - || num_stack_slots.(1) > 0 - || (!contains_calls && is_elf32) + || fd.fun_num_stack_slots.(0) > 0 + || fd.fun_num_stack_slots.(1) > 0 + || (fd.fun_contains_calls && is_elf32) -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/power/reload.ml b/asmcomp/power/reload.ml index 040c7939..21ace08c 100644 --- a/asmcomp/power/reload.ml +++ b/asmcomp/power/reload.ml @@ -15,5 +15,5 @@ (* Reloading for the PowerPC *) -let fundecl f = - (new Reloadgen.reload_generic)#fundecl f +let fundecl f num_stack_slots = + (new Reloadgen.reload_generic)#fundecl f num_stack_slots diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml index 7be55c2f..1da5fe2a 100644 --- a/asmcomp/printcmm.ml +++ b/asmcomp/printcmm.ml @@ -72,10 +72,6 @@ let chunk = function | Double -> "float64" | Double_u -> "float64u" -let raise_kind fmt = function - | Raise_withtrace -> Format.fprintf fmt "raise_withtrace" - | Raise_notrace -> Format.fprintf fmt "raise_notrace" - let phantom_defining_expr ppf defining_expr = match defining_expr with | Cphantom_const_int i -> Targetint.print ppf i @@ -139,7 +135,7 @@ let operation d = function | Cfloatofint -> "floatofint" | Cintoffloat -> "intoffloat" | Ccmpf c -> Printf.sprintf "%sf" (float_comparison c) - | Craise k -> Format.asprintf "%a%s" raise_kind k (Debuginfo.to_string d) + | Craise k -> Lambda.raise_kind k ^ Debuginfo.to_string d | Ccheckbound -> "checkbound" ^ Debuginfo.to_string d let rec expr ppf = function diff --git a/asmcomp/printcmm.mli b/asmcomp/printcmm.mli index 0a631d3d..462239ac 100644 --- a/asmcomp/printcmm.mli +++ b/asmcomp/printcmm.mli @@ -28,4 +28,3 @@ val expression : formatter -> Cmm.expression -> unit val fundecl : formatter -> Cmm.fundecl -> unit val data : formatter -> Cmm.data_item list -> unit val phrase : formatter -> Cmm.phrase -> unit -val raise_kind: formatter -> Cmm.raise_kind -> unit diff --git a/asmcomp/printlinear.ml b/asmcomp/printlinear.ml index 4e62fc6f..793580c0 100644 --- a/asmcomp/printlinear.ml +++ b/asmcomp/printlinear.ml @@ -18,7 +18,7 @@ open Format open Mach open Printmach -open Linearize +open Linear let label ppf l = Format.fprintf ppf "L%i" l @@ -61,12 +61,14 @@ let instr ppf i = fprintf ppf "@,endswitch" | Lentertrap -> fprintf ppf "enter trap" + | Ladjust_trap_depth { delta_traps } -> + fprintf ppf "adjust trap depth by %d traps" delta_traps | Lpushtrap { lbl_handler; } -> fprintf ppf "push trap %a" label lbl_handler | Lpoptrap -> fprintf ppf "pop trap" | Lraise k -> - fprintf ppf "%a %a" Printcmm.raise_kind k reg i.arg.(0) + fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0) end; if not (Debuginfo.is_none i.dbg) then fprintf ppf " %s" (Debuginfo.to_string i.dbg) diff --git a/asmcomp/printlinear.mli b/asmcomp/printlinear.mli index b598868e..fdf36024 100644 --- a/asmcomp/printlinear.mli +++ b/asmcomp/printlinear.mli @@ -16,7 +16,7 @@ (* Pretty-printing of linearized machine code *) open Format -open Linearize +open Linear val instr: formatter -> instruction -> unit val fundecl: formatter -> fundecl -> unit diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml index d90e302d..64662e33 100644 --- a/asmcomp/printmach.ml +++ b/asmcomp/printmach.ml @@ -113,8 +113,6 @@ let test tst ppf arg = | Ieventest -> fprintf ppf "%a & 1 == 0" reg arg.(0) | Ioddtest -> fprintf ppf "%a & 1 == 1" reg arg.(0) -let print_live = ref false - let operation op arg ppf res = if Array.length res > 0 then fprintf ppf "%a := " regs res; match op with @@ -169,7 +167,7 @@ let operation op arg ppf res = Arch.print_specific_operation reg op ppf arg let rec instr ppf i = - if !print_live then begin + if !Clflags.dump_live then begin fprintf ppf "@[<1>{%a" regsetaddr i.live; if Array.length i.arg > 0 then fprintf ppf "@ +@ %a" regs i.arg; fprintf ppf "}@]@,"; @@ -220,14 +218,15 @@ let rec instr ppf i = fprintf ppf "@ and"; aux t in - aux handlers + aux handlers; + fprintf ppf "@;<0 -2>endcatch@]" | Iexit i -> fprintf ppf "exit(%d)" i | Itrywith(body, handler) -> fprintf ppf "@[try@,%a@;<0 -2>with@,%a@;<0 -2>endtry@]" instr body instr handler | Iraise k -> - fprintf ppf "%a %a" Printcmm.raise_kind k reg i.arg.(0) + fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0) end; if not (Debuginfo.is_none i.dbg) then fprintf ppf "%s" (Debuginfo.to_string i.dbg); diff --git a/asmcomp/printmach.mli b/asmcomp/printmach.mli index 13a79464..0cad0776 100644 --- a/asmcomp/printmach.mli +++ b/asmcomp/printmach.mli @@ -29,5 +29,3 @@ val phase: string -> formatter -> Mach.fundecl -> unit val interferences: formatter -> unit -> unit val intervals: formatter -> unit -> unit val preferences: formatter -> unit -> unit - -val print_live: bool ref diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli index 4e0e0364..91b15de4 100644 --- a/asmcomp/proc.mli +++ b/asmcomp/proc.mli @@ -65,12 +65,10 @@ val regs_are_volatile: Reg.t array -> bool val op_is_pure: Mach.operation -> bool (* Info for laying out the stack frame *) -val num_stack_slots: int array -val contains_calls: bool ref -val frame_required : unit -> bool +val frame_required : Mach.fundecl -> bool (* Function prologues *) -val prologue_required : unit -> bool +val prologue_required : Mach.fundecl -> bool (** For a given register class, the DWARF register numbering for that class. Given an allocated register with location [Reg n] and class [reg_class], the diff --git a/asmcomp/reload.mli b/asmcomp/reload.mli index f636877b..5d9e35e3 100644 --- a/asmcomp/reload.mli +++ b/asmcomp/reload.mli @@ -15,4 +15,4 @@ (* Insert load/stores for pseudoregs that got assigned to stack locations. *) -val fundecl: Mach.fundecl -> Mach.fundecl * bool +val fundecl: Mach.fundecl -> int array -> Mach.fundecl * bool diff --git a/asmcomp/reloadgen.ml b/asmcomp/reloadgen.ml index b1f260c1..bea7bafa 100644 --- a/asmcomp/reloadgen.ml +++ b/asmcomp/reloadgen.ml @@ -123,11 +123,14 @@ method private reload i = instr_cons (Itrywith(self#reload body, self#reload handler)) [||] [||] (self#reload i.next) -method fundecl f = +method fundecl f num_stack_slots = redo_regalloc <- false; let new_body = self#reload f.fun_body in ({fun_name = f.fun_name; fun_args = f.fun_args; fun_body = new_body; fun_codegen_options = f.fun_codegen_options; - fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape}, + fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape; + fun_contains_calls = f.fun_contains_calls; + fun_num_stack_slots = Array.copy num_stack_slots; + }, redo_regalloc) end diff --git a/asmcomp/reloadgen.mli b/asmcomp/reloadgen.mli index 75e870fb..638082f0 100644 --- a/asmcomp/reloadgen.mli +++ b/asmcomp/reloadgen.mli @@ -22,6 +22,6 @@ class reload_generic : object method makereg : Reg.t -> Reg.t (* Can be overridden to avoid creating new registers of some class (i.e. if all "registers" of that class are actually on stack) *) - method fundecl : Mach.fundecl -> Mach.fundecl * bool + method fundecl : Mach.fundecl -> int array -> Mach.fundecl * bool (* The entry point *) end diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 619b454f..05070ec7 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -22,13 +22,19 @@ open Arch open Proc open Reg open Mach -open Linearize +open Linear open Emitaux (* Layout of the stack. The stack is kept 8-aligned. *) let stack_offset = ref 0 +let num_stack_slots = Array.make Proc.num_register_classes 0 + +let prologue_required = ref false + +let contains_calls = ref false + let frame_size () = let size = !stack_offset + (* Trap frame, outgoing parameters *) @@ -308,7 +314,7 @@ let emit_instr i = match i.desc with Lend -> () | Lprologue -> - assert (Proc.prologue_required ()); + assert (!prologue_required); let n = frame_size() in emit_stack_adjust n; if !contains_calls then @@ -429,10 +435,12 @@ let emit_instr i = gc_return_lbl = lbl_redo; gc_frame_lbl = lbl_frame } :: !call_gc_sites; `{emit_label lbl_redo}:`; - ` lay %r11, {emit_int(-n)}(%r11)\n`; - ` clgr %r11, %r10\n`; - ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) - ` la {emit_reg i.res.(0)}, 8(%r11)\n` + ` lay {emit_reg i.res.(0)}, {emit_int(-n+8)}(%r11)\n`; + let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in + ` clg {emit_reg i.res.(0)}, {emit_int offset}(%r10)\n`; + ` brcl 12, {emit_label lbl_call_gc}\n`; + (* less than or equal *) + ` lay %r11, -8({emit_reg i.res.(0)})\n` | Lop(Iintop Imulh) -> (* Hacker's Delight section 8.3: @@ -610,6 +618,11 @@ let emit_instr i = emit_string code_space | Lentertrap -> () + | Ladjust_trap_depth { delta_traps } -> + (* each trap occupies 16 bytes on the stack *) + let delta = 16 * delta_traps in + emit_stack_adjust delta; + stack_offset := !stack_offset + delta | Lpushtrap { lbl_handler; } -> stack_offset := !stack_offset + 16; emit_stack_adjust 16; @@ -623,10 +636,16 @@ let emit_instr i = stack_offset := !stack_offset - 16 | Lraise k -> begin match k with - | Cmm.Raise_withtrace -> + | Lambda.Raise_regular-> + let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in + ` lghi %r1, 0\n`; + ` stg %r1, {emit_int offset}(%r10)\n`; + emit_call "caml_raise_exn"; + `{record_frame Reg.Set.empty true i.dbg}\n` + | Lambda.Raise_reraise -> emit_call "caml_raise_exn"; `{record_frame Reg.Set.empty true i.dbg}\n` - | Cmm.Raise_notrace -> + | Lambda.Raise_notrace -> ` lg %r1, 0(%r13)\n`; ` lgr %r15, %r13\n`; ` lg %r13, {emit_int size_addr}(%r15)\n`; @@ -655,6 +674,11 @@ let fundecl fundecl = bound_error_call := 0; float_literals := []; int_literals := []; + for i = 0 to Proc.num_register_classes - 1 do + num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i); + done; + prologue_required := fundecl.fun_prologue_required; + contains_calls := fundecl.fun_contains_calls; ` .globl {emit_symbol fundecl.fun_name}\n`; emit_debug_info fundecl.fun_dbg; ` .type {emit_symbol fundecl.fun_name}, @function\n`; diff --git a/asmcomp/s390x/proc.ml b/asmcomp/s390x/proc.ml index db2b0c04..9f0dff21 100644 --- a/asmcomp/s390x/proc.ml +++ b/asmcomp/s390x/proc.ml @@ -35,7 +35,7 @@ let word_addressed = false 2 - 5 function arguments and results (volatile) 6 function arguments and results (preserved by C) 7 - 9 general purpose, preserved by C - 10 allocation limit (preserved by C) + 10 domain state pointer (preserved by C) 11 allocation pointer (preserved by C) 12 general purpose (preserved by C) 13 trap pointer (preserved by C) @@ -225,16 +225,13 @@ let op_is_pure = function (* Layout of the stack *) -let num_stack_slots = [| 0; 0 |] -let contains_calls = ref false +let frame_required fd = + fd.fun_contains_calls + || fd.fun_num_stack_slots.(0) > 0 + || fd.fun_num_stack_slots.(1) > 0 -let frame_required () = - !contains_calls - || num_stack_slots.(0) > 0 - || num_stack_slots.(1) > 0 - -let prologue_required () = - frame_required () +let prologue_required fd = + frame_required fd (* Calling the assembler *) diff --git a/asmcomp/s390x/reload.ml b/asmcomp/s390x/reload.ml index f5d710a1..46d1daa7 100644 --- a/asmcomp/s390x/reload.ml +++ b/asmcomp/s390x/reload.ml @@ -46,5 +46,5 @@ method! reload_operation op arg res = end -let fundecl f = - (new reload)#fundecl f +let fundecl f num_stack_slots = + (new reload)#fundecl f num_stack_slots diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index 41484228..966dbbec 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -17,7 +17,7 @@ open Reg open Mach -open Linearize +open Linear (* Representation of the code DAG. *) @@ -393,6 +393,10 @@ method schedule_fundecl f = fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape; fun_tailrec_entry_point_label = f.fun_tailrec_entry_point_label; + fun_contains_calls = f.fun_contains_calls; + fun_num_stack_slots = f.fun_num_stack_slots; + fun_frame_required = f.fun_frame_required; + fun_prologue_required = f.fun_prologue_required; } end else f diff --git a/asmcomp/schedgen.mli b/asmcomp/schedgen.mli index 0fa16dac..bc3f798d 100644 --- a/asmcomp/schedgen.mli +++ b/asmcomp/schedgen.mli @@ -16,7 +16,7 @@ (* Instruction scheduling *) type code_dag_node = - { instr: Linearize.instruction; + { instr: Linear.instruction; delay: int; mutable sons: (code_dag_node * int) list; mutable date: int; @@ -43,7 +43,7 @@ class virtual scheduler_generic : object method is_checkbound : Mach.operation -> bool (* Says whether the given operation is a checkbound *) (* Entry point *) - method schedule_fundecl : Linearize.fundecl -> Linearize.fundecl + method schedule_fundecl : Linear.fundecl -> Linear.fundecl end val reset : unit -> unit diff --git a/asmcomp/scheduling.mli b/asmcomp/scheduling.mli index 93830106..9f734780 100644 --- a/asmcomp/scheduling.mli +++ b/asmcomp/scheduling.mli @@ -15,4 +15,4 @@ (* Instruction scheduling *) -val fundecl: Linearize.fundecl -> Linearize.fundecl +val fundecl: Linear.fundecl -> Linear.fundecl diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index ea59ad22..b024dfe7 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -78,6 +78,18 @@ let oper_result_type = function (* Infer the size in bytes of the result of an expression whose evaluation may be deferred (cf. [emit_parts]). *) +let size_component = function + | Val | Addr -> Arch.size_addr + | Int -> Arch.size_int + | Float -> Arch.size_float + +let size_machtype mty = + let size = ref 0 in + for i = 0 to Array.length mty - 1 do + size := !size + size_component mty.(i) + done; + !size + let size_expr (env:environment) exp = let rec size localenv = function Cconst_int _ | Cconst_natint _ -> Arch.size_int @@ -372,9 +384,10 @@ method select_store is_assign addr arg = (Istore(Word_val, addr, is_assign), arg) (* call marking methods, documented in selectgen.mli *) +val contains_calls = ref false method mark_call = - Proc.contains_calls := true + contains_calls := true method mark_tailcall = () @@ -391,8 +404,9 @@ method mark_instr = function self#mark_c_tailcall (* caml_ml_array_bound_error *) | Iraise raise_kind -> begin match raise_kind with - | Cmm.Raise_notrace -> () - | Cmm.Raise_withtrace -> + | Lambda.Raise_notrace -> () + | Lambda.Raise_regular + | Lambda.Raise_reraise -> (* PR#6239 *) (* caml_stash_backtrace; we #mark_call rather than #mark_c_tailcall to get a good stack backtrace *) @@ -1203,7 +1217,6 @@ method insert_prologue _f ~loc_arg ~rarg ~spacetime_node_hole:_ ~env = method initial_env () = env_empty method emit_fundecl f = - Proc.contains_calls := false; current_function_name := f.Cmm.fun_name; let rargs = List.map @@ -1242,6 +1255,8 @@ method emit_fundecl f = fun_codegen_options = f.Cmm.fun_codegen_options; fun_dbg = f.Cmm.fun_dbg; fun_spacetime_shape; + fun_num_stack_slots = Array.make Proc.num_register_classes 0; + fun_contains_calls = !contains_calls; } end diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli index 87c35be7..f3c734fc 100644 --- a/asmcomp/selectgen.mli +++ b/asmcomp/selectgen.mli @@ -107,7 +107,7 @@ class virtual selector_generic : object method mark_call : unit (* informs the code emitter that the current function is non-leaf: it may perform a (non-tail) call; by default, sets - [Proc.contains_calls := true] *) + [contains_calls := true] *) method mark_tailcall : unit (* informs the code emitter that the current function may end with @@ -121,7 +121,7 @@ class virtual selector_generic : object (which is the main purpose of tracking leaf functions) but some architectures still need to ensure that the stack is properly aligned when the C function is called. This is achieved by - overloading this method to set [Proc.contains_calls := true] *) + overloading this method to set [contains_calls := true] *) method mark_instr : Mach.instruction_desc -> unit (* dispatches on instructions to call one of the marking function @@ -181,6 +181,10 @@ class virtual selector_generic : object val mutable instr_seq : Mach.instruction + (* [contains_calls] is declared as a reference instance variable, + instead of a mutable boolean instance variable, + because the traversal uses functional object copies. *) + val contains_calls : bool ref end val reset : unit -> unit diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml index 0aeee83c..da739f97 100644 --- a/asmcomp/spill.ml +++ b/asmcomp/spill.ml @@ -432,4 +432,6 @@ let fundecl f = fun_codegen_options = f.fun_codegen_options; fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape; + fun_num_stack_slots = f.fun_num_stack_slots; + fun_contains_calls = f.fun_contains_calls; } diff --git a/asmcomp/split.ml b/asmcomp/split.ml index cfe4b0d6..87c9c71f 100644 --- a/asmcomp/split.ml +++ b/asmcomp/split.ml @@ -220,4 +220,6 @@ let fundecl f = fun_codegen_options = f.fun_codegen_options; fun_dbg = f.fun_dbg; fun_spacetime_shape = f.fun_spacetime_shape; + fun_num_stack_slots = f.fun_num_stack_slots; + fun_contains_calls = f.fun_contains_calls; } diff --git a/asmcomp/strmatch.mli b/asmcomp/strmatch.mli index bf63d990..8c4c63eb 100644 --- a/asmcomp/strmatch.mli +++ b/asmcomp/strmatch.mli @@ -23,7 +23,7 @@ module type I = sig Cmm.expression end -module Make(I:I) : sig +module Make(_:I) : sig (* Compile stringswitch (arg,cases,d) Note: cases should not contain string duplicates *) val compile : Debuginfo.t -> Cmm.expression (* arg *) diff --git a/autogen b/autogen index 40f47afa..8c85c2cb 100755 --- a/autogen +++ b/autogen @@ -1,4 +1,4 @@ -#!/bin/sh +#!/bin/sh -e #************************************************************************** #* * #* OCaml * @@ -13,17 +13,28 @@ #* * #************************************************************************** -version=$(autoconf --version | sed -ne 's/^autoconf .* \([0-9][^ ]*\)$/\1/p') -if [ "$version" != '2.69' ] ; then - echo "autoconf 2.69 is required" >&2 - exit 1 -else - # Remove the autom4te.cache directory to make sure we start in a clean state - rm -rf autom4te.cache - autoconf -W all,error - # Some distros have this 2013 patch to autoconf, some don't... - sed -i -e '/^runstatedir/d' \ - -e '/-runstatedir /,+8d' \ - -e '/--runstatedir=DIR/d' \ - -e 's/ runstatedir//' configure -fi +# Remove the autom4te.cache directory to make sure we start in a clean state +rm -rf autom4te.cache + +autoconf --force --warnings=all,error + +# Allow pre-processing of configure arguments for Git check-outs +# The sed call removes dra27's copyright on the whole configure script... +sed -e '/^#[^!]/d' tools/git-dev-options.sh > configure.tmp + +# Some distros have the 2013 --runstatedir patch to autoconf (see +# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=a197431414088a417b407b9b20583b2e8f7363bd +# in the GNU autoconf repo), and some don't, so ensure its effects are +# removed for CI consistency... +# POSIX Notes +# - sed -i without a backup file is not portable, hence configure.tmp +# - GNU sed's /../,+8d becomes /../{N;..;d;} (and the last ; is important) +sed -e '/^runstatedir/d' \ + -e '/-runstatedir /{N;N;N;N;N;N;N;N;d;}' \ + -e '/--runstatedir=DIR/d' \ + -e 's/ runstatedir//' \ + -e '1d' \ + configure >> configure.tmp + +mv -f configure.tmp configure +chmod +x configure diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml index 9f3d4f6d..4cc10b83 100644 --- a/boot/menhir/parser.ml +++ b/boot/menhir/parser.ml @@ -16,7 +16,7 @@ module MenhirBasics = struct | VAL | UNDERSCORE | UIDENT of ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) # 22 "parsing/parser.ml" ) @@ -28,7 +28,7 @@ module MenhirBasics = struct | THEN | STRUCT | STRING of ( -# 658 "parsing/parser.mly" +# 680 "parsing/parser.mly" (string * string option) # 34 "parsing/parser.ml" ) @@ -44,7 +44,7 @@ module MenhirBasics = struct | QUESTION | PRIVATE | PREFIXOP of ( -# 644 "parsing/parser.mly" +# 666 "parsing/parser.mly" (string) # 50 "parsing/parser.ml" ) @@ -54,7 +54,7 @@ module MenhirBasics = struct | PERCENT | OR | OPTLABEL of ( -# 637 "parsing/parser.mly" +# 659 "parsing/parser.mly" (string) # 60 "parsing/parser.ml" ) @@ -72,12 +72,12 @@ module MenhirBasics = struct | MATCH | LPAREN | LIDENT of ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) # 78 "parsing/parser.ml" ) | LETOP of ( -# 602 "parsing/parser.mly" +# 624 "parsing/parser.mly" (string) # 83 "parsing/parser.ml" ) @@ -97,39 +97,39 @@ module MenhirBasics = struct | LBRACE | LAZY | LABEL of ( -# 607 "parsing/parser.mly" +# 629 "parsing/parser.mly" (string) # 103 "parsing/parser.ml" ) | INT of ( -# 606 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string * char option) # 108 "parsing/parser.ml" ) | INITIALIZER | INHERIT | INFIXOP4 of ( -# 600 "parsing/parser.mly" +# 622 "parsing/parser.mly" (string) # 115 "parsing/parser.ml" ) | INFIXOP3 of ( -# 599 "parsing/parser.mly" +# 621 "parsing/parser.mly" (string) # 120 "parsing/parser.ml" ) | INFIXOP2 of ( -# 598 "parsing/parser.mly" +# 620 "parsing/parser.mly" (string) # 125 "parsing/parser.ml" ) | INFIXOP1 of ( -# 597 "parsing/parser.mly" +# 619 "parsing/parser.mly" (string) # 130 "parsing/parser.ml" ) | INFIXOP0 of ( -# 596 "parsing/parser.mly" +# 618 "parsing/parser.mly" (string) # 135 "parsing/parser.ml" ) @@ -137,7 +137,7 @@ module MenhirBasics = struct | IN | IF | HASHOP of ( -# 655 "parsing/parser.mly" +# 677 "parsing/parser.mly" (string) # 143 "parsing/parser.ml" ) @@ -150,7 +150,7 @@ module MenhirBasics = struct | FUN | FOR | FLOAT of ( -# 585 "parsing/parser.mly" +# 607 "parsing/parser.mly" (string * char option) # 156 "parsing/parser.ml" ) @@ -164,7 +164,7 @@ module MenhirBasics = struct | ELSE | DOWNTO | DOTOP of ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) # 170 "parsing/parser.ml" ) @@ -172,14 +172,14 @@ module MenhirBasics = struct | DOT | DONE | DOCSTRING of ( -# 674 "parsing/parser.mly" +# 696 "parsing/parser.mly" (Docstrings.docstring) # 178 "parsing/parser.ml" ) | DO | CONSTRAINT | COMMENT of ( -# 673 "parsing/parser.mly" +# 695 "parsing/parser.mly" (string * Location.t) # 185 "parsing/parser.ml" ) @@ -190,7 +190,7 @@ module MenhirBasics = struct | COLON | CLASS | CHAR of ( -# 565 "parsing/parser.mly" +# 587 "parsing/parser.mly" (char) # 196 "parsing/parser.ml" ) @@ -203,7 +203,7 @@ module MenhirBasics = struct | ASSERT | AS | ANDOP of ( -# 603 "parsing/parser.mly" +# 625 "parsing/parser.mly" (string) # 209 "parsing/parser.ml" ) @@ -430,6 +430,15 @@ let expecting loc nonterm = let not_expecting loc nonterm = raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm))) +let dotop ~left ~right ~assign ~ext ~multi = + let assign = if assign then "<-" else "" in + let mid = if multi then ";.." else "" in + String.concat "" ["."; ext; left; mid; right; assign] +let paren = "(",")" +let brace = "{", "}" +let bracket = "[", "]" +let lident x = Lident x +let ldot x y = Ldot(x,y) let dotop_fun ~loc dotop = (* We could use ghexp here, but sticking to mkexp for parser.mly compatibility. TODO improve parser.mly *) @@ -449,6 +458,10 @@ let array_set_fun ~loc = let string_set_fun ~loc = ghexp ~loc (Pexp_ident(array_function ~loc "String" "set")) +let multi_indices ~loc = function + | [a] -> false, a + | l -> true, mkexp ~loc (Pexp_array l) + let index_get ~loc get_fun array index = let args = [Nolabel, array; Nolabel, index] in mkexp ~loc (Pexp_apply(get_fun, args)) @@ -459,11 +472,20 @@ let index_set ~loc set_fun array index value = let array_get ~loc = index_get ~loc (array_get_fun ~loc) let string_get ~loc = index_get ~loc (string_get_fun ~loc) -let dotop_get ~loc dotop = index_get ~loc (dotop_fun ~loc dotop) +let dotop_get ~loc path (left,right) ext array index = + let multi, index = multi_indices ~loc index in + index_get ~loc + (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false)) + array index let array_set ~loc = index_set ~loc (array_set_fun ~loc) let string_set ~loc = index_set ~loc (string_set_fun ~loc) -let dotop_set ~loc dotop = index_set ~loc (dotop_fun ~loc dotop) +let dotop_set ~loc path (left,right) ext array index value= + let multi, index = multi_indices ~loc index in + index_set ~loc + (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true)) + array index value + let bigarray_function ~loc str name = ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name)) @@ -752,7 +774,7 @@ let mk_directive ~loc name arg = } -# 756 "parsing/parser.ml" +# 778 "parsing/parser.ml" module Tables = struct @@ -1254,22 +1276,22 @@ module Tables = struct Obj.repr () and default_reduction = - (16, "\000\000\000\000\000\000\002\219\002\218\002\217\002\216\002\215\002\170\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\002\198\002\197\002\196\002\169\002\195\002\194\002\193\002\192\002\191\002\190\002\189\002\188\002\187\002\186\002\185\002\184\002\183\002\182\002\181\002\180\002\179\002\178\002\177\002\176\002\175\002\174\002\173\002\172\002\171\000\000\000\000\000\"\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\027\001\146\001}\001\143\001\142\001\141\001\147\001\151\000\000\003\028\001\145\001\144\001~\001\149\001\140\001\139\001\138\001\137\001\136\001\134\001\150\001\148\000\000\000\000\000\000\001\129\000\000\000\000\001\131\000\000\000\000\001\133\001\155\001\152\001\135\001\127\001\153\001\154\000\000\003\026\003\025\003\024\000\000\000\000\000\016\001;\000\000\000\213\000\214\000\015\000\000\000\000\001\177\001\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\020\000\000\003\021\000\000\000\000\003\018\000\000\003\017\003\r\002\022\000\000\003\016\000\000\002\023\000\000\000\000\000\000\000\000\000f\000\000\000\000\000c\000\000\000\000\003\011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\180\001?\000\000\000\000\000\000\000\000\000\000\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000m\000_\000\000\000\000\000\000\000\000\0009\000\000\000\000\001@\000:\002j\000\000\001\r\000\000\000j\000\000\000\000\000\t\000\b\000\000\000\000\000\000\000\000\002\151\000\000\002I\002J\000\000\002G\002H\000\000\000\000\000\000\000\000\000\000\000\000\002\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\244\002\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000i\000\000\000\225\000\000\000\000\000\226\000\000\002L\002K\000\000\000\000\000\000\001\159\000\000\000\000\000\029\000\000\000\000\000\000\000\022\000\000\000\000\001f\000\017\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001=\000\000\001<\000\000\003\012\000 \000\000\000\000\000\023\000\018\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\198\002 \002\018\000\000\000\026\000\000\002\019\000\000\000\000\001\156\000\000\000\000\000\000\000\n\000\000\000\000\000\000\000\011\002\245\000\000\002\246\000\000\000u\000\000\000\000\000\025\000\000\000\000\000\000\000\027\000\000\000\028\000\000\000\030\000\000\000\000\000\031\002\b\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000]\000\000\002\156\000`\000l\000^\002\145\002\146\001\211\002\148\000\000\000\000\002\153\002F\002\155\000\000\000\000\000\000\002\162\002\159\000\000\000\000\000\000\001\208\001\194\000\000\000\000\000\000\000\000\001\198\000\000\001\193\000\000\001\210\002\168\000\000\001\209\001\201\000\000\000h\000\000\002\161\002\160\000\000\001\204\000\000\000\000\001\200\000\000\000\000\001\196\001\195\000\000\002\158\000\000\002N\002M\000\000\000\000\002*\002\157\002\154\000\000\000\000\000\000\000\000\001\161\001(\001)\002P\000\000\002Q\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202\000\201\000\199\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001X\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000\002\017\000\000\000\000\001W\000\000\000\000\000\000\001^\001]\001[\002\004\002\003\000\000\001V\001U\000\000\000\200\000\000\000\000\001I\000\000\000\000\001M\000\000\001\181\001\180\000\000\000\000\001\179\001\178\001L\001J\000\000\001N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\003\029\002s\002q\000\000\000\000\000\000\002~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\144\000\000\002\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\222\000\000\000\000\000\000\000\000\000\000\000\000\000\234\001\221\000\235\000\000\000\000\000\000\001h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\230\000\000\000\000\000\000\002{\000\000\000\000\000\000\002V\002U\000\000\000\000\000\000\000\000\002}\002p\002o\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\179\000\000\000\000\000\000\000\164\000\000\000\000\000\000\0021\0020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\002\222\000\000\003\b\000\000\000\000\003\007\000\000\000\000\000\000\000\000\000\000\000\190\000\189\000\239\000\000\002\223\002\224\000\000\000\000\000k\000\000\002\163\002\147\000\000\002\166\000\000\002\165\002\164\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\000\000\002\n\000\000\000\000\000\000\000\242\000\000\000\000\000\241\000\240\000\000\000\000\000\000\000\000\000\245\000\000\000\000\000\244\000\000\001\207\000\000\000\000\001\218\000\000\000\000\001\220\000\000\000\000\001\216\001\215\001\213\001\214\000\000\000\000\000\000\000\000\000\000\001\019\000\012\000\247\000\000\000\000\000\000\002X\002W\000\000\000\000\002f\002e\000\000\000\000\000\000\000\000\002b\002a\000\000\000\000\002`\002_\000\000\000\000\002d\002c\002w\000\000\000\000\000\000\000\000\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002Z\000\000\000\000\000\000\000\000\000\000\002^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\006\002\005\000\163\000\000\002[\000\000\000\000\002Y\000\000\000\000\002]\000\000\000v\000w\000\000\000\000\000\000\000\000\000\134\000\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\193\000\194\000\127\000\000\000~\000\000\000\000\001+\000\000\001,\001*\002\012\000\000\000\000\002\r\002\011\000\000\000\000\000\000\000\000\000\000\000\254\000\000\000\000\000\255\000\000\000\000\000\166\000\000\001\001\001\000\000\000\000\000\002\127\002x\000\000\002\136\000\000\002\137\002\135\000\000\000\000\002$\000\000\002\141\000\000\002\142\002\140\000\000\000\000\002z\002y\000\000\000\000\000\000\001\244\000\000\001\175\000\000\000\000\000\000\002-\001\243\000\000\002\131\002\130\000\000\000\000\000\000\003\030\000\000\002h\000\000\002i\002g\000\000\002\129\002\128\000\000\000\000\000\000\002'\002v\000\000\002u\002t\000\000\002\139\002\138\000|\000\000\000\000\000\000\000\000\000{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000y\000\000\001C\000\000\000\000\000\000\000a\000\000\000\000\000d\000\000\000b\000e\000\000\000\000\000\000\001`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\219\000\000\000\000\000q\000\000\000\222\000\220\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\001\242\000\000\000\000\000\246\001\173\000\000\000\232\000\233\000\253\000\000\000\000\000\000\000\000\000\000\001\188\001\182\000\000\001\187\000\000\001\185\000\000\001\186\000\000\001\183\000\000\000\000\001\184\000\000\001z\000\000\000\000\000\000\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\\\000\000\000\000\000\000\000\000\002\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\002\237\000\000\000\000\000\000\000\000\000\000\001\227\000\000\000\000\000\000\000\000\000\000\000\000\002\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001j\000\000\001\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\221\000\000\000\000\0022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\000\001{\000\000\000\000\000\000\000\000\000\000\000\000\002>\000\000\001P\000\000\001O\000\000\000\000\000\000\002=\000\000\001E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\002@\000\000\000\000\000\000\000\000\002C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001e\000\000\001d\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\001\240\000\000\001\239\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\005\002D\0026\000\000\002<\0027\002B\002A\002?\001\022\000\000\0024\000\000\000\000\000\000\000\000\000\000\002\001\000\000\000\000\001\015\0028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001u\001q\000\000\000\000\000\000\000\207\000\000\000\000\001\247\002\001\000\000\000\000\001\017\001\245\001\246\000\000\000\000\000\000\000\000\000\000\001x\001t\001p\000\000\000\000\000\208\000\000\000\000\001w\001s\001o\001m\0029\0025\002E\001\021\001\224\0023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\000\000\000\003#\000\000\000.\000\000\000\000\003)\000\000\003(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\000\000\000\003\"\000\000\000\000\000\000\001\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\000\000\000\000\0018\0016\000\000\000/\000\000\000\000\003,\000\000\003+\000\000\000\000\000\000\0014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\0017\0015\000\000\000\000\000\000\0001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000+\000\000\000\000\000P\000\000\000)\000\250\000\000\0008\000%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\163\000\000\000-\000\000\000\000\000\000\000,\000\000\000\000\000\000\0000\000\000\000R\000U\000\000\0002\0003\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\0006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\003\002\240\002\231\000\000\000\000\002\235\002\220\002\230\002\239\002\238\001\026\000\000\000\000\002\228\000\000\002\232\002\229\002\241\001\223\000\000\000\000\002\226\000\000\000\186\002\225\000\000\000\000\000\217\000\000\000\000\001\025\001\024\000\000\001G\001F\000\000\000\000\002\167\002\150\000\000\000;\000\000\000\000\000<\000\000\000\000\000\138\000\137\002\134\000\000\002\133\002\132\002r\000\000\000\000\000\000\000\000\002k\000\000\002m\000\000\002l\000\000\002S\002R\000\000\002T\000\000\000\000\000\130\000\000\000\000\001\232\000\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\000\000\002\234\001\252\001\253\001\248\001\250\001\249\001\251\000\000\000\000\000\000\000\185\000\000\000\000\002\001\000\000\000\211\000\000\000\000\000\000\000\000\002\233\000\000\000\183\000\000\000\000\000\000\000\000\0013\001-\000\000\000\000\001.\000\021\000\000\000\020\000\000\000\000\000\197\000\000\000\000\000\000\000\024\000\019\000\000\000\000\000\000\000\r\000\000\000\000\000\000\000\000\001v\001r\000\000\001n\003\n\000\000\002\001\000\000\000\210\000\000\000\000\000\000\000\000\002;\002\000\001\254\001\255\000\000\000\000\000\000\002\001\000\000\000\209\000\000\000\000\000\000\000\000\002:\000\000\001R\001Q\000\000\000\014\000\000\003$\000\000\000#\000\000\000\000\000\000\000\000\000\133\000\000\000\215\000\001\000\000\000\000\000\216\000\002\000\000\000\003\000\000\001\189\000\000\000\000\001\190\000\004\000\000\000\000\001\191\000\005\000\000\000\000\000\000\002\253\002\248\002\249\002\252\002\250\000\000\000\000\003\001\000\006\000\000\003\000\000\000\001 \000\000\000\000\002\254\000\000\002\255\000\000\000\000\000\000\000\000\001$\001%\000\000\000\000\001#\001\"\000\007\000\000\000\000\000\000\003\023\000\000\003\022") + (16, "\000\000\000\000\000\000\002\221\002\220\002\219\002\218\002\217\002\172\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\002\198\002\171\002\197\002\196\002\195\002\194\002\193\002\192\002\191\002\190\002\189\002\188\002\187\002\186\002\185\002\184\002\183\002\182\002\181\002\180\002\179\002\178\002\177\002\176\002\175\002\174\002\173\000\000\000\000\000\"\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\029\001\148\001\127\001\145\001\144\001\143\001\149\001\153\000\000\003\030\001\147\001\146\001\128\001\151\001\142\001\141\001\140\001\139\001\138\001\136\001\152\001\150\000\000\000\000\000\000\000\215\000\000\000\000\001\131\000\000\000\000\000\000\001\133\000\000\000\000\000\000\001\135\001\157\001\154\001\137\001\129\001\155\001\156\000\000\003\028\003\027\003\026\000\000\000\000\000\016\001;\000\000\000\211\000\212\000\015\000\000\000\000\001\179\001\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\000\000\003\023\000\000\000\000\003\020\000\000\003\019\003\015\002\024\000\000\003\018\000\000\002\025\000\000\000\000\000\000\000\000\000f\000\000\000\000\000c\000\000\000\000\003\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\180\001?\000\000\000\000\000\000\000\000\000\000\000\000\002\003\000\000\000\000\000\000\000\000\000\000\000\000\000m\000_\000\000\000\000\000\000\000\000\0009\000\000\000\000\001@\000:\002l\000\000\001\r\000\000\000j\000\000\000\000\000\t\000\b\000\000\000\000\000\000\000\000\002\153\000\000\002K\002L\000\000\002I\002J\000\000\000\000\000\000\000\000\000\000\001P\001O\000\000\002\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\246\002\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000i\000\000\000\225\000\000\000\000\000\226\000\000\002N\002M\000\000\000\000\000\000\001\161\000\000\000\000\000\029\000\000\000\000\000\000\000\022\000\000\000\000\001h\000\017\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001=\000\000\001<\000\000\003\014\000 \000\000\000\000\000\023\000\018\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\198\002\"\002\020\000\000\000\026\000\000\002\021\000\000\000\000\001\158\000\000\000\000\000\000\000\n\000\000\000\000\000\000\000\011\002\247\000\000\002\248\000\000\000u\000\000\000\000\000\025\000\000\000\000\000\000\000\027\000\000\000\028\000\000\000\030\000\000\000\000\000\031\002\n\002\t\000\000\000\000\000\000\000\000\000\000\000\000\000]\000\000\002\158\000`\000l\000^\002\147\002\148\001\213\002\150\000\000\000\000\002\155\002H\002\157\000\000\000\000\000\000\002\164\002\161\000\000\000\000\000\000\001\210\001\196\000\000\000\000\000\000\000\000\001\200\000\000\001\195\000\000\001\212\002\170\000\000\001\211\001\203\000\000\000h\000\000\002\163\002\162\000\000\001\206\000\000\000\000\001\202\000\000\000\000\001\198\001\197\000\000\002\160\000\000\002P\002O\000\000\000\000\002,\002\159\002\156\000\000\000\000\000\000\000\000\001\163\001(\001)\002R\000\000\002S\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\199\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\000\000\0034\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\000\000\000\002\019\000\000\000\000\001Y\000\000\000\000\000\000\001`\001_\001]\002\006\002\005\000\000\001X\001W\000\000\000\200\000\000\000\000\001I\000\000\000\000\001M\000\000\001\183\001\182\000\000\000\000\001\181\001\180\001L\001J\000\000\001N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002p\003\031\002u\002s\000\000\000\000\000\000\002\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\146\000\000\002\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\224\000\000\000\000\000\000\000\000\000\000\000\000\000\234\001\223\000\235\000\000\000\000\000\000\001j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\000\000\000\230\000\000\000\000\000\000\002}\000\000\000\000\000\000\002X\002W\000\000\000\000\000\000\000\000\002\127\002r\002q\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\179\000\000\000\000\000\000\000\164\000\000\000\000\000\000\0023\0022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\002\224\000\000\003\n\000\000\000\000\003\t\000\000\000\000\000\000\000\000\000\000\000\190\000\189\000\239\000\000\002\225\002\226\000\000\000\000\000k\000\000\002\165\002\149\000\000\002\168\000\000\002\167\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\000\000\002\012\000\000\000\000\000\000\000\242\000\000\000\000\000\241\000\240\000\000\000\000\000\000\000\000\000\245\000\000\000\000\000\244\000\000\001\209\000\000\000\000\001\220\000\000\000\000\001\222\000\000\000\000\001\218\001\217\001\215\001\216\000\000\000\000\000\000\000\000\000\000\001\019\000\012\000\247\000\000\000\000\000\000\002Z\002Y\000\000\000\000\002h\002g\000\000\000\000\000\000\000\000\002d\002c\000\000\000\000\002&\000\000\000\000\002b\002a\000\000\000\000\002f\002e\002y\000\000\000\000\000\000\000\000\000\000\002^\000\000\000\000\000\000\000\000\000\000\002\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\007\000\163\000\000\002]\000\000\000\000\002[\000\000\000\000\002_\000\000\000v\000w\000\000\000\000\000\000\000\000\000\134\000\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\193\000\194\000\127\000\000\000~\000\000\000\000\001+\000\000\001,\001*\002\014\000\000\000\000\002\015\002\r\000\000\000\000\000\000\000\000\000\000\000\254\000\000\000\000\000\255\000\000\000\000\000\166\000\000\001\001\001\000\000\000\000\000\002\129\002z\000\000\002\138\000\000\002\139\002\137\000\000\002\143\000\000\002\144\002\142\000\000\000\000\002|\002{\000\000\000\000\000\000\001\246\000\000\001\177\000\000\000\000\000\000\002/\001\245\000\000\002\133\002\132\000\000\000\000\000\000\003 \000\000\002j\000\000\002k\002i\000\000\002\131\002\130\000\000\000\000\000\000\002)\002x\000\000\002w\002v\000\000\002\141\002\140\000|\000\000\000\000\000\000\000\000\000{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000y\000\000\001C\000\000\000\000\000\000\000a\000\000\000\000\000d\000\000\000b\000e\000\000\000\000\000\000\001b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\219\000\000\000\000\000q\000\000\000\222\000\220\000\000\000\000\000\000\000\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\001\244\000\000\000\000\000\246\001\175\000\000\000\232\000\233\000\253\000\000\000\000\000\000\000\000\000\000\001\190\001\184\000\000\001\189\000\000\001\187\000\000\001\188\000\000\001\185\000\000\000\000\001\186\000\000\001|\000\000\000\000\000\000\001{\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\t\002\239\000\000\000\000\002\238\000\000\000\000\000\000\000\000\000\000\001\229\000\000\000\000\000\000\000\000\000\000\000\000\002\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001l\000\000\001\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\223\000\000\000\000\0024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\000\001}\000\000\000\000\000\000\000\000\000\000\001R\000\000\001Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\002B\000\000\000\000\000\000\002@\000\000\000\000\000\000\002?\000\000\001E\000\000\000\000\000\000\000\000\002E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003(\000\000\000\000\000\000\000\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001g\000\000\001f\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\001\242\000\000\001\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\005\002F\0028\000\000\002>\0029\002D\002C\002A\001\022\000\000\0026\000\000\000\000\000\000\000\000\000\000\002\003\000\000\000\000\001\015\002:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\001s\000\000\000\000\000\000\000\205\000\000\000\000\001\249\002\003\000\000\000\000\001\017\001\247\001\248\000\000\000\000\000\000\000\000\000\000\001z\001v\001r\000\000\000\000\000\206\000\000\000\000\001y\001u\001q\001o\002;\0027\002G\001\021\001\226\0025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003#\000\000\000\000\003%\000\000\000.\000\000\000\000\003+\000\000\003*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\"\000\000\000\000\003$\000\000\000\000\000\000\001\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001:\000\000\000\000\0018\0016\000\000\000/\000\000\000\000\003.\000\000\003-\000\000\000\000\000\000\0014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\0017\0015\000\000\000\000\000\000\0001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000+\000\000\000\000\000P\000\000\000)\000\250\000\000\0008\000%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\165\000\000\000-\000\000\000\000\000\000\000,\000\000\000\000\000\000\0000\000\000\000R\000U\000\000\0002\0003\000\000\001\030\000\000\000\000\000\000\000\000\000\000\000\000\0006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\003\002\242\002\233\000\000\000\000\002\237\002\222\002\232\002\241\002\240\001\026\000\000\000\000\002\230\000\000\002\234\002\231\002\243\001\225\000\000\000\000\002\228\000\000\000\186\002\227\000\000\000\000\000\217\000\000\000\000\001\025\001\024\000\000\001G\001F\000\000\000\000\002\169\002\152\000\000\000;\000\000\000\000\000<\000\000\000\000\000\138\000\137\002\136\000\000\002\135\002\134\002t\000\000\000\000\000\000\000\000\002m\000\000\002o\000\000\002n\000\000\002U\002T\000\000\002V\000\000\000\000\000\130\000\000\000\000\001\234\000\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\000\000\002\236\001\254\001\255\001\250\001\252\001\251\001\253\000\000\000\000\000\000\000\185\000\000\000\000\002\003\000\000\000\209\000\000\000\000\000\000\000\000\002\235\000\000\000\183\000\000\000\000\000\000\000\000\0013\001-\000\000\000\000\001.\000\021\000\000\000\020\000\000\000\000\000\197\000\000\000\000\000\000\000\024\000\019\000\000\000\000\000\000\000\r\000\000\000\000\000\000\000\000\001x\001t\000\000\001p\003\012\000\000\002\003\000\000\000\208\000\000\000\000\000\000\000\000\002=\002\002\002\000\002\001\000\000\000\000\000\000\002\003\000\000\000\207\000\000\000\000\000\000\000\000\002<\000\000\001T\001S\000\000\000\014\000\000\003&\000\000\000#\000\000\000\000\000\000\000\000\000\133\000\000\000\213\000\001\000\000\000\000\000\216\000\002\000\000\000\003\000\000\001\191\000\000\000\000\001\192\000\004\000\000\000\000\001\193\000\005\000\000\000\000\000\000\002\255\002\250\002\251\002\254\002\252\000\000\000\000\003\003\000\006\000\000\003\002\000\000\001 \000\000\000\000\003\000\000\000\003\001\000\000\000\000\000\000\000\000\001$\001%\000\000\000\000\001#\001\"\000\007\000\000\000\000\000\000\003\025\000\000\003\024") and error = - (122, "'\225 \022*\183\204\207@P?\144\000\0148\b\216@\005\194\141\241'\208\004\015\128\000\001\142\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\182mf\235\252\205\255\005G\248\132A\231\129\247\217\016\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\129\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\031\128\176\144\000\015\136\128A\000@\162\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\002\012\\ \000\016\000\000\000\000\000\001\000@\001\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\132\128 \000 \128\bP\000@\001\136\000\b\000! \b\000\b \002\016\000\016\000b\000\002\000\0000\000\b0A0\001\000\000\000\000\000\000\000\000\012\000\002\b\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\b \0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\130\000\016\000\000\000\000\000\000\000\000\000\000\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000 \128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128\b`\000@\001\216\004H\001\000\200\0008\016\000\197\194\128\001\000\128 \000\016\bH\002 \003\b$\135\000\004@\025\132A\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\192@\003\023\n\000\004\002\000\128\000@\000\192\0020\016 \197\194\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\002\236\000\131%!\192\193\018\007`\022a\022\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\004\000@\000\000\004\000\000\000\018\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\bP\t\024\000\004\144\135\003\000H\004\132H\000A\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\000\000\000\000\000\000\000\000\0000\000\b \0010\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\017\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\b\216@\005\194\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\001\000 0H\228\000\000`\000\000c\000\004\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\246o\191\223\255\240t\255\152\132\014y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\024\129\248\171}H\244\249\139\228\016\006k\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\b\016\002\003\004\142@\000\006\000\000\0060\b\216@\005\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\001\000\n\bP0\000\000\b\004\000\000!\000\000\000\000\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\132\003\000\000\000\128@\000\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\134 ~\002\206R->2\027\004\001\146\203\128\000\b\000\000\000\000\000@\000\004\000\000\000\000 @\000\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\159\132\128X\170\2233}\001@\254 \0008\224\167\225 \022*\183\204\207@P?\136\000\0148)\248H\133\138\173\2433\208\020\015\230\000\003\142\000\016 \000\016\000 A\000\000\004\000\000\000\002\000\004\b\000\004\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000P \000\000\000 @\000\000\004\000\000\000\000\000\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000\\(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\200@\000\128\004\193\"\208\001\001\160\000\001D\0002\016 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\016\000\192\000\176\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\003\000\000\192@\003\023\b\000\004\000\000\000\000P\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\236\000\131!!\192\193\018\007`\022!\022\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 .\192\b2\018\028\012\017 v\001b\017`0\000\b\000\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000 \000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001`.\192\b2R\028\012\017 v\001b\017`\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001`.\192\b2R\028\012\017 v\001b\017`0\000\b\000\0001p\128\000@\000\000\000\000\003\022\002\236\000\131%!\192\193\018\007`\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000@\000\002\000\000\000\001\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\b\000\000\000\000@\000\002\000\000\000\001\002\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004H\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\236\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\0002\016\0000\0010I\164\000@`\000\000A\000\012\132\000\b\000L\018i\000\016\024\000\000\016@\003!\000\002\000\019\004\138@\004\006\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\164m\t\001L\018k\000\016\025B\006\213P\000\001\000\002\000\016\000\000@\000\004\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027B@S\004\155\192\004\006\208A\181T\000@\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\128 \0010H\180\000@h\000\002A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\192\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010I\180\000@h\000\000A\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020@\012\132\000\b\000L\018-\000\016\026\000\000\016@\144\000\027\000\000@\000\016\000\000\000P\0011D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000l\000\001\000\000@\000\000\001@\004\197\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\200F\192\128\020\193&\208\001\001\180\000MU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027\002\000S\004\155@\004\006\208\0015T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020B\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\b\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\128\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001 \000\000\000\001\000\000\000\000\000\018\020B\012\132\b\b\000L\018-\000\016\026\000\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000@\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000 \192\000@\000\000@\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0010I\172\000@d\000\019E@\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\012\132\016\012\130L\018m\000\016\026\000\000\016@\001\002\000\001\000\002\004\016\000\000@\000\000\000 \000@\128\000@\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\0000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128\b\128\016\002\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000\130\000\019\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\004\000\000\012\000\003\129\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128\b\128P\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\004\136\0051 \n\128\b0\018\028\000\017\000v\001\"\000@0\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 \n\128\b0\018\028\000\017\000v\001\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@@\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\004@\029\132\b\128\016\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\017\000v\016\"\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004 \000\000\000\000\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\025\000v\000&\000@P \128\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\002\000\016\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\192\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\025\000v\016&\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\b\216@\133\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\002\000\000@\000\000\000\000\000\000\004\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000H@\004\000\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\000\192\004\020\t\000\000\141\132\000\\(\223\018}\000@\248 \000\024\224#a\000\022\n7\196\159@\016>\b\000\0068\b\216@\005\130\141\241#\208\004\015\130\000\001\142\000\018\016\001\016 0I\228\000\000`\000\000c\000\004\132\000@\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\142@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\181\207\239\254\216}\246\223\255|\004\000\000\000\000\012\0028\000\000\000\000\000\000\000\163a\136\031\138\183\212\143O\152\190A\000f\186\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\129`\163|H\244\001\003\224\000\000c\130\141\132 X(\223\018=\000@\248\000\000\024\224\129\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000@\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\b\022\n7\196\143@\016>\000\000\0068(\216B\005\130\141\241#\208\004\015\128\000\001\142\b2\016\128 \0010H\180\000@`\000\000A\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\141\132\000\\(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016\0000\0010I\180\000@h\000\000E\000\012\132\000\b\000L\018m\000\016\026\000\000\017@\003!\000\002\000\019\004\139@\004\006\128\000\004P\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\004\000\001\000\000\000\000\000\018\004@\141\132\000X(\223\018=\000@\248\000\000\024\224\003)\000C@\019\004\154\192\004\006\000\000\004\016\000\202@\016\144\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010H\172\000@`\000\000A\000\b\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\001\000\000\000\004\000\019\004@\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000@\000\000\000\000\000\002\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b:\024\129\248\0119H\180\248\200l\016\006K,\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\001\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@#a\000\022\n7\196\143@\016>\000\000\0068\000\200@\000\192\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010I\180\000@h\000\000A\000\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\016\000\000\000@\001 D\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\018\016\001\016 0I\228\000\000`\000\000c\000\004\132\000@\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\142@\000\006\000\000\00601%.\195\232>\022\028\015\251`w\219~p\240\018\016\001\000 0H\228\000\000`\000\000c\003\022\246\237\127\139\237s\251\255\182\031}\183\255\223\000\000\000\000\000\002\000\n\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\131\022\246\237\127\139\237s\251\255\182\031}\183\255\207\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\003\000\n\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\022\246\237\127\139\237s\251\255\182\031}\183\255\207\196\148\187\015\160\248Xp?\237\129\223m\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\215?\191\251a\247\219\127\252\252IK\176\250\015\133\135\003\254\216\029\246\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\253n\199\234\191\247?\223\253o\247\139\127\254\247\223dB\011\248\212\000\019\007\007\184\226\192\160\208\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2402\016\000 \0010I\180\000@`\000\000A\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\003)\000B@\019\004\154\192\004\006@\001\180T \232b\007\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\148\016\000\200@\000\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000d\000\000\000\000@\000\000\001\000\000\000\000\131\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\001\000\000\000\004\000\b\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\128\000\025\000\000\000\000\016\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\tA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\016\000\000\000\000\0010D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\128\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\019\004@\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004B\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004B\018\000\136\000\130\001!\128\001\144\006`\000 \004\132\128\"\000 \136H`0d\001\152\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\130\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b \248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192@\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000 C\224\012\004\004\003\224 \016\000X <[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\136\015\1280\016\016\015\128\128@\001`\128\241on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000 \131\224\012\004\004\003\224 \016\000X <[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\015\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\252[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\241on\215\248\190\215?\191\251a\247\219\127\253\252[\219\181\254/\181\207\239\254X}\226\223\255<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\b\128\248\003\001\001\000\248\b\004\000\022\b\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000 \131\224\012\004\004\003\224 \016\000X 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\129\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\014\134 ~\002\206R->2\027\004\001\146\203\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\004$\0050H\172\000@`\000\001A\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000A\000\000\000\004\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000@\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\018\004@\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\1306\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\132 @\b\012\0189\000\000\024\000\000\024\192\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\146\015\1280\016\016\015\128\128@\001a\128\232\216@\133\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\bX(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\0060\016\000\000\000\000\000\000\000\000\003\000\000P\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\004\000\000\000\002\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\129\000\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\192\000\020\000\000\000\004\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\012\000A@\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\176\250\015\133\135\003\254\216\029\246\223\156<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\016\248\003\001\001\000\248\024\004\000\022\b\014\000\000@\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000 \000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\001\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\000 \130Hp\000d\001\152\000\b\001\000@\016\000\000 \193\000\000\000\016\000\000\000\000\004\000\000\000\000\004\000\001\000\000\000\004\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\000 \130Hp\000d\001\152\000\b\001\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\016\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\002\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\016\000 \000\000\000\016\000\000\192\000 \000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\004@\000\000\000\004\000\000 \000\000\000\001\000\000\001\016\000\000\000\001\000\000\000\000\000\000\000\000\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\001\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\001\000\000\b\000\000\000\000@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\bX\n \002\012\020\135\000\006@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\000 \129Hp\000d\001\152\004\bA\000\192\000 \000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\000 \129Hp\000d\001\152\004\bA!`(\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\001\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016@ \0010I\180\000@`\000\000A\000\012\132\016\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\bH\002 \002\b\004\134\000\006@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\000\b\000L\018-\000\016\026\000\000\017@\196\148\187\015\160\248Xp?\229\129\222-\249\195\224\000\"\003\224\012\004\004\003\224 \016\000| 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\001\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\016\000\016\001\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000v\000\002\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\001!\192\001\016\006`\000 \000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000@\000\000\000\001\000\000\000\000\000\000\000\000\004\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\004\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\018\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\159\132\137X\170\2233=\001@\254\000\000x\224\003!\000\002\000\019\004\139@\004\006\128\000\004\016\004\000\000\128\000\000\000\004\000\000\000\000\000H\017\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\000\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\003\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\bH\018 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\016\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\012 \018\028\000\017\000v\000\006\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\128\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\016\002\016\000\016\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\000 \128Hp\000D\001\152\000\b\000! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\192\001\016\006`\000 \000\132\128\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000x\002,\006\b1\244\128\004@\024\000\000\128\002\018\000\136\000\130\000!\000\001\000\006`\000 \000\001\000\000\001\000\000\000\016\000\000\000\000\000\000 \000@\000\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \130\b`\000@\001\152@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \130\b`\000@\001\152@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000@\016\000\000\001\000\000\000\000\000\000\000\000\004\000\016\000\000\000\000@\000\000\000\000\000\000\000\001\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\020\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 @\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\002\018\000\136\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\000 \192\bp\000@\001\152\000\b\001! \b\128\b \002\016\000\016\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\001\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \001\128\000\000 \000\000\000\000\004\128\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\0000\128\bp\000@\001\152\000\024\000\002 \000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\016\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\b\000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000!\000\000\000\000\002\130\020\004\000\000\002\001\000\000\b@\000\000\000\000\160\132\001\000\000\000\128@\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\001\000\000\000\128@\000\000 \000\000\000\004\004\000@\000\000\000\000\000\000\000\b\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\016\001\000\000\000\000\000\000\000\000 \000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000 \000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\018\001\000\000\b@\000\000\000\000\128\134\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000H\004\000\000\000@\000\000\002\000Q\006\000\000\000\000\000\000\000\000\016\000\000\000\128\020@\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\000\000\000\016\000\000\000\000\b\000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\001\004@\029\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\000\000\128\020@\128\000\000\000\000\000\000\002\018\000\168\000\130!!\192A\016\007`\016 \004\132\000\000\000\000\b\bp\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001q\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\b@\000\000\000\000\128\135\003\000\000\000\128@\000\002\016\000\000\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`\016\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\1285p\128\000@\000\000\000\000\002\022\002\168\000\131\004!\192\001\016\007`\000`\004\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\1285p\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\016\000\000\000\000\001\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\1285p\128\000@\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\133\128\170\000 \193\bp\000D\001\216\000\b\001!`*\128\b0B\028\000\017\000v\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\168\000\130\000!\192\001\000\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\018\018\000\136\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b@\000@\001\152\000\b\001\000\128\000 \128\004\192\004\000\000\000\000\000\000\000\000 \000\b \0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\018\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\132\000\004\000\025\128\000\128\016\b\000\002\b\000L\000@\000\000\000\000\000\000\000\002\000\000\130\000\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\012\128\003\129\000\012\\(\000\016\b\002\000\001\000\003\000\002\192@\003\023\b\000\004\000\000\000\000P\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!h\b\128\b \146\026\000\017\000\230\001\002\000HH\002 \003\b\004\135\000\004@\025\128A\132\018\018\000\136\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\001\002\016@\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\001\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\029\128@\128\016\004\128\000\128\000\b\000(\000\000\b\002\000\001\000\001 \000\000\000\002\000\n\000\000\002\000\128\000@\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \003\b\004\135\000\004@\025\128A\132\018\018\000\136\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000\000\000\000\000\000\000\136\000\000\016\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\000P@\001\000\000\000\b\003D\b\000\000\016\000\000\000\000!\000\000\000\000\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\132\003\000\000\000\128@\000\002\016\000\000\000\000 !\000\192\000\000 \016\000\000\b\000\000\000\001\001\000\016\000\000\000\000\000\000 \000\000\000\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\144\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\134\003\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000\b\004\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\t\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\001\000\016\000\000\000\000\000\000 \000\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\000\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000\005\004\0008\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000 \000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000\005\004\0008\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\130\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\209\006\000\000\004\000\000\000\b\000\016\000\000\000\1284A\128\000\001\000\000\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\200A\000\200\004\193&\208\001\001\128\000\001\004\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\012\132\016\b\000L\018m\000\016\024\000\000\016@\003!\004\002\000\019\004\139@\004\006\000\000\004\016\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\002\000\002\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000 \000@\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010H\172\000@`\000\000A\000\012\164\001\t\001L\018+\000\016\024\000\000\016@\001\000\000\000\b\003D\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\016\000\000\000\1284@\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\169*Pb\139L\254\240D\007\152\004\0305!jJ\148\024\162\211?\188\017\001\230\001\007\141@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\168\000\130!!\192\193\016\006`\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\003\004@\025\128A\128P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@2\016@ \0010H\180\000@`\000\000A\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000 \000 \000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\002\001\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\1284@\128\000\001\000\000\000\000\002\016\000\000\000\000 !\192\192\000\000 \016\000\016\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001q\128\000@\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b@0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\016\012\000\003\001 \r\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\016\012\164\001\t\000L\018+\000\016\025\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\000P@\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\016\000\016\000f\000\002\000\0002\016@0\0010I\180\000@`\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\016\000\017\000f\000\002\000HH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000D\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\016\000f\000\002\000\bH\002 \002\b\004\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\000\001\144\006`\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004\000\025\128\000\128\002\018\000\136\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001 \n\128\b0\146\028\000\017\000v\000\"\000L\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\003\000\000\000\128@\000\002\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\b\000\004\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000 \001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@\000\000\131\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\000 \0010H\180\000@h\000\000E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\0000\128Hp\000D\001\216\000\024@\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\0000\128Hp\000D\001\216\000\024@\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002 \002\b\004\135\000\004@\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\002\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\000 \128H`\000D\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000 \000\000\000\000\0000\000\b\000\0001q\128\000H\000\b\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\016\000\000\000H\000\000\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\001\000\000\000\004\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\000\000\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\135\000\004@\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\0008\016\000\197\194\128\001\000\128 \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\002\000\000 \000\128\000\000 \000\000\004\000\004\128\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\000 \128\b`\000@\001\152\000\b@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002 \130\b\000\134\000\004\000\029\128D\128\016\012\128\003\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000 \000\002\000\b\000\000\002\000\000\000@\000H\000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002 \002\b\000\134\000\004\000\025\128\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \002\016\000\016\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\001\000\000\000\001\000\018\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\248H\005\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\022\132\128\000\130\r!\001\001\016\014@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \018\016\000\017\000d\016\002\000\000\016\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\128\000\130\001!\000\001\000\006\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\b\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002~\018\001b\171|\204\244\005C\249\000\000\227\128\159\132\128X\170\2233=\001P\254@\0008\224\004\128 \000 \128H@\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H`\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \b\000\b \018\024\000\017\000d\000\002\000\000H\002\000\002\b\004\132\000\004@\025\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000") + (122, "'\225 \022*\183\204\207@P?\144\000\0148\b\216@\005\194\141\241'\208\004\015\128\000\001\142\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\254\182mf\235\252\205\255\005G\248\132A\231\129\247\217\016\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\129\247\217\016\130\2545\000\004\193\193\2388\176(4'\225\"V*\183\204\207@P?\128\000\0308\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\031\128\176\144\000\015\136\128A\000@\162\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\131\023\b\000\004\000\000\000\000\000\000@\016\000@ \193\004\000\000\016\000\000\000\000\000\016\004\000\000\b0A\000\000\004\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216@\136\001! \b\000\b \002\020\000\016\000b\000\002\000\bH\002\000\002\b\000\132\000\004\000\024\128\000\128\000\012\000\002\012\016L\000@\000\000\000\000\000\000\000\003\000\000\130\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000 \128\004\000\000\000\000\000\000\000\000\000\000 \000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\b \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \002\024\000\016\000v\001\018\000@2\000\014\004\0001p\160\000@ \b\000\004\002\018\000\136\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200\0000\016\000\197\194\128\001\000\128 \000\016\0000\000\140\004\b1p\128\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\152E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\001\000\000\000\004\128\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\020\002F\000\001$!\192\192\018\001!\018\000\016}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\131\004\019\000\016\000\000\000\000\000\000\000\000\192\000 \129\004\192\004\000\000\000\000\000\000\000\0000\000\b A0\000\000\000\000\000\000\000\000\000\012\000\002\b\000L\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\016 \004}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\0026\016\001p\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\132\000@\b\012\0189\000\000\024\000\000\024\192\001\000\000\001\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000+\250\221\253\155\239\247\255\252\029?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\141\134 ~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 HB\004\000\128\193#\144\000\001\128\000\001\140\0026\016\001`\163|H\244\001\003\224\000\000s\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000@\002\130\020\012\000\000\002\001\000\000\b@\000\000\000\000\160\133\003\000\000\000\128@\000\002\016\000\000\000\000(!\000\192\000\000 \016\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136\031\128\179\148\139O\140\134\193\000d\178\224\000\002\000\000\000\000\000\016\000\001\000\000\000\000\b0\000\000\016\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\n~\018\001b\171|\205\244\005\003\248\128\000\227\130\159\132\128X\170\2233=\001@\254 \0008\224\167\225\"\022*\183\204\207@P?\152\000\0148\000@\128\000@\000\129\004\000\000\016\000\000\000\b\000\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\001@\128\000\000\000\129\000\000\000\016\000\000\000\000\0026\016\001`\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001p\163|I\244\001\003\224\000\000c\128\141\132\000X(\223\018}\000@\248\000\000\024\224#a\000\022\n7\196\143@\016>\000\000\00681on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\128\012\132\000\b\000L\018-\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\128\000\005\016\000\200@\128\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000D\000\000\000\000\000\000\000\001\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000@\003\000\002\192@\003\023\b\000\004\000\000\000\000P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\001\000\012\000\003\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\001\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\176\002\012\132\135\003\004H\029\128X\132X\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\196\128\187\000 \200Hp0D\129\216\005\136E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\002\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\128\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\136E\128@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\000 \201Hp0D\129\216\005\136E\128\192\000 \000\000\197\194\000\001\000\000\000\000\000\012X\011\176\002\012\148\135\003\004H\029\128X\132X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \001\000\000\001\000\000\b\000\000\000\004\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004\b\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000 \000\000\000\017 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\001\000\000\b\000\000\000\004H\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\016\000\000\128\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\176\002\012\132\135\003\004H\029\128X\132P\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\012\004\0001p\128\000@\000\000\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\001\000\000\000\004\000\000\000\002\000\000D\000\000\000\000\000\000\000\001\000\000\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\200@\000\192\004\193&\144\001\001\128\000\001\004\0002\016\000 \0010I\164\000@`\000\000A\000\012\132\000\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\145\180$\0050I\172\000@e\b\027U@\000\004\000\b\000@\000\001\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\164m\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\002\000\138\000\000\000\000\000\000\000 \200B\000\128\004\193\"\208\001\001\160\000\t\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\003\000\019\004\155@\004\006\128\000\004\016\000\200@\000\128\004\193&\208\001\001\160\000\001\004\0002\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\0002\016\000 \0010H\180\000@h\000\000A\002@\000l\000\001\000\000@\000\000\001@\004\197\016\131!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\004\000\001\000\000\000\005\000\019\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027\002\000S\004\155@\004\006\208\0015T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\132l\b\001L\018m\000\016\027@\004\213P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\016\000\000\000\000\001 D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000$\000\006\192\000\016\000\004\000\000\000\020\000LQ\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000@\000\016\000\000\000P\0011D \000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\004\128\000\000\000\004\000\000\000\000\000HQ\b2\016 \0010H\180\000@h\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\001\000\000\000\000\000\018\004B\000\000D\000\000\000\000\000\000\000\000\000\000\000\000\131\000\001\000\000\001\000\000\000\000\000\000\000\000\000 \000\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193&\176\001\001\144\000M\021\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000@\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\001\000\000\000\004\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016@2\t0I\180\000@h\000\000A\000\004\b\000\004\000\b\016@\000\001\000\000\000\000\128\001\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\192\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@\000\000\131\004\000\000\000@\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000 \001\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\192\000 \128\004\192\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\003\000\000\224@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\003\018\000\168\000\131\001!\192\001\016\007`\002 \020\003\000\000\192@\003\023\b\000\004\000\000\000\000\0001 \n\128\b0\018\028\000\017\000v\001\"\001LH\002\160\002\012\004\135\000\004@\029\128H\128\016\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\012H\002\160\002\012\004\135\000\004@\029\128H\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\168\000\131\t!\192\001\016\007a\002 \004\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\004@\029\132\b\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\000\136\001\000 \000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\196\128*\000 \192Hp\000D\001\216\000\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\004\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216@\136\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\006@\029\128\t\128\016\020\b \000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@\000\000\131\004\000\000\000@\000\000\000\0000\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\160\002\012$\135\000\006@\029\132\t\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\016\000 \000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0026\016!`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\001\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\018\016\001\000 0H\228\000\000`\000\000c\003\000\000D\000\000\000\000\000\0000\001\005\002@\000#a\000\023\n7\196\159@\016>\b\000\0068\b\216@\005\130\141\241'\208\004\015\130\000\001\142\0026\016\001`\163|H\244\001\003\224\128\000c\128\004\132\000D\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\158@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\000\018\016\001\000 0H\228\000\000`\000\000c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\246\237\127\139\237s\251\255\182\031}\183\255\223\001\000\000\000\000\003\000\142\000\000\000\000\000\000\000(\216b\007\226\173\245#\211\230/\144@\025\174\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\141\132 X(\223\018=\000@\248\000\000\024\224\163a\b\022\n7\196\143@\016>\000\000\0068 @\128\000@\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\002\000\016\000\000\000\000\000\016\000 @\016\000\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\216B\005\130\141\241#\208\004\015\128\000\001\142\n6\016\129`\163|H\244\001\003\224\000\000c\130\012\132 \b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\016\000\000\000@\0010D\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224#a\000\023\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241'\208\004\015\128\000\001\142\0026\016\001`\163|H\244\001\003\224\000\000c\128\012\132\000\012\000L\018m\000\016\026\000\000\017@\003!\000\002\000\019\004\155@\004\006\128\000\004P\000\200@\000\128\004\193\"\208\001\001\160\000\001\020\0002\016\000 \0010H\180\000@h\000\000A\000@\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\202@\016\208\004\193&\176\001\001\128\000\001\004\0002\144\004$\0010I\172\000@`\000\000A\000\012\164\001\t\000L\018+\000\016\024\000\000\016@\002\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\000 \0010H\180\000@h\000\000A\000\000\000 \000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\004\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\014\134 ~\002\206R->2\027\004\001\146\203\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\b\216@\005\130\141\241#\208\004\015\128\000\001\142\0002\016\0000\0010I\180\000@h\000\000A\000\012\132\000\b\000L\018m\000\016\026\000\000\016@\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\001`\163|H\244\001\003\224\000\000c\128\004\132\000D\b\012\018y\000\000\024\000\000\024\192\001!\000\016\002\003\004\158@\000\006\000\000\0060\000H@\004\000\128\193#\144\000\001\128\000\001\140\012IK\176\250\015\133\135\003\254\216\029\246\223\156<\004\132\000@\b\012\0189\000\000\024\000\000\024\192\197\189\187_\226\251\\\254\255\237\135\223m\255\247\192\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\141\132\000X(\223\018=\000@\248\000\000\024\224\197\189\187_\226\251\\\254\255\237\135\223m\255\243\192\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H@\004\000\128\193#\144\000\001\128\000\001\140\012[\219\181\254/\181\207\239\254\216}\246\223\255|\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\197\189\187_\226\251\\\254\255\237\135\223m\255\243\241%.\195\232>\022\028\015\251`w\219~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\181\207\239\254\216}\246\223\255?\018R\236>\131\225a\192\255\182\007}\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\177\250\175\253\207\247\255[\253\226\223\255\189\247\217\016\130\2545\000\004\193\193\2388\176(4#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\012\132\000\b\000L\018m\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\202@\016\144\004\193&\176\001\001\144\000m\021\b:\024\129\248\0119H\180\248\200l\016\006K,\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\202@\016\144\004\193\"\176\001\001\144\000%\004\0002\016\000 \0010H\164\000@`\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\016\000\000\000@\000\000\000 \192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000d\000\000\000\000@\000\000\001\000\002\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000 \000\006@\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\000L\018+\000\016\025\000\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\004\000\000@\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\132\000\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b2\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000@\001 D \200@\000\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\128\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0002\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\132\128\"\000 \128H`\000d\001\152\000\b\001! \b\128\b\"\018\024\012\025\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\130\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\130\000\002\004>\000\192@@>\002\001\000\005\130\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\155\015\1280\016\016\015\128\128@\001a\128\232\216B\197\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000\016\002\003\004\142@\000\006\000\000\00601on\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000 \000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156<\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015\128\000\145\015\1280\016\016\015\128\128@\001`\128\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0000\000\160\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\0001on\215\248\190\223?\191\251a\247\219\127\252\2426\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\0068 \000\000\128\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\b\016\248\003\001\001\000\248\b\004\000\022\b\015\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\181\254/\183\207\239\254\216}\246\223\255<\141\132\000X(\223\018=\000@\248\000\000\024\224\196\148\187\015\160\248Xp?\229\129\222-\249\195\200\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\003\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\2426\016\001`\163|H\244\001\003\224\000\000c\130\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187_\226\251|\254\255\237\135\223m\255\243\200\216@\005\130\141\241#\208\004\015\128\000\001\142\012IK\176\250\015\133\135\003\254X\029\226\223\156?\022\246\237\127\139\237\243\251\255\182\031}\183\255\207#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\252[\219\181\254/\181\207\239\254\216}\246\223\255\127\022\246\237\127\139\237s\251\255\150\031x\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\161\136\031\128\179\148\139O\140\134\193\000d\178\192\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\012\164\001\t\001L\018+\000\016\024\000\000P@\003\000\000\128\000\003\023\b\000\004\000\000\000\000\000\000@\000\000\000\016@\000\000\001\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@S\004\138\192\004\006\000\000\020\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\005\130\141\241#\208\004\015\128\016\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001%.\195\232>\022\028\015\249`w\139~p\2402\016\000 \0010H\180\000@h\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\131\018R\236>\131\225a\192\255\150\007x\183\231\015#a\000\022\n7\196\143@\016>\000\000\00681%.\195\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000 \141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\b\016\002\003\004\142@\000\006\000\000\0060 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0078\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\216@\133\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\001\000 0H\228\000\000`\000\000c\001\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\004\000\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000@\000\000\000 \000\004@\000\000\000\000\000\000\000\000\000\000\000\b\016\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\012\000\001@\000\000\000@\000\000\000\000\192#\128\000\000\000\000\000\000\012\000\001\016\000\000\000\000\000\000\192\004\020\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\015\160\248Xp?\237\129\223m\249\195\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\145\015\1280\016\016\015\129\128@\001`\128\224\000\004\000\000\000\000\000\000\000@\000\000\000\000\b\000\000\000\000\000\016\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000\000\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000 \001\000\002\000\000\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\bH\002 \002\b$\135\000\006@\025\128\000\128\016\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000@\000\000\000\000@\000\016\000\000\000@\000\000\000\000@\128\000\000\000\129\000\000\000\016\000\000\000\000\bH\002 \002\b$\135\000\006@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000 \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\002\000\000\000\001\000\000\012\000\002\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000D\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\016\000\000\000\000\000\000\000\000\000\004@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\016\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\016\000\000\128\000\000\000\004\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\000 \193Hp\000d\001\152\004\bA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bX\n \002\b\020\135\000\006@\025\128@\132\016\012\000\002\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\000 \000\000\197\194\000\001\000\000\000\000\000\bX\002 \002\b\020\135\000\006@\025\128@\132\018\022\002\136\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\016\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004\002\000\019\004\155@\004\006\000\000\004\016\000\200A\000\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\132\000\b\000L\018-\000\016\024\000\000\016@\132\128\"\000 \128H`\000d\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\200@\000\128\004\193\"\208\001\001\160\000\001\020\012IK\176\250\015\133\135\003\254X\029\226\223\156>\000\002 >\000\192@@>\002\001\000\007\194\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\000\000\b0@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\000\000\b0@\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000@\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\001\000\000 \000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000! \b\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\000\016\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\001\000\001\000\016\000\000\000\000\000\000\000\000@\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\007`\000 \000\001\000@\000\000\131\004\000\000\000@\000\000\000\0001 \b\128\b0\018\028\000\017\000f\000\002\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\016\000\000\000\000\000\000\000\000\192\001\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@0\000\000\000\000\000\001\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\016\000! \b\128\b \018\024\000\017\000f\000\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D \191\141@\0010p{\142,\n\r\t\248H\149\138\173\2433\208\020\015\224\000\007\142\0002\016\000 \0010H\180\000@h\000\000A\000@\000\b\000\000\000\000@\000\000\000\000\004\129\016#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223dB\011\248\212\000\019\007\007\184\226\192\160\208\159\132\137X\170\2233=\001@\254\000\000x\224\001\002\000\001\000\002\004\016\000\000@\000\000\000\000\000@\128\000\000\000\129\004\000\000\016\000\000\000\000\000\016 \000\000\000 @\000\000\004\000\000\000\000\002\018\000\136\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\000 \128H`\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000`\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\192\001\016\006a\000!\000\001\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\bH\002 \002\b\004\135\000\004@\025\128\000\128\002\018\000\136\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000\bH\002 \002\b\004\134\000\004@\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\192`\131\031H\000D\001\128\000\b\000! \b\128\b \002\016\000\016\000f\000\002\000\000\016\000\000\016\000\000\001\000\000\000\000\000\000\002\000\004\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\001\000\000\000\016\000\000\000\000\000\000\000\000\192\001\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\001@\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b \134\000\004\000\025\132\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\000\000\b0@\000\000\004\000\000\000\000\003\018\000\136\000\131\000!\192\001\000\006`\000 \004\132\128\"\000 \128\b@\000@\001\152\000\b\001\000\192\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@\000\000\131\004\000\000\000@\000\000\000\0001 \b\128\b0\002\028\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\002\018\000\136\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\001\000\004\002\012\016@\000\001\000\000\000\000\000\001\000@\000\000\131\004\016\000\000@\000\000\000\000\000@\016\000\000 \193\000\000\000\016\000\000\000\000\012H\002 \002\012\000\135\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\001\000\002\000\024\000\000\002\000\000\000\000\000H\000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\000!\192\001\000\006`\000`\000\b\128\000\001\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000 \000\b \001\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000 \005\016 \000\000\000\000\000\000\000\132\000\000\000\000\n\bP\016\000\000\b\004\000\000!\000\000\000\000\002\130\016\004\000\000\002\001\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\016\016\001\000\000\000\000\000\000\000\000 \000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\004\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000H\004\000\000!\000\000\000\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\192\192\000\001 \016\000\000\001\000\000\000\b\001D\024\000\000\000\000\000\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\016\000\000\000\000\000\000 \000@\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000\000\b\001D\b\000\000\000\000\000\000\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000@\000\000\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\128\000\000\000\004\000\000\000\000\000@\000\000\000\000 \000\000\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\004\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000@\000\000\000@\000\000\002\000Q\002\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\001\004@\029\128@\128\018\016\000\000\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\198\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000!\000\000\000\000\002\002\028\012\000\000\002\001\000\000\b@\000\000\000\000\128\134\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\000\000\000\128\132\001\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000 \005\016 \000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\024\000\000\000\000\000\000\000\002\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\bX\n\160\002\012\016\135\000\004@\029\128\001\128\016\012\000\002\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\005\000\000\000\b\000\000\000\000@\000\000\000\000\004\001\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\192\0000\018\000\213\194\000\001\000\000\000\000\000\0000\000\b\000\0001p\128\000@\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\002\022\002\168\000\131\004!\192\001\016\007`\000 \004\133\128\170\000 \193\bp\000D\001\216\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\000\135\000\004\000\029\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016 \000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000HH\002 \002\b\000\132\000\004\000\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\024\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\000!\000\001\000\006`\000 \004\002\000\000\130\000\019\000\016\000\000\000\000\000\000\000\000\128\000 \128\004\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\017\000f\001\002\000HH\002 \002\b\004\132\000\004@\025\128\000\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \002\016\000\016\000f\000\002\000@ \000\b \0010\001\000\000\000\000\000\000\000\000\b\000\002\b\000L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\0002\000\014\004\0001p\160\000@ \b\000\004\000\012\000\011\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\160\"\000 \130Hh\000D\003\152\004\b\001! \b\128\012 \018\028\000\017\000f\001\006\016HH\002 \002\b\004\135\000\004@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\004\bA\000H\000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b`\000@\001\152\004\b\001! \b\128\b \002\016\000\016\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000v\001\002\000@\018\000\002\000\000 \000\160\000\000 \b\000\004\000\004\128\000\000\000\b\000(\000\000\b\002\000\001\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\012 \018\028\000\017\000f\001\006\016HH\002 \002\b\004\135\000\004@\025\128@\132\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\016\000\000\000\000\000\000\000\002 \000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\001A\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\132\000\000\000\000\n\bP0\000\000\b\004\000\000!\000\000\000\000\002\130\016\012\000\000\002\001\000\000\b@\000\000\000\000\128\132\003\000\000\000\128@\000\000 \000\000\000\004\004\000@\000\000\000\000\000\000\128\000\000\000\000\001\001\000\016\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\141\132\000X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\192\192\000\000 \016\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000$\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\128\000\004\000@\000\000\000\000\000\000\128\000\000\000 \000\001\000\016\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\020\016\000\224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\192\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\138\192\004\006@\000\020\016\000\224\0000\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\b\216@\005\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\159@\016>\000\000\0068\b\216@\005\130\141\241#\208\004\015\128\000\001\142\b@\000\000\000\000\128\134\003\000\000\000\128@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\b\003D\024\000\000\016\000\000\000 \000@\000\000\002\000\209\006\000\000\004\000\000\000\000\000\016\000\000\000\1284@\128\000\001\000\000\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\003!\004\003 \019\004\155@\004\006\000\000\004\016\031}\145\b/\227P\000L\028\030\227\139\002\131@2\016@ \0010I\180\000@`\000\000A\000\012\132\016\b\000L\018-\000\016\024\000\000\016@\003!\000\002\000\019\004\139@\004\006\000\000\004\016\000\000\000\000\000\000\000\b\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000B@\019\004\154\192\004\006\000\000\004\016\000\202@\016\144\004\193\"\176\001\001\128\000\001\004\0002\144\004$\0050H\172\000@`\000\000A\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\022\164\169A\138-3\251\193\016\030`\016x\212\133\169*Pb\139L\254\240D\007\152\004\0305\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\160\002\b\132\135\003\004@\025\128A\128P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \n\128\b\"\018\028\012\017\000f\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\000 \136Hp0D\001\152\004\024\005\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\004\000\000\000\004\000\000\000 \r\016 \000\000@\000\000\000\000\132\128*\000 \136Hp0D\001\152\004\024\005\000\200A\000\128\004\193\"\208\001\001\128\000\001\004\0002\016\000 \0010H\180\000@`\000\000A\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\000\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192H\003W\b\000\004\000\000\000\000\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\bp0\000\000\b\004\000\004\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\209\002\000\000\004\000\000\000\000\b@\000\000\000\000\128\135\003\000\000\000\128@\000B\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\0000\016\000\197\198\000\001\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\002\016\000\000\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\b\b`0\000\000\b\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\016\000\000\000\000 !\000\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000@0\000\012\004\1285p\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\b\003D\b\000\000\016\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\000@2\144\004$\0010H\172\000@d\000\001A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000D\001\152\000\b\001! \b\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\016\001\128\000\000\000\000\000\000\000 \000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\004$\0010H\172\000@d\000\001A\002\018\000\136\000\130\001!\128\001\016\006`\000 \004\132\128\"\000 \128H@\000D\001\152\000\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000@\001\152\000\b\000\000\200A\000\192\004\193&\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H@\000D\001\152\000\b\001! \b\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128H`\000@\001\152\000\b\000! \b\128\b \018\016\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\132\000\006@\025\128\000\128\016\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\024\000\016\000f\000\002\000\bH\002 \002\b\004\132\000\004\000\025\128\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\000 \194Hp\000D\001\216\000\136\0010\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\0010D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\012\004\0001p\128\000@\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000!\000\000\000\000\002\002\016\012\000\000\002\001\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016 \000\016\000 A\000\000\004\000\000\000\000\000\004\b\000\000\000\b\016@\000\001\000\000\000\000\000\001\002\000\000\000\002\004\000\000\000@\000\000\000\000\000\000\002\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\001\000\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\002\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \200@\000\128\004\193\"\208\001\001\160\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\018R\236>\131\225a\192\255\150\007x\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000 \000\002\000\b\000\000\002\000\000\000@\000H\000\000\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\136\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\002\000\b\000\000\002\000\000\000\000! \b\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\b \128H`\000D\001\216\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\004\134\000\004@\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\002\018\000\136\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\128\000\000\000\000\000\192\000 \000\000\197\198\000\001 \000 \000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\004\000\000\000@\000\000\001 \000\000\000\000\0000\000\b\000\0001p\128\000H\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\016\000\000\004\000\000\000\000\004\000\000\000\016\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\001\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\003\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\016\000\000\000\000\001\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \b\128\b \018\028\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000\224@\003\023\n\000\004\002\000\128\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002 \002\b\000\134\000\004\000\025\128@\128\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000H\000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000 \000\128\000\000 \000\000\004\002\018\000\136\000\130\000!\128\001\000\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000\000\000\000\000\000\000\000! \b\130\b \002\024\000\016\000v\001\018\000@2\000\014\004\0001p\160\000@ \b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128\b`\000@\001\152\004\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\004\128\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\002\000\b\000\000\002\000\000\000@! \b\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\004\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\000 \128Hp\000D\001\152\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\001`\163|H\244\001\003\224\000\000c\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128\b@\000@\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\192@\003\023\b\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000\022\n7\196\143@\016>\000\000\0068\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000\002\000\019\004\139@\004\006\128\000\004\016\000\000\000\000\000\000\000\004\000\000\000\004\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \022*\183\204\207@T?\144\000\0148\000@\000\000\000\000@\000\000\000\000\000\000\000\000\000Z\018\000\002\b4\132\004\004@9\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H@\000D\001\144@\b\000\000@\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\000\002\b\004\132\000\004\000\024\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000 \000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\248H\005\138\173\2433\208\021\015\228\000\003\142\002~\018\001b\171|\204\244\005C\249\000\000\227\128\018\000\128\000\130\001!\000\001\016\006@\000 \000\004\128 \000 \128H@\000D\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\128\000\130\001!\128\001\016\006@\000 \000\004\128 \000 \128H@\000D\001\144\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \000 \128H`\000D\001\144\000\b\000\001 \b\000\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000") and start = 7 and action = - ((16, "C\134O\006B\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\240B\154\000\000\000\000\020\004B\154C\134\028Z\005\162\002\134X\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\001r\000\b\000\000\001|\000\252\000\000\002\208\005\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\244\000\000\000\000\000\000\003\012o\180\000\000\000\000\0032\000\000\000\000\000\000\003\186\003\160\000\000\000\000rTN\200\020\004A\028Y\252\020\004R\154O\006\020\004Lj\000\000\021P\000\000\021P\000\007\000\000\0032\000\000\000\000\000\000\001h\000\000\021P\000\000\003\148^\204\132:b\132\000\000\134`|8\000\000J\136D8\000\000I*\027:M \0032r\174B\154C\134\000\000\000\000O\006\020\004R\188\021P\004&y\018\000\000\129\150B\154C\134O\006\020\004\000\000\000\000\000\000\0164\020\184\000V\005|\000\000\004\182\tF\000\000\000\000\000\000\020\004\000\000@\190\000\000{\210C\134\000\000\000\000NF\020\004BjT\208\000\000\001\022\000\000\000\000\002\n\000\000\000\000F\b\001\022\b\138\000V\005\182\000\017\000\000A\028\006n\006>\019\168\020\180\020\004C\134C\134EjEj\019\168\020\180\020\180\020\004\000\000\000\000\000\000O\006\020\004\000\000\000\244\000\000T\208v>v>\000\000\tL\000\000\000}\n@\000\000\003\168\000\000\000\000 \140o\180b@\000\000rTb@\000\000rTrT\005|\000\000rT\0032\000\000\000\000T:o\180R\172D8\003|\001\016\000\000\001\146\000\000\007R\000\000\0114\000\000\000\000LZ\005|\000\000\000\000D8\007jo\180\000\000MLD8N>\000\000\000\000\000\000\001j\000\000rT\000\000\000\252u\156\000\000o\180\005\192o\180\000\000\023|\b\018\0032\000\000\000\000\024p\000\000\t\144\000\000V\\\005\214\000\000\007rrT\007\190\000\000\t\202\000\000\004F\000\000\000\000\005@\000\000\000\000\000\000\025\000\027\220T\208N\198\020\004T\208\000\000\002\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000KnEH\000\000\000\000\000\000\001\236 \224v>\000\000\000\000wJ\020\004T\208\000\000\000\000P(T\208Q\148|d\000\000p\014\000\000T\208\000\000\000\000U\184\000\000\000\000\b\186\000\000\023<\000\000\000\000|\202\000\000\136\n}D\000\000\136H\003$\000\000\000\000{R\000\000\b\176\000\000\000\000\023\002v\210\000\000\000\000\000\000@\000\019\168\025\248\021\142\000\000\000\000\000\000\000\000\000\028\000\000\000\000W\146\005\012\b\216\002\198o\180\000\216\n\002\000\000\000\000\006\000\b\216\003\180\000\000O\006G\176Ej\019\168\020\180\005\162\004\\\000&\000\000\000\000\000\000\tfA\028A\028\005\162\004\\\007\234A\028\000\000f|\001\224\021P\tL\006Hz\150\000\000o\180c@o\180Z\182c\214o\180\004\174o\180dl\000\000\000\000\021J\001\016[L\tF\001\016\\\006\000\000g\018\001\224\000\000A\028g\168\000\000\005P\011X\\\192\000\000\000\000\000\000\000\000\000\000\0240\000\000\000\000\027\134\000\000\t>\020\180\000\000YfBb\000\000\021\196\000\000\000\000A\028\024\170\000\000\000\000\000\000\000\000X\030\000\000\003\168\000\000I\168\006B\0224\000\000\021\218M\024O\006\020\004H\194N\198\020\004\0164\0164\000\000\000\000\000\000\000\000\001\232\020ZA\168\000\000O\188PrEj\019\168\020\180\006\150A\"\000\000\028\244\000\000Q(Q\222}\170\022do\180\005\162\000\000O\006\020\004\000\000wJ\020\004v>T\208@\160\000\000O\006\020\004y|\000b\000\000T\208@\000o\180\004\168\003\180\nZ\000\000\000\000\000\000F\b\005\b\005\b\000\000\011\180s2\000\000wJ\020\004T\208\023\002\000\000N\198\020\004\0164\021\218\0164\002\220\003\158\000\000\000\000\0164\011\198\000\000\011\216\000\000\0164\003\208\0120\000\000!\212\000\000\007P\000\000\000\000\025\170\000\000\017(\022\206\000\000\000\000\000\000\007\000\000\000\000\000\026\158\000\000\027\146\000\000\028\134\000\000\018\028\023\194\000\000\000\000\000\000B\154\000\000\000\000\000\000\000\000\029z\000\000\030n\000\000\031b\000\000 V\000\000!J\000\000\">\000\000#2\000\000$&\000\000%\026\000\000&\014\000\000'\002\000\000'\246\000\000(\234\000\000)\222\000\000*\210\000\000+\198\000\000,\186\000\000-\174\000\000.\162\000\000/\150\020\004T\208V\230F\240\005\b\012\134h T\208\000\000\000\000\000\000o\180\000\000\026\132\138\004\000\000\024\236o\180\027x\012\018\000\000\000\000\000\000\000\000h \000\000\000\000\002f\012\186\000\000B\146\000\000\000\000\138H\000\000\006\180\000\000\000\000M \005\b\012Vo\180\006\162\000\000\000\000\nP\0032\000\000o\180\tr\000\000\000\000\012\172\000\000\000\000\000\000\025@o\180\n\018\000\000\000\000\027\198\000\000\000\000~$\000\000\028\028~\138\000\000\028\186\127\004\000\000\029\016\004l\000\000\000\000\000\000\000\000\029\174T\208\030\004s\172s\172\000\000\000\000\000\0000\138\000\000\011H\000\000\000\000\000\000h\134\000\000\000\000\000}\bb\000\000h\224\000\000\000\000\000\000ib\000\000\000\000\000\000i\228\000\000\000\000\000\000\0164\004\196\tV\000\000j>\000\000\005\184\000\0001~\000\000j\192\000\000\006\172\000\0002r\000\000kB\000\000\007\160\000\0003f\"\200\000\000\b\014\b\148\000\0004Z\000\000\011\140\t\136\000\0005N\000\000k\196\n|\000\0006B\0046\nJ\000\000l\030\011p\000\00076\000\000l\160\012d\000\0008*\000\000m\"\rX\000\0009\030\014L\000\000:\018\015@\019\016\000\000\000\000\000\000m|\000\000\000\000m\254\000\000\000\000n\128\000\000\t\020\000\000\000\000\000\000\012\172\000\000\r\002\000\000\000\000G\216\005\b\r\210s2D8\002\234\000\000\000\000s2\000\000\000\000\000\000s2\000\000\r\172\000\000\000\000\000\000\000\000\000\000\000\000;\006T\208\000\000\000\000\r\242\000\000;\250\000\000<\238\000\000\030\162\000\000\000\000\006\222\000\000\000\000T\208\000\000\000\000\127\026\t\018\000\000\000\000I\168\000\000\005\212\000\000\000\000]fH\194\000\000St\000\000\012<\000\000\000\000\0022\b\154\000\000\000\000\021\218\025.\tL\000\000\031\152\000\000\031\172\021\184\022\234\000\000\000\000\005\144\000\000\000\000\001\230\021FU0\000\000\024\182\000\000\006\244\000\000\000\000\t`\000\000\000\000]\232\005\188\0022\000\000\000\000\n,\000\000\000\000\012Z\000\000\000\000\000\000\019\168\020\180\004\174\000\000\000\000\007\150\000V\014h\004\\\020\180y\222A\028\020\144\020\180z\\\r\236\000\000\000\000\004\\\000\000E$\020\004\000\142\000\000\b \014l\000\000\014n\000\000\000\000\003\186D8\006\168\000\000\014N\r\228M \n^o\180\0190\005\216\012\132\002\252\000\000\027$\014\156\000\000\006\168\000\000\000\000\014\194D8^\128\000\000d\234D8\014\150D8o\024^\254\005\216\014Z\000\000\000\000\020\004\130\014\000\000T\208s\172\000\000\000\000\014\200\000\000\000\000\000\000=\226\014\240v>>\214_\170\000\000\000\000Cj\000\000\029\028\000\000C\182\000\000\025\182\000\000A\028\029\232\000\000\130p\000\000\019\168\020\180\130p\000\000\025\204\020\184\000V\0032\132\188A\028\127\168s\172\000\000\000V\nF\004\\s\172\000\000\014\230\004\\s\172\134\132\000V\014\242\004\\s\172\134\132\000\000\000\000B\154C\134T\208F4\000\000\000\000B\154C\134Ej\019\168\020\180\130p\000\000\028Z\005\162\002\134\014\024`p\166D|\000\000\020\004o\180\011Zo\180S\252D|\000\000\011\190\000\000\000\000D|\000\000\000\000VP\000\000s\172\134\222\019\174\007J\011\184\015*\014\216\024`s\172\134\222\000\000\000\000\019\174\007J\011\184\0150\014\196N\018ehD8\015NN\018rT\003\254\015RN\018D8\015ZN\018\011\252\r\028q$q\162\000\000\130\240\000\000\000\000s\172\136\252\019\174\007J\011\184\015P\014\232N\018s\172\136\252\000\000\000\000\000\000\137v\000\000\000\000\000\000\000\000\000\000\000\000h \000\000\135V\020\004\021P\015xy\018\000\000\129\150\135V\000\000\000\000\137\000\020\004\021P\015~\015\016\132:rT\006\168\015\182\000\000\000\000r\026t*\020\004\000\000\128z\000\142\000\000\000\000tv\137\000\000\000\000\000\000\000z\218EZO\200\006\168\015\184\000\000\000\000\000\000t*\020\004\000\000\006\168\015\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r`\020\184\019\174\007J\011\184\015\150t\154B\178\020\004BjG\130\026\158\002\252\006\168\015\162\003\198\000\000\000\000\015T\000\000\000\000F\224\000\000\bX\012\172\000\000\rD\000\000\015\174\015Ro\180Yn\015\218\004<\000\000\000\000\015\136\000\000\000\000\028n\007r\011\186\000\000\015\222u<\131\030\005\b\015~o\180\012\238\000\000\000\000\015\148\000\000\000\000\000\000F\224\000\000\t\132\012\210\000\000\r\150\000\000\015\242\015\128M \000\000\016\000u\222\136J\005\b\015\162o\180\012\244\000\000\000\000\015\182\000\000\000\000\000\000\020\004\000\000F\224\000\000\020&\019\206B\178B\178w\196B\154\020\004\130\014T\208\011&\000\000\011.\000V\000\000\r\144B\178o\180\012\128\005|\000\000\020\004U\184t\154B\178\nBB\178\000\000DfEH\000\000`>\000\000\000\000`\214\000\000\000\000an\000\000\r\172B\178b\006\130\014T\208\011&\000\000\000\"\000\000\000\000N\018\012l\000\000\000\000L\028\016\028\000\000F\224\000\000B\178L\028F\224\000\000\020\004o\180F\224\000\000\r`\000\000\000\000F\224\000\000\000\000G\130\000\000\131JN\018\015\202B\178\131\202t\154\000\000s\172\135\176\019\174\007J\011\184\016 t\154s\172\135\176\000\000\000\000\000\000\137zO\006\000\000\000\000\000\000\000\000\000\000\000\000\133\232s\172\000\000\135V\000\000\000\000\000\000\000\000h \137z\000\000\016V\000\000\000\000\133\232\016b\000\000h \137z\000\000\000\000\r\196\000\000\000\000e\230\026\024\000\000\000\000@\160\000\000o\180\r`\000\000G\130\r\238\000\000\000\000\000\000\r\184\000\000\000\000\000\000Ej\019\168\020\180\004\174\000\000Fz\000\000\030\016\000\000\001\180\000\000\000\000\016l\000\000\016\150{R\000\000?\202\016t\000\000\000\000\016j\0268\022h\000\142x>\007:\020\004\000\000s\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000xP\007:\020\004\000\000\r\242y\018\000\000\129\150\000\000\016z\0268\022hs\172\000\000\016\158\000\000\006\162\r\\\020\004K\150\000\000\000\000\028F\\\234\000\000\000\000\0160\000\000\016\132o\180\000\000\r\138\n\138\005|\000\000\000\000o\180\007\246\b\198\000\000o\180\t\b\006\168\016\170\000\000\000\000\128~\000\000\000\000\132:\000\000tv\000\000\016\162\0268\023\\h \000\000\000\000\000\000\000\000\0144y\018\132:\000\000tv\000\000\016\164\0268\023\\h \000\000\014T\000\000\000\000\030\220\000\000s\172\000\000\016\188\000\000\000\000\016,\000\000\0166\000\000\016J\000\000\000\000K \016f\000\000\000\000o\180\000\000\r\168\000\000\000\000\016h\000\000\000\000T\208\031\150\000\000\000\000H\194\0032\129<\000\000\000\000\000\000\000\000\000\000w<\023l\000\000\000\000\017\b\000\000JV\000\000\014D\017\n\000\000\017\012\000\000I\168I\168\138\\\138\\\000\000\000\000sN\138\\\000\000\000\000\000\000sN\138\\\016~\000\000\016\132\000\000"), (16, "\b\185\b\185\000\006\002\026\005\253\b\185\002\134\002\138\b\185\002\182\002\194\b\185\003V\b\185\006R\002\198\b\185\023n\b\185\b\185\b\185\002\030\b\185\b\185\005\253\006\174\006\178\002\202\b\185\003\n\003\014\t\170\b\185\011\218\b\185\003\206\003\018\023r\002\206\006\182\b\185\b\185\003\150\003\154\b\185\003\158\002\250\003\170\003\178\006\142\004-\b\185\b\185\002~\001j\b\162\003\006\b\185\b\185\b\185\007\214\007\218\007\230\007\250\004-\0056\b\185\b\185\b\185\b\185\b\185\b\185\b\185\b\185\b\185\bn\000\238\b\185\0156\b\185\b\185\002N\bz\b\146\b\230\005B\005F\b\185\b\185\b\185\004-\b\185\b\185\b\185\b\185\b\166\b\194\r\150\b\185\003Z\b\185\b\185\000\238\b\185\b\185\b\185\b\185\b\185\b\185\005J\007\238\b\185\b\185\b\185\b\006\004\018\b\250\015:\b\185\b\185\b\185\b\185\012]\012]\023v\006V\006\005\012]\003}\012]\012]\015F\012]\012]\012]\012]\0046\012]\012]\0061\012]\012]\012]\001\186\012]\012]\006\005\012]\004-\012]\012]\012]\012]\012]\012]\012]\012]\015N\001*\0061\012]\004\162\012]\012]\012]\012]\012]\000\238\012]\012]\017\186\012]\003\174\012]\012]\012]\001v\001\186\012]\012]\012]\012]\012]\012]\012]\000\238\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\003}\012]\012]\0022\012]\012]\004\146\003*\001f\004-\012]\012]\012]\012]\012]\001r\012]\012]\012]\012]\012]\025\022\012]\012]\004>\012]\012]\003.\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\012]\025\026\004-\012]\012]\012]\012]\001\153\001\153\001\153\0042\006\226\001\153\001\162\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\166\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\007\030\b\149\001\153\0026\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\004\150\001\153\001\153\001\153\004B\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\006=\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\n\134\001\153\001\153\n\146\0036\006=\007\222\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\014~\b\030\001\153\005v\001\153\001\153\003:\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\149\001\153\001\153\001\153\001\153\001\153\t\237\t\237\018\178\001\002\001\170\t\237\0036\t\237\t\237\003y\t\237\t\237\t\237\t\237\001\186\t\237\t\237\001~\t\237\t\237\t\237\001b\t\237\t\237\018\186\t\237\003:\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\001n\005\254\001z\t\237\004-\t\237\t\237\t\237\t\237\t\237\007\173\t\237\t\237\rf\t\237\001\194\t\237\t\237\t\237\002f\004-\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004-\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\000\238\t\237\t\237\003y\t\237\t\237\004-\001\002\001\170\004Z\t\237\t\237\t\237\t\237\t\237\001\198\t\237\t\237\t\237\t\237\t\018\006j\tB\t\237\001\186\t\237\t\237\003\218\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004-\t\237\t\237\t\237\t\237\t\237\003\153\003\153\004-\003\222\0042\003\153\006\173\003\153\003\153\001\178\003\153\003\153\003\153\003\153\000\238\003\153\003\153\002B\003\153\003\153\003\153\t\022\003\153\003\153\015V\003\153\007\154\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\r\018\001\210\r\030\003\153\000\238\003\153\003\153\003\153\003\153\003\153\bM\003\153\003\153\003)\003\153\001\186\003\153\003\153\003\153\007\210\004J\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003)\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\138\t\n\t:\011\130\003\153\003\153\005\006\000\238\001\214\021\166\003\153\003\153\003\153\003\153\003\153\002\162\003\153\003\153\003\153\003\153\t\018\015\182\tB\003\153\n\134\003\153\003\153\n\146\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\170\003\153\003\153\003\153\003\153\003\153\003\141\003\141\001\002\001\170\bM\003\141\003\237\003\141\003\141\024\254\003\141\003\141\003\141\003\141\b\129\003\141\003\141\005\n\003\141\003\141\003\141\021\238\003\141\003\141\012\170\003\141\003\206\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\007\154\n\134\014\254\003\141\n\146\003\141\003\141\003\141\003\141\003\141\000\238\003\141\003\141\000\238\003\141\004\150\003\141\003\141\003\141\005\153\015\006\003\141\003\141\003\141\003\141\003\141\003\141\003\141\014\230\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\237\t\n\t:\007\018\003\141\003\141\b\210\006b\006z\005\018\003\141\003\141\003\141\003\141\003\141\002\226\003\141\003\141\003\141\003\141\t\018\025\002\tB\003\141\002\138\003\141\003\141\014r\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\0042\003\141\003\141\003\141\003\141\003\141\ti\ti\b\145\014v\006\r\ti\003R\ti\ti\005\153\ti\ti\ti\ti\014\n\ti\ti\002\218\ti\ti\ti\014\178\ti\ti\006\r\ti\004-\ti\ti\ti\ti\ti\ti\ti\ti\004-\004-\004\230\ti\004-\ti\ti\ti\ti\ti\007Z\ti\ti\000\238\ti\012.\ti\ti\ti\001\130\004\018\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\bj\ti\ti\b\145\006\130\015\254\004-\ti\ti\ti\ti\ti\004-\ti\ti\ti\ti\ti\018\134\ti\ti\003b\ti\ti\003f\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\007\222\004-\ti\ti\ti\ti\ta\ta\004\178\014\014\n\234\ta\b}\ta\ta\018\142\ta\ta\ta\ta\004-\ta\ta\005\129\ta\ta\ta\003q\ta\ta\n\238\ta\014\186\ta\ta\ta\ta\ta\ta\ta\ta\007\154\014\150\015^\ta\006\238\ta\ta\ta\ta\ta\005y\ta\ta\000\238\ta\012F\ta\ta\ta\000\238\006\246\ta\ta\ta\ta\ta\ta\ta\000\238\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\004-\ta\ta\002\138\ta\ta\002\194\tN\018F\011\006\ta\ta\ta\ta\ta\004F\ta\ta\ta\ta\ta\bB\ta\ta\r\218\ta\ta\tR\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\tv\017>\ta\ta\ta\ta\tq\tq\002\209\004-\012\145\tq\014\154\tq\tq\017B\tq\tq\tq\tq\004n\tq\tq\012\145\tq\tq\tq\r\226\tq\tq\004-\tq\000\n\tq\tq\tq\tq\tq\tq\tq\tq\005F\000\238\004\246\tq\nZ\tq\tq\tq\tq\tq\bQ\tq\tq\0042\tq\012^\tq\tq\tq\002\209\tN\tq\tq\tq\tq\tq\tq\tq\be\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\012r\tq\tq\006\210\tq\tq\004\194\000\238\006\170\002Z\tq\tq\tq\tq\tq\004\238\tq\tq\tq\tq\tq\021\198\tq\tq\019\026\tq\tq\000\238\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\006\170\001*\tq\tq\tq\tq\tQ\tQ\002\209\014:\bQ\tQ\004\150\tQ\tQ\021\206\tQ\tQ\tQ\tQ\006\018\tQ\tQ\005y\tQ\tQ\tQ\011\222\tQ\tQ\be\tQ\000\n\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\011\238\006\022\011\254\tQ\005\210\tQ\tQ\tQ\tQ\tQ\026\030\tQ\tQ\015>\tQ\012v\tQ\tQ\tQ\002\209\017\198\tQ\tQ\tQ\tQ\tQ\tQ\tQ\r\246\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\r.\tQ\tQ\bi\tQ\tQ\006f\014>\r\250\000\238\tQ\tQ\tQ\tQ\tQ\002\254\tQ\tQ\tQ\tQ\tQ\002\230\tQ\tQ\002\138\tQ\tQ\014\162\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\018V\000\238\tQ\tQ\tQ\tQ\tY\tY\022R\014\166\007\142\tY\026\"\tY\tY\006\170\tY\tY\tY\tY\002\234\tY\tY\003\198\tY\tY\tY\012\030\tY\tY\022Z\tY\b\129\tY\tY\tY\tY\tY\tY\tY\tY\0126\r2\012N\tY\bi\tY\tY\tY\tY\tY\007\165\tY\tY\000\238\tY\012\138\tY\tY\tY\n\202\004\254\tY\tY\tY\tY\tY\tY\tY\000\238\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\0026\tY\tY\011\"\tY\tY\006v\014\194\018\146\b\129\tY\tY\tY\tY\tY\006\190\tY\tY\tY\tY\tY\004-\tY\tY\002\230\tY\tY\016\146\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\016\158\b\129\tY\tY\tY\tY\t\145\t\145\011\018\b\190\005\133\t\145\000\238\t\145\t\145\011\018\t\145\t\145\t\145\t\145\001\186\t\145\t\145\003\210\t\145\t\145\t\145\012\174\t\145\t\145\004\150\t\145\000\238\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\012\194\011F\012\214\t\145\014\198\t\145\t\145\t\145\t\145\t\145\023\026\t\145\t\145\000\238\t\145\012\158\t\145\t\145\t\145\002f\018\138\t\145\t\145\t\145\t\145\t\145\t\145\t\145\005\137\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\011\026\t\145\t\145\017\022\t\145\t\145\018\250\015r\018\190\026\006\t\145\t\145\t\145\t\145\t\145\nZ\t\145\t\145\t\145\t\145\t\145\004-\t\145\t\145\004F\t\145\t\145\011\190\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\019\018\007^\t\145\t\145\t\145\t\145\t\129\t\129\011\194\018\182\007\177\t\129\002\230\t\129\t\129\018v\t\129\t\129\t\129\t\129\011\190\t\129\t\129\004N\t\129\t\129\t\129\002\174\t\129\t\129\007\181\t\129\000\238\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\001\198\012\134\004E\t\129\019z\t\129\t\129\t\129\t\129\t\129\017N\t\129\t\129\000\238\t\129\012\186\t\129\t\129\t\129\b\222\011\018\t\129\t\129\t\129\t\129\t\129\t\129\t\129\022\014\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\019&\t\129\t\129\019f\t\129\t\129\022\230\004E\002\233\007\165\t\129\t\129\t\129\t\129\t\129\t&\t\129\t\129\t\129\t\129\t\129\018N\t\129\t\129\t.\t\129\t\129\014*\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\0042\014\206\t\129\t\129\t\129\t\129\ty\ty\014.\019\006\023~\ty\018\210\ty\ty\019~\ty\ty\ty\ty\001\186\ty\ty\014\210\ty\ty\ty\t>\ty\ty\023\130\ty\007.\ty\ty\ty\ty\ty\ty\ty\ty\015\130\022\254\nr\ty\003e\ty\ty\ty\ty\ty\020\014\ty\ty\n\170\ty\012\206\ty\ty\ty\018\238\019J\ty\ty\ty\ty\ty\ty\ty\n\206\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\021\202\ty\ty\007.\ty\ty\022V\017\166\012\153\004F\ty\ty\ty\ty\ty\n\254\ty\ty\ty\ty\ty\017\222\ty\ty\004F\ty\ty\012\165\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\021\210\019&\ty\ty\ty\ty\t\137\t\137\019\030\011.\023\190\t\137\000\238\t\137\t\137\000\238\t\137\t\137\t\137\t\137\r>\t\137\t\137\020\018\t\137\t\137\t\137\025\202\t\137\t\137\024\198\t\137\007\129\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\022^\022.\005}\t\137\022\142\t\137\t\137\t\137\t\137\t\137\026\002\t\137\t\137\024\226\t\137\012\226\t\137\t\137\t\137\024\158\rF\t\137\t\137\t\137\t\137\t\137\t\137\t\137\000\238\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\024\210\t\137\t\137\007\169\t\137\t\137\rZ\004\193\r\138\001\186\t\137\t\137\t\137\t\137\t\137\r\182\t\137\t\137\t\137\t\137\t\137\023\194\t\137\t\137\000\238\t\137\t\137\022\242\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\023R\001\186\t\137\t\137\t\137\t\137\t\217\t\217\025\150\007.\026\166\t\217\026\018\t\217\t\217\027\003\t\217\t\217\t\217\t\217\004E\t\217\t\217\007.\t\217\t\217\t\217\014\250\t\217\t\217\024\162\t\217\015\026\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\026z\015B\024\230\t\217\015J\t\217\t\217\t\217\t\217\t\217\024\214\t\217\t\217\015f\t\217\012\238\t\217\t\217\t\217\002\174\015j\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015\146\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015\166\t\217\t\217\015\190\t\217\t\217\015\210\015\250\016\014\016\162\t\217\t\217\t\217\t\217\t\217\016\182\t\217\t\217\t\217\t\217\t\217\026\170\t\217\t\217\017\014\t\217\t\217\017\026\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\003\190\005\206\t\217\t\217\t\217\t\217\003\137\003\137\017\226\017\230\017\250\003\137\017\254\003\137\003\137\018^\003\137\003\137\003\137\003\137\018b\003\137\003\137\018\154\003\137\003\137\003\137\018\158\003\137\003\137\018\198\003\137\018\202\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\018\246\019\174\019\178\003\137\019\214\003\137\003\137\003\137\003\137\003\137\019\218\003\137\003\137\019\234\003\137\019\250\003\137\003\137\003\137\020\006\020B\003\137\003\137\003\137\003\137\003\137\003\137\003\137\020F\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\020\146\t\n\t:\020\186\003\137\003\137\020\190\020\206\021\030\021>\003\137\003\137\003\137\003\137\003\137\021~\003\137\003\137\003\137\003\137\t\018\021\162\tB\003\137\021\178\003\137\003\137\021\218\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\021\222\003\137\003\137\003\137\003\137\003\137\001\221\001\221\021\234\021\250\022\022\001\221\022&\002\138\001\221\022:\002\194\001\221\t\"\001\221\022f\002\198\001\221\022j\001\221\001\221\001\221\022v\001\221\001\221\022\134\t*\022\154\002\202\001\221\001\221\001\221\001\221\001\221\t2\001\221\023\142\023\230\024\014\002\206\024v\001\221\001\221\001\221\001\221\001\221\024\134\002\250\001\170\025\"\001\221\025*\001\221\001\221\002~\025:\025F\003\006\001\221\001\221\001\221\007\214\007\218\007\230\025\170\012\018\0056\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\025\190\t\n\t:\025\238\001\221\001\221\025\246\0262\026Z\026\146\005B\005F\001\221\001\221\001\221\026\194\001\221\001\221\001\221\001\221\012\026\026\206\012f\001\221\026\214\001\221\001\221\026\223\001\221\001\221\001\221\001\221\001\221\001\221\005J\007\238\001\221\001\221\001\221\b\006\004\018\026\239\027\015\001\221\001\221\001\221\001\221\t\193\t\193\027[\027o\027w\t\193\027\179\002\138\t\193\027\187\002\194\t\193\t\193\t\193\000\000\002\198\t\193\000\000\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\000\000\002\202\t\193\t\193\t\193\t\193\t\193\t\193\t\193\000\000\000\000\000\000\002\206\000\000\t\193\t\193\t\193\t\193\t\193\000\000\002\250\001\170\000\000\t\193\000\000\t\193\t\193\002~\000\000\000\000\003\006\t\193\t\193\t\193\007\214\007\218\007\230\000\000\t\193\0056\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\000\000\000\000\000\000\000\000\005B\005F\t\193\t\193\t\193\000\000\t\193\t\193\t\193\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\000\000\t\193\t\193\t\193\t\193\t\193\t\193\005J\007\238\t\193\t\193\t\193\b\006\004\018\000\000\000\000\t\193\t\193\t\193\t\193\t\189\t\189\000\000\000\000\000\000\t\189\000\000\002\138\t\189\000\000\002\194\t\189\t\189\t\189\000\000\002\198\t\189\000\000\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\000\000\002\202\t\189\t\189\t\189\t\189\t\189\t\189\t\189\000\000\000\000\000\000\002\206\000\000\t\189\t\189\t\189\t\189\t\189\000\000\002\250\001\170\000\000\t\189\000\000\t\189\t\189\002~\000\000\000\000\003\006\t\189\t\189\t\189\007\214\007\218\007\230\000\000\t\189\0056\t\189\t\189\t\189\t\189\t\189\t\189\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\000\000\000\000\000\000\000\000\005B\005F\t\189\t\189\t\189\000\000\t\189\t\189\t\189\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\000\000\t\189\t\189\t\189\t\189\t\189\t\189\005J\007\238\t\189\t\189\t\189\b\006\004\018\000\000\000\000\t\189\t\189\t\189\t\189\002)\002)\000\000\000\000\000\000\002)\000\000\002\138\002)\000\000\002\194\002)\t\"\002)\000\000\002\198\002)\000\000\002)\002)\002)\000\000\002)\002)\000\000\t*\000\000\002\202\002)\002)\002)\002)\002)\t2\002)\007\153\000\000\000\000\002\206\007\153\002)\002)\002)\002)\002)\000\000\002\250\001\170\000\000\002)\000\000\002)\002)\002~\000\000\000\000\003\006\002)\002)\002)\007\214\007\218\007\230\000\000\012\018\0056\002)\002)\002)\002)\002)\002)\002)\002)\002)\007\153\004\149\002)\000\000\002)\002)\000\000\000\000\004-\000\000\005B\005F\002)\002)\002)\004-\002)\002)\002)\002)\0066\007\153\000\000\002)\004\149\002)\002)\004-\002)\002)\002)\002)\002)\002)\005J\007\238\002)\002)\002)\b\006\004\018\000\000\000\000\002)\002)\002)\002)\004-\000\000\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004\190\004-\000\238\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\000\000\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004-\002\230\004-\004-\004-\004-\004-\004-\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\000\000\004-\006\222\000\000\004-\004-\004-\000\238\004-\000\000\000\000\004-\004-\004-\004-\004-\004-\004-\004-\004-\b\"\001\170\004-\004-\003\142\002\209\002\138\004-\002\209\018:\r\254\004-\004-\003n\014\030\0142\014B\000\000\000\000\004-\004-\004-\007J\000\000\004-\004-\004-\004-\000\000\000\129\004-\000\129\000\n\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\238\000\129\022\186\000\129\000\129\003\138\000\129\000\129\002\209\000\000\000\129\000\129\002~\000\129\000\129\000\000\000\129\000\000\000\129\000\129\002\209\002\209\000\129\000\129\000\000\000\129\000\129\000\129\000\000\000\129\015\014\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\230\006\162\000\129\000\129\012I\0125\000\129\000\129\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\000\000\000\000\000\000\000\012I\000\129\000\000\000\129\000\000\000\129\002\006\006}\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\b\"\014\130\002\014\000\129\000\000\002\018\0125\000\000\000\222\006>\r\254\b\169\000\129\006}\014\030\0142\014B\007\166\000\129\000\129\000\129\000\129\000\000\000\000\000\129\000\129\000\129\000\129\002\025\002\025\014b\000\000\000\000\002\025\b\169\002\138\002\025\007\170\002\194\002\025\000\000\002\025\000\000\002\198\002\025\007&\002\025\002\025\002\025\000\000\002\025\002\025\000\000\007.\000\000\002\202\002\025\002\025\002\025\002\025\002\025\0072\002\025\007\154\000\000\000\000\002\206\000\000\002\025\002\025\002\025\002\025\002\025\006\149\002\250\007\234\000\238\002\025\000\000\002\025\002\025\002~\000\000\000\000\003\006\002\025\002\025\002\025\007\214\007\218\007\230\000\000\006\149\0056\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\t\n\t:\0156\002\025\002\025\002N\000\000\000\000\000\000\005B\005F\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\t\018\007\174\tB\002\025\000\000\002\025\002\025\000\000\002\025\002\025\002\025\002\025\002\025\002\025\005J\007\238\002\025\002\025\002\025\b\006\004\018\000\000\015:\002\025\002\025\002\025\002\025\0025\0025\006\149\000\000\006\170\0025\007=\000\000\0025\015F\000\000\0025\007\226\0025\b\173\000\000\0025\000\000\0025\0025\0025\002\138\0025\0025\000\000\000\000\b\157\000\000\0025\0025\0025\0025\0025\000\000\0025\015N\007=\b\173\000\000\000\000\0025\0025\0025\0025\0025\006\030\000\000\017\170\b\157\0025\007=\0025\0025\007=\bb\005\218\000\000\0025\0025\0025\007=\003\198\025N\017\182\007=\017\198\0025\0025\0025\0025\0025\0025\0025\0025\0025\005\222\t\n\t:\0156\0025\0025\002N\000\000\000\000\000\000\000\238\002\230\0025\0025\0025\000\000\0025\0025\0025\0025\t\018\000\000\tB\0025\000\000\0025\0025\000\000\0025\0025\0025\0025\0025\0025\b9\000\000\0025\0025\0025\000\238\b\246\000\000\015:\0025\0025\0025\0025\0021\0021\000\000\001\002\001\170\0021\000\000\005\226\0021\015F\005\166\0021\000\000\0021\000\000\b\157\0021\005\238\0021\0021\0021\005\250\0021\0021\b9\000\000\000\000\000\000\0021\0021\0021\0021\0021\000\000\0021\015N\005\226\000\000\000\000\005\166\0021\0021\0021\0021\0021\b9\005\238\000\000\000\000\0021\005\250\0021\0021\000\000\000\000\007z\006\222\0021\0021\0021\000\000\000\000\020\234\000\000\000\000\000\000\0021\0021\0021\0021\0021\0021\0021\0021\0021\007~\t\n\t:\b9\0021\0021\000\000\004\190\000\000\000\000\b9\001\186\0021\0021\0021\000\000\0021\0021\0021\0021\t\018\007J\tB\0021\000\000\0021\0021\000\000\0021\0021\0021\0021\0021\0021\b5\000\000\0021\0021\0021\000\238\018f\007\182\006\222\0021\0021\0021\0021\002\029\002\029\002\209\000\000\018\238\002\029\018\242\000\000\002\029\000\000\002~\002\029\000\000\002\029\007\186\000\000\002\029\019\n\002\029\002\029\002\029\000\000\002\029\002\029\b5\000\000\000\n\012\r\002\029\002\029\002\029\002\029\002\029\000\000\002\029\007J\000\000\006\145\000\000\000\000\002\029\002\029\002\029\002\029\002\029\b5\012\r\012\r\000\000\002\029\012\r\002\029\002\029\000\238\002\209\000\000\006\145\002\029\002\029\002\029\006\145\014J\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\000\000\t\n\t:\b5\002\029\002\029\000\000\004\190\000\000\000\000\b5\000\238\002\029\002\029\002\029\000\000\002\029\002\029\002\029\002\029\t\018\000\238\tB\002\029\000\000\002\029\002\029\000\000\002\029\002\029\002\029\002\029\002\029\002\029\017v\000\000\002\029\002\029\002\029\000\000\000\000\012\r\000\000\002\029\002\029\002\029\002\029\002-\002-\000\000\000\000\006\145\002-\nE\006\222\002-\n\158\000\000\002-\000\000\002-\t\n\t:\002-\000\000\002-\002-\002-\000\000\002-\002-\002\209\016j\016>\000\000\002-\002-\002-\002-\002-\t\018\002-\tB\nE\000\000\002\209\004\153\002-\002-\002-\002-\002-\006:\002\138\007J\000\n\002-\nE\002-\002-\nE\011>\024\174\006\222\002-\002-\002-\nE\000\000\004\153\000\000\nE\000\238\002-\002-\002-\002-\002-\002-\002-\002-\002-\024\178\002\209\002-\007\165\002-\002-\007\165\000\000\000\000\000\000\000\000\003\198\002-\002-\002-\000\000\002-\002-\002-\002-\000\000\007J\022\014\002-\000\000\002-\002-\000\000\tZ\002-\002-\002-\002-\002-\012\021\016B\002-\002-\002-\000\238\000\000\000\000\007\165\002-\002-\002-\002-\b\181\b\181\000\000\000\000\004-\b\181\012\021\012\021\b\181\007\165\012\021\b\181\000\000\b\181\000\000\000\000\t\130\000\000\b\181\t\166\b\181\000\000\b\181\b\181\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\b\181\007\165\000\000\000\000\000\000\004-\b\181\b\181\t\234\t\242\b\181\000\000\000\238\004-\000\000\b\181\000\000\t\250\b\181\000\000\000\000\000\000\000\000\b\181\b\181\000\238\000\000\000\000\007\165\000\000\000\000\000\000\b\181\b\181\t\138\t\202\n\002\n\n\n\026\b\181\b\181\000\000\012\021\b\181\000\000\b\181\n\"\000\000\000\000\000\000\000\000\012)\007\149\b\181\b\181\n*\007\149\b\181\b\181\b\181\b\181\000\000\000\000\012)\b\181\000\000\b\181\b\181\000\000\nJ\b\181\nR\n\018\b\181\b\181\012\017\000\000\b\181\n2\b\181\021\150\000\000\000\000\006\222\b\181\b\181\n:\nB\002a\002a\000\000\012)\007\149\002a\012\017\012\017\002a\000\000\012\017\002a\000\000\002a\007\134\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\000\000\007\149\000\000\000\000\002a\002a\002a\002a\002a\012)\002a\007J\012)\006\165\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\238\000\000\000\000\002a\000\000\002a\002a\000\238\000\000\000\000\006\165\002a\002a\002a\006\165\000\000\004\190\002r\000\000\000\000\002a\002a\t\138\002a\002a\002a\002a\002a\002a\000\000\012\017\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\001\186\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\025\222\000\000\002a\002a\002a\004-\011R\000\000\000\000\002a\002a\002a\002a\002I\002I\000\000\000\000\005&\002I\000\238\011Z\002I\000\n\011f\002I\000\000\002I\004-\002f\002I\011r\002I\002I\002I\011~\002I\002I\002\209\002\209\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\004-\0075\002\209\000\000\000\000\002I\002I\002I\002I\002I\004Z\000\000\000\238\004\197\002I\0075\002I\002I\005\166\000\000\000\000\006\222\002I\002I\002I\0075\000\000\000\000\000\000\0075\000\000\002I\002I\t\138\002I\002I\002I\002I\002I\002I\bN\006\222\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\007M\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\016.\007J\000\000\002I\000\000\002I\002I\022\006\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\002I\000\238\007M\007J\000\000\002I\002I\002I\002I\002U\002U\000\000\000\000\000\000\002U\000\238\007M\002U\000\000\005\166\002U\000\238\002U\000\000\000\000\t\130\007M\002U\002U\002U\007M\002U\002U\000\000\000\000\000\000\000\000\002U\002U\002U\t\194\002U\000\000\002U\000\000\007i\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\005\226\002U\002U\005\166\000\000\000\000\006\222\002U\002U\002U\007i\000\000\000\000\000\000\007i\000\000\002U\002U\t\138\t\202\002U\002U\002U\002U\002U\016J\006\222\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007a\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\025\014\007J\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\238\007a\007J\000\000\002U\002U\002U\002U\002e\002e\000\000\000\000\000\000\002e\000\238\011\150\002e\000\000\007a\002e\000\238\002e\000\000\000\000\002e\007a\002e\002e\002e\007a\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\002e\000\000\0071\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\000\000\000\000\000\002e\0071\002e\002e\005\166\000\000\000\000\006\222\002e\002e\002e\0071\000\000\000\000\000\000\0071\000\000\002e\002e\t\138\002e\002e\002e\002e\002e\002e\026\178\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\000\000\002e\002e\002e\000\000\002e\002e\002e\002e\000\000\007J\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\238\r\206\000\000\000\000\002e\002e\002e\002e\002E\002E\000\000\000\000\000\000\002E\000\000\011Z\002E\000\000\011f\002E\000\000\002E\000\000\000\000\002E\011r\002E\002E\002E\011~\002E\002E\000\000\000\000\000\000\006\181\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\006\149\000\000\000\000\002E\002E\002E\002E\002E\000\000\006\181\000\000\000\000\002E\006\181\002E\002E\000\000\000\000\000\000\006\149\002E\002E\002E\006\149\000\000\000\000\000\000\000\000\000\000\002E\002E\t\138\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\000\238\000\000\002E\002E\002E\000\000\002E\002E\002E\002E\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\002E\000\000\000\000\006\181\027\031\002E\002E\002E\002E\002Q\002Q\000\000\000\000\007\226\002Q\000\000\005\226\002Q\n\134\005\166\002Q\n\146\002Q\000\000\000\000\t\130\005\238\002Q\002Q\002Q\005\250\002Q\002Q\000\000\000\000\000\000\006\141\002Q\002Q\002Q\t\194\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\006\141\000\000\000\000\002Q\006\141\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\t\138\t\202\002Q\002Q\002Q\002Q\002Q\000\000\002\230\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\005z\006\141\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\003\182\000\000\002M\000\000\006\006\002M\003\194\000\000\002M\003\230\002M\000\000\000\000\t\130\000\000\002M\002M\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\t\194\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\t\138\t\202\002M\002M\002M\002M\002M\000\000\002\138\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\002M\000\000\tF\003\198\000\000\002M\002M\002M\002M\002u\002u\000\000\000\000\000\000\002u\000\000\011\182\002u\011\198\000\000\002u\000\000\002u\000\000\000\000\t\130\000\000\002u\002u\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\t\234\t\242\002u\000\000\000\000\000\000\000\000\002u\000\000\t\250\002u\000\000\000\000\000\000\000\000\002u\002u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\t\138\t\202\n\002\n\n\n\026\002u\002u\000\000\002\138\002u\000\000\002u\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\n*\000\000\002u\002u\002u\002u\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\n\018\002u\002u\000\000\000\000\002u\n2\002u\000\000\012j\003\198\000\000\002u\002u\n:\nB\002]\002]\000\000\000\000\000\000\002]\000\000\012~\002]\012\146\000\000\002]\000\000\002]\000\000\000\000\t\130\000\000\002]\002]\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\t\194\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\138\t\202\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\t\130\000\000\002Y\002Y\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\t\194\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\138\t\202\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002m\002m\000\000\000\000\000\000\002m\000\000\000\000\002m\000\000\000\000\002m\000\000\002m\000\000\000\000\t\130\000\000\002m\002m\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\t\234\t\242\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\138\t\202\n\002\n\n\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\n\018\002m\002m\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002A\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\t\130\000\000\002A\002A\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\t\194\002A\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002A\000\000\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\t\138\t\202\002A\002A\002A\002A\002A\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\002A\002A\002A\002A\002A\002A\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002=\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\t\130\000\000\002=\002=\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002=\000\000\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\t\234\t\242\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\002=\002=\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\t\138\t\202\n\002\n\n\002=\002=\002=\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\002=\002=\002=\002=\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\n\018\002=\002=\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\t\130\000\000\002\153\002\153\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\234\t\242\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\138\t\202\n\002\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\002\153\002\153\002\153\n\018\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\0029\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\t\130\000\000\0029\0029\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\t\234\t\242\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\t\138\t\202\n\002\n\n\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\n\018\0029\0029\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002q\002q\000\000\000\000\000\000\002q\000\000\000\000\002q\000\000\000\000\002q\000\000\002q\000\000\000\000\t\130\000\000\002q\002q\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002q\000\000\002q\000\000\000\000\000\000\000\000\000\000\002q\002q\t\234\t\242\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\t\138\t\202\n\002\n\n\002q\002q\002q\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\002q\002q\002q\002q\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\002q\002q\002q\n\018\002q\002q\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\002q\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\t\130\000\000\002i\002i\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\t\234\t\242\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\t\138\t\202\n\002\n\n\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\n\018\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\t\130\000\000\002y\002y\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\t\234\t\242\002y\000\000\000\000\000\000\000\000\002y\000\000\t\250\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\138\t\202\n\002\n\n\n\026\002y\002y\000\000\000\000\002y\000\000\002y\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n*\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\n\018\002y\002y\000\000\000\000\002y\n2\002y\000\000\000\000\000\000\000\000\002y\002y\n:\nB\002}\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\t\130\000\000\002}\002}\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\t\234\t\242\002}\000\000\000\000\000\000\000\000\002}\000\000\t\250\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\t\138\t\202\n\002\n\n\n\026\002}\002}\000\000\000\000\002}\000\000\002}\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\n*\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n\018\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\n:\nB\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\130\000\000\002\129\002\129\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\234\t\242\002\129\000\000\000\000\000\000\000\000\002\129\000\000\t\250\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\138\t\202\n\002\n\n\n\026\002\129\002\129\000\000\000\000\002\129\000\000\002\129\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n*\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n\018\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\n:\nB\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\000\000\000\000\bq\000\000\bq\000\000\000\000\t\130\000\000\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\bq\000\000\000\000\000\000\000\000\000\000\bq\bq\t\234\t\242\bq\000\000\000\000\000\000\000\000\bq\000\000\t\250\bq\000\000\000\000\000\000\000\000\bq\bq\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bq\bq\t\138\t\202\n\002\n\n\n\026\bq\bq\000\000\000\000\bq\000\000\bq\n\"\000\000\000\000\000\000\000\000\000\000\000\000\bq\bq\n*\000\000\bq\bq\bq\bq\000\000\000\000\000\000\bq\000\000\bq\bq\000\000\bq\bq\bq\n\018\bq\bq\000\000\000\000\bq\n2\bq\000\000\000\000\000\000\000\000\bq\bq\n:\nB\002\133\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\t\130\000\000\002\133\002\133\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\234\t\242\002\133\000\000\000\000\000\000\000\000\002\133\000\000\t\250\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\138\t\202\n\002\n\n\n\026\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n*\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\nJ\002\133\nR\n\018\002\133\002\133\000\000\000\000\002\133\n2\002\133\000\000\000\000\000\000\000\000\002\133\002\133\n:\nB\bm\bm\000\000\000\000\000\000\bm\000\000\000\000\bm\000\000\000\000\bm\000\000\bm\000\000\000\000\t\130\000\000\bm\bm\bm\000\000\bm\bm\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\bm\000\000\000\000\000\000\000\000\000\000\bm\bm\t\234\t\242\bm\000\000\000\000\000\000\000\000\bm\000\000\t\250\bm\000\000\000\000\000\000\000\000\bm\bm\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bm\bm\t\138\t\202\n\002\n\n\n\026\bm\bm\000\000\000\000\bm\000\000\bm\n\"\000\000\000\000\000\000\000\000\000\000\000\000\bm\bm\n*\000\000\bm\bm\bm\bm\000\000\000\000\000\000\bm\000\000\bm\bm\000\000\bm\bm\bm\n\018\bm\bm\000\000\000\000\bm\n2\bm\000\000\000\000\000\000\000\000\bm\bm\n:\nB\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\130\000\000\002\181\002\181\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\234\t\242\002\181\000\000\000\000\000\000\000\000\002\181\000\000\t\250\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\138\t\202\n\002\n\n\n\026\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n*\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\nJ\002\181\nR\n\018\002\181\002\181\000\000\000\000\002\181\n2\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n:\nB\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\130\000\000\002\177\002\177\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\234\t\242\002\177\000\000\000\000\000\000\000\000\002\177\000\000\t\250\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\138\t\202\n\002\n\n\n\026\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n*\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\nJ\002\177\nR\n\018\002\177\002\177\000\000\000\000\002\177\n2\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n:\nB\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\130\000\000\002\185\002\185\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\234\t\242\002\185\000\000\000\000\000\000\000\000\002\185\000\000\t\250\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\138\t\202\n\002\n\n\n\026\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n*\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\nJ\002\185\nR\n\018\002\185\002\185\000\000\000\000\002\185\n2\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n:\nB\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\t\130\000\000\002\165\002\165\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\234\t\242\002\165\000\000\000\000\000\000\000\000\002\165\000\000\t\250\002\165\000\000\000\000\000\000\000\000\002\165\002\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\138\t\202\n\002\n\n\n\026\002\165\002\165\000\000\000\000\002\165\000\000\002\165\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\n*\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\nJ\002\165\nR\n\018\002\165\002\165\000\000\000\000\002\165\n2\002\165\000\000\000\000\000\000\000\000\002\165\002\165\n:\nB\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\130\000\000\002\169\002\169\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\234\t\242\002\169\000\000\000\000\000\000\000\000\002\169\000\000\t\250\002\169\000\000\000\000\000\000\000\000\002\169\002\169\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\138\t\202\n\002\n\n\n\026\002\169\002\169\000\000\000\000\002\169\000\000\002\169\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n*\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\nJ\002\169\nR\n\018\002\169\002\169\000\000\000\000\002\169\n2\002\169\000\000\000\000\000\000\000\000\002\169\002\169\n:\nB\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\130\000\000\002\173\002\173\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\234\t\242\002\173\000\000\000\000\000\000\000\000\002\173\000\000\t\250\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\138\t\202\n\002\n\n\n\026\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n*\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\nJ\002\173\nR\n\018\002\173\002\173\000\000\000\000\002\173\n2\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n:\nB\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\130\000\000\002\193\002\193\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\234\t\242\002\193\000\000\000\000\000\000\000\000\002\193\000\000\t\250\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\138\t\202\n\002\n\n\n\026\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n*\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\nJ\002\193\nR\n\018\002\193\002\193\000\000\000\000\002\193\n2\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n:\nB\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\130\000\000\002\189\002\189\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\234\t\242\002\189\000\000\000\000\000\000\000\000\002\189\000\000\t\250\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\138\t\202\n\002\n\n\n\026\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n*\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\nJ\002\189\nR\n\018\002\189\002\189\000\000\000\000\002\189\n2\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n:\nB\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\130\000\000\002\197\002\197\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\234\t\242\002\197\000\000\000\000\000\000\000\000\002\197\000\000\t\250\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\138\t\202\n\002\n\n\n\026\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n*\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\nJ\002\197\nR\n\018\002\197\002\197\000\000\000\000\002\197\n2\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n:\nB\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\t\130\000\000\002\161\002\161\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\234\t\242\002\161\000\000\000\000\000\000\000\000\002\161\000\000\t\250\002\161\000\000\000\000\000\000\000\000\002\161\002\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\138\t\202\n\002\n\n\n\026\002\161\002\161\000\000\000\000\002\161\000\000\002\161\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n*\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\nJ\002\161\nR\n\018\002\161\002\161\000\000\000\000\002\161\n2\002\161\000\000\000\000\000\000\000\000\002\161\002\161\n:\nB\001\241\001\241\000\000\000\000\000\000\001\241\000\000\000\000\001\241\000\000\000\000\001\241\000\000\001\241\000\000\000\000\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\001\241\001\241\001\241\001\241\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\r\166\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\t\130\000\000\002\r\002\r\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\234\t\242\002\r\000\000\000\000\000\000\000\000\002\r\000\000\t\250\002\r\000\000\000\000\000\000\000\000\002\r\002\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\138\t\202\n\002\n\n\n\026\002\r\002\r\000\000\000\000\002\r\000\000\002\r\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\n*\000\000\002\r\002\r\r\190\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\nJ\002\r\nR\n\018\002\r\002\r\000\000\000\000\002\r\n2\002\r\000\000\000\000\000\000\000\000\002\r\002\r\n:\nB\002\t\002\t\000\000\000\000\000\000\002\t\000\000\000\000\002\t\000\000\000\000\002\t\000\000\002\t\000\000\000\000\t\130\000\000\002\t\002\t\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\234\t\242\002\t\000\000\000\000\000\000\000\000\002\t\000\000\t\250\002\t\000\000\000\000\000\000\000\000\002\t\002\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\138\t\202\n\002\n\n\n\026\002\t\002\t\000\000\000\000\002\t\000\000\002\t\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\n*\000\000\002\t\002\t\002\t\002\t\000\000\000\000\000\000\002\t\000\000\002\t\002\t\000\000\nJ\002\t\nR\n\018\002\t\002\t\000\000\000\000\002\t\n2\002\t\000\000\000\000\000\000\000\000\002\t\002\t\n:\nB\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\t\130\000\000\002\157\002\157\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\234\t\242\002\157\000\000\000\000\000\000\000\000\002\157\000\000\t\250\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\138\t\202\n\002\n\n\n\026\002\157\002\157\000\000\000\000\002\157\000\000\002\157\n\"\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\n*\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\nJ\002\157\nR\n\018\002\157\002\157\000\000\000\000\002\157\n2\002\157\000\000\000\000\000\000\000\000\002\157\002\157\n:\nB\001\253\001\253\000\000\000\000\000\000\001\253\000\000\000\000\001\253\000\000\000\000\001\253\000\000\001\253\000\000\000\000\001\253\000\000\001\253\001\253\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\001\253\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\001\253\001\253\001\253\001\253\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\001\253\r\166\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\000\000\000\000\000\000\006\169\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\006\169\003\233\000\000\002\001\006\169\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\238\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\b\142\002\001\002\001\r\166\000\000\000\000\003\233\000\000\002\001\002\001\002\001\002\001\001\006\000\000\000\006\000\000\000\000\024\186\002\134\002\138\005\226\002\182\002\194\005\166\b\174\000\000\000\000\002\198\001\n\000\000\005\238\000\000\002\254\000\000\005\250\000\000\000\000\000\000\r\146\003\002\001\018\b*\b.\001\030\001\"\000\000\000\000\000\000\003\018\000\000\002\206\000\000\024\238\000\000\bR\bV\000\238\003\158\002\250\003\170\bZ\006\142\bF\001:\000\000\002~\001\238\000\000\003\006\001\238\000\000\000\000\007\214\007\218\007\230\007\250\001\242\0056\000\000\001\242\001>\001B\001F\001J\001N\000\000\000\000\bn\001R\000\000\000\000\000\000\001V\000\000\bz\b\146\b\230\005B\005F\003^\005\226\001Z\003^\005\166\024\190\006\194\001\198\001^\006\194\001\198\005\238\000\000\002~\000\000\005\250\002~\000\000\001\134\n\202\000\000\000\000\005J\007\238\000\000\001\138\000\000\r\238\004\018\b\250\001\006\001\146\000\006\001\150\001\154\000\000\002\134\002\138\000\000\002\182\002\194\006\198\000\000\000\000\006\198\002\198\001\n\000\000\000\000\000\000\b&\000\000\000\000\000\000\000\000\000\000\000\000\003\002\001\018\b*\b.\001\030\001\"\000\000\000\000\000\000\003\018\000\000\002\206\000\000\b2\000\000\bR\bV\000\000\003\158\002\250\003\170\bZ\006\142\000\000\001:\000\000\002~\000\000\000\000\003\006\000\000\000\000\000\000\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\bn\001R\000\000\000\000\000\000\001V\000\000\bz\b\146\b\230\005B\005F\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\241\003\142\000\000\002\138\000\000\000\241\000\000\000\000\001\134\005\206\003n\000\000\005J\007\238\000\000\001\138\007\158\r\238\004\018\b\250\n\214\001\146\000\000\001\150\001\154\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\n\218\000>\003\138\002\138\000\241\000B\003\030\000\000\000\000\002~\000F\000\000\000\241\000\000\000\000\000\000\000J\000\241\000N\000R\000V\000Z\000^\000b\000f\000\000\000\241\000\241\000j\000n\000\000\000r\021\134\000v\000\000\000\000\000\000\006\162\000\000\000\238\000\000\000\000\022\194\002\218\000\000\022\198\000\000\000z\000\000\002~\000~\000\130\000\241\000\000\000\000\000\000\022\246\000\134\000\138\000\142\000\000\000\241\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\023\006\000\000\000\000\000\186\005\226\000\190\000\194\005\166\n\222\016&\000\000\000\000\000\000\000\198\005\238\000\202\001\238\000\000\005\250\000\000\000\000\000\206\000\210\004Y\000\214\000\006\001\242\000\000\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\000\000\002\198\000\000\000\000\003v\000\000\000\000\000\000\004Y\000\000\0166\016\210\003^\002\202\000\000\003\n\003\014\001\238\006\194\001\198\003z\000\000\003\018\000\000\002\206\002~\016f\001\242\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\000\000\000\000\007\214\007\218\007\230\007\250\003^\0056\000\000\006\198\000\000\000\000\006\194\001\198\000\000\016\234\000\000\bn\000\000\002~\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\004Y\004Y\000\000\000\000\001\182\001\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\198\000\000\017j\021j\005J\007\238\024\218\000\141\001\190\b\006\004\018\b\250\000\141\000\000\002\138\000\141\000\000\002\194\004E\t\"\000\000\000\000\002\198\004E\000\000\000\141\000\000\000\141\000\000\000\141\001\222\002f\t*\000\000\002\202\002j\000\000\002~\003\234\003\246\t2\000\141\000\000\000\000\004\002\002\206\015Z\000\141\000\000\000\000\000\000\000\141\000\000\002\250\001\170\000\000\000\141\000\000\000\000\000\141\002~\004\006\004E\003\006\000\141\000\141\000\141\007\214\007\218\007\230\004E\012\018\0056\000\141\000\141\004E\002\174\000\238\000\000\000\000\000\141\000\000\000\000\000\000\000\141\004E\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\141\000\141\000\000\000\000\000\141\000\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\002\209\004E\000\000\002\209\000\000\000\141\000\141\005J\007\238\000\000\004E\000\165\b\006\004\018\000\000\000\141\000\165\000\141\002\138\000\165\000\000\002\194\000\000\t\"\000\n\000\000\002\198\0156\001*\000\165\002N\000\165\000\000\000\165\000\000\002\209\t*\000\000\002\202\002\209\000\000\003&\002\209\000\000\t2\000\165\021\018\000\000\000\000\002\206\000\000\000\165\002\209\002\209\0032\000\165\000\000\002\250\001\170\000\n\000\165\000\000\000\000\000\165\002~\000\000\015:\003\006\000\165\000\165\000\165\007\214\007\218\007\230\002\209\012\018\0056\000\165\000\165\002\209\015F\002\209\0216\000\000\000\165\000\000\000\000\002\209\000\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\165\000\165\000\000\000\000\000\165\000\165\000\000\000\000\015N\001\006\000\000\002\209\000\000\000\000\000\165\003\"\002\138\b\206\021B\002\194\000\165\000\165\005J\007\238\002\198\001\n\000\000\b\006\004\018\002\254\000\165\000\000\000\165\000\000\016\218\020\214\001\014\001\018\001\022\003B\001\030\001\"\000\000\000\000\003~\000\000\000\000\000\000\000\000\003F\000\000\001.\n\198\007\133\000\000\003>\001\170\0016\000\000\000\249\001:\000\000\002~\000\000\000\249\003\182\025\006\000\000\000\000\003\186\000\000\003\194\005*\001\238\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\001\242\000\000\001R\005:\000\000\000\000\001V\000\238\000\000\000\000\000\000\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\000\000\000\249\001^\018n\003^\000\000\000\000\000\000\000\000\000\249\006\194\001\198\001\134\n\202\000\249\004E\005J\002~\000\000\001\138\004E\001\142\004\018\001\006\000\249\001\146\000\000\001\150\001\154\003\"\002\138\nj\005\226\002\194\000\000\005\166\000\000\000\000\002\198\001\n\000\000\000\000\005\238\002\254\000\000\006\198\005\250\000\000\000\000\000\249\001\014\001\018\001\022\003B\001\030\001\"\000\000\000\000\000\249\004E\000\000\000\000\000\000\003F\000\000\001.\n\198\004E\000\000\003>\001\170\0016\004E\002\174\001:\000\000\002~\000\000\000\000\003\182\000\000\004E\004E\003\186\000\000\003\194\005*\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\004q\000\000\000\000\001R\005:\021\146\000\000\001V\000\000\000\000\000\000\004E\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\004E\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\001\134\n\202\000\000\000\000\005J\002\209\000\000\001\138\000\000\001\142\004\018\001\006\022\002\001\146\000\000\001\150\001\154\003\"\002\138\rR\016\202\002\194\000\n\000\000\000\000\016\226\002\198\001\n\000\000\000\000\000\000\002\254\000\000\000\000\022\166\022\182\000\000\002\209\001\014\001\018\001\022\003B\001\030\001\"\002\209\000\000\000\000\000\000\000\000\000\000\002\209\003F\000\000\001.\n\198\000\000\000\000\003>\001\170\0016\004q\000\000\001:\000\000\002~\000\000\000\000\003\182\000\000\023\170\000\000\003\186\002\209\003\194\005*\000\000\0056\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005:\000\000\000\000\001V\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\001Z\000\000\000\000\000\000\000\000\006\150\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\134\n\202\000\000\000\000\005J\000\000\000\000\001\138\000\000\001\142\004\018\000\000\b\137\001\146\000\006\001\150\001\154\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\000\000\002\198\000\000\000\000\004y\000\000\000\000\000\000\b\137\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\000\000\003z\000\000\003\018\000\000\002\206\000\000\016f\000\000\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\001\182\001\186\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\234\000\000\bn\001\190\027*\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\027O\014\142\000\000\000\000\000\000\000\000\000\000\001\222\002n\000\000\000\000\000\000\002j\000\000\002~\003\234\003\246\021j\005J\007\238\b\137\004\002\000\000\b\006\004\018\b\250\000\006\000\000\000\000\000\246\002\134\002\138\002\142\002\182\002\194\000\000\000\000\000\000\004\006\002\198\000\000\025\230\027~\000\000\000\000\000\000\003\190\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\025\210\003z\000\000\003\018\000\000\002\206\000\000\016f\000\000\003\150\003\154\000\000\003\158\002\250\003\170\003\178\006\142\000\000\000\000\016\202\002~\000\000\000\000\003\006\016\226\000\000\000\000\007\214\007\218\007\230\007\250\000\000\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\234\000\000\bn\000\000\027*\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\016\254\017*\000\000\000\000\004\129\000\246\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\021j\005J\007\238\014\002\012)\012)\b\006\004\018\b\250\012)\000\000\012)\012)\003z\000\000\000\000\000\000\000\000\000\000\016f\012)\000\000\012)\012)\012)\000\000\012)\012)\024*\000\000\000\000\016\202\000\000\000\000\000\000\000\000\016\226\000\000\012)\000\000\000\000\000\000\000\000\000\000\012)\012)\000\000\000\000\012)\000\000\000\000\012)\016\234\012)\000\000\000\000\012)\000\000\000\000\000\000\000\000\012)\012)\012)\000\000\000\000\016\254\017*\000\000\000\000\012)\012)\000\000\000\000\000\000\000\000\000\000\012)\000\000\000\000\000\000\012)\000\000\000\000\012)\000\246\000\000\021j\001\250\000\000\000\000\012)\012)\012)\000\000\012)\012)\000\000\017n\000\000\000\000\000\000\000\000\000\000\000\000\012)\000\000\012)\012)\000\000\000\000\002b\012)\000\000\017r\000\000\000\000\012)\000\000\n]\017\154\012)\n]\012)\012)\n]\n]\000\000\000\000\n]\000\000\n]\016\202\000\000\n]\000\000\000\000\016\226\n]\n]\000\000\n]\n]\000\000\n]\001\182\001\186\000\000\000\000\n]\000\000\000\000\n]\018\018\000\000\000\000\000\000\000\000\000\000\000\000\n]\000\000\n]\001\190\000\000\n]\n]\016\254\018&\000\000\000\000\004M\n]\000\000\000\000\n]\000\000\000\000\n]\n]\000\000\n]\000\000\n]\n]\001\222\002n\000\000\0186\000\000\002j\000\000\002~\003\234\003\246\000\000\n]\000\000\000\000\004\002\000\000\000\000\000\000\000\000\n]\n]\006\133\000\000\n]\000\000\n]\006\133\000\000\000\000\000\000\005b\004\006\000\000\000\000\004\185\000\000\000\000\n]\n]\000\000\n]\n]\000\000\n]\000\000\n]\000\000\n]\000\000\n]\025\210\n]\bu\bu\000\000\000\000\000\000\bu\000\000\001\186\bu\000\000\000\000\000\000\000\000\006\133\012I\0125\bu\000\000\bu\bu\bu\006\133\bu\bu\000\000\000\000\006\133\006\133\000\238\000\000\000\000\000\000\012I\000\000\bu\006\133\006\133\000\000\002\006\000\000\bu\bu\000\000\000\000\bu\002\n\000\000\002f\000\000\bu\000\000\002\014\bu\000\000\002\018\0125\000\000\bu\bu\bu\000\000\006\133\000\000\000\000\000\000\000\000\bu\bu\000\000\000\000\006\133\000\000\000\000\bu\000\000\000\000\000\000\004Z\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\023\138\bu\bu\bu\000\000\bu\bu\000\000\000\000\003\129\012]\000\000\000\000\n\150\000\000\bu\000\000\bu\bu\001\182\001\186\n\246\bu\000\000\000\000\000\000\000\000\bu\003\129\000\000\000\000\bu\003\129\bu\bu\012\005\012\005\002v\001\206\000\000\012\005\000\000\001\186\012\005\000\000\000\000\001\218\000\000\000\000\000\000\000\000\004z\000\000\012\005\012\005\012\005\000\000\012\005\012\005\001\222\002^\000\000\000\000\000\000\002j\000\000\002~\003\234\003\246\012\005\000\000\000\000\000\000\004\002\000\000\012\005\012\005\000\000\000\000\012\005\000\000\000\000\002f\000\000\012\005\012]\012]\012\005\000\000\000\000\004\006\000\000\012\005\012\005\012\005\000\000\000\000\000\000\003\129\000\000\000\000\012\005\012\005\000\000\012]\000\000\012]\000\000\012\005\000\000\000\000\000\000\004Z\003\129\000\000\012\005\003\129\000\000\000\000\000\000\000\000\000\000\012\005\012\005\012\005\000\000\012\005\012\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\005\000\000\012\005\012\005\001\182\001\186\000\000\012\005\000\000\000\000\000\000\000\000\012\005\000\000\000\000\000\000\012\005\000\000\012\005\012\005\by\by\001\190\001\206\002\209\by\000\000\001\186\by\002\209\000\000\001\218\000\000\000\000\018f\000\000\by\000\000\by\by\by\000\000\by\by\001\222\019\222\000\000\018\242\000\000\002j\000\000\002~\003\234\003\246\by\000\n\000\000\000\000\019\238\000\000\by\by\000\000\000\000\by\000\000\000\000\002f\002\209\by\002\209\000\000\by\000\000\000\000\004\006\002\209\by\by\by\000\000\002\209\000\000\002\209\000\000\000\000\by\by\000\000\000\000\002\209\002\209\000\000\by\002\209\002\209\002\209\004Z\002\209\000\000\by\000\000\000\000\002\209\000\000\000\000\002\209\by\by\by\000\000\by\by\000\000\000\000\002\209\002\209\000\000\002\209\000\n\000\n\by\002\209\by\by\002\209\002\209\002\209\by\002\209\002\209\002\209\002\209\by\002\209\002\209\002\209\by\000\000\by\by\002\209\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\000\n\000\000\002\209\006\146\000\000\002\209\002\209\002\209\000\000\014\238\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\000\000\002\209\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\015*\000\000\000\000\0065\002\209\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000\000\000\000\0156\000\000\000!\002N\000\000\002\209\002\209\0065\000\000\000\000\002\209\002\209\002\209\000\000\000!\000\000\000!\000!\000\000\000\000\000\000\000\000\000\000\000!\000\000\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000!\000!\000!\000\000\000\000\015:\000!\007\017\000\000\000!\007\017\000\000\000\000\000!\000!\000!\000!\000\000\000!\015F\000\000\021\022\000\000\000\000\000\000\000\000\007\017\007\017\000!\007\017\007\017\000\000\000\000\000\000\000\000\000!\000!\000!\000!\000!\000\000\000\000\000\000\000\000\0061\015N\000\029\000\000\007\017\000\000\000\029\000\029\000\000\000\029\000\029\021\"\000\000\000\000\000\000\000\029\000\000\000\000\000!\000!\0061\000\000\007\017\000!\000!\000!\000\000\000\029\020\214\000\029\000\029\000\000\000\000\000\000\000\000\000\000\000\029\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\007\017\000\029\007\017\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\000\000\029\005\158\000\000\000\000\007\017\007\017\000\000\000\000\000\000\007\017\000\029\007\017\000\000\000\000\000\000\007\017\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\000\006A\000\000\011\205\000\000\000\000\000\000\011\205\011\205\000\000\011\205\011\205\000\000\000\000\000\000\000\000\011\205\000\000\000\000\000\029\000\029\006A\000\000\000\000\000\029\000\029\000\029\000\000\011\205\000\000\011\205\011\205\000\000\000\000\000\000\000\000\000\000\011\205\000\000\011\205\000\000\000\000\000\000\011\205\011\205\000\000\011\205\011\205\011\205\011\205\011\205\000\000\000\000\000\000\011\205\007%\000\000\011\205\007%\000\000\000\000\011\205\011\205\011\205\011\205\000\000\011\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007%\007%\011\205\007%\007%\000\000\000\000\000\000\000\000\011\205\011\205\011\205\011\205\011\205\000\000\000\000\000\000\000\000\006=\000\000\011\201\000\000\007%\000\000\011\201\011\201\000\000\011\201\011\201\000\000\000\000\000\000\000\000\011\201\000\000\000\000\011\205\011\205\006=\000\000\000\238\011\205\011\205\011\205\000\000\011\201\000\000\011\201\011\201\000\000\000\000\000\000\000\000\000\000\011\201\000\000\011\201\000\000\000\000\000\000\011\201\011\201\000\000\011\201\011\201\011\201\011\201\011\201\000\000\000\000\007%\011\201\007%\000\000\011\201\000\000\000\000\000\000\011\201\011\201\011\201\011\201\000\000\011\201\007%\000\000\000\000\005\166\007%\000\000\000\000\000\000\007%\011\201\007%\000\000\000\000\000\000\007%\000\000\011\201\011\201\011\201\011\201\011\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\246\000\000\000\000\001\250\012\t\012\t\000\000\000\000\000\000\012\t\011\201\011\201\012\t\017n\000\000\011\201\011\201\011\201\012I\0125\004*\000\000\012\t\012\t\012\t\000\000\012\t\012\t\000\000\017r\000\000\000\000\000\000\000\000\000\000\017\154\012I\000\000\012\t\000\000\000\000\000\000\002\006\000\000\012\t\012\t\000\000\016\202\012\t\002\154\000\000\000\000\016\226\012\t\000\000\002\014\012\t\000\000\002\018\0125\000\000\012\t\012\t\012\t\000\000\000\000\000\000\000\000\018\018\000\000\012\t\012\t\000\000\000\000\000\000\000\000\000\000\012\t\000\000\000\000\000\000\012\t\016\254\018&\012\t\000\000\000\000\004M\000\000\000\000\000\000\012\t\012\t\012\t\000\000\012\t\012\t\000\000\000\000\000\000\000\000\000\000\000\000\0186\007\145\012\t\000\006\012\t\012\t\007\145\002\134\002\138\012\t\002\182\002\194\000\000\000\000\012\t\000\000\002\198\000\000\012\t\000\000\012\t\012\t\000\000\014\"\000\000\000\000\000\000\000\000\002\202\000\000\003\n\003\014\000\000\000\000\000\000\000\000\000\000\003\018\000\000\002\206\000\000\000\000\000\000\003\150\003\154\007\145\003\158\002\250\003\170\003\178\006\142\000\000\000\000\007\145\002~\000\000\000\000\003\006\007\145\007\145\000\238\007\214\007\218\007\230\007\250\000\000\0056\007\145\007\145\001\181\000\000\000\000\000\000\000\000\001\181\000\000\bn\000\000\000\000\000\000\000\000\000\000\000\000\bz\b\146\b\230\005B\005F\000\000\000\000\007\145\000\000\000\000\007\145\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\007\145\000\000\000\000\003\t\000\000\000\000\003\t\000\000\005J\007\238\000\000\001\181\000\000\b\006\004\018\b\250\003\t\003\t\003\t\001\181\003\t\003\t\000\000\000\000\001\181\001\181\000\238\000\000\000\000\000\000\000\000\000\000\003\t\001\181\001\181\000\000\000\000\000\000\003\t\004\"\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\001\181\000\000\000\000\000\000\000\000\003\t\003\t\000\000\000\000\001\181\000\000\000\000\003\t\000\000\ni\000\000\003\t\ni\000\000\003\t\003\"\002\138\000\000\000\000\002\194\000\000\003\t\003\t\003\t\002\198\003\t\003\t\000\000\ni\ni\000\000\ni\ni\000\000\000\000\003\t\000\000\003\t\003\t\003&\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\ni\003\t\0032\003\t\003\t\003>\001\170\003\133\012]\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\ni\003\186\000\000\003\194\005*\000\000\0056\000\000\003\133\000\000\000\000\000\000\003\133\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\ni\000\000\ni\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ni\000\000\000\000\ni\ni\000\000\005J\000\000\ni\000\000\ni\000\000\004\018\ne\ni\000\000\ne\000\000\000\000\003\"\002\138\012]\012]\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\ne\ne\003\133\ne\ne\000\000\006~\000\000\012]\000\000\012]\003&\000\000\000\000\b\158\000\000\000\000\003\133\000\000\000\000\003\133\000\000\ne\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\ne\003\186\000\000\003\194\005*\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004i\005:\000\000\000\000\000\000\018~\001\205\001\205\000\000\005B\005F\001\205\005\134\ne\001\205\ne\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\001\205\001\205\ne\001\205\001\205\ne\ne\000\000\005J\000\000\ne\000\000\ne\000\000\004\018\001\205\ne\000\000\000\000\018\170\000\000\001\205\001\205\000\000\000\000\001\205\000\000\016\202\000\000\000\000\001\205\000\000\016\226\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\018\230\000\000\000\000\000\000\000\000\001\205\001\205\000\000\000\000\000\000\000\000\000\000\001\205\000\000\003\"\002\138\001\205\000\000\002\194\001\205\006^\000\000\000\000\002\198\000\000\004i\001\205\001\205\001\205\000\000\001\205\001\205\000\000\006~\019Z\000\000\000\000\000\000\003&\000\000\001\205\b\158\001\205\001\205\000\000\000\000\000\000\001\205\000\000\000\000\000\000\0032\001\205\000\000\nf\001\170\004\190\000\000\001\205\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\nA\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\n~\000\000\000\000\003\"\002\138\000\000\000\000\002\194\000\000\006^\000\000\000\000\002\198\000\000\nA\n\134\000\000\nA\n\242\000\000\005J\000\000\006~\000\000\nA\000\000\004\018\003&\nA\000\000\b\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\nf\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\nA\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\005)\005)\000\000\000\000\007\141\005)\000\000\005:\005)\007\141\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005)\n~\005)\000\000\005)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nA\005)\000\000\nA\nA\000\000\005J\005)\005)\000\000\nA\000\000\004\018\005)\nA\007\141\005)\000\000\000\000\005)\000\000\000\000\000\000\007\141\005)\005)\005)\000\000\007\141\007\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\007\141\007\141\000\000\005)\005)\000\000\000\000\005)\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\000\000\005)\005)\005)\000\000\005)\005)\007\141\000\000\000\000\007\141\007.\001\n\000\000\000\000\000\000\000\000\000\000\005)\007\141\000\000\005)\005)\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\000\000\005)\000\000\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\000\000\000\000\001:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\000\000\000\000\000\000\001V\000\000\005\029\005\029\000\000\000\000\012y\005\029\000\000\001Z\005\029\012y\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\005\029\000\000\005\029\000\000\005\029\001\134\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\142\000\000\005\029\000\000\001\146\000\000\001\150\001\154\005\029\005\029\000\000\000\000\000\000\000\000\007\154\000\000\012y\005\029\000\000\000\000\005\029\000\000\000\000\000\000\012y\005\029\005\029\000\238\000\000\012y\012y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\005\029\005\029\003Q\003Q\005\029\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\005\029\005\029\005\029\000\000\005\029\005\029\003Q\000\000\003Q\012y\003Q\000\000\000\000\000\000\000\000\000\000\000\000\005\029\012y\000\000\005\029\005\029\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\000\000\000\000\005\029\000\000\004\233\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\b\001\b\001\000\000\000\000\004\233\b\001\000\000\000\000\b\001\000\000\000\000\003Q\000\000\000\000\000\000\003Q\000\000\000\000\b\001\000\000\b\001\000\000\b\001\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\000\000\000\000\000\000\000\000\b\001\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\000\000\b\001\000\000\000\000\000\000\000\000\b\001\b\001\b\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\001\000\000\012\185\012\185\b\001\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\b\001\b\001\b\001\000\000\b\001\b\001\012\185\000\000\012\185\000\000\012\185\000\000\000\000\000\000\b\001\000\000\000\000\b\001\000\000\000\000\000\000\b\001\012\185\000\000\000\000\000\000\000\000\000\000\012\185\012\185\004\190\000\000\b\001\000\000\0042\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\000\000\000\000\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\012\185\012\185\012\189\012\189\000\000\000\000\004B\012\189\000\000\000\000\012\189\000\000\000\000\012\185\000\000\000\000\000\000\012\185\000\000\000\000\012\189\000\000\012\189\000\000\012\189\000\000\000\000\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\012\189\012\189\000\000\000\000\000\000\000\000\0042\000\000\000\000\012\189\000\000\000\000\012\189\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\012\189\012\189\003Q\003Q\000\000\000\000\004B\003Q\000\000\000\000\003Q\000\000\000\000\012\189\000\000\000\000\000\000\012\189\000\000\000\000\003Q\000\000\003Q\000\000\003Q\000\000\000\000\000\000\012\189\001\182\001\186\000\000\000\000\000\000\000\000\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\000\000\000\000\000\000\001\190\004\237\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\222\002n\000\000\000\000\000\000\002j\003Q\002~\003\234\003\246\003Q\000\000\000\000\000\000\004\002\000\000\b\133\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\004\237\004\006\t\130\000\000\004\189\014\022\000\000\003Q\b\133\000\000\000\000\003Q\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\025\210\000\000\003Q\000\000\000\000\000\000\000\000\000\000\t\234\t\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\006\153\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\006\153\000\000\000\000\000\000\006\153\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\b\133\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\001\189\000\000\000\000\006\153\n\"\001\189\000\000\001\186\001\189\000\000\000\000\000\000\000\000\n*\000\000\000\000\ba\000\000\001\189\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\000\000\000\000\000\000\001\189\000\000\n2\000\000\012!\000\000\001\189\001\189\000\000\012!\n:\nB\012!\002f\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\012!\001\189\001\189\001\189\012!\000\000\000\000\0035\000\000\000\000\012)\000\000\0035\000\000\001\186\0035\012!\001\189\001\189\000\000\000\000\004Z\012!\b]\000\000\0035\000\000\000\000\000\000\0035\000\000\001\189\001\189\000\000\012!\001\189\001\189\000\000\000\000\012!\012!\0035\000\000\000\000\000\000\001\189\000\000\0035\001\185\000\000\000\000\000\000\001\189\000\000\002f\012!\0035\001\189\000\000\0035\000\000\000\000\000\000\001\189\0035\0035\0035\000\000\000\000\012!\012!\002F\000\000\012!\012!\000\000\000\000\000\000\000\000\000\000\0035\0035\000\000\012!\004Z\000\000\000\000\026F\000\000\000\000\012!\000\000\000\000\016\026\0035\0035\000\000\000\000\0035\0035\000\000\012!\000\000\000\000\000\000\000\000\000\000\000\000\0035\t\130\000\000\000\000\000\000\016\030\000\000\0035\000\000\000\000\000\000\000\000\0035\t\186\t\210\t\218\t\194\t\226\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\149\000\000\000\000\000\000\000\000\000\149\n\"\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n*\000\000\000\000\000\149\000\000\000\149\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\nJ\016\"\nR\n\018\0162\000\149\000\000\000\000\000\000\n2\000\000\000\149\000\000\000\000\000\000\000\149\000\000\n:\nB\000\000\000\149\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\149\000\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\000\000\000\000\217\000\149\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\149\000\149\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\217\000\000\000\217\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\149\000\000\000\149\000\217\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\217\000\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\157\000\217\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\217\000\217\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\217\000\000\000\217\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\153\000\157\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\153\006u\006u\000\000\000\000\000\000\000\153\000\157\000\000\000\157\000\153\000\000\000\000\000\000\000\000\000\153\000\000\003\250\000\153\006u\006u\000\000\000\000\000\153\000\153\000\238\000\000\000\000\006u\001\129\000\000\000\000\000\153\000\153\001\129\000\000\000\000\001\129\000\000\000\153\000\000\006u\006u\000\153\000\000\000\000\006u\001\129\006u\006u\006u\001\129\000\000\000\153\000\153\006u\000\000\000\153\000\153\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\153\000\000\001\129\000\000\000\000\006u\000\153\000\153\004\233\000\000\000\000\001\129\000\000\000\000\001\129\000\000\000\153\000\000\000\153\001\129\001\129\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001\129\000\000\003\238\000\000\006u\000\000\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\001\129\001\129\000\000\012\181\012\181\000\000\004\233\000\000\012\181\000\000\001\129\012\181\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\000\012\181\001\129\012\181\000\000\012\181\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\000\000\000\000\000\000\012\181\012\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\012\181\000\000\000\000\000\000\000\000\012\181\012\181\012\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\012\177\012\177\012\181\000\000\000\000\012\177\000\000\000\000\012\177\000\000\000\000\000\000\012\181\012\181\012\181\000\000\012\181\012\181\012\177\000\000\012\177\000\000\012\177\000\000\000\000\000\000\000\000\000\000\000\000\012\181\000\000\000\000\000\000\012\181\012\177\000\000\000\000\000\000\000\000\000\000\012\177\012\177\004\190\000\000\012\181\000\000\000\000\000\000\000\000\012\177\000\000\000\000\012\177\000\000\000\000\000\000\000\000\012\177\012\177\012\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\177\000\000\b\005\b\005\012\177\000\000\000\000\b\005\000\000\000\000\b\005\000\000\000\000\000\000\012\177\012\177\012\177\000\000\012\177\012\177\b\005\000\000\b\005\000\000\b\005\000\000\000\000\000\000\007\n\000\000\000\000\012\177\000\000\000\000\000\000\012\177\b\005\000\000\000\000\000\000\000\000\000\000\b\005\b\005\000\000\000\000\012\177\000\000\000\000\000\000\000\000\b\005\000\000\000\000\b\005\000\000\000\000\000\000\000\000\b\005\b\005\000\238\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\001\185\000\000\001\186\001\185\000\000\b\005\000\000\000\000\000\000\b\005\000\000\b]\000\000\001\185\000\000\000\000\000\000\001\185\000\000\b\005\b\005\b\005\000\000\b\005\b\005\000\000\000\000\000\000\000\000\001\185\000\000\000\000\000\000\b\005\000\000\001\185\b\005\000\000\000\000\000\000\b\005\000\000\002f\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\b\005\001\185\001\185\001\185\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\000\000\012)\001i\000\000\001\185\001\185\000\000\000\000\004Z\000\000\012)\000\000\001i\000\000\001i\000\000\001i\000\000\001\185\001\185\000\000\000\000\001\185\001\185\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\001\185\000\000\001i\012)\000\000\000\000\000\000\001\185\000\000\012)\000\000\000\000\001\185\000\000\001i\000\000\000\000\000\000\001\185\001i\001i\001i\000\000\000\000\000\000\005M\005M\000\000\000\000\000\000\005M\000\000\000\000\005M\000\000\001i\000\000\000\000\000\000\012)\000\000\000\000\000\000\005M\000\000\005M\000\000\005M\000\000\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\000\000\005M\000\000\000\000\000\000\000\000\000\000\005M\005M\000\000\000\000\019\226\001i\007\154\000\000\000\000\005M\000\000\000\000\005M\000\000\000\000\000\000\001i\005M\005M\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005M\000\000\005I\006\222\005M\000\000\000\000\005I\000\000\000\000\005I\000\000\000\000\000\000\005M\005M\005M\000\000\005M\005M\005I\000\000\005I\000\000\005I\000\000\000\000\000\000\000\000\000\000\000\000\005M\000\000\000\000\000\000\005M\005I\000\000\000\000\000\000\000\000\000\000\005I\007J\000\000\000\000\005M\000\000\000\000\000\000\000\000\005I\000\000\000\000\005I\000\000\000\000\000\000\000\000\005I\005I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005I\000\000\005e\005e\005I\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\005I\005I\005I\000\000\005I\005I\005e\000\000\005e\000\000\005e\000\000\000\000\000\000\000\000\000\000\000\000\005I\000\000\000\000\000\000\005I\005e\000\000\000\000\000\000\000\000\000\000\005e\005e\000\000\000\000\005I\000\000\000\000\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\000\000\005e\005e\005e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005e\000\000\005a\006\222\005e\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\005e\005e\005e\000\000\005e\005e\005a\000\000\005a\000\000\005a\000\000\000\000\000\000\000\000\000\000\000\000\005e\000\000\000\000\000\000\005e\005a\000\000\000\000\000\000\000\000\000\000\005a\007J\000\000\000\000\007B\000\000\000\000\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\004E\000\000\000\000\000\000\000\000\004E\003\"\002\138\004E\000\000\002\194\000\000\006^\005a\000\000\002\198\000\000\005a\004E\000\000\000\000\000\000\004E\000\000\000\000\006~\000\000\005a\005a\005a\003&\005a\005a\b\158\004E\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\0032\005a\000\000\nf\001\170\005a\004E\000\000\011\206\004E\002~\000\000\000\000\003\182\004E\002\174\005a\003\186\000\000\003\194\000\000\nv\0056\000\000\t\130\000\000\000\000\000\000\000\000\000\000\004E\011\210\000\000\000\000\005:\000\000\t\186\t\210\t\218\t\194\t\226\000\000\005B\005F\004E\004E\n~\000\000\004E\004E\t\234\t\242\000\000\011\230\007.\000\000\000\000\000\000\000\000\t\250\000\000\n\134\000\000\000\000\n\146\004E\005J\000\238\000\000\t\130\020\234\000\000\004\018\011\234\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\011\246\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\011\250\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012\006\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\n\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\012&\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\012*\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\012>\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\012B\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012V\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012Z\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\011\206\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\154\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\011\230\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\012\182\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\011\246\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\012\202\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012\006\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\012\222\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\012&\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\t\130\000\000\000\000\000\000\r\014\000\000\000\000\t\138\t\202\n\002\n\n\n\026\t\186\t\210\t\218\t\194\t\226\000\000\000\000\n\"\000\000\000\000\000\000\000\000\000\000\000\000\t\234\t\242\n*\000\000\000\000\000\000\000\000\000\000\000\000\t\250\000\000\000\000\000\000\000\000\000\000\000\000\nJ\000\238\nR\n\018\000\000\000\000\000\000\012>\000\000\n2\t\138\t\202\n\002\n\n\n\026\000\000\000\000\n:\nB\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\r\026\000\000\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\012V\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\t\130\000\000\000\000\000\000\000\000\000\000\000\000\r&\n*\000\000\000\000\000\000\t\186\t\210\t\218\t\194\t\226\000\000\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\t\234\t\242\000\000\000\000\000\000\n2\000\000\000\000\000\000\t\250\000\000\000\000\000\000\n:\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\138\t\202\n\002\n\n\n\026\000\000\000\000\000\000\0031\000\000\000\000\000\000\n\"\0031\000\000\001\186\0031\000\000\000\000\000\000\000\000\n*\000\000\000\000\000\000\000\000\0031\000\000\000\000\000\000\0031\000\000\000\000\000\000\000\000\nJ\000\000\nR\n\018\000\000\000\000\000\000\0031\000\000\n2\000\000\000\000\000\000\0031\000\000\000\000\000\000\n:\nB\000\000\002f\000\000\0031\000\000\000\000\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\000\000\000\000\004Z\n\138\000\000\000\000\000\000\000\000\000\246\001\182\001\186\001\250\0031\0031\000\000\000\000\0031\0031\000\000\000\000\000\000\017n\000\000\000\000\000\000\004M\0031\001\190\001\206\000\000\000\000\000\000\000\000\0031\000\000\000\000\001\218\017r\0031\000\000\000\000\000\000\000\000\017\154\0031\000\000\000\000\000\000\006\253\001\222\002^\006\253\000\000\000\000\002j\016\202\002~\003\234\003\246\000\000\016\226\0011\000\000\004\002\000\000\000\000\0011\006\253\006\253\0011\006\253\006\253\000\000\000\000\000\000\000\000\018\018\000\000\000\000\0011\004\006\0011\000\000\0011\000\000\000\000\000\000\000\000\000\000\006\253\016\254\018&\000\000\000\000\000\000\0011\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\000\000\0011\000\000\006\253\000\000\000\000\0011\0186\000\000\0011\000\000\000\000\000\000\000\000\0011\0011\000\238\000\000\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\000\000\000\000\001-\000\000\0011\000\000\000\000\006\253\0011\006\253\000\000\000\000\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\006\253\0011\0011\005\166\006\253\000\000\000\000\001-\006\253\000\000\006\253\0011\000\000\001-\006\253\000\000\000\000\001-\0011\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\001-\000\238\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\000\000\012-\001m\000\000\001-\000\000\000\000\000\000\001-\000\000\012-\000\000\001m\000\000\001m\000\000\001m\000\000\001-\001-\001-\000\000\001-\001-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\000\000\001m\012-\000\000\000\000\000\000\001-\000\000\012-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\001m\001m\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\000}\001\029\000\000\001m\000\000\000\000\000\000\012-\000\000\000}\000\000\001\029\000\000\001\029\000\000\001\029\000\000\001m\001m\001m\000\000\001m\001m\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\000}\000\000\000\000\000\000\001m\000\000\000}\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\001m\001\029\001\029\001\029\001\197\000\000\000\000\000\000\000\000\001\197\000\000\0156\001\197\000\000\002N\000\000\000\000\001\029\000\000\000\000\000\000\000}\001\197\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\001\197\001\182\001\186\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\015:\000\000\001\029\001\197\000\000\015J\001\197\001\190\001\206\000\000\000\000\001\197\001\197\001\029\015F\000\000\001\218\000\000\000\000\000\000\000\000\000\000\000\000\001\226\000\000\000\000\000\000\001\197\0009\001\222\002^\001\197\000\000\0009\002j\0009\002~\003\234\003\246\000\000\015N\001\197\001\197\004\002\0009\001\197\001\197\0009\000\000\000\000\000\000\0009\b!\000\000\000\000\001\197\000\000\000\000\000\000\000\000\004\006\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\0009\001\197\000\000\0009\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\0009\0009\0009\000\000\000\000\000\000\000\000\000\000\000\000\0009\0009\004\014\000\000\004\018\000\000\003\"\002\138\000\000\000\000\002\194\0009\006^\000\000\0009\002\198\000\000\000\000\000\000\004E\000\000\000\000\004E\0009\000\000\006~\0009\000\000\000\000\000\000\003&\b!\004E\b\158\000\000\0009\000\000\000\000\0009\000\000\000\000\b\226\000\000\0032\000\000\000\000\rN\001\170\004E\000\000\000\000\0009\000\000\002~\004E\000\000\003\182\000\000\000\000\000\000\003\186\004E\003\194\004E\nv\0056\004E\000\000\000\000\004E\000\000\004E\002\174\000\000\000\000\000\000\000\000\005:\000\000\004E\000\000\000\000\000\000\004E\000\000\005B\005F\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\000\000\r^\000\000\005J\004E\000\000\000\000\004E\000\000\004\018\000\000\000\000\004E\002\174\000\238\000\000\004E\000\000\003)\000\000\000\000\004E\004E\003)\000\000\000\000\003)\000\000\004E\004E\000\000\000\000\004E\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\000\000\000\000\003)\015V\000\000\000\000\004E\000\000\003)\000\000\000\000\004E\000\000\004E\004E\000\000\000\000\003)\025N\000\000\003)\000\000\000\000\000\000\004E\003)\003)\003)\004E\000\000\003\"\002\138\000\000\000\000\002\194\000\000\006^\000\000\000\000\002\198\004E\003)\000\000\000\000\000\000\003)\004E\000\000\000\000\006~\000\000\000\000\0042\000\000\003&\003)\003)\b\158\004E\003)\003)\000\000\000\000\004E\002\174\023\018\000\000\0032\000\000\003)\003>\001\170\000\000\000\000\000\000\015\182\003)\002~\000\000\004E\003\182\003)\000\000\000\000\003\186\000\000\003\194\003)\nv\0056\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\005:\000\000\004B\000\000\000\000\000\000\007\n\000\000\005B\005F\003\"\002\138\021\130\004E\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\006~\023\222\000\000\005J\000\000\003&\000\000\000\000\b\158\004\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\nf\001\170\000\000\000\000\000\000\000\000\000\000\002~\006q\006q\003\182\000\000\000\000\000\000\003\186\000\000\003\194\000\000\nv\0056\000\000\000\000\000\000\000\000\000\000\000\000\006q\006q\000\000\000\000\000\000\005:\000\000\000\000\000\000\006q\000\000\000\000\000\000\005B\005F\003\"\002\138\n~\000\000\002\194\000\000\006^\006q\006q\002\198\000\000\000\000\006q\000\000\006q\006q\006q\000\000\000\000\006~\022\026\006q\005J\000\000\003&\000\000\000\000\b\158\004\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\006q\000\000\nf\001\170\005~\000\000\000\000\000\000\000\000\002~\003\"\002\138\003\182\000\000\002\194\000\000\003\186\000\000\003\194\002\198\nv\0056\000\000\000\000\005\130\000\000\003\190\000\000\000\000\000\000\000\000\000\000\000\000\005:\003&\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\004\166\000\000\n~\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\022z\003\186\005J\003\194\005*\000\000\0056\000\000\004\018\000\000\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\005:\000\000\000\000\003\"\002\138\000\000\000\000\002\194\005B\005F\000\000\005\134\002\198\000\000\000\000\000\000\000\000\000\000\000\000\b\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\005\206\000\000\000\000\005J\000\000\006J\000\000\b\134\000\000\004\018\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\011\233\000\000\003\186\011\233\003\194\005*\000\000\0056\002\209\002\209\000\000\000\000\002\209\011\233\000\000\000\000\000\000\002\209\000\000\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\011\233\005\134\000\000\002\209\000\n\000\000\011\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\233\002\209\000\000\011\233\002\209\002\209\000\000\005J\011\233\b\161\000\000\002\209\000\000\004\018\002\209\000\000\000\000\002\209\002\209\000\000\002\209\002\209\000\000\002\209\011\233\004-\004-\000\000\011\233\004-\000\000\000\000\000\000\000\000\004-\002\209\000\000\000\000\011\233\011\233\004-\000\000\011\233\002\209\002\209\000\000\002\209\000\000\027J\004-\022\202\000\000\000\000\022\226\000\000\000\000\000\000\000\000\000\000\011\233\000\000\000\000\004-\000\000\000\000\004-\004-\002\209\000\000\000\000\000\000\002\209\004-\002\209\000\000\004-\000\000\000\000\000\238\004-\003)\004-\004-\000\000\004-\003)\000\000\000\000\003)\003)\000\000\000\000\000\000\000\000\003)\000\000\004-\003)\003)\000\000\000\000\000\000\003)\000\000\004-\004-\000\000\003)\000\000\000\000\000\000\003)\000\000\000\000\003)\015V\000\000\000\000\000\000\000\000\003)\000\000\000\000\003)\015V\000\000\000\000\000\000\004-\003)\000\000\000\000\003)\000\000\004-\000\000\000\000\003)\003)\003)\003)\003)\000\000\000\000\000\000\003)\003)\003)\003)\000\000\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\003)\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\003)\003)\025V\000\000\003)\003)\000\000\003)\015V\003)\003)\025\134\000\000\003)\003)\000\000\000\000\000\000\000\000\012!\015\182\003)\003)\000\000\012!\003)\003)\012!\000\000\015\182\003)\003)\003)\000\000\000\000\003)\000\000\012!\000\000\000\000\000\000\012!\000\000\000\000\000\000\000\000\003)\012)\000\000\000\000\003)\000\000\000\000\012!\000\000\000\000\000\000\000\000\000\000\012!\003)\003)\017:\000\000\003)\003)\000\000\000\000\012!\000\000\000\000\012!\000\000\000\000\000\000\000\000\012!\012!\003\"\002\138\015\182\003)\002\194\000\000\006^\000\000\000\000\002\198\000\000\000\000\000\000\000\000\012!\000\000\000\000\000\000\012!\006~\000\000\000\000\000\000\000\000\003&\000\000\000\000\b\158\012!\012!\002F\000\000\012!\012!\000\000\000\000\000\000\0032\000\000\000\000\b\202\001\170\012!\005\001\000\000\000\000\026~\002~\005\001\012!\003\182\005\001\000\000\000\000\003\186\000\000\003\194\000\000\nv\0056\012!\005\001\000\000\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\000\000\000\000\005\001\000\000\005B\005F\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\007\154\000\000\000\000\005\001\000\000\000\000\005\001\000\000\000\000\000\000\000\000\005\001\005\001\000\238\005J\000\000\000\000\005\005\000\000\000\000\004\018\000\000\005\005\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\000\000\000\000\000\000\005\005\000\000\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\000\005\005\012\193\012\193\000\000\000\000\000\000\005\005\000\000\000\000\000\000\000\000\005\001\007\154\000\000\000\000\005\005\000\000\000\000\005\005\012\193\012\193\006\242\005\001\005\005\005\005\000\238\000\000\000\000\012\193\005\169\000\000\000\000\000\000\000\000\005\169\000\000\000\000\005\169\000\000\005\005\005\005\012\193\012\193\005\005\000\000\000\000\012\193\005\169\012\193\012\193\012\193\005\169\000\000\005\005\005\005\012\193\000\000\005\005\005\005\000\000\000\000\000\000\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\000\000\000\000\012\193\000\000\005\005\000\000\000\000\000\000\005\169\000\000\000\000\005\169\000\000\000\000\000\000\005\005\005\169\005\169\000\238\025.\000\000\000\000\000\000\000\000\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\005\169\000\000\002\198\000\000\005\169\000\000\000\000\000\000\000\000\006\n\000\000\000\000\000\000\000\000\005\169\005\169\021\014\003&\005\169\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\0032\000\000\000\000\003>\001\170\005\169\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\000\000\005\169\003\186\000\000\003\194\005*\005\241\0056\000\000\000\000\000\000\000\000\000\000\002\138\000\000\000\000\002\194\000\000\000\000\005:\000\000\002\198\000\000\000\000\000\000\000\000\005\241\005B\005F\000\000\005\134\000\000\000\000\002\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\206\000\000\000\000\000\000\000\000\000\000\000\000\005J\002\250\001\170\000\000\b\134\000\000\004\018\000\000\002~\000\000\000\000\003\006\001\182\001\186\000\000\007\214\007\218\007\230\000\000\000\000\0056\000\000\000\000\000\000\000\000\000\000\002Z\000\000\005\170\000\000\001\190\001\206\000\000\000\000\003\"\002\138\000\000\000\000\002\194\001\218\005B\005F\000\000\002\198\000\000\000\000\001\226\000\000\000\000\000\000\000\000\000\000\001\222\002^\000\000\000\000\000\000\002j\003&\002~\003\234\003\246\000\000\000\000\005J\007\238\004\002\000\000\000\000\b\006\004\018\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\005\230\000\000\002~\000\000\004\006\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\015>\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\005\242\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\000\000\000\000\002\198\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\000\000\000\000\005\245\000\000\002~\004\018\000\000\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\005\245\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\011^\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\000\000\000\000\000\000\000\000\002\198\005:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\000\000\000\000\011j\000\000\002~\004\018\000\000\003\182\003\"\002\138\000\000\003\186\002\194\003\194\005*\000\000\0056\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005:\000\000\000\000\000\000\003&\000\000\000\000\000\000\005B\005F\000\000\005\134\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\000\000\000\000\000\000\000\000\000\000\002~\000\000\000\000\003\182\000\000\005J\000\000\003\186\011v\003\194\005*\004\018\0056\000\000\003\"\002\138\000\000\000\000\002\194\006\025\000\000\000\000\000\000\002\198\005:\000\000\002\138\000\000\000\000\002\194\000\000\000\000\005B\005F\002\198\005\134\000\000\000\000\003&\006\025\000\000\000\000\000\000\000\000\000\000\000\000\002\202\000\000\000\000\000\000\000\000\0032\000\000\000\000\003>\001\170\005J\002\206\000\000\000\000\000\000\002~\004\018\000\000\003\182\002\250\001\170\000\000\003\186\000\000\003\194\005*\002~\0056\000\000\003\006\000\000\000\000\000\000\007\214\007\218\007\230\000\000\000\000\0056\005:\000\000\000\000\000\000\000\000\006\161\006\222\000\000\005B\005F\006\161\005\134\000\000\006\161\000\000\000\000\000\000\000\000\000\000\005B\005F\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\005J\000\000\000\000\000\000\000\000\000\000\004\018\006\161\000\000\000\000\000\000\005J\007\238\006\161\007J\000\000\b\006\004\018\001\153\000\000\000\000\000\000\006\161\001\153\000\000\006\161\001\153\000\000\000\000\000\000\006\161\006\161\000\238\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\161\000\000\001\153\000\000\000\000\000\000\000\000\000\000\001\153\000\000\006\161\006\161\000\000\000\000\006\161\006\161\000\000\001\153\000\000\000\000\001\153\000\000\000\000\000\000\000\000\001\153\001\153\001\153\001\201\000\000\005\173\006\161\000\000\001\201\000\000\005\173\001\201\000\000\005\173\000\000\000\000\001\153\000\000\000\000\000\000\001\153\001\201\000\000\005\173\000\000\001\201\000\000\005\173\000\000\000\000\001\153\001\153\000\000\000\000\001\153\001\153\000\000\001\201\000\000\005\173\017J\000\000\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\001\153\001\201\000\000\005\173\001\201\001\153\005\173\000\000\000\000\001\201\001\201\005\173\005\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\000\000\005\173\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\001\201\005\173\005\173\001\201\001\201\005\173\005\173\000\000\000\000\000\000\000\000\000\000\000\000\001\201\011\217\005\173\002\138\011\217\000\000\0272\001\201\000\000\005\173\000\000\0276\020\234\000\000\011\217\000\000\000\000\000\000\001\201\000\000\005\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\004E\001\002\001\170\000\000\011\217\004E\000\000\011\217\004E\000\000\000\000\000\000\011\217\000\000\000\000\000\000\000\000\000\000\004E\000\000\027:\000\000\004E\000\000\000\000\000\000\000\000\000\000\011\217\000\000\000\000\000\000\011\217\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\027>\011\217\011\217\000\000\000\000\011\217\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\000\000\004E\002\174\000\000\000\000\000\000\000\000\011\217\000\000\000\000\007\193\007\193\000\000\000\000\007\193\000\000\000\000\004E\000\000\007\193\000\000\004E\000\000\000\000\000\000\015\226\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\007\193\004E\004E\006\222\000\000\000\000\000\000\004E\000\000\000\000\004E\007\n\000\000\007\193\000\000\000\000\007\193\007\193\004E\004E\004E\000\000\000\000\007\193\004E\000\000\007\193\004E\000\000\004E\007\193\000\000\007\193\007\193\000\000\007\193\004E\004E\000\000\000\000\000\000\004E\004E\007J\000\000\000\000\000\000\007\193\000\000\000\000\000\000\000\000\000\000\004E\004E\007\193\007\193\000\000\000\000\004E\002\174\000\238\000\000\000\000\000\000\007\154\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\004E\004E\002\174\000\238\007\193\000\000\000\000\000\000\001U\000\000\007\193\000\000\000\000\001U\004E\004E\001U\004E\004E\004E\000\000\004E\000\000\000\000\000\000\000\000\001U\000\000\001U\000\000\001U\004E\004E\000\000\000\000\004E\004E\001\182\001\186\022\030\000\000\000\000\001U\000\000\000\000\000\000\004E\000\000\001U\000\000\000\000\000\000\004E\000\205\000\000\002v\001\206\000\000\000\205\000\000\001U\000\205\000\000\000\000\001\218\001U\001U\000\238\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\205\000\000\001\222\002^\000\000\000\000\001U\002j\000\000\002~\003\234\003\246\000\205\000\000\000\000\000\000\004\002\000\000\000\205\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\205\000\000\000\000\000\205\000\000\000\000\004\006\000\000\000\205\000\205\000\238\000\000\000\000\000\000\001U\000\209\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\205\001U\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\205\000\205\000\000\000\000\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\000\000\000\000\205\000\000\000\209\000\209\000\238\000\000\000\000\001\182\002J\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\000\000\000\001\190\001\206\002R\000\000\000\000\000\000\000\000\000\209\000\209\001\218\000\000\000\209\000\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002V\002^\000\000\000\000\000\000\002j\000\209\002~\003\234\003\246\000\000\000\000\000\000\000\000\020\194\000\000\020\198\000\209\000\000\006\157\000\000\000\000\000\000\000\000\006\157\000\000\000\000\006\157\000\000\000\000\000\000\004\006\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\015N\006\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\210\000\000\000\000\006\157\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\005\161\000\000\000\000\020\214\006\157\005\161\000\000\006\157\005\161\000\000\000\000\000\000\006\157\006\157\000\000\017\026\000\000\000\000\005\161\000\000\000\000\000\000\005\161\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\006\157\000\000\005\161\000\000\000\000\000\000\000\000\000\000\005\161\000\000\006\157\006\157\016z\000\000\006\157\006\157\000\000\005\161\000\000\000\000\005\161\000\000\000\000\000\000\000\000\005\161\005\161\000\000\005\r\006\222\000\000\006\157\000\000\005\r\000\000\000\000\005\r\000\000\000\000\000\000\000\000\005\161\000\000\000\000\000\000\005\161\005\r\000\000\000\000\000\000\005\r\000\000\000\000\000\000\000\000\005\161\005\161\000\000\000\000\005\161\005\161\000\000\005\r\000\000\000\000\000\000\000\000\000\000\005\r\007J\000\000\000\000\000\000\011\137\000\000\000\000\005\161\000\000\011\137\000\000\005\r\011\137\000\000\000\000\000\000\005\r\005\r\000\238\000\000\000\000\000\000\011\137\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\005\r\000\000\000\000\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\011\137\000\000\005\r\005\r\000\000\000\000\005\r\005\r\000\000\011\137\000\000\000\000\011\137\000\000\000\000\000\000\000\000\011\137\000\000\000\000\000\000\000\000\000\000\005\r\000\000\000\000\001\182\002J\000\000\000\000\002N\000\000\000\000\011\137\tv\000\000\000\000\011\137\004\029\000\000\000\000\000\000\000\000\004\029\001\190\001\206\004\029\011\137\011\137\000\000\000\000\011\137\011\137\001\218\000\000\000\000\004\029\000\000\000\000\000\000\004\029\000\000\000\000\000\000\000\000\000\000\002V\002^\011\137\000\000\000\000\002j\004\029\002~\003\234\003\246\000\000\000\000\004\029\nZ\020\194\000\000\026*\004\021\000\000\000\000\000\000\004\029\004\021\000\000\004\029\004\021\000\000\000\000\000\000\004\029\000\000\004\006\000\000\000\000\000\000\004\021\000\000\000\000\000\000\004\021\015N\000\000\000\000\000\000\000\000\004\029\000\000\000\000\000\000\004\029\0266\004\021\000\000\000\000\000\000\000\000\000\000\004\021\000\000\004\029\004\029\000\000\000\000\004\029\004\029\000\000\004\021\020\214\000\000\004\021\000\000\000\000\000\000\000\000\004\021\000\000\000\000\0045\000\000\000\000\004\029\000\000\0045\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\021\016\174\000\000\000\000\004\021\0045\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\021\004\021\000\000\000\000\004\021\004\021\000\000\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\005\000\000\000\000\004\021\0045\004\005\000\000\0045\004\005\000\000\000\000\000\000\0045\000\000\019\158\000\000\000\000\000\000\004\005\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\0045\000\000\004\005\000\000\000\000\000\000\000\000\000\000\004\005\000\000\0045\0045\000\000\007)\0045\0045\007)\004\005\000\000\000\000\004\005\000\000\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\000\000\0045\007)\007)\000\000\007)\007)\000\000\000\000\000\000\000\000\004\005\020\134\000\000\007\025\004\005\000\000\007\025\000\000\000\000\000\000\001\182\001\186\022~\007)\004\005\004\005\000\000\000\000\004\005\004\005\000\000\000\000\007\025\007\025\000\000\007\025\007\025\000\000\002v\001\206\000\000\000\238\000\000\000\000\004%\004\005\000\000\001\218\000\000\004%\000\000\000\000\004%\000\000\007\025\000\000\023\254\000\000\000\000\000\000\001\222\002^\004%\000\000\000\000\002j\004%\002~\003\234\003\246\000\000\007)\000\238\007)\004\002\000\000\000\000\000\000\004%\000\000\000\000\000\000\000\000\000\000\004%\007)\000\000\000\000\005\166\007)\000\000\004\006\000\000\007)\000\000\007)\004%\000\000\000\000\007)\000\000\004%\007\025\004\r\007\025\004=\000\000\000\000\004\r\000\000\004=\004\r\000\000\004=\000\000\000\000\005\226\004%\000\000\005\166\007\025\004\r\000\000\004=\007\025\004\r\007\025\004=\000\000\000\000\007\025\004%\004%\000\000\000\000\004%\004%\004\r\000\000\004=\000\000\000\000\000\000\004\r\000\000\004=\000\000\000\000\000\000\000\000\000\000\000\000\004%\000\000\000\000\004\r\000\000\004=\000\000\000\000\004\r\000\000\004=\017\242\004M\000\000\004Y\000\000\000\000\000\246\000\000\000\246\001\250\000\000\002\142\000\000\004\r\000\000\004=\000\000\000\000\000\000\017n\000\000\003v\000\000\004M\000\000\004Y\000\000\004\r\004\r\004=\004=\004\r\004\r\004=\004=\017r\000\000\003z\000\000\000\000\000\000\017\154\000\000\016f\000\000\000\000\000\000\000\000\004\r\000\000\004=\000\000\024*\016\202\000\000\016\202\000\000\000\000\016\226\0202\016\226\020\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\150\000\000\018\018\000\000\016\234\000\000\001\182\001\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\254\018&\016\254\017*\004M\004M\004Y\004Y\001\190\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\218\n\226\000\000\000\000\0186\000\000\021j\001\182\001\186\000\000\000\000\000\000\000\000\001\222\002^\000\000\000\246\000\000\002j\002\142\002~\003\234\003\246\000\000\000\000\001\190\001\206\004\002\000\000\027~\000\000\000\000\000\000\000\000\001\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\006\003z\000\000\001\222\002^\000\000\000\000\016f\002j\000\000\002~\003\234\003\246\000\000\000\000\000\000\024*\004\002\000\000\016\202\000\000\000\000\000\000\000\000\016\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\006\000\000\000\000\000\000\000\000\000\000\016\234\000\000\000\000\000\000\027*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\254\017*\000\000\000\000\004\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021j")) + ((16, "C\134O\006B\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\240B\154\000\000\000\000\020\004B\154C\134\025\128\005\162\003$YJ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\005B\000|\000\000\001r\000\b\000\000\001j\001|\000\252\000\000\006.\002\b\005\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\244\000\000\000\000\000\000\001vd\250\000\000\000\000\0032\000\000\000\000\000\000\003J\003B\000\000\000\000m\128N\200\020\004A\028Z\132\020\004R\154O\006\020\004Lj\000\000\021P\000\000\021P\000\007\000\000\0032\000\000\000\000\000\000\003\014\000\000\021P\000\000\004&^\208Y\002b\136\000\000\128\252wd\000\000J\136D8\000\000I*\027:M \0032m\218B\154C\134\000\000\000\000O\006\020\004R\188\021P\005|t>\000\000|\194B\154C\134O\006\020\004\000\000\000\000\000\000\0164\020\184\000V\007\174\000\000\003\180\bR\000\000\000\000\000\000\020\004\000\000@\190\000\000v\254C\134\000\000\000\000NF\020\004BjT\208\000\000\001\022\000\000\000\000\002\n\000\000\000\000F\b\001\022\028\000\003\200\000&\000\000\000\000\000\017\000\000A\028\004\228\005&\019\168\020\180\020\004C\134C\134EjEj\019\168\020\180\020\180\020\004\000\000\000\000\000\000O\006\020\004\000\000\000\244\000\000T\208qjqj\000\000\tL\000\000\000}\n@\000\000\005\144\000\000\000\000 \140d\250bD\000\000d\250bD\000\000d\250d\250\007\174\000\000d\250\0032\000\000\000\000T:d\250R\172D8\006\158\001\016\000\000\001\146\000\000\005j\000\000\n\138\000\000\000\000LZ\007\174\000\000\000\000D8\007 d\250\000\000MLD8N>\000\000\000\000\000\000\006\238\000\000d\250\000\000\000\252p\200\000\000d\250\005\192d\250\000\000\023|\007H\0032\000\000\000\000\024p\000\000\007\168\000\000V\\\n\176\000\000\007Td\250\011x\000\000\011\138\000\000\004F\000\000\000\000\005\152\000\000\000\000\000\000\026\232\027\220T\208N\198\020\004T\208\000\000\002\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000KnEH\000\000\000\000\000\000\001\236 \224qj\000\000\000\000rv\020\004T\208\000\000\000\000P(T\208Q\148w\144\000\000W\216\000\000T\208\000\000\000\000U\184\000\000\000\000\b\026\000\000\023<\000\000\000\000w\246\000\000k:xp\000\000\128F\003$\000\000\000\000v~\000\000\011\140\000\000\000\000\023\002q\254\000\000\000\000\000\000@\000\019\168\025\248\021\142\000\000\000\000\000\000\000\000\000\028\000\000\000\000W\146\006\244\b\b\002\198d\250\000\216\bx\000\000\000\000\b\222\b\b\005\172\000\000O\006G\176Ej\019\168\020\180\005\162\003\134\000&\000\000\b\030A\028A\028\005\162\003\134\003\134A\028\000\000g \001\224\021P\tL\007c\218d\250\004\174d\250dp\000\000\000\000\021J\001\016[\212\bR\001\016\\\142\000\000g\182\001\224\000\000A\028hL\000\000\0078\011\022]H\000\000\000\000\000\000\000\000\000\000\0240\000\000\000\000\027\134\000\000\t\210\020\180\000\000Y\238Bb\000\000\021\196\000\000\000\000A\028\024\170\000\000\000\000\000\000\000\000X\030\000\000\003\168\000\000I\168\006B\0224\000\000\021\218M\024O\006\020\004H\194N\198\020\004\0164\0164\000\000\000\000\000\000\000\000\001\232\020ZA\168\000\000O\188PrEj\019\168\020\180\006\150A\"\000\000\029\028\000\000Q(Q\222x\214\022dd\250\006B\000\000O\006\020\004\000\000rv\020\004qjT\208@\160\000\000O\006\020\004t\168\000b\000\000T\208@\000d\250\004\168\005\172\t\014\000\000\000\000\000\000F\b\005\b\005\b\000\000\t n^\000\000rv\020\004T\208\023\002\000\000N\198\020\004\0164\021\218\0164\002\220\003\158\000\000\000\000\0164\t\030\000\000\t\138\000\000\0164\003\208\t\222\000\000!\212\000\000\002\228\000\000\000\000\025\170\000\000\017(\022\206\000\000\000\000\000\000\005~\000\000\000\000\026\158\000\000\027\146\000\000\028\134\000\000\018\028\023\194\000\000\000\000\000\000B\154\000\000\000\000\000\000\000\000\029z\000\000\030n\000\000\031b\000\000 V\000\000!J\000\000\">\000\000#2\000\000$&\000\000%\026\000\000&\014\000\000'\002\000\000'\246\000\000(\234\000\000)\222\000\000*\210\000\000+\198\000\000,\186\000\000-\174\000\000.\162\000\000/\150\020\004T\208V\230F\240\005\b\nHh\196T\208\000\000\000\000\000\000d\250\000\000\026\132j\224\000\000\024\236d\250\027x\n\018\000\000\000\000\000\000\000\000h\196\000\000\000\000\002f\011\026\000\000B\146\000\000\000\000\131\230\000\000\006\180\000\000\000\000M \005\b\n\216d\250\006\162\000\000\000\000\0046\0032\000\000d\250\0076\000\000\000\000\011`\000\000\000\000\000\000\025@d\250\007\138\000\000\000\000\027\198\000\000\000\000yP\000\000\028\028y\182\000\000\028\186z0\000\000\029\016\004l\000\000\000\000\000\000\000\000\029\174T\208\030\004n\216n\216\000\000\000\000\000\0000\138\000\000\012<\000\000\000\000\000\000i*\000\000\000\000\000}\bb\000\000\t\002\000\000\000\000X\196H\194\000\000\000\000\012\128\000\000\000\000\000\000\006\132\000\000\000\000\000\000\0164\004\196\tV\000\000\t\246\000\000\005\184\000\0001~\000\000\012\134\000\000\006\172\000\0002r\000\000\012`\007\160\000\0003fd\246\000\000\"\200\000\000\n\234\b\148\000\0004Z\000\000\012\152\t\136\000\0005N\000\000i\172\n|\000\0006B\t\198\nJ\000\000\011<\011p\000\00076\000\000\r0\012d\000\0008*\000\000\t`\rX\000\0009\030\014L\000\000:\018\015@\019\016\000\000\000\000\000\000\011\222\000\000\000\000\rN\000\000\000\000\012\180\000\000\bV\000\000\000\000\000\000\012>\000\000\012f\000\000\000\000G\216\005\b\rZn^D8\002\234\000\000\000\000n^\000\000\000\000\000\000n^\000\000\r\168\000\000\000\000\000\000\000\000\000\000\000\000;\006T\208\000\000\000\000\014&\000\000;\250\000\000<\238\000\000\030\162\000\000\000\000\n6\000\000\000\000T\208\000\000\000\000zF\011\238\000\000\000\000I\168\000\000\011\208\000\000\000\000St\000\000\r`\000\000\000\000\0022\011v\000\000\000\000\021\218\025.\tL\000\000\031\152\000\000\031\172\021\184\022\234\000\000\000\000\012\210\000\000\000\000\001\230\021FU0\000\000\024\182\000\000\b\226\000\000\000\000\rt\000\000\000\000]\236\005\188\0022\000\000\000\000\011\186\000\000\000\000\014$\000\000\000\000\000\000\019\168\020\180\004\174\000\000\000\000\021l\003\200\000&\004\\\020\180u\nA\028\020\144\020\180u\136\r\226\000\000\000\000\004\\\000\000E$\020\004\000\142\000\000\007\128\014T\000\000\014\158\000\000\000\000\003\186D8\006\168\000\000\014\148\014*M \n^d\250\0190\005\216\rx\002\252\000\000\029\012\015F\000\000\006\168\000\000\000\000\015hD8^\132\000\000e\142D8\015\214_\174\000\000\000\000Cj\000\000\029\232\000\000C\182\000\000\025$\000\000A\028\030\016\000\000}\156\000\000\019\168\020\180}\156\000\000\025\162\020\184\000V\0032\127PA\028z\212n\216\000\000\003\200\002\212\000&\004\\n\216\129~\003\200\000&\004\\n\216\129~\000\000\000\000\004\\n\216\000\000B\154C\134T\208F4\000\000\000\000B\154C\134Ej\019\168\020\180}\156\000\000\025\128\005\162\003$\014\232d\250\t\030\015\184\127\200\000\000n\216\000\000E$\020\004\000\142s\226\007:\011\b\015\176{.\t\248\015\014\020\004n\216\000\000\020\004n\216\000\000j\224\127B\024\172\b\138\000V\001\016o\162\000\000\000V\001\016o\162\000\000\025\162\003\200\007\152\022z\001T\000\000o\162\000\000\000&\015\016A\028}z\130\192\003\200\000&\015\018A\028}z\130\192\000\000\000\000\005P\000\000h\196\000\000A\028\128\020h\196\000\000\005P\000\000N\200\020\004A\028}z\000\000E$\020\004\000\142oV\020\184\020\184\019\174\b>\000\000\012\172\021P\011V\000\000\015\168\015Z\024`\020\004Fld\250\011T\000\000VP\003v\006p\012\186\000\000\r\244\000\000\015\218\015dd\250D|\000\000\020\004\t\132\011\216\000\000\r\246\000\000\015\222\015jM \011\232d\250StD|\000\000]\228\019\206\024`\000\000\016\002\tF\000V\000\000\r2\024`d\250\012>\014\n\0128\014\016\000\000\000\000d\250\b\194\003\254\000\000\000\000kT\000\000\000\000\014&\024`k\210D|\000\000\020\004d\250\012\214d\250S\252D|\000\000\011x\000\000\000\000D|\000\000\000\000VP\000\000n\216\129\130\019\174\b>\012\172\015\242\015\164\024`n\216\129\130\000\000\000\000\019\174\b>\012\172\016\000\015\142N\018f\012D8\016\022N\018d\250\003\254\016(N\018D8\016*N\018\r\002\0144lPl\206\000\000~\028\000\000\000\000n\216\130\206\019\174\b>\012\172\016 \015\172N\018n\216\130\206\000\000\000\000\000\000\127B\000\000\000\000\000\000\000\000\000\000\000\000h\196\000\000\129\252\020\004\021P\0160t>\000\000|\194\129\252\000\000\000\000\131N\020\004\021P\0166\015\198Y\002m\128\006\168\016r\000\000\000\000mFoV\020\004\000\000{\166\000\142\000\000\000\000o\162\131N\000\000\000\000\000\000v\006EZO\200\006\168\016t\000\000\000\000\000\000oV\020\004\000\000\006\168\016\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003v\020\184\019\174\b>\012\172\016lo\198B\178\020\004BjG\130\026\158\002\252\006\168\016r\003\198\000\000\000\000\016$\000\000\000\000F\224\000\000\n$\014H\000\000\014\146\000\000\016z\016\004d\250Wn\016~\004<\000\000\000\000\0166\000\000\000\000\029b\bf\r\162\000\000\016\150ph~J\005\b\0168d\250\012\238\000\000\000\000\016N\000\000\000\000\000\000F\224\000\000\nx\014\132\000\000\014\230\000\000\016\190\016HM \000\000\016\206q\n\132*\005\b\016ld\250\r<\000\000\000\000\016~\000\000\000\000\000\000\020\004\000\000F\224\000\000\020&\019\206B\178B\178r\240B\154\020\004}:T\208\007V\000\000\n:\000V\000\000\014\132B\178d\250\r>\007\174\000\000\020\004U\184o\198B\178\011\226B\178\000\000DfEH\000\000`B\000\000\000\000`\218\000\000\000\000ar\000\000\014\160B\178b\n}:T\208\007V\000\000\000\"\000\000\000\000N\018\014X\000\000\000\000L\028\016\214\000\000F\224\000\000B\178L\028F\224\000\000\020\004d\250F\224\000\000\014\148\000\000\000\000F\224\000\000\000\000G\130\000\000~vN\018\016\136B\178~\246o\198\000\000n\216\130t\019\174\b>\012\172\016\230o\198n\216\130t\000\000\000\000\000\000\131\\O\006\000\000\000\000\000\000\000\000\000\000\000\000\128\140n\216\000\000\129\252\000\000\000\000\000\000\000\000h\196\131\\\000\000\017\030\000\000\000\000\128\140\017&\000\000h\196\131\\\000\000\000\000\014\244\000\000\000\000f\138\026@\000\000\000\000@\160\000\000d\250\012H\000\000G\130\015H\000\000\000\000\000\000\014\172\000\000\000\000\000\000Ej\019\168\020\180\004\174\000\000Fz\000\000\030\220\000\000\001\180\000\000\000\000\0170\000\000\017Zv~\000\000?\202\017B\000\000\000\000\0178\0268\022h\000\142sj\007:\020\004\000\000n\216\000\000\000\000\000\000\000\000\000\000\000\000\000\000s|\007:\020\004\000\000\014\254t>\000\000|\194\000\000\017:\0268\022hn\216\000\000\017J\000\000\006\162\015D\020\004K\150\000\000\000\000\028F\132\\\000\000\000\000\016\226\000\000\0176d\250\000\000\r\144\t\150\007\174\000\000\000\000d\250\t\b\n\210\000\000d\250\n\240\006\168\017^\000\000\000\000{\170\000\000\000\000Y\002\000\000o\162\000\000\017\\\0268\023\\h\196\000\000\000\000\000\000\000\000\015(t>Y\002\000\000o\162\000\000\017^\0268\023\\h\196\000\000\015p\000\000\000\000\031\004\000\000n\216\000\000\017z\000\000\000\000\016\246\000\000\017\000\000\000\017\020\000\000\000\000K \017\022\000\000\000\000d\250\000\000\014\156\000\000\000\000\017\024\000\000\000\000T\208\031\150\000\000\000\000H\194\0032|h\000\000\000\000\000\000\000\000\000\000rh\023l\000\000\000\000\017\172\000\000JV\000\000\015\128\017\184\000\000\017\196\000\000I\168I\168\132>\132>\000\000\000\000nz\132>\000\000\000\000\000\000nz\132>\0178\000\000\017>\000\000"), (16, "\b\193\b\193\000\006\002.\006\005\b\193\002\154\002\158\b\193\002\202\002\214\b\193\003r\b\193\006n\002\218\b\193\023\138\b\193\b\193\b\193\0022\b\193\b\193\006\005\003f\003j\002\222\b\193\003\030\003\"\t\190\b\193\011\238\b\193\003\234\003&\023\142\002\226\006\202\b\193\b\193\003\178\003\182\b\193\003\186\003\014\003\198\003\206\006\170\004-\b\193\b\193\002\146\001v\b\182\003\026\b\193\b\193\b\193\007\234\007\238\007\250\b\014\001*\005R\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\193\b\130\000\238\b\193\015N\b\193\b\193\002b\b\142\b\166\b\250\005^\005b\b\193\b\193\b\193\004-\b\193\b\193\b\193\b\193\b\186\b\214\r\186\b\193\003v\b\193\b\193\000\238\b\193\b\193\b\193\b\193\b\193\b\193\005f\b\002\b\193\b\193\b\193\b\026\004.\t\014\015R\b\193\b\193\b\193\b\193\012e\012e\023\146\006r\006\r\012e\003}\012e\012e\015^\012e\012e\012e\012e\004R\012e\012e\0069\012e\012e\012e\001\206\012e\012e\006\r\012e\004-\012e\012e\012e\012e\012e\012e\012e\012e\015f\001j\0069\012e\004\190\012e\012e\012e\012e\012e\000\238\012e\012e\017\198\012e\003\202\012e\012e\012e\001\134\001\206\012e\012e\012e\012e\012e\012e\012e\000\238\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\003}\012e\012e\001f\012e\012e\003U\003>\001r\004-\012e\012e\012e\012e\012e\001\130\012e\012e\012e\012e\012e\0252\012e\012e\004Z\012e\012e\003B\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\012e\0256\004-\012e\012e\012e\012e\001\153\001\153\001\153\004N\006\246\001\153\001\182\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\186\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\0072\b\157\001\153\001\146\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\198\001\153\001\153\001\153\004^\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\006E\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\n\154\001\153\001\153\n\166\003J\006E\007\242\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\014\150\b2\001\153\005\146\001\153\001\153\003N\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\157\001\153\001\153\001\153\001\153\001\153\t\245\t\245\003f\003j\tb\t\245\003J\t\245\t\245\003y\t\245\t\245\t\245\t\245\001\206\t\245\t\245\016\170\t\245\t\245\t\245\001b\t\245\t\245\tf\t\245\003N\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\001z\006\026\001\138\t\245\004-\t\245\t\245\t\245\t\245\t\245\002F\t\245\t\245\r\138\t\245\001\214\t\245\t\245\t\245\002z\004-\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004-\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\238\t\245\t\245\003y\t\245\t\245\004-\001\002\001\190\004v\t\245\t\245\t\245\t\245\t\245\001\218\t\245\t\245\t\245\t\245\t&\006\134\tV\t\245\007\137\t\245\t\245\001\230\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004-\t\245\t\245\t\245\t\245\t\245\003\153\003\153\004-\004-\006\230\003\153\002J\003\153\003\153\006\198\003\153\003\153\003\153\003\153\000\238\003\153\003\153\004-\003\153\003\153\003\153\t*\003\153\003\153\015n\003\153\007\174\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\r6\001\234\rB\003\153\000\238\003\153\003\153\003\153\003\153\003\153\bU\003\153\003\153\003!\003\153\001\206\003\153\003\153\003\153\007\230\000\238\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003!\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\011&\t\030\tN\011\150\003\153\003\153\005\"\000\238\002\246\021\194\003\153\003\153\003\153\003\153\003\153\002V\003\153\003\153\003\153\003\153\t&\015\206\tV\003\153\n\154\003\153\003\153\n\166\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\006\198\003\153\003\153\003\153\003\153\003\153\003\141\003\141\001\002\001\190\bU\003\141\003\237\003\141\003\141\025\026\003\141\003\141\003\141\003\141\b\137\003\141\003\141\005&\003\141\003\141\003\141\022\n\003\141\003\141\003~\003\141\011.\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\007\174\n\154\015\022\003\141\n\166\003\141\003\141\003\141\003\141\003\141\000\238\003\141\003\141\000\238\003\141\004\178\003\141\003\141\003\141\005\161\015\030\003\141\003\141\003\141\003\141\003\141\003\141\003\141\014\254\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\237\t\030\tN\007&\003\141\003\141\b\230\001f\003U\003\130\003\141\003\141\003\141\003\141\003\141\004b\003\141\003\141\003\141\003\141\t&\025\030\tV\003\141\001\206\003\141\003\141\003\246\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\003\141\006\198\003\141\003\141\003\141\003\141\003\141\tq\tq\b\153\003\250\006\021\tq\005.\tq\tq\005\161\tq\tq\tq\tq\006\181\tq\tq\002\182\tq\tq\tq\014\202\tq\tq\006\021\tq\004-\tq\tq\tq\tq\tq\tq\tq\tq\004-\004-\018\n\tq\004-\tq\tq\tq\tq\tq\t\138\tq\tq\000\238\tq\012N\tq\tq\tq\001\150\018\022\tq\tq\tq\tq\tq\tq\tq\000\238\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\000\238\tq\tq\001f\tq\tq\b\153\003U\006\166\004-\tq\tq\tq\tq\tq\nn\tq\tq\tq\tq\tq\018\162\tq\tq\004.\tq\tq\012&\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\tq\007\242\004-\tq\tq\tq\tq\ti\ti\004\206\012*\n\254\ti\000\238\ti\ti\018\170\ti\ti\ti\ti\004-\ti\ti\005\137\ti\ti\ti\003q\ti\ti\011\002\ti\014\210\ti\ti\ti\ti\ti\ti\ti\ti\007\174\b~\015v\ti\004N\ti\ti\ti\ti\ti\005\129\ti\ti\000\238\ti\012f\ti\ti\ti\000\238\004\174\ti\ti\ti\ti\ti\ti\ti\000\238\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\004-\ti\ti\002\158\ti\ti\002\214\006~\006\150\011\026\ti\ti\ti\ti\ti\004f\ti\ti\ti\ti\ti\bV\ti\ti\004\138\ti\ti\004\222\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\ti\004N\017V\ti\ti\ti\ti\ty\ty\003f\017\190\002n\ty\000\238\ty\ty\017Z\ty\ty\ty\ty\002\158\ty\ty\017\210\ty\ty\ty\002\194\ty\ty\004\178\ty\b\137\ty\ty\ty\ty\ty\ty\ty\ty\005b\0116\004E\ty\007\002\ty\ty\ty\ty\ty\007n\ty\ty\000\238\ty\012z\ty\ty\ty\002\238\007\n\ty\ty\ty\ty\ty\ty\ty\000\238\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\005\n\ty\ty\011Z\ty\ty\005\238\004E\018b\b\137\ty\ty\ty\ty\ty\015V\ty\ty\ty\ty\ty\002\250\ty\ty\006\130\ty\ty\rR\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\ty\000\238\b\137\ty\ty\ty\ty\tY\tY\002\209\004-\012\153\tY\006\146\tY\tY\004-\tY\tY\tY\tY\002\254\tY\tY\012\153\tY\tY\tY\011\242\tY\tY\004-\tY\000\n\tY\tY\tY\tY\tY\tY\tY\tY\012\014\000\238\012\030\tY\014\174\tY\tY\tY\tY\tY\bY\tY\tY\006\210\tY\012\154\tY\tY\tY\002\209\011\250\tY\tY\tY\tY\tY\tY\tY\rV\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\011\254\tY\tY\bm\tY\tY\b\210\000\238\006\158\016\022\tY\tY\tY\tY\tY\b\242\tY\tY\tY\tY\tY\004-\tY\tY\002\158\tY\tY\012&\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\tY\t:\000\238\tY\tY\tY\tY\ta\ta\018\206\r\002\bY\ta\000\238\ta\ta\014\178\ta\ta\ta\ta\001\206\ta\ta\003\226\ta\ta\ta\012>\ta\ta\018\214\ta\000\238\ta\ta\ta\ta\ta\ta\ta\ta\012V\017.\012n\ta\bm\ta\ta\ta\ta\ta\007\181\ta\ta\tB\ta\012\174\ta\ta\ta\002z\012F\ta\ta\ta\ta\ta\ta\ta\002\250\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\012J\ta\ta\007\162\ta\ta\019\022\021\226\006\198\026\"\ta\ta\ta\ta\ta\tR\ta\ta\ta\ta\ta\004-\ta\ta\002\250\ta\ta\017f\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\ta\n\134\021\234\ta\ta\ta\ta\t\153\t\153\022n\005\129\012\206\t\153\003\234\t\153\t\153\011&\t\153\t\153\t\153\t\153\004b\t\153\t\153\003\238\t\153\t\153\t\153\012\210\t\153\t\153\022v\t\153\000\238\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\230\n\190\012\250\t\153\r\254\t\153\t\153\t\153\t\153\t\153\007\173\t\153\t\153\005\002\t\153\012\194\t\153\t\153\t\153\004j\tb\t\153\t\153\t\153\t\153\t\153\t\153\t\153\026:\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\150\t\153\t\153\bq\t\153\t\153\023\002\015\138\014\006\007r\t\153\t\153\t\153\t\153\t\153\003\018\t\153\t\153\t\153\t\153\t\153\011\250\t\153\t\153\n\226\t\153\t\153\000\238\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\t\153\012\218\000\238\t\153\t\153\t\153\t\153\t\137\t\137\001\218\014R\019\150\t\137\018\146\t\137\t\137\018r\t\137\t\137\t\137\t\137\006.\t\137\t\137\b\133\t\137\t\137\t\137\011\018\t\137\t\137\026>\t\137\005\018\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\005\026\0062\014\218\t\137\bq\t\137\t\137\t\137\t\137\t\137\000\238\t\137\t\137\014.\t\137\012\222\t\137\t\137\t\137\n\222\012F\t\137\t\137\t\137\t\137\t\137\t\137\t\137\014\026\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\r2\t\137\t\137\018\210\t\137\t\137\011B\014V\014\030\011&\t\137\t\137\t\137\t\137\t\137\002J\t\137\t\137\t\137\t\137\t\137\019\154\t\137\t\137\007\189\t\137\t\137\011\210\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\t\137\014\222\004\178\t\137\t\137\t\137\t\137\t\129\t\129\011\214\019.\004\178\t\129\024\226\t\129\t\129\0236\t\129\t\129\t\129\t\129\012\022\t\129\t\129\012^\t\129\t\129\t\129\012v\t\129\t\129\004N\t\129\011\210\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\018\238\012\026\0142\t\129\012b\t\129\t\129\t\129\t\129\t\129\000\238\t\129\t\129\012\170\t\129\012\242\t\129\t\129\t\129\nn\014\138\t\129\t\129\t\129\t\129\t\129\t\129\t\129\rJ\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\0196\t\129\t\129\014\142\t\129\t\129\rb\018\166\002\233\019B\t\129\t\129\t\129\t\129\t\129\005\145\t\129\t\129\t\129\t\129\t\129\018j\t\129\t\129\rj\t\129\t\129\012\022\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\t\129\000\238\012^\t\129\t\129\t\129\t\129\t\145\t\145\012\238\004N\014B\t\145\000\238\t\145\t\145\023\026\t\145\t\145\t\145\t\145\014\186\t\145\t\145\r>\t\145\t\145\t\145\r~\t\145\t\145\019\130\t\145\014F\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\015\154\022J\014\190\t\145\003e\t\145\t\145\t\145\t\145\t\145\000\238\t\145\t\145\026\030\t\145\r\006\t\145\t\145\t\145\020*\019\"\t\145\t\145\t\145\t\145\t\145\t\145\t\145\022*\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\022\170\t\145\t\145\007B\t\145\t\145\r\174\018\174\018\218\007\173\t\145\t\145\t\145\t\145\t\145\019B\t\145\t\145\t\145\t\145\t\145\001\206\t\145\t\145\004b\t\145\t\145\014\230\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\t\145\r\218\004b\t\145\t\145\t\145\t\145\t\225\t\225\014\234\005\141\007\185\t\225\023\154\t\225\t\225\026.\t\225\t\225\t\225\t\225\019\n\t\225\t\225\019:\t\225\t\225\t\225\0152\t\225\t\225\015Z\t\225\023\158\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\020.\023\218\021\230\t\225\021\238\t\225\t\225\t\225\t\225\t\225\012\161\t\225\t\225\024\254\t\225\r\018\t\225\t\225\t\225\022r\019f\t\225\t\225\t\225\t\225\t\225\t\225\t\225\015b\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\012\173\t\225\t\225\007B\t\225\t\225\022z\005\133\015~\024\186\t\225\t\225\t\225\t\225\t\225\015\130\t\225\t\225\t\225\t\225\t\225\001\206\t\225\t\225\000\238\t\225\t\225\023\014\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\023n\001\206\t\225\t\225\t\225\t\225\003\137\003\137\007\177\007B\024\238\003\137\023\222\003\137\003\137\027\031\003\137\003\137\003\137\003\137\025\178\003\137\003\137\007B\003\137\003\137\003\137\025\230\003\137\003\137\026\194\003\137\015\170\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\026\150\015\190\025\002\003\137\015\214\003\137\003\137\003\137\003\137\003\137\015\234\003\137\003\137\016\018\003\137\004E\003\137\003\137\003\137\024\190\016&\003\137\003\137\003\137\003\137\003\137\003\137\003\137\017&\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\0172\t\030\tN\003\218\003\137\003\137\005\234\004\193\017\218\017\242\003\137\003\137\003\137\003\137\003\137\002\194\003\137\003\137\003\137\003\137\t&\024\242\tV\003\137\018z\003\137\003\137\018~\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\026\198\003\137\003\137\003\137\003\137\003\137\001\221\001\221\018\182\018\186\018\226\001\221\018\230\002\158\001\221\019\018\002\214\001\221\t6\001\221\019\202\002\218\001\221\019\206\001\221\001\221\001\221\019\242\001\221\001\221\019\246\t>\020\006\002\222\001\221\001\221\001\221\001\221\001\221\tF\001\221\020\022\020\"\020^\002\226\020b\001\221\001\221\001\221\001\221\001\221\020\174\003\014\001\190\020\214\001\221\020\218\001\221\001\221\002\146\020\234\021:\003\026\001\221\001\221\001\221\007\234\007\238\007\250\021Z\0122\005R\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\001\221\021\154\t\030\tN\021\190\001\221\001\221\021\206\021\246\021\250\022\006\005^\005b\001\221\001\221\001\221\022\022\001\221\001\221\001\221\001\221\012:\0222\012\138\001\221\022B\001\221\001\221\022V\001\221\001\221\001\221\001\221\001\221\001\221\005f\b\002\001\221\001\221\001\221\b\026\004.\022\130\022\134\001\221\001\221\001\221\001\221\t\201\t\201\022\146\022\162\022\182\t\201\023\170\002\158\t\201\024\002\002\214\t\201\t\201\t\201\024*\002\218\t\201\024\146\t\201\t\201\t\201\024\162\t\201\t\201\025>\t\201\025F\002\222\t\201\t\201\t\201\t\201\t\201\t\201\t\201\025V\025b\025\198\002\226\025\218\t\201\t\201\t\201\t\201\t\201\026\n\003\014\001\190\026\018\t\201\026N\t\201\t\201\002\146\026v\026\174\003\026\t\201\t\201\t\201\007\234\007\238\007\250\026\222\t\201\005R\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\026\234\t\201\t\201\026\242\t\201\t\201\026\251\027\011\027+\027w\005^\005b\t\201\t\201\t\201\027\139\t\201\t\201\t\201\t\201\t\201\027\147\t\201\t\201\027\207\t\201\t\201\027\215\t\201\t\201\t\201\t\201\t\201\t\201\005f\b\002\t\201\t\201\t\201\b\026\004.\000\000\000\000\t\201\t\201\t\201\t\201\t\197\t\197\000\000\000\000\000\000\t\197\000\000\002\158\t\197\000\000\002\214\t\197\t\197\t\197\000\000\002\218\t\197\000\000\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\000\000\002\222\t\197\t\197\t\197\t\197\t\197\t\197\t\197\000\000\000\000\000\000\002\226\000\000\t\197\t\197\t\197\t\197\t\197\000\000\003\014\001\190\000\000\t\197\000\000\t\197\t\197\002\146\000\000\000\000\003\026\t\197\t\197\t\197\007\234\007\238\007\250\000\000\t\197\005R\t\197\t\197\t\197\t\197\t\197\t\197\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\000\000\000\000\000\000\000\000\005^\005b\t\197\t\197\t\197\000\000\t\197\t\197\t\197\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\000\000\t\197\t\197\t\197\t\197\t\197\t\197\005f\b\002\t\197\t\197\t\197\b\026\004.\000\000\000\000\t\197\t\197\t\197\t\197\002)\002)\000\000\000\000\000\000\002)\000\000\002\158\002)\000\000\002\214\002)\t6\002)\000\000\002\218\002)\000\000\002)\002)\002)\000\000\002)\002)\000\000\t>\000\000\002\222\002)\002)\002)\002)\002)\tF\002)\007\161\000\000\000\000\002\226\007\161\002)\002)\002)\002)\002)\000\000\003\014\001\190\000\000\002)\000\000\002)\002)\002\146\000\000\000\000\003\026\002)\002)\002)\007\234\007\238\007\250\000\000\0122\005R\002)\002)\002)\002)\002)\002)\002)\002)\002)\007\161\004\149\002)\000\000\002)\002)\000\000\000\000\004-\000\000\005^\005b\002)\002)\002)\004-\002)\002)\002)\002)\006R\007\161\000\000\002)\004\149\002)\002)\004-\002)\002)\002)\002)\002)\002)\005f\b\002\002)\002)\002)\b\026\004.\000\000\000\000\002)\002)\002)\002)\004-\000\000\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004\218\004-\000\238\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\000\000\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\004-\004-\004-\004-\004-\004-\004-\004-\002\250\004-\004-\004-\004-\004-\004-\004-\004-\000\238\004-\004-\004-\004-\004-\004-\004-\004-\000\000\000\000\004-\006\242\000\000\004-\004-\004-\000\238\004-\000\000\000\000\004-\004-\004-\004-\004-\004-\004-\004-\004-\b6\001\190\004-\004-\003\170\002\209\002\158\004-\002\209\018V\014\"\004-\004-\003\138\0146\014J\014Z\000\000\000\000\004-\004-\004-\007^\000\000\004-\004-\004-\004-\000\000\000\129\004-\000\129\000\n\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\238\000\129\022\214\000\129\000\129\003\166\000\129\000\129\002\209\000\000\000\129\000\129\002\146\000\129\000\129\000\000\000\129\000\000\000\129\000\129\002\209\002\209\000\129\000\129\000\000\000\129\000\129\000\129\000\000\000\129\015&\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\250\006\190\000\129\000\129\012Q\012=\000\129\000\129\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\002\209\002\209\000\000\000\000\012Q\000\129\000\000\000\129\000\000\000\129\002\026\006\133\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\b6\014\154\002\"\000\129\000\n\002&\012=\000\000\000\222\006Z\014\"\b\177\000\129\006\133\0146\014J\014Z\007\186\000\129\000\129\000\129\000\129\000\000\000\000\000\129\000\129\000\129\000\129\002\025\002\025\014z\000\000\002\209\002\025\b\177\002\158\002\025\007\190\002\214\002\025\000\000\002\025\000\000\002\218\002\025\007:\002\025\002\025\002\025\000\000\002\025\002\025\000\000\007B\000\000\002\222\002\025\002\025\002\025\002\025\002\025\007F\002\025\007\174\000\000\000\000\002\226\000\000\002\025\002\025\002\025\002\025\002\025\006\157\003\014\007\254\000\238\002\025\000\000\002\025\002\025\002\146\000\000\000\000\003\026\002\025\002\025\002\025\007\234\007\238\007\250\000\000\006\157\005R\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\t\030\tN\015N\002\025\002\025\002b\000\000\000\000\000\000\005^\005b\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\t&\007\194\tV\002\025\000\000\002\025\002\025\000\000\002\025\002\025\002\025\002\025\002\025\002\025\005f\b\002\002\025\002\025\002\025\b\026\004.\000\000\015R\002\025\002\025\002\025\002\025\0025\0025\006\157\000\000\0059\0025\007E\000\000\0025\015^\000\000\0025\007\246\0025\b\181\000\000\0025\000\000\0025\0025\0025\002\158\0025\0025\000\000\000\000\b\165\000\000\0025\0025\0025\0025\0025\000\000\0025\015f\007E\b\181\000\000\000\000\0025\0025\0025\0025\0025\006:\000\000\0059\b\165\0025\007E\0025\0025\007E\bv\005\246\000\000\0025\0025\0025\007E\003\226\025j\017\194\007E\0059\0025\0025\0025\0025\0025\0025\0025\0025\0025\005\250\t\030\tN\015N\0025\0025\002b\000\000\000\000\000\000\000\238\002\250\0025\0025\0025\000\000\0025\0025\0025\0025\t&\000\000\tV\0025\000\000\0025\0025\000\000\0025\0025\0025\0025\0025\0025\bA\000\000\0025\0025\0025\000\238\t\n\000\000\015R\0025\0025\0025\0025\0021\0021\000\000\001\002\001\190\0021\000\000\005\254\0021\015^\005\194\0021\000\000\0021\000\000\b\165\0021\006\n\0021\0021\0021\006\022\0021\0021\bA\000\000\000\000\000\000\0021\0021\0021\0021\0021\000\000\0021\015f\005\254\000\000\000\000\005\194\0021\0021\0021\0021\0021\bA\006\n\000\000\000\000\0021\006\022\0021\0021\000\000\000\000\007\142\006\242\0021\0021\0021\000\000\000\000\021\006\000\000\000\000\000\000\0021\0021\0021\0021\0021\0021\0021\0021\0021\007\146\t\030\tN\bA\0021\0021\000\000\004\218\000\000\000\000\bA\001\206\0021\0021\0021\000\000\0021\0021\0021\0021\t&\007^\tV\0021\000\000\0021\0021\000\000\0021\0021\0021\0021\0021\0021\b=\000\000\0021\0021\0021\000\238\018\130\007\202\006\242\0021\0021\0021\0021\002\029\002\029\002\209\000\000\019\n\002\029\019\014\000\000\002\029\000\000\002\146\002\029\000\000\002\029\007\206\000\000\002\029\019&\002\029\002\029\002\029\000\000\002\029\002\029\b=\000\000\000\n\012\021\002\029\002\029\002\029\002\029\002\029\000\000\002\029\007^\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\b=\012\021\012\021\000\000\002\029\012\021\002\029\002\029\000\238\002\209\000\000\006\242\002\029\002\029\002\029\000\000\014b\000\000\000\000\000\000\000\000\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\002\029\016V\t\030\tN\b=\002\029\002\029\000\000\004\218\000\000\000\000\b=\000\238\002\029\002\029\002\029\000\000\002\029\002\029\002\029\002\029\t&\007^\tV\002\029\000\000\002\029\002\029\000\000\002\029\002\029\002\029\002\029\002\029\002\029\017\142\000\000\002\029\002\029\002\029\000\238\000\000\012\021\000\000\002\029\002\029\002\029\002\029\002-\002-\002\209\002\209\016\130\002-\nM\000\000\002-\n\178\000\n\002-\000\000\002-\t\030\tN\002-\002\209\002-\002-\002-\000\000\002-\002-\000\000\002\209\002\209\000\n\002-\002-\002-\002-\002-\t&\002-\tV\nM\016Z\002\209\004\153\002-\002-\002-\002-\002-\006V\002\158\000\000\000\000\002-\nM\002-\002-\nM\011R\002\209\000\000\002-\002-\002-\nM\000\000\004\153\000\000\nM\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\024\202\006\242\002-\007\173\002-\002-\007\173\000\000\000\000\000\000\000\000\003\226\002-\002-\002-\000\000\002-\002-\002-\002-\024\206\000\000\022*\002-\000\000\002-\002-\000\000\tn\002-\002-\002-\002-\002-\012\029\000\000\002-\002-\002-\000\000\000\000\007^\007\173\002-\002-\002-\002-\b\189\b\189\000\000\000\000\004-\b\189\012\029\012\029\b\189\007\173\012\029\b\189\000\238\b\189\000\000\000\000\t\150\000\000\b\189\t\186\b\189\000\000\b\189\b\189\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\b\189\007\173\000\000\006\153\000\000\004-\b\189\b\189\t\254\n\006\b\189\000\000\000\238\004-\000\000\b\189\000\000\n\014\b\189\000\000\000\000\000\000\006\153\b\189\b\189\000\238\006\153\000\000\007\173\000\000\000\000\000\000\b\189\b\189\t\158\t\222\n\022\n\030\n.\b\189\b\189\000\000\012\029\b\189\000\000\b\189\n6\000\000\000\000\000\000\000\000\0121\000\000\b\189\b\189\n>\000\000\b\189\b\189\b\189\b\189\000\000\000\238\0121\b\189\000\000\b\189\b\189\000\000\n^\b\189\nf\n&\b\189\b\189\012\025\000\000\b\189\nF\b\189\021\178\000\000\000\000\006\242\b\189\b\189\nN\nV\002a\002a\000\000\0121\006\153\002a\012\025\012\025\002a\000\000\012\025\002a\000\000\002a\007\154\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\0121\002a\007^\0121\006\173\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\238\000\000\000\000\002a\000\000\002a\002a\000\238\000\000\001*\006\173\002a\002a\002a\006\173\002\209\002\209\002\134\000\000\000\000\002a\002a\t\158\002a\002a\002a\002a\002a\002a\000\000\012\025\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\n\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\001\206\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\025\250\000\000\002a\002a\002a\002\209\011f\000\000\000\000\002a\002a\002a\002a\002I\002I\000\000\000\000\005B\002I\000\238\011n\002I\000\000\011z\002I\000\000\002I\000\000\002z\002I\011\134\002I\002I\002I\011\146\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\000\000\007=\000\000\000\000\000\000\002I\002I\002I\002I\002I\004v\000\000\000\000\004\197\002I\007=\002I\002I\005\194\000\000\000\000\000\000\002I\002I\002I\007=\000\000\000\000\000\000\007=\000\000\002I\002I\t\158\002I\002I\002I\002I\002I\002I\000\000\006\242\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\007U\007\157\002I\002I\002I\007\157\002I\002I\002I\002I\bb\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\002I\004-\007U\007^\000\000\002I\002I\002I\002I\002U\002U\000\000\000\000\007\157\002U\000\238\007U\002U\000\000\005\194\002U\000\238\002U\004-\000\000\t\150\007U\002U\002U\002U\007U\002U\002U\000\000\007\157\000\000\000\000\002U\002U\002U\t\214\002U\000\000\002U\004-\007q\000\000\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\238\000\000\002U\005\254\002U\002U\005\194\000\000\000\000\006\242\002U\002U\002U\007q\000\000\004\218\000\000\007q\000\000\002U\002U\t\158\t\222\002U\002U\002U\002U\002U\016F\006\242\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007i\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\016b\007^\000\000\002U\000\000\002U\002U\022\"\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\238\007i\007^\000\000\002U\002U\002U\002U\002e\002e\000\000\000\000\000\000\002e\000\238\011\170\002e\000\000\007i\002e\000\238\002e\000\000\000\000\002e\007i\002e\002e\002e\007i\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\002e\000\000\0079\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\000\000\000\000\000\002e\0079\002e\002e\005\194\000\000\000\000\006\242\002e\002e\002e\0079\000\000\000\000\000\000\0079\000\000\002e\002e\t\158\002e\002e\002e\002e\002e\002e\025*\006\242\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\000\000\002e\002e\002e\000\000\002e\002e\002e\002e\026\206\007^\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\238\r\242\007^\000\000\002e\002e\002e\002e\002E\002E\000\000\000\000\000\000\002E\000\000\011n\002E\000\000\011z\002E\000\238\002E\000\000\000\000\002E\011\134\002E\002E\002E\011\146\002E\002E\000\000\000\000\000\000\006\189\002E\002E\002E\002E\002E\000\000\002E\000\000\000\000\006\157\000\000\000\000\002E\002E\002E\002E\002E\000\000\006\189\000\000\000\000\002E\006\189\002E\002E\000\000\000\000\000\000\006\157\002E\002E\002E\006\157\000\000\000\000\000\000\000\000\000\000\002E\002E\t\158\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\000\000\002E\002E\000\000\000\000\000\000\000\000\000\238\000\000\002E\002E\002E\000\000\002E\002E\002E\002E\000\000\000\000\000\000\002E\000\000\002E\002E\000\000\002E\002E\002E\002E\002E\002E\000\000\000\000\002E\002E\002E\000\000\000\000\006\189\027;\002E\002E\002E\002E\002Q\002Q\000\000\000\000\007\246\002Q\000\000\005\254\002Q\n\154\005\194\002Q\n\166\002Q\000\000\000\000\t\150\006\n\002Q\002Q\002Q\006\022\002Q\002Q\000\000\000\000\000\000\006\149\002Q\002Q\002Q\t\214\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\006\149\000\000\000\000\002Q\006\149\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\t\158\t\222\002Q\002Q\002Q\002Q\002Q\000\000\002\250\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\005\150\006\149\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\003\210\000\000\002M\000\000\006\"\002M\003\222\000\000\002M\004\002\002M\000\000\000\000\t\150\000\000\002M\002M\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\t\214\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\t\158\t\222\002M\002M\002M\002M\002M\000\000\002\158\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\002M\000\000\tZ\003\226\000\000\002M\002M\002M\002M\002u\002u\000\000\000\000\000\000\002u\000\000\011\202\002u\011\218\000\000\002u\000\000\002u\000\000\000\000\t\150\000\000\002u\002u\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\t\254\n\006\002u\000\000\000\000\000\000\000\000\002u\000\000\n\014\002u\000\000\000\000\000\000\000\000\002u\002u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\t\158\t\222\n\022\n\030\n.\002u\002u\000\000\002\158\002u\000\000\002u\n6\000\000\000\000\000\000\000\000\000\000\000\000\002u\002u\n>\000\000\002u\002u\002u\002u\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\n&\002u\002u\000\000\000\000\002u\nF\002u\000\000\012\142\003\226\000\000\002u\002u\nN\nV\002]\002]\000\000\000\000\000\000\002]\000\000\012\162\002]\012\182\000\000\002]\000\000\002]\000\000\000\000\t\150\000\000\002]\002]\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\t\214\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\158\t\222\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\t\150\000\000\002Y\002Y\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\t\214\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\158\t\222\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002m\002m\000\000\000\000\000\000\002m\000\000\000\000\002m\000\000\000\000\002m\000\000\002m\000\000\000\000\t\150\000\000\002m\002m\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\t\254\n\006\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\158\t\222\n\022\n\030\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\n&\002m\002m\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002A\002A\000\000\000\000\000\000\002A\000\000\000\000\002A\000\000\000\000\002A\000\000\002A\000\000\000\000\t\150\000\000\002A\002A\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\t\214\002A\000\000\002A\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002A\000\000\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\t\158\t\222\002A\002A\002A\002A\002A\000\000\000\000\002A\000\000\002A\002A\000\000\000\000\000\000\000\000\000\000\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\000\000\000\000\000\000\002A\000\000\002A\002A\000\000\002A\002A\002A\002A\002A\002A\000\000\000\000\002A\002A\002A\000\000\000\000\000\000\000\000\002A\002A\002A\002A\002=\002=\000\000\000\000\000\000\002=\000\000\000\000\002=\000\000\000\000\002=\000\000\002=\000\000\000\000\t\150\000\000\002=\002=\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002=\000\000\002=\000\000\000\000\000\000\000\000\000\000\002=\002=\t\254\n\006\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\002=\002=\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\t\158\t\222\n\022\n\030\002=\002=\002=\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\000\000\002=\002=\002=\002=\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\002=\002=\002=\n&\002=\002=\000\000\000\000\002=\002=\002=\000\000\000\000\000\000\000\000\002=\002=\002=\002=\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\t\150\000\000\002\153\002\153\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\254\n\006\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\t\158\t\222\n\022\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\002\153\002\153\002\153\n&\002\153\002\153\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\0029\0029\000\000\000\000\000\000\0029\000\000\000\000\0029\000\000\000\000\0029\000\000\0029\000\000\000\000\t\150\000\000\0029\0029\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\0029\000\000\0029\000\000\000\000\000\000\000\000\000\000\0029\0029\t\254\n\006\0029\000\000\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\0029\0029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\t\158\t\222\n\022\n\030\0029\0029\0029\000\000\000\000\0029\000\000\0029\0029\000\000\000\000\000\000\000\000\000\000\000\000\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\000\000\000\0029\000\000\0029\0029\000\000\0029\0029\0029\n&\0029\0029\000\000\000\000\0029\0029\0029\000\000\000\000\000\000\000\000\0029\0029\0029\0029\002q\002q\000\000\000\000\000\000\002q\000\000\000\000\002q\000\000\000\000\002q\000\000\002q\000\000\000\000\t\150\000\000\002q\002q\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002q\000\000\002q\000\000\000\000\000\000\000\000\000\000\002q\002q\t\254\n\006\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\t\158\t\222\n\022\n\030\002q\002q\002q\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\002q\002q\002q\002q\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\002q\002q\002q\n&\002q\002q\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\002q\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\t\150\000\000\002i\002i\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\t\254\n\006\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\t\158\t\222\n\022\n\030\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\n&\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\t\150\000\000\002y\002y\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\t\254\n\006\002y\000\000\000\000\000\000\000\000\002y\000\000\n\014\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\158\t\222\n\022\n\030\n.\002y\002y\000\000\000\000\002y\000\000\002y\n6\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n>\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\n&\002y\002y\000\000\000\000\002y\nF\002y\000\000\000\000\000\000\000\000\002y\002y\nN\nV\002}\002}\000\000\000\000\000\000\002}\000\000\000\000\002}\000\000\000\000\002}\000\000\002}\000\000\000\000\t\150\000\000\002}\002}\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\t\254\n\006\002}\000\000\000\000\000\000\000\000\002}\000\000\n\014\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\t\158\t\222\n\022\n\030\n.\002}\002}\000\000\000\000\002}\000\000\002}\n6\000\000\000\000\000\000\000\000\000\000\000\000\002}\002}\n>\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n&\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\nN\nV\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\150\000\000\002\129\002\129\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\254\n\006\002\129\000\000\000\000\000\000\000\000\002\129\000\000\n\014\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\158\t\222\n\022\n\030\n.\002\129\002\129\000\000\000\000\002\129\000\000\002\129\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n>\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n&\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\nN\nV\by\by\000\000\000\000\000\000\by\000\000\000\000\by\000\000\000\000\by\000\000\by\000\000\000\000\t\150\000\000\by\by\by\000\000\by\by\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\by\000\000\000\000\000\000\000\000\000\000\by\by\t\254\n\006\by\000\000\000\000\000\000\000\000\by\000\000\n\014\by\000\000\000\000\000\000\000\000\by\by\000\238\000\000\000\000\000\000\000\000\000\000\000\000\by\by\t\158\t\222\n\022\n\030\n.\by\by\000\000\000\000\by\000\000\by\n6\000\000\000\000\000\000\000\000\000\000\000\000\by\by\n>\000\000\by\by\by\by\000\000\000\000\000\000\by\000\000\by\by\000\000\by\by\by\n&\by\by\000\000\000\000\by\nF\by\000\000\000\000\000\000\000\000\by\by\nN\nV\002\133\002\133\000\000\000\000\000\000\002\133\000\000\000\000\002\133\000\000\000\000\002\133\000\000\002\133\000\000\000\000\t\150\000\000\002\133\002\133\002\133\000\000\002\133\002\133\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\254\n\006\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n\014\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\158\t\222\n\022\n\030\n.\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n>\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\n^\002\133\nf\n&\002\133\002\133\000\000\000\000\002\133\nF\002\133\000\000\000\000\000\000\000\000\002\133\002\133\nN\nV\bu\bu\000\000\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\bu\000\000\bu\000\000\000\000\t\150\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\t\254\n\006\bu\000\000\000\000\000\000\000\000\bu\000\000\n\014\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\000\000\000\000\000\000\000\000\000\000\000\000\bu\bu\t\158\t\222\n\022\n\030\n.\bu\bu\000\000\000\000\bu\000\000\bu\n6\000\000\000\000\000\000\000\000\000\000\000\000\bu\bu\n>\000\000\bu\bu\bu\bu\000\000\000\000\000\000\bu\000\000\bu\bu\000\000\bu\bu\bu\n&\bu\bu\000\000\000\000\bu\nF\bu\000\000\000\000\000\000\000\000\bu\bu\nN\nV\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\150\000\000\002\181\002\181\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\254\n\006\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n\014\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\158\t\222\n\022\n\030\n.\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n>\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\n^\002\181\nf\n&\002\181\002\181\000\000\000\000\002\181\nF\002\181\000\000\000\000\000\000\000\000\002\181\002\181\nN\nV\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\150\000\000\002\177\002\177\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\254\n\006\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n\014\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\158\t\222\n\022\n\030\n.\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n>\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\n^\002\177\nf\n&\002\177\002\177\000\000\000\000\002\177\nF\002\177\000\000\000\000\000\000\000\000\002\177\002\177\nN\nV\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\150\000\000\002\185\002\185\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\254\n\006\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n\014\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\158\t\222\n\022\n\030\n.\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n>\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\n^\002\185\nf\n&\002\185\002\185\000\000\000\000\002\185\nF\002\185\000\000\000\000\000\000\000\000\002\185\002\185\nN\nV\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\t\150\000\000\002\165\002\165\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\254\n\006\002\165\000\000\000\000\000\000\000\000\002\165\000\000\n\014\002\165\000\000\000\000\000\000\000\000\002\165\002\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\t\158\t\222\n\022\n\030\n.\002\165\002\165\000\000\000\000\002\165\000\000\002\165\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\n>\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\n^\002\165\nf\n&\002\165\002\165\000\000\000\000\002\165\nF\002\165\000\000\000\000\000\000\000\000\002\165\002\165\nN\nV\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\150\000\000\002\169\002\169\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\254\n\006\002\169\000\000\000\000\000\000\000\000\002\169\000\000\n\014\002\169\000\000\000\000\000\000\000\000\002\169\002\169\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\t\158\t\222\n\022\n\030\n.\002\169\002\169\000\000\000\000\002\169\000\000\002\169\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n>\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\n^\002\169\nf\n&\002\169\002\169\000\000\000\000\002\169\nF\002\169\000\000\000\000\000\000\000\000\002\169\002\169\nN\nV\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\150\000\000\002\173\002\173\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\254\n\006\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n\014\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\158\t\222\n\022\n\030\n.\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n>\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\n^\002\173\nf\n&\002\173\002\173\000\000\000\000\002\173\nF\002\173\000\000\000\000\000\000\000\000\002\173\002\173\nN\nV\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\150\000\000\002\193\002\193\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\254\n\006\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n\014\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\158\t\222\n\022\n\030\n.\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n>\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\n^\002\193\nf\n&\002\193\002\193\000\000\000\000\002\193\nF\002\193\000\000\000\000\000\000\000\000\002\193\002\193\nN\nV\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\150\000\000\002\189\002\189\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\254\n\006\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n\014\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\158\t\222\n\022\n\030\n.\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n>\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\n^\002\189\nf\n&\002\189\002\189\000\000\000\000\002\189\nF\002\189\000\000\000\000\000\000\000\000\002\189\002\189\nN\nV\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\150\000\000\002\197\002\197\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\254\n\006\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n\014\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\158\t\222\n\022\n\030\n.\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n>\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\n^\002\197\nf\n&\002\197\002\197\000\000\000\000\002\197\nF\002\197\000\000\000\000\000\000\000\000\002\197\002\197\nN\nV\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\t\150\000\000\002\161\002\161\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\254\n\006\002\161\000\000\000\000\000\000\000\000\002\161\000\000\n\014\002\161\000\000\000\000\000\000\000\000\002\161\002\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\t\158\t\222\n\022\n\030\n.\002\161\002\161\000\000\000\000\002\161\000\000\002\161\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\n>\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\n^\002\161\nf\n&\002\161\002\161\000\000\000\000\002\161\nF\002\161\000\000\000\000\000\000\000\000\002\161\002\161\nN\nV\001\241\001\241\000\000\000\000\000\000\001\241\000\000\000\000\001\241\000\000\000\000\001\241\000\000\001\241\000\000\000\000\001\241\000\000\001\241\001\241\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\001\241\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\000\000\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\000\000\001\241\001\241\000\000\000\000\000\000\000\000\000\000\000\000\001\241\001\241\001\241\000\000\001\241\001\241\001\241\001\241\000\000\000\000\000\000\001\241\000\000\001\241\001\241\000\000\001\241\001\241\001\241\001\241\001\241\001\241\000\000\000\000\001\241\001\241\r\202\000\000\000\000\000\000\000\000\001\241\001\241\001\241\001\241\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\t\150\000\000\002\r\002\r\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\254\n\006\002\r\000\000\000\000\000\000\000\000\002\r\000\000\n\014\002\r\000\000\000\000\000\000\000\000\002\r\002\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\t\158\t\222\n\022\n\030\n.\002\r\002\r\000\000\000\000\002\r\000\000\002\r\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\n>\000\000\002\r\002\r\r\226\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\n^\002\r\nf\n&\002\r\002\r\000\000\000\000\002\r\nF\002\r\000\000\000\000\000\000\000\000\002\r\002\r\nN\nV\002\t\002\t\000\000\000\000\000\000\002\t\000\000\000\000\002\t\000\000\000\000\002\t\000\000\002\t\000\000\000\000\t\150\000\000\002\t\002\t\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\254\n\006\002\t\000\000\000\000\000\000\000\000\002\t\000\000\n\014\002\t\000\000\000\000\000\000\000\000\002\t\002\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\t\158\t\222\n\022\n\030\n.\002\t\002\t\000\000\000\000\002\t\000\000\002\t\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\n>\000\000\002\t\002\t\002\t\002\t\000\000\000\000\000\000\002\t\000\000\002\t\002\t\000\000\n^\002\t\nf\n&\002\t\002\t\000\000\000\000\002\t\nF\002\t\000\000\000\000\000\000\000\000\002\t\002\t\nN\nV\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\t\150\000\000\002\157\002\157\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\254\n\006\002\157\000\000\000\000\000\000\000\000\002\157\000\000\n\014\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\t\158\t\222\n\022\n\030\n.\002\157\002\157\000\000\000\000\002\157\000\000\002\157\n6\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\n>\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\n^\002\157\nf\n&\002\157\002\157\000\000\000\000\002\157\nF\002\157\000\000\000\000\000\000\000\000\002\157\002\157\nN\nV\001\253\001\253\000\000\000\000\000\000\001\253\000\000\000\000\001\253\000\000\000\000\001\253\000\000\001\253\000\000\000\000\001\253\000\000\001\253\001\253\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\001\253\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\000\000\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\000\000\001\253\001\253\000\000\000\000\000\000\000\000\000\000\000\000\001\253\001\253\001\253\000\000\001\253\001\253\001\253\001\253\000\000\000\000\000\000\001\253\000\000\001\253\001\253\000\000\001\253\001\253\001\253\001\253\001\253\001\253\000\000\000\000\001\253\001\253\r\202\000\000\000\000\000\000\000\000\001\253\001\253\001\253\001\253\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\000\000\000\000\000\000\006\177\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\006\177\003\233\000\000\002\001\006\177\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\238\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\b\162\002\001\002\001\r\202\000\000\000\000\003\233\000\000\002\001\002\001\002\001\002\001\001\006\000\000\000\006\000\000\000\000\024\214\002\154\002\158\005\254\002\202\002\214\005\194\b\194\000\000\000\000\002\218\001\n\000\000\006\n\000\000\003\018\000\000\006\022\000\000\000\000\000\000\r\182\003\022\001\018\b>\bB\001\030\001\"\000\000\000\000\000\000\003&\000\000\002\226\000\000\025\n\000\000\bf\bj\000\238\003\186\003\014\003\198\bn\006\170\bZ\001:\000\000\002\146\002\002\000\000\003\026\002\002\000\000\000\000\007\234\007\238\007\250\b\014\002\006\005R\000\000\002\006\001>\001B\001F\001J\001N\000\000\000\000\b\130\001R\000\000\000\000\000\000\001V\000\000\b\142\b\166\b\250\005^\005b\003z\005\254\001Z\003z\005\194\024\218\006\214\001\218\001^\006\214\001\218\006\n\000\000\002\146\000\000\006\022\002\146\000\000\001\154\n\222\000\000\000\000\005f\b\002\000\000\001\158\000\000\014\018\004.\t\014\001\006\001\166\000\006\001\170\001\174\000\000\002\154\002\158\000\000\002\202\002\214\006\218\000\000\000\000\006\218\002\218\001\n\000\000\000\000\000\000\b:\000\000\000\000\000\000\000\000\000\000\000\000\003\022\001\018\b>\bB\001\030\001\"\000\000\000\000\000\000\003&\000\000\002\226\000\000\bF\000\000\bf\bj\000\000\003\186\003\014\003\198\bn\006\170\000\000\001:\000\000\002\146\000\000\000\000\003\026\000\000\000\000\000\000\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\b\130\001R\000\000\000\000\000\000\001V\000\000\b\142\b\166\b\250\005^\005b\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\241\003\170\000\000\002\158\000\000\000\241\000\000\000\000\001\154\005\234\003\138\000\000\005f\b\002\000\000\001\158\007\178\014\018\004.\t\014\n\234\001\166\000\000\001\170\001\174\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\n\238\000>\003\166\002\158\000\241\000B\0032\000\000\000\000\002\146\000F\000\000\000\241\000\000\000\000\000\000\000J\000\241\000N\000R\000V\000Z\000^\000b\000f\000\000\000\241\000\241\000j\000n\000\000\000r\021\162\000v\000\000\000\000\000\000\006\190\000\000\000\238\000\000\000\000\022\222\002\238\000\000\022\226\000\000\000z\000\000\002\146\000~\000\130\000\241\000\000\000\000\000\000\023\018\000\134\000\138\000\142\000\000\000\241\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\023\"\000\000\000\000\000\186\005\254\000\190\000\194\005\194\n\242\016>\000\000\000\000\000\000\000\198\006\n\000\202\002\002\000\000\006\022\000\000\000\000\000\206\000\210\004Y\000\214\000\006\002\006\000\000\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\000\000\002\218\000\000\000\000\003\146\000\000\000\000\000\000\004Y\000\000\016N\016\234\003z\002\222\000\000\003\030\003\"\002\002\006\214\001\218\003\150\000\000\003&\000\000\002\226\002\146\016~\002\006\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\000\000\000\000\007\234\007\238\007\250\b\014\003z\005R\000\000\006\218\000\000\000\000\006\214\001\218\000\000\017\002\000\000\b\130\000\000\002\146\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\004Y\004Y\000\000\000\000\001\202\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\218\000\000\017\130\021\134\005f\b\002\024\246\000\141\001\210\b\026\004.\t\014\000\141\000\000\002\158\000\141\000\000\002\214\004E\t6\000\000\000\000\002\218\004E\000\000\000\141\000\000\000\141\000\000\000\141\001\242\002z\t>\000\000\002\222\002~\000\000\002\146\004\006\004\018\tF\000\141\000\000\000\000\004\030\002\226\015r\000\141\000\000\000\000\000\000\000\141\000\000\003\014\001\190\000\000\000\141\000\000\000\000\000\141\002\146\004\"\004E\003\026\000\141\000\141\000\141\007\234\007\238\007\250\004E\0122\005R\000\141\000\141\004E\002\194\000\238\000\000\000\000\000\141\000\000\000\000\000\000\000\141\004E\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\141\000\141\000\000\000\000\000\141\000\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\141\002\209\004E\000\000\002\209\000\000\000\141\000\141\005f\b\002\000\000\004E\000\165\b\026\004.\000\000\000\141\000\165\000\141\002\158\000\165\000\000\002\214\000\000\t6\000\n\000\000\002\218\015N\001*\000\165\002b\000\165\000\000\000\165\000\000\002\209\t>\000\000\002\222\002\209\000\000\003:\002\209\000\000\tF\000\165\021.\000\000\000\000\002\226\000\000\000\165\002\209\002\209\003F\000\165\000\000\003\014\001\190\000\n\000\165\000\000\000\000\000\165\002\146\000\000\015R\003\026\000\165\000\165\000\165\007\234\007\238\007\250\002\209\0122\005R\000\165\000\165\002\209\015^\002\209\021R\000\000\000\165\000\000\000\000\002\209\000\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\165\000\165\000\000\000\000\000\165\000\165\000\000\000\000\015f\001\006\000\000\002\209\000\000\000\000\000\165\0036\002\158\b\226\021^\002\214\000\165\000\165\005f\b\002\002\218\001\n\000\000\b\026\004.\003\018\000\165\000\000\000\165\000\000\016\242\020\242\001\014\001\018\001\022\003V\001\030\001\"\000\000\000\000\003\154\000\000\000\000\000\000\000\000\003Z\000\000\001.\n\218\007\141\000\000\003R\001\190\0016\000\000\000\249\001:\000\000\002\146\000\000\000\249\003\210\025\"\000\000\000\000\003\214\000\000\003\222\005F\002\002\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\002\006\000\000\001R\005V\000\000\000\000\001V\000\238\000\000\000\000\000\000\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\000\000\000\249\001^\018\138\003z\000\000\000\000\000\000\000\000\000\249\006\214\001\218\001\154\n\222\000\249\004E\005f\002\146\000\000\001\158\004E\001\162\004.\001\006\000\249\001\166\000\000\001\170\001\174\0036\002\158\n~\005\254\002\214\000\000\005\194\000\000\000\000\002\218\001\n\000\000\000\000\006\n\003\018\000\000\006\218\006\022\000\000\000\000\000\249\001\014\001\018\001\022\003V\001\030\001\"\000\000\000\000\000\249\004E\000\000\000\000\000\000\003Z\000\000\001.\n\218\004E\000\000\003R\001\190\0016\004E\002\194\001:\000\000\002\146\000\000\000\000\003\210\000\000\004E\004E\003\214\000\000\003\222\005F\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\004q\000\000\000\000\001R\005V\021\174\000\000\001V\000\000\000\000\000\000\004E\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\004E\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\001\154\n\222\000\000\000\000\005f\002\209\000\000\001\158\000\000\001\162\004.\001\006\022\030\001\166\000\000\001\170\001\174\0036\002\158\rv\016\226\002\214\000\n\000\000\000\000\016\250\002\218\001\n\000\000\000\000\000\000\003\018\000\000\000\000\022\194\022\210\000\000\002\209\001\014\001\018\001\022\003V\001\030\001\"\002\209\000\000\000\000\000\000\000\000\000\000\002\209\003Z\000\000\001.\n\218\000\000\000\000\003R\001\190\0016\004q\000\000\001:\000\000\002\146\000\000\000\000\003\210\000\000\023\198\000\000\003\214\002\209\003\222\005F\000\000\005R\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005V\000\000\000\000\001V\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\001Z\000\000\000\000\000\000\000\000\006\178\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\n\222\000\000\000\000\005f\000\000\000\000\001\158\000\000\001\162\004.\000\000\b\145\001\166\000\006\001\170\001\174\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\000\000\002\218\000\000\000\000\004y\000\000\b\145\000\000\b\145\b\145\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\000\000\003\150\000\000\003&\000\000\002\226\000\000\016~\000\000\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\001\202\001\206\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\002\000\000\b\130\001\210\027F\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\027k\014\166\000\000\000\000\000\000\000\000\000\000\001\242\002\130\000\000\000\000\000\000\002~\000\000\002\146\004\006\004\018\021\134\005f\b\002\b\145\004\030\000\000\b\026\004.\t\014\000\006\000\000\000\000\000\246\002\154\002\158\002\162\002\202\002\214\000\000\000\000\000\000\004\"\002\218\000\000\026\002\027\154\000\000\000\000\000\000\003\218\000\000\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\025\238\003\150\000\000\003&\000\000\002\226\000\000\016~\000\000\003\178\003\182\000\000\003\186\003\014\003\198\003\206\006\170\000\000\000\000\016\226\002\146\000\000\000\000\003\026\016\250\000\000\000\000\007\234\007\238\007\250\b\014\000\000\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\002\000\000\b\130\000\000\027F\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\017\022\017B\000\000\000\000\004\129\000\246\000\000\000\000\002\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004y\000\000\000\000\021\134\005f\b\002\014&\0121\0121\b\026\004.\t\014\0121\000\000\0121\0121\003\150\000\000\000\000\000\000\000\000\000\000\016~\0121\000\000\0121\0121\0121\000\000\0121\0121\024F\000\000\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\0121\000\000\000\000\000\000\000\000\000\000\0121\0121\000\000\000\000\0121\000\000\000\000\0121\017\002\0121\000\000\000\000\0121\000\000\000\000\000\000\000\000\0121\0121\0121\000\000\000\000\017\022\017B\000\000\000\000\0121\0121\000\000\000\000\000\000\000\000\000\000\0121\000\000\000\000\000\000\0121\000\000\000\000\0121\000\246\000\000\021\134\002\014\000\000\000\000\0121\0121\0121\000\000\0121\0121\000\000\017\134\000\000\000\000\000\000\000\000\000\000\000\000\0121\000\000\0121\0121\000\000\000\000\002v\0121\000\000\017\138\000\000\000\000\0121\000\000\ne\017\178\0121\ne\0121\0121\ne\ne\000\000\000\000\ne\000\000\ne\016\226\000\000\ne\000\000\000\000\016\250\ne\ne\000\000\ne\ne\000\000\ne\001\202\001\206\000\000\000\000\ne\000\000\000\000\ne\018.\000\000\000\000\000\000\000\000\000\000\000\000\ne\000\000\ne\001\210\000\000\ne\ne\017\022\018B\000\000\000\000\004M\ne\000\000\000\000\ne\000\000\000\000\ne\ne\000\000\ne\000\000\ne\ne\001\242\002\130\000\000\018R\000\000\002~\000\000\002\146\004\006\004\018\000\000\ne\000\000\000\000\004\030\000\000\000\000\000\000\000\000\ne\ne\006\141\000\000\ne\000\000\ne\006\141\000\000\000\000\000\000\005~\004\"\000\000\000\000\004\185\000\000\000\000\ne\ne\000\000\ne\ne\000\000\ne\000\000\ne\000\000\ne\000\000\ne\025\238\ne\b}\b}\000\000\000\000\000\000\b}\000\000\001\206\b}\000\000\000\000\000\000\000\000\006\141\012Q\012=\b}\000\000\b}\b}\b}\006\141\b}\b}\000\000\000\000\006\141\006\141\000\238\000\000\000\000\000\000\012Q\000\000\b}\006\141\006\141\000\000\002\026\000\000\b}\b}\000\000\000\000\b}\002\030\000\000\002z\000\000\b}\000\000\002\"\b}\000\000\002&\012=\000\000\b}\b}\b}\000\000\006\141\000\000\000\000\000\000\000\000\b}\b}\000\000\000\000\006\141\000\000\000\000\b}\000\000\000\000\000\000\004v\000\000\000\000\b}\000\000\000\000\000\000\000\000\000\000\023\166\b}\b}\b}\000\000\b}\b}\000\000\000\000\003\129\012e\000\000\000\000\n\170\000\000\b}\000\000\b}\b}\001\202\001\206\011\n\b}\000\000\000\000\000\000\000\000\b}\003\129\000\000\000\000\b}\003\129\b}\b}\012\r\012\r\002\138\001\226\000\000\012\r\000\000\001\206\012\r\000\000\000\000\001\238\000\000\000\000\000\000\000\000\004\150\000\000\012\r\012\r\012\r\000\000\012\r\012\r\001\242\002r\000\000\000\000\000\000\002~\000\000\002\146\004\006\004\018\012\r\000\000\000\000\000\000\004\030\000\000\012\r\012\r\000\000\000\000\012\r\000\000\000\000\002z\000\000\012\r\012e\012e\012\r\000\000\000\000\004\"\000\000\012\r\012\r\012\r\000\000\000\000\000\000\003\129\000\000\000\000\012\r\012\r\000\000\012e\000\000\012e\000\000\012\r\000\000\000\000\000\000\004v\003\129\000\000\012\r\003\129\000\000\000\000\000\000\000\000\000\000\012\r\012\r\012\r\000\000\012\r\012\r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\r\000\000\012\r\012\r\001\202\001\206\000\000\012\r\000\000\000\000\000\000\000\000\012\r\000\000\000\000\000\000\012\r\000\000\012\r\012\r\b\129\b\129\001\210\001\226\002\209\b\129\000\000\001\206\b\129\002\209\000\000\001\238\000\000\000\000\018\130\000\000\b\129\000\000\b\129\b\129\b\129\000\000\b\129\b\129\001\242\019\250\000\000\019\014\000\000\002~\000\000\002\146\004\006\004\018\b\129\000\n\000\000\000\000\020\n\000\000\b\129\b\129\000\000\000\000\b\129\000\000\000\000\002z\002\209\b\129\002\209\000\000\b\129\000\000\000\000\004\"\002\209\b\129\b\129\b\129\000\000\002\209\000\000\002\209\000\000\000\000\b\129\b\129\000\000\000\000\002\209\002\209\000\000\b\129\002\209\002\209\002\209\004v\002\209\000\000\b\129\000\000\000\000\002\209\000\000\000\000\002\209\b\129\b\129\b\129\000\000\b\129\b\129\000\000\000\000\002\209\002\209\000\000\002\209\000\n\000\n\b\129\002\209\b\129\b\129\002\209\002\209\002\209\b\129\002\209\002\209\002\209\002\209\b\129\002\209\002\209\002\209\b\129\000\000\b\129\b\129\002\209\002\209\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\000\n\000\000\002\209\006\174\000\000\002\209\002\209\002\209\000\000\015\006\000\000\002\209\002\209\000\000\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\000\000\002\209\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\015B\000\000\000\000\006=\002\209\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000\000\000\000\015N\000\000\000!\002b\000\000\002\209\002\209\006=\000\000\000\000\002\209\002\209\002\209\000\000\000!\000\000\000!\000!\000\000\000\000\000\000\000\000\000\000\000!\000\000\000!\000\000\000\000\000\000\000!\000!\000\000\000!\000!\000!\000!\000!\000\000\000\000\015R\000!\007\025\000\000\000!\007\025\000\000\000\000\000!\000!\000!\000!\000\000\000!\015^\000\000\0212\000\000\000\000\000\000\000\000\007\025\007\025\000!\007\025\007\025\000\000\000\000\000\000\000\000\000!\000!\000!\000!\000!\000\000\000\000\000\000\000\000\0069\015f\000\029\000\000\007\025\000\000\000\029\000\029\000\000\000\029\000\029\021>\000\000\000\000\000\000\000\029\000\000\000\000\000!\000!\0069\000\000\007\025\000!\000!\000!\000\000\000\029\020\242\000\029\000\029\000\000\000\000\000\000\000\000\000\000\000\029\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\007\025\000\029\007\025\000\000\000\029\000\000\000\000\000\000\000\029\000\029\000\029\000\029\000\000\000\029\005\186\000\000\000\000\007\025\007\025\000\000\000\000\000\000\007\025\000\029\007\025\000\000\000\000\000\000\007\025\000\000\000\029\000\029\000\029\000\029\000\029\000\000\000\000\000\000\000\000\006I\000\000\011\213\000\000\000\000\000\000\011\213\011\213\000\000\011\213\011\213\000\000\000\000\000\000\000\000\011\213\000\000\000\000\000\029\000\029\006I\000\000\000\000\000\029\000\029\000\029\000\000\011\213\000\000\011\213\011\213\000\000\000\000\000\000\000\000\000\000\011\213\000\000\011\213\000\000\000\000\000\000\011\213\011\213\000\000\011\213\011\213\011\213\011\213\011\213\000\000\000\000\000\000\011\213\007-\000\000\011\213\007-\000\000\000\000\011\213\011\213\011\213\011\213\000\000\011\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007-\007-\011\213\007-\007-\000\000\000\000\000\000\000\000\011\213\011\213\011\213\011\213\011\213\000\000\000\000\000\000\000\000\006E\000\000\011\209\000\000\007-\000\000\011\209\011\209\000\000\011\209\011\209\000\000\000\000\000\000\000\000\011\209\000\000\000\000\011\213\011\213\006E\000\000\000\238\011\213\011\213\011\213\000\000\011\209\000\000\011\209\011\209\000\000\000\000\000\000\000\000\000\000\011\209\000\000\011\209\000\000\000\000\000\000\011\209\011\209\000\000\011\209\011\209\011\209\011\209\011\209\000\000\000\000\007-\011\209\007-\000\000\011\209\000\000\000\000\000\000\011\209\011\209\011\209\011\209\000\000\011\209\007-\000\000\000\000\005\194\007-\000\000\000\000\000\000\007-\011\209\007-\000\000\000\000\000\000\007-\000\000\011\209\011\209\011\209\011\209\011\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\014\012\017\012\017\000\000\000\000\000\000\012\017\011\209\011\209\012\017\017\134\000\000\011\209\011\209\011\209\012Q\012=\004F\000\000\012\017\012\017\012\017\000\000\012\017\012\017\000\000\017\138\000\000\000\000\000\000\000\000\000\000\017\178\012Q\000\000\012\017\000\000\000\000\000\000\002\026\000\000\012\017\012\017\000\000\016\226\012\017\002\174\000\000\000\000\016\250\012\017\000\000\002\"\012\017\000\000\002&\012=\000\000\012\017\012\017\012\017\000\000\000\000\000\000\000\000\018.\000\000\012\017\012\017\000\000\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\012\017\017\022\018B\012\017\000\000\000\000\004M\000\000\000\000\000\000\012\017\012\017\012\017\000\000\012\017\012\017\000\000\000\000\000\000\000\000\000\000\000\000\018R\007\153\012\017\000\006\012\017\012\017\007\153\002\154\002\158\012\017\002\202\002\214\000\000\000\000\012\017\000\000\002\218\000\000\012\017\000\000\012\017\012\017\000\000\014:\000\000\000\000\000\000\000\000\002\222\000\000\003\030\003\"\000\000\000\000\000\000\000\000\000\000\003&\000\000\002\226\000\000\000\000\000\000\003\178\003\182\007\153\003\186\003\014\003\198\003\206\006\170\000\000\000\000\007\153\002\146\000\000\000\000\003\026\007\153\007\153\000\238\007\234\007\238\007\250\b\014\000\000\005R\007\153\007\153\001\181\000\000\000\000\000\000\000\000\001\181\000\000\b\130\000\000\000\000\000\000\000\000\000\000\000\000\b\142\b\166\b\250\005^\005b\000\000\000\000\007\153\000\000\000\000\007\153\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\007\153\000\000\000\000\003\t\000\000\000\000\003\t\000\000\005f\b\002\000\000\001\181\000\000\b\026\004.\t\014\003\t\003\t\003\t\001\181\003\t\003\t\000\000\000\000\001\181\001\181\000\238\000\000\000\000\000\000\000\000\000\000\003\t\001\181\001\181\000\000\000\000\000\000\003\t\004>\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\001\181\000\000\000\000\000\000\000\000\003\t\003\t\000\000\000\000\001\181\000\000\000\000\003\t\000\000\nq\000\000\003\t\nq\000\000\003\t\0036\002\158\000\000\000\000\002\214\000\000\003\t\003\t\003\t\002\218\003\t\003\t\000\000\nq\nq\000\000\nq\nq\000\000\000\000\003\t\000\000\003\t\003\t\003:\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\000\000\nq\003\t\003F\003\t\003\t\003R\001\190\003\133\012e\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nq\003\214\000\000\003\222\005F\000\000\005R\000\000\003\133\000\000\000\000\000\000\003\133\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\nq\000\000\nq\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nq\000\000\000\000\nq\nq\000\000\005f\000\000\nq\000\000\nq\000\000\004.\nm\nq\000\000\nm\000\000\000\000\0036\002\158\012e\012e\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\nm\nm\003\133\nm\nm\000\000\006\154\000\000\012e\000\000\012e\003:\000\000\000\000\b\178\000\000\000\000\003\133\000\000\000\000\003\133\000\000\nm\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nm\003\214\000\000\003\222\005F\n\138\005R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004i\005V\000\000\000\000\000\000\018\154\001\205\001\205\000\000\005^\005b\001\205\005\162\nm\001\205\nm\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\001\205\001\205\nm\001\205\001\205\nm\nm\000\000\005f\000\000\nm\000\000\nm\000\000\004.\001\205\nm\000\000\000\000\018\198\000\000\001\205\001\205\000\000\000\000\001\205\000\000\016\226\000\000\000\000\001\205\000\000\016\250\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\019\002\000\000\000\000\000\000\000\000\001\205\001\205\000\000\000\000\000\000\000\000\000\000\001\205\000\000\0036\002\158\001\205\000\000\002\214\001\205\006z\000\000\000\000\002\218\000\000\004i\001\205\001\205\001\205\000\000\001\205\001\205\000\000\006\154\019v\000\000\000\000\000\000\003:\000\000\001\205\b\178\001\205\001\205\000\000\000\000\000\000\001\205\000\000\000\000\000\000\003F\001\205\000\000\nz\001\190\004\218\000\000\001\205\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\nI\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\012\129\000\000\000\000\000\000\000\000\012\129\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\n\146\000\000\000\000\0036\002\158\000\000\000\000\002\214\000\000\006z\000\000\000\000\002\218\000\000\nI\n\154\000\000\nI\011\006\000\000\005f\000\000\006\154\012\129\nI\000\000\004.\003:\nI\000\000\b\178\012\129\007\005\000\000\000\000\007\005\012\129\012\129\000\238\000\000\003F\000\000\000\000\nz\001\190\012\129\012\129\000\000\000\000\000\000\002\146\007\005\007\005\003\210\007\005\007\005\nI\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\000\000\000\000\005)\005)\000\000\000\000\012\129\005)\007\005\005V\005)\000\000\000\000\000\000\000\000\012\129\000\000\005^\005b\000\000\005)\n\146\005)\000\000\005)\000\000\007\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nI\005)\000\000\nI\nI\000\000\005f\005)\005)\000\000\nI\000\000\004.\005)\nI\000\000\005)\000\000\000\000\005)\000\000\007\005\000\000\007\005\005)\005)\005)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\005\194\007\005\005)\005)\000\000\007\005\005)\007\005\000\000\000\000\000\000\007\005\b\141\000\000\000\000\000\000\005)\005)\005)\000\000\005)\005)\000\000\000\000\000\000\000\000\007B\000\000\t\150\000\000\000\000\012\006\b\141\005)\b\141\b\141\005)\005)\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\005)\001\202\002^\000\000\000\000\002b\t\254\n\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\014\000\000\000\000\000\000\001\210\001\226\002f\000\000\000\238\000\000\000\000\000\000\000\000\001\238\000\000\000\000\001\006\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\000\000\002j\002r\000\000\n6\000\000\002~\001\n\002\146\004\006\004\018\000\000\000\000\n>\000\000\020\222\000\000\020\226\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n^\000\000\nf\n&\001&\004\"\001.\0012\b\141\nF\000\000\000\000\0016\000\000\015f\001:\000\000\nN\nV\000\000\000\000\000\000\000\000\000\000\020\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\020\242\000\000\000\000\001V\000\000\005\029\005\029\000\000\000\000\000\000\005\029\000\000\001Z\005\029\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\005\029\000\000\005\029\000\000\005\029\001\154\000\000\000\000\000\000\000\000\000\000\000\000\001\158\000\000\001\162\000\000\005\029\000\000\001\166\000\000\001\170\001\174\005\029\005\029\000\000\000\000\000\000\000\000\007\174\000\000\000\000\005\029\000\000\000\000\005\029\000\000\000\000\000\000\000\000\005\029\005\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\029\005\029\003I\003I\005\029\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\005\029\005\029\005\029\000\000\005\029\005\029\003I\000\000\003I\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\005\029\000\000\000\000\005\029\005\029\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\000\000\000\000\005\029\000\000\004\233\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\003I\003I\b\t\b\t\000\000\000\000\004\233\b\t\000\000\000\000\b\t\000\000\000\000\003I\000\000\000\000\000\000\003I\000\000\000\000\b\t\000\000\b\t\000\000\b\t\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\000\000\000\000\000\000\000\000\b\t\b\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\000\000\b\t\000\000\000\000\000\000\000\000\b\t\b\t\b\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\t\000\000\012\193\012\193\b\t\000\000\000\000\012\193\000\000\000\000\012\193\000\000\000\000\000\000\b\t\b\t\b\t\000\000\b\t\b\t\012\193\000\000\012\193\000\000\012\193\000\000\000\000\000\000\b\t\000\000\000\000\b\t\000\000\000\000\000\000\b\t\012\193\000\000\000\000\000\000\000\000\000\000\012\193\012\193\004\218\000\000\b\t\000\000\004N\000\000\000\000\012\193\000\000\000\000\012\193\000\000\000\000\000\000\000\000\012\193\012\193\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\193\000\000\000\000\000\000\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\193\012\193\012\193\000\000\012\193\012\193\012\197\012\197\000\000\000\000\004^\012\197\000\000\000\000\012\197\000\000\000\000\012\193\000\000\000\000\000\000\012\193\000\000\000\000\012\197\000\000\012\197\000\000\012\197\000\000\000\000\000\000\012\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\012\197\012\197\000\000\000\000\000\000\000\000\004N\000\000\000\000\012\197\000\000\000\000\012\197\000\000\000\000\000\000\000\000\012\197\012\197\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\012\197\012\197\000\000\012\197\012\197\003I\003I\000\000\000\000\004^\003I\000\000\000\000\003I\000\000\000\000\012\197\000\000\000\000\000\000\012\197\000\000\000\000\003I\000\000\003I\000\000\003I\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\000\000\003I\003I\000\000\000\000\000\000\000\000\004\237\000\000\000\000\003I\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\003I\003I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\003I\007\149\000\000\000\000\000\000\006\161\007\149\000\000\000\000\000\000\003I\003I\003I\000\000\003I\003I\000\000\000\000\000\000\000\000\004\237\t\150\000\000\000\000\006\161\000\000\000\000\003I\006\161\000\000\000\000\003I\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\000\000\003I\000\000\000\000\007\149\000\000\t\254\n\006\000\000\000\000\000\000\000\000\007\149\000\000\000\000\n\014\000\000\007\149\007\149\000\238\000\000\000\000\000\000\000\238\000\000\000\000\007\149\007\149\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\001\189\000\000\000\000\006\161\n6\001\189\000\000\001\206\001\189\007\149\000\000\000\000\007\149\n>\000\000\000\000\bi\000\000\001\189\000\000\000\000\007\149\001\189\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\001\189\000\000\nF\000\000\012)\000\000\001\189\001\189\000\000\012)\nN\nV\012)\002z\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\012)\001\189\001\189\001\189\012)\000\000\000\000\003-\000\000\000\000\0121\000\000\003-\000\000\001\206\003-\012)\001\189\001\189\000\000\000\000\004v\012)\be\000\000\003-\000\000\000\000\000\000\003-\000\000\001\189\001\189\000\000\012)\001\189\001\189\000\000\000\000\012)\012)\003-\000\000\000\000\000\000\001\189\000\000\003-\001\185\000\000\000\000\000\000\001\189\000\000\002z\012)\003-\001\189\000\000\003-\000\000\000\000\000\000\001\189\003-\003-\003-\000\000\000\000\012)\012)\002Z\000\000\012)\012)\000\000\000\000\000\000\000\000\000\000\003-\003-\000\000\012)\004v\000\000\000\000\026b\000\000\000\000\012)\000\000\000\000\0162\003-\003-\000\000\000\000\003-\003-\000\000\012)\000\000\000\000\000\000\000\000\000\000\000\000\003-\t\150\000\000\000\000\000\000\0166\000\000\003-\000\000\000\000\000\000\000\000\003-\t\206\t\230\t\238\t\214\t\246\003-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\254\n\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\149\000\000\000\000\000\000\000\000\000\149\n6\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n>\000\000\000\000\000\149\000\000\000\149\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\000\n^\016:\nf\n&\016J\000\149\000\000\000\000\000\000\nF\000\000\000\149\000\000\000\000\000\000\000\149\000\000\nN\nV\000\000\000\149\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\149\000\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\000\000\000\000\217\000\149\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\149\000\149\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\217\000\000\000\217\000\000\000\000\000\149\000\000\000\000\000\000\000\000\000\000\000\149\000\149\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\149\000\000\000\149\000\217\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\217\000\217\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\157\000\217\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\217\000\217\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\217\000\217\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\217\000\000\000\217\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\153\000\157\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\153\006}\006}\000\000\000\000\000\000\000\153\000\157\000\000\000\157\000\153\000\000\000\000\000\000\000\000\000\153\000\000\004\022\000\153\006}\006}\000\000\000\000\000\153\000\153\000\238\000\000\000\000\006}\001\129\000\000\000\000\000\153\000\153\001\129\000\000\000\000\001\129\000\000\000\153\000\000\006}\006}\000\153\000\000\000\000\006}\001\129\006}\006}\006}\001\129\000\000\000\153\000\153\006}\000\000\000\153\000\153\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\153\000\000\001\129\000\000\000\000\006}\000\153\000\153\004\233\000\000\000\000\001\129\000\000\000\000\001\129\000\000\000\153\000\000\000\153\001\129\001\129\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001\129\000\000\004\n\000\000\006}\000\000\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\001\129\001\129\000\000\012\189\012\189\000\000\004\233\000\000\012\189\000\000\001\129\012\189\000\000\000\000\000\000\000\000\001\129\001\129\000\000\000\000\000\000\012\189\001\129\012\189\000\000\012\189\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\000\000\000\000\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\012\189\000\000\000\000\000\000\000\000\012\189\012\189\012\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\012\185\012\185\012\189\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\012\189\012\189\012\189\000\000\012\189\012\189\012\185\000\000\012\185\000\000\012\185\000\000\000\000\000\000\000\000\000\000\000\000\012\189\000\000\000\000\000\000\012\189\012\185\000\000\000\000\000\000\000\000\000\000\012\185\012\185\004\218\000\000\012\189\000\000\000\000\000\000\000\000\012\185\000\000\000\000\012\185\000\000\000\000\000\000\000\000\012\185\012\185\012\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\185\000\000\b\r\b\r\012\185\000\000\000\000\b\r\000\000\000\000\b\r\000\000\000\000\000\000\012\185\012\185\012\185\000\000\012\185\012\185\b\r\000\000\b\r\000\000\b\r\000\000\000\000\000\000\007\030\000\000\000\000\012\185\000\000\000\000\000\000\012\185\b\r\000\000\000\000\000\000\000\000\000\000\b\r\b\r\000\000\000\000\012\185\000\000\000\000\000\000\000\000\b\r\000\000\000\000\b\r\000\000\000\000\000\000\000\000\b\r\b\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\134\000\000\n\158\000\000\000\000\000\000\b\r\000\000\001\202\001\206\b\r\000\000\000\000\000\000\000\000\000\000\t\150\000\000\000\000\012\006\b\r\b\r\b\r\b\141\b\r\b\r\001\210\001\226\t\206\t\230\t\238\t\214\t\246\000\000\b\r\001\238\000\000\b\r\000\000\000\000\000\000\b\r\t\254\n\006\000\000\000\000\000\000\000\000\001\242\002r\000\000\n\014\b\r\002~\000\000\002\146\004\006\004\018\000\000\000\238\000\000\000\000\004\030\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\001\185\000\000\000\000\004\"\n6\001\185\000\000\001\206\001\185\000\000\000\000\000\000\000\000\n>\000\000\000\000\be\000\000\001\185\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\001\185\000\000\nF\000\000\000\000\004*\001\185\004.\000\000\000\000\nN\nV\000\000\002z\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\000\000\001\185\001\185\001\185\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\000\000\0121\001i\000\000\001\185\001\185\000\000\000\000\004v\000\000\0121\000\000\001i\000\000\001i\000\000\001i\000\000\001\185\001\185\000\000\000\000\001\185\001\185\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\001\185\000\000\001i\0121\000\000\000\000\000\000\001\185\000\000\0121\000\000\000\000\001\185\000\000\001i\000\000\000\000\000\000\001\185\001i\001i\001i\000\000\000\000\000\000\005U\005U\000\000\000\000\000\000\005U\000\000\000\000\005U\000\000\001i\000\000\000\000\000\000\0121\000\000\000\000\000\000\005U\000\000\005U\000\000\005U\000\000\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005U\000\000\000\000\019\254\001i\007\174\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\001i\005U\005U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\005Q\006\242\005U\000\000\000\000\005Q\000\000\000\000\005Q\000\000\000\000\000\000\005U\005U\005U\000\000\005U\005U\005Q\000\000\005Q\000\000\005Q\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\005U\005Q\000\000\000\000\000\000\000\000\000\000\005Q\007^\000\000\000\000\005U\000\000\000\000\000\000\000\000\005Q\000\000\000\000\005Q\000\000\000\000\000\000\000\000\005Q\005Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005Q\000\000\005m\005m\005Q\000\000\000\000\005m\000\000\000\000\005m\000\000\000\000\000\000\005Q\005Q\005Q\000\000\005Q\005Q\005m\000\000\005m\000\000\005m\000\000\000\000\000\000\000\000\000\000\000\000\005Q\000\000\000\000\000\000\005Q\005m\000\000\000\000\000\000\000\000\000\000\005m\005m\000\000\000\000\005Q\000\000\000\000\000\000\000\000\005m\000\000\000\000\005m\000\000\000\000\000\000\000\000\005m\005m\005m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005m\000\000\005i\006\242\005m\000\000\000\000\005i\000\000\000\000\005i\000\000\000\000\000\000\005m\005m\005m\000\000\005m\005m\005i\000\000\005i\000\000\005i\000\000\000\000\000\000\000\000\000\000\000\000\005m\000\000\000\000\000\000\005m\005i\000\000\000\000\000\000\000\000\000\000\005i\007^\000\000\000\000\007V\000\000\000\000\000\000\000\000\005i\000\000\000\000\005i\000\000\000\000\000\000\000\000\005i\005i\000\238\004E\000\000\000\000\000\000\000\000\004E\0036\002\158\004E\000\000\002\214\000\000\006z\005i\000\000\002\218\000\000\005i\004E\000\000\000\000\000\000\004E\000\000\000\000\006\154\000\000\005i\005i\005i\003:\005i\005i\b\178\004E\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\003F\005i\000\000\nz\001\190\005i\004E\000\000\011\226\004E\002\146\000\000\000\000\003\210\004E\002\194\005i\003\214\000\000\003\222\000\000\n\138\005R\000\000\t\150\000\000\000\000\000\000\000\000\000\000\004E\011\230\000\000\000\000\005V\000\000\t\206\t\230\t\238\t\214\t\246\000\000\005^\005b\004E\004E\n\146\000\000\004E\004E\t\254\n\006\000\000\000\000\007B\000\000\000\000\000\000\000\000\n\014\000\000\n\154\000\000\000\000\n\166\004E\005f\000\238\000\000\000\000\021\006\000\000\004.\011\226\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\t\150\000\000\000\000\000\000\000\000\000\000\000\000\012\190\n>\000\000\000\000\000\000\t\206\t\230\t\238\t\214\t\246\000\000\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\t\254\n\006\000\000\000\000\000\000\nF\000\000\000\000\000\000\n\014\000\000\000\000\000\000\nN\nV\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\158\t\222\n\022\n\030\n.\000\000\000\000\000\000\003)\000\000\000\000\000\000\n6\003)\000\000\001\206\003)\000\000\000\000\000\000\000\000\n>\000\000\000\000\000\000\000\000\003)\000\000\000\000\000\000\003)\000\000\000\000\000\000\000\000\n^\000\000\nf\n&\000\000\000\000\000\000\003)\000\000\nF\000\000\000\000\000\000\003)\000\000\000\000\000\000\nN\nV\000\000\002z\000\000\003)\000\000\000\000\003)\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\000\000\000\000\004v\n\170\000\000\000\000\000\000\000\000\000\246\001\202\001\206\002\014\003)\003)\000\000\000\000\003)\003)\000\000\000\000\000\000\017\134\000\000\000\000\000\000\004M\003)\001\210\001\226\000\000\000\000\000\000\000\000\003)\000\000\000\000\001\238\017\138\003)\000\000\000\000\000\000\000\000\017\178\003)\000\000\000\000\000\000\0071\001\242\002r\0071\000\000\000\000\002~\016\226\002\146\004\006\004\018\000\000\016\250\0011\000\000\004\030\000\000\000\000\0011\0071\0071\0011\0071\0071\000\000\000\000\000\000\000\000\018.\000\000\000\000\0011\004\"\0011\000\000\0011\000\000\000\000\000\000\000\000\000\000\0071\017\022\018B\000\000\000\000\000\000\0011\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\000\000\0011\000\000\000\238\000\000\000\000\0011\018R\000\000\0011\000\000\000\000\000\000\000\000\0011\0011\000\238\000\000\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\000\000\000\000\001-\000\000\0011\000\000\000\000\0071\0011\0071\000\000\000\000\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\0071\0011\0011\005\194\0071\000\000\000\000\001-\0071\000\000\0071\0011\000\000\001-\0071\000\000\000\000\001-\0011\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\001-\000\238\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\000\000\0125\001m\000\000\001-\000\000\000\000\000\000\001-\000\000\0125\000\000\001m\000\000\001m\000\000\001m\000\000\001-\001-\001-\000\000\001-\001-\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\000\000\001m\0125\000\000\000\000\000\000\001-\000\000\0125\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\001-\001m\001m\001m\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\000}\001\029\000\000\001m\000\000\000\000\000\000\0125\000\000\000}\000\000\001\029\000\000\001\029\000\000\001\029\000\000\001m\001m\001m\000\000\001m\001m\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\000}\000\000\000\000\000\000\001m\000\000\000}\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\001m\001\029\001\029\001\029\001\197\000\000\000\000\000\000\000\000\001\197\000\000\015N\001\197\000\000\002b\000\000\000\000\001\029\000\000\000\000\000\000\000}\001\197\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\001\197\001\202\001\206\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\015R\000\000\001\029\001\197\000\000\015b\001\197\001\210\001\226\000\000\000\000\001\197\001\197\001\029\015^\000\000\001\238\000\000\000\000\000\000\000\000\000\000\000\000\001\246\000\000\000\000\000\000\001\197\0009\001\242\002r\001\197\000\000\0009\002~\0009\002\146\004\006\004\018\000\000\015f\001\197\001\197\004\030\0009\001\197\001\197\0009\000\000\000\000\000\000\0009\b)\000\000\000\000\001\197\000\000\000\000\000\000\000\000\004\"\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\0009\001\197\000\000\0009\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\0009\0009\0009\000\000\000\000\000\000\000\000\000\000\000\000\0009\0009\004*\000\000\004.\000\000\0036\002\158\000\000\000\000\002\214\0009\006z\000\000\0009\002\218\000\000\000\000\000\000\004E\000\000\000\000\004E\0009\000\000\006\154\0009\000\000\000\000\000\000\003:\b)\004E\b\178\000\000\0009\000\000\000\000\0009\000\000\000\000\b\246\000\000\003F\000\000\000\000\rr\001\190\004E\000\000\000\000\0009\000\000\002\146\004E\000\000\003\210\000\000\000\000\000\000\003\214\004E\003\222\004E\n\138\005R\004E\000\000\000\000\004E\000\000\004E\002\194\000\000\000\000\000\000\000\000\005V\000\000\004E\000\000\000\000\000\000\004E\000\000\005^\005b\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\000\000\r\130\000\000\005f\004E\000\000\000\000\004E\000\000\004.\000\000\000\000\004E\002\194\000\238\000\000\004E\000\000\003!\000\000\000\000\004E\004E\003!\000\000\000\000\003!\000\000\004E\004E\000\000\000\000\004E\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\000\000\000\000\003!\015n\000\000\000\000\004E\000\000\003!\000\000\000\000\004E\000\000\004E\004E\000\000\000\000\003!\025j\000\000\003!\000\000\000\000\000\000\004E\003!\003!\003!\004E\000\000\0036\002\158\000\000\000\000\002\214\000\000\006z\000\000\000\000\002\218\004E\003!\000\000\000\000\000\000\003!\004E\000\000\000\000\006\154\000\000\000\000\004N\000\000\003:\003!\003!\b\178\004E\003!\003!\000\000\000\000\004E\002\194\023.\000\000\003F\000\000\003!\003R\001\190\000\000\000\000\000\000\015\206\003!\002\146\000\000\004E\003\210\003!\000\000\000\000\003\214\000\000\003\222\003!\n\138\005R\000\000\000\000\000\000\004E\004E\000\000\000\000\004E\004E\000\000\000\000\005V\000\000\004^\000\000\000\000\000\000\007\030\000\000\005^\005b\0036\002\158\021\158\004E\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\006\154\023\250\000\000\005f\000\000\003:\000\000\000\000\b\178\004.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\nz\001\190\000\000\000\000\000\000\000\000\000\000\002\146\006y\006y\003\210\000\000\000\000\000\000\003\214\000\000\003\222\000\000\n\138\005R\000\000\000\000\000\000\000\000\000\000\000\000\006y\006y\000\000\000\000\000\000\005V\000\000\000\000\000\000\006y\000\000\000\000\000\000\005^\005b\0036\002\158\n\146\000\000\002\214\000\000\006z\006y\006y\002\218\000\000\000\000\006y\000\000\006y\006y\006y\000\000\000\000\006\154\0226\006y\005f\000\000\003:\000\000\000\000\b\178\004.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\006y\000\000\nz\001\190\005\154\000\000\000\000\000\000\000\000\002\146\0036\002\158\003\210\000\000\002\214\000\000\003\214\000\000\003\222\002\218\n\138\005R\000\000\000\000\005\158\000\000\003\218\000\000\000\000\000\000\000\000\000\000\000\000\005V\003:\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\004\194\000\000\n\146\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\022\150\003\214\005f\003\222\005F\000\000\005R\000\000\004.\000\000\000\000\000\000\000\000\000\000\000\000\b\169\000\000\000\000\005V\000\000\000\000\0036\002\158\000\000\000\000\002\214\005^\005b\000\000\005\162\002\218\000\000\000\000\000\000\000\000\000\000\000\000\b\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003:\000\000\005\234\000\000\000\000\005f\000\000\006f\000\000\b\154\000\000\004.\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\011\241\000\000\003\214\011\241\003\222\005F\000\000\005R\002\209\002\209\000\000\000\000\002\209\011\241\000\000\000\000\000\000\002\209\000\000\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\011\241\005\162\000\000\002\209\000\n\000\000\011\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\241\002\209\000\000\011\241\002\209\002\209\000\000\005f\011\241\b\169\000\000\002\209\000\000\004.\002\209\000\000\000\000\002\209\002\209\000\000\002\209\002\209\000\000\002\209\011\241\004-\004-\000\000\011\241\004-\000\000\000\000\000\000\000\000\004-\002\209\000\000\000\000\011\241\011\241\004-\000\000\011\241\002\209\002\209\000\000\002\209\000\000\027f\004-\022\230\000\000\000\000\022\254\000\000\000\000\000\000\000\000\000\000\011\241\000\000\000\000\004-\000\000\000\000\004-\004-\002\209\000\000\000\000\000\000\002\209\004-\002\209\000\000\004-\000\000\000\000\000\238\004-\003!\004-\004-\000\000\004-\003!\000\000\000\000\003!\003!\000\000\000\000\000\000\000\000\003!\000\000\004-\003!\003!\000\000\000\000\000\000\003!\000\000\004-\004-\000\000\003!\000\000\000\000\000\000\003!\000\000\000\000\003!\015n\000\000\000\000\000\000\000\000\003!\000\000\000\000\003!\015n\000\000\000\000\000\000\004-\003!\000\000\000\000\003!\000\000\004-\000\000\000\000\003!\003!\003!\003!\003!\000\000\000\000\000\000\003!\003!\003!\003!\000\000\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\003!\000\000\000\000\000\000\003!\000\000\000\000\000\000\003!\003!\003!\025r\000\000\003!\003!\000\000\003!\015n\003!\003!\025\162\000\000\003!\003!\000\000\000\000\000\000\000\000\012)\015\206\003!\003!\000\000\012)\003!\003!\012)\000\000\015\206\003!\003!\003!\000\000\000\000\003!\000\000\012)\000\000\000\000\000\000\012)\000\000\000\000\000\000\000\000\003!\0121\000\000\000\000\003!\000\000\000\000\012)\000\000\000\000\000\000\000\000\000\000\012)\003!\003!\017R\000\000\003!\003!\000\000\000\000\012)\000\000\000\000\012)\000\000\000\000\000\000\000\000\012)\012)\0036\002\158\015\206\003!\002\214\000\000\006z\000\000\000\000\002\218\000\000\000\000\000\000\000\000\012)\000\000\000\000\000\000\012)\006\154\000\000\000\000\000\000\000\000\003:\000\000\000\000\b\178\012)\012)\002Z\000\000\012)\012)\000\000\000\000\000\000\003F\000\000\000\000\b\222\001\190\012)\005\001\000\000\000\000\026\154\002\146\005\001\012)\003\210\005\001\000\000\000\000\003\214\000\000\003\222\000\000\n\138\005R\012)\005\001\000\000\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\000\000\000\000\005\001\000\000\005^\005b\000\000\000\000\005\001\000\000\000\000\000\000\000\000\000\000\007\174\000\000\000\000\005\001\000\000\000\000\005\001\000\000\000\000\000\000\000\000\005\001\005\001\000\238\005f\000\000\000\000\005\005\000\000\000\000\004.\000\000\005\005\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\000\000\000\000\000\000\005\005\000\000\000\000\000\000\005\005\000\000\005\001\005\001\000\000\000\000\005\001\005\001\000\000\000\000\000\000\000\000\005\005\012\201\012\201\000\000\000\000\000\000\005\005\000\000\000\000\000\000\000\000\005\001\007\174\000\000\000\000\005\005\000\000\000\000\005\005\012\201\012\201\007\006\005\001\005\005\005\005\000\238\000\000\000\000\012\201\005\177\000\000\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\005\005\005\005\012\201\012\201\005\005\000\000\000\000\012\201\005\177\012\201\012\201\012\201\005\177\000\000\005\005\005\005\012\201\000\000\005\005\005\005\000\000\000\000\000\000\000\000\005\177\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\012\201\000\000\005\005\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\000\000\000\000\005\005\005\177\005\177\000\238\025J\000\000\000\000\000\000\000\000\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\005\177\000\000\002\218\000\000\005\177\000\000\000\000\000\000\000\000\006&\000\000\000\000\000\000\000\000\005\177\005\177\021*\003:\005\177\005\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\177\000\000\003F\000\000\000\000\003R\001\190\005\177\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\000\000\005\177\003\214\000\000\003\222\005F\005\249\005R\000\000\000\000\000\000\000\000\000\000\002\158\000\000\000\000\002\214\000\000\000\000\005V\000\000\002\218\000\000\000\000\000\000\000\000\005\249\005^\005b\000\000\005\162\000\000\000\000\002\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\226\000\000\000\000\000\000\000\000\000\000\000\000\005f\003\014\001\190\000\000\b\154\000\000\004.\000\000\002\146\000\000\000\000\003\026\001\202\001\206\000\000\007\234\007\238\007\250\000\000\000\000\005R\000\000\000\000\000\000\000\000\000\000\002n\000\000\005\198\000\000\001\210\001\226\000\000\000\000\0036\002\158\000\000\000\000\002\214\001\238\005^\005b\000\000\002\218\000\000\000\000\001\246\000\000\000\000\000\000\000\000\000\000\001\242\002r\000\000\000\000\000\000\002~\003:\002\146\004\006\004\018\000\000\000\000\005f\b\002\004\030\000\000\000\000\b\026\004.\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\006\002\000\000\002\146\000\000\004\"\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\015V\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\006\014\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\000\000\000\000\002\218\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\003:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\000\000\000\000\005\253\000\000\002\146\004.\000\000\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\005\253\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\011r\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\000\000\000\000\000\000\000\000\002\218\005V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\000\000\000\000\003:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\000\000\000\000\011~\000\000\002\146\004.\000\000\003\210\0036\002\158\000\000\003\214\002\214\003\222\005F\000\000\005R\002\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\000\000\003:\000\000\000\000\000\000\005^\005b\000\000\005\162\000\000\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\000\000\000\000\000\000\000\000\000\000\002\146\000\000\000\000\003\210\000\000\005f\000\000\003\214\011\138\003\222\005F\004.\005R\000\000\0036\002\158\000\000\000\000\002\214\006!\000\000\000\000\000\000\002\218\005V\000\000\002\158\000\000\000\000\002\214\000\000\000\000\005^\005b\002\218\005\162\000\000\000\000\003:\006!\000\000\000\000\000\000\000\000\000\000\000\000\002\222\000\000\000\000\000\000\000\000\003F\000\000\000\000\003R\001\190\005f\002\226\000\000\000\000\000\000\002\146\004.\000\000\003\210\003\014\001\190\000\000\003\214\000\000\003\222\005F\002\146\005R\000\000\003\026\000\000\000\000\000\000\007\234\007\238\007\250\000\000\000\000\005R\005V\000\000\000\000\000\000\000\000\006\169\006\242\000\000\005^\005b\006\169\005\162\000\000\006\169\000\000\000\000\000\000\000\000\000\000\005^\005b\000\000\000\000\006\169\000\000\000\000\000\000\006\169\000\000\000\000\000\000\000\000\005f\000\000\000\000\000\000\000\000\000\000\004.\006\169\000\000\000\000\000\000\005f\b\002\006\169\007^\000\000\b\026\004.\001\153\000\000\000\000\000\000\006\169\001\153\000\000\006\169\001\153\000\000\000\000\000\000\006\169\006\169\000\238\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\000\000\006\169\000\000\000\000\000\000\006\169\000\000\001\153\000\000\000\000\000\000\000\000\000\000\001\153\000\000\006\169\006\169\000\000\000\000\006\169\006\169\000\000\001\153\000\000\000\000\001\153\000\000\000\000\000\000\000\000\001\153\001\153\001\153\001\201\000\000\005\181\006\169\000\000\001\201\000\000\005\181\001\201\000\000\005\181\000\000\000\000\001\153\000\000\000\000\000\000\001\153\001\201\000\000\005\181\000\000\001\201\000\000\005\181\000\000\000\000\001\153\001\153\000\000\000\000\001\153\001\153\000\000\001\201\000\000\005\181\017b\000\000\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\001\153\001\201\000\000\005\181\001\201\001\153\005\181\000\000\000\000\001\201\001\201\005\181\005\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\000\000\005\181\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\201\001\201\005\181\005\181\001\201\001\201\005\181\005\181\000\000\000\000\000\000\000\000\000\000\000\000\001\201\011\225\005\181\002\158\011\225\000\000\027N\001\201\000\000\005\181\000\000\027R\021\006\000\000\011\225\000\000\000\000\000\000\001\201\000\000\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\004E\001\002\001\190\000\000\011\225\004E\000\000\011\225\004E\000\000\000\000\000\000\011\225\000\000\000\000\000\000\000\000\000\000\004E\000\000\027V\000\000\004E\000\000\000\000\000\000\000\000\000\000\011\225\000\000\000\000\000\000\011\225\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\027Z\011\225\011\225\000\000\000\000\011\225\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\000\000\004E\002\194\000\000\000\000\000\000\000\000\011\225\000\000\000\000\007\201\007\201\000\000\000\000\007\201\000\000\000\000\004E\000\000\007\201\000\000\004E\000\000\000\000\000\000\015\250\000\000\000\000\000\000\000\000\000\000\004E\004E\000\000\007\201\004E\004E\006\242\000\000\000\000\000\000\004E\000\000\000\000\004E\007\030\000\000\007\201\000\000\000\000\007\201\007\201\004E\004E\004E\000\000\000\000\007\201\004E\000\000\007\201\004E\000\000\004E\007\201\000\000\007\201\007\201\000\000\007\201\004E\004E\000\000\000\000\000\000\004E\004E\007^\000\000\000\000\000\000\007\201\000\000\000\000\000\000\000\000\000\000\004E\004E\007\201\007\201\000\000\000\000\004E\002\194\000\238\000\000\000\000\000\000\007\174\000\000\000\000\004E\000\000\000\000\004E\000\000\000\000\000\000\004E\004E\002\194\000\238\007\201\000\000\000\000\000\000\001U\000\000\007\201\000\000\000\000\001U\004E\004E\001U\004E\004E\004E\000\000\004E\000\000\000\000\000\000\000\000\001U\000\000\001U\000\000\001U\004E\004E\000\000\000\000\004E\004E\001\202\001\206\022:\000\000\000\000\001U\000\000\000\000\000\000\004E\000\000\001U\000\000\000\000\000\000\004E\000\205\000\000\002\138\001\226\000\000\000\205\000\000\001U\000\205\000\000\000\000\001\238\001U\001U\000\238\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\205\000\000\001\242\002r\000\000\000\000\001U\002~\000\000\002\146\004\006\004\018\000\205\000\000\000\000\000\000\004\030\000\000\000\205\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\205\000\000\000\000\000\205\000\000\000\000\004\"\000\000\000\205\000\205\000\238\000\000\000\000\000\000\001U\000\209\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\000\205\001U\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\209\000\205\000\205\000\000\000\000\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\004M\000\000\000\209\000\000\000\000\000\246\000\205\006\165\002\014\000\000\000\000\000\209\006\165\000\000\000\209\006\165\000\000\000\205\017\134\000\209\000\209\000\238\004M\000\000\000\000\006\165\000\000\000\000\000\000\006\165\000\000\000\000\000\000\000\000\017\138\000\209\000\000\000\000\000\000\000\209\017\178\006\165\000\000\000\000\000\000\000\000\000\000\006\165\000\000\000\209\000\209\000\000\016\226\000\209\000\209\000\000\006\165\016\250\000\000\006\165\000\000\000\000\000\000\000\000\006\165\006\165\000\000\005\169\000\000\000\000\000\209\000\000\005\169\018.\000\000\005\169\000\000\000\000\000\000\000\000\006\165\000\209\0172\000\000\006\165\005\169\000\000\017\022\018B\005\169\000\000\004M\004M\000\000\006\165\006\165\016\146\000\000\006\165\006\165\000\000\005\169\000\000\000\000\000\000\005\r\006\242\005\169\018R\000\000\005\r\000\000\000\000\005\r\000\000\006\165\005\169\000\000\000\000\005\169\000\000\000\000\000\000\005\r\005\169\005\169\000\000\005\r\000\000\000\000\007!\000\000\000\000\007!\000\000\000\000\000\000\000\000\000\000\005\r\005\169\000\000\000\000\000\000\005\169\005\r\007^\000\000\000\000\007!\007!\000\000\007!\007!\005\169\005\169\000\000\005\r\005\169\005\169\000\000\000\000\005\r\005\r\000\238\011\145\000\000\000\000\000\000\000\000\011\145\007!\000\000\011\145\000\000\005\169\000\000\000\000\005\r\000\000\000\000\000\000\000\000\011\145\000\000\000\000\000\000\011\145\000\000\000\238\000\000\000\000\005\r\005\r\000\000\000\000\005\r\005\r\000\000\011\145\000\000\000\000\000\000\000\000\000\000\011\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\r\011\145\000\000\000\000\011\145\000\000\007!\000\000\007!\011\145\000\000\000\000\000\000\000\000\001\202\002^\000\000\000\000\002b\000\000\005\254\000\000\000\000\005\194\007!\011\145\t\138\000\000\007!\011\145\007!\000\000\001\210\001\226\007!\000\000\000\000\000\000\000\000\011\145\011\145\001\238\000\000\011\145\011\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002j\002r\000\000\000\000\000\000\002~\011\145\002\146\004\006\004\018\000\000\000\000\000\000\000\000\020\222\000\000\026F\nn\000\000\004\029\000\000\004\021\000\000\000\000\004\029\000\000\004\021\004\029\000\000\004\021\000\000\004\"\000\000\000\000\000\000\000\000\000\000\004\029\000\000\004\021\015f\004\029\000\000\004\021\000\000\000\000\000\000\000\000\000\000\000\000\026R\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\000\000\000\000\020\242\004\029\000\000\004\021\004\029\000\000\004\021\000\000\000\000\004\029\000\000\004\021\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\0045\000\000\000\000\0045\000\000\004\029\000\000\004\021\000\000\004\029\000\000\004\021\000\000\0045\000\000\000\000\000\000\0045\000\000\004\029\004\029\004\021\004\021\004\029\004\029\004\021\004\021\000\000\000\000\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\004\029\000\000\004\021\000\000\0045\000\000\000\000\0045\000\000\000\000\000\000\016\186\0045\019\186\000\000\004\005\000\000\000\000\000\000\000\000\004\005\000\000\000\000\004\005\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\0045\004\005\000\000\000\000\000\000\004\005\000\000\000\000\000\000\000\000\0045\0045\000\000\000\000\0045\0045\000\000\004\005\000\000\000\000\000\000\004%\000\000\004\005\000\000\000\000\004%\000\000\004\r\004%\000\000\0045\004\005\004\r\000\000\004\005\004\r\000\000\000\000\004%\004\005\000\000\020\162\004%\000\000\000\000\004\r\000\000\000\000\000\000\004\r\000\000\000\000\000\000\000\000\004%\004\005\000\000\000\000\000\000\004\005\004%\004\r\000\000\000\000\000\000\000\000\000\000\004\r\000\000\004\005\004\005\000\000\004%\004\005\004\005\000\000\000\000\004%\000\000\004\r\000\000\000\000\000\000\000\000\004\r\000\000\000\000\000\000\000\000\000\000\004\005\004=\000\000\004%\000\000\000\000\004=\000\000\004Y\004=\004\r\024\026\000\000\000\246\000\000\000\000\002\162\004%\004%\004=\000\000\004%\004%\004=\004\r\004\r\003\146\000\000\004\r\004\r\004Y\000\000\000\000\000\000\000\000\004=\000\000\000\000\004%\000\000\000\000\004=\003\150\000\000\000\000\004\r\000\000\000\000\016~\017\230\000\000\000\000\000\000\004=\000\000\000\000\020N\024F\004=\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004=\000\000\000\000\n\246\000\000\000\000\000\000\017\002\000\000\001\202\001\206\000\000\000\000\000\000\004=\004=\000\000\000\000\004=\004=\000\000\017\022\017B\000\000\000\000\004Y\004Y\001\210\001\226\000\000\000\000\000\000\000\000\000\000\000\000\004=\001\238\000\000\000\000\000\000\000\000\000\000\021\134\001\202\001\206\022\154\020\202\000\000\000\000\001\242\002r\000\000\000\246\000\000\002~\002\162\002\146\004\006\004\018\000\000\000\000\002\138\001\226\004\030\000\000\027\154\000\000\000\000\001\202\001\206\001\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\"\003\150\000\000\001\242\002r\000\000\001\210\016~\002~\000\000\002\146\004\006\004\018\000\000\000\000\000\000\024F\004\030\000\000\016\226\000\000\000\000\000\000\000\000\016\250\000\000\000\000\000\000\001\242\002\130\000\000\000\000\000\000\002~\004\"\002\146\004\006\004\018\000\000\000\000\017\002\000\000\004\030\000\000\027F\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\022\017B\000\000\000\000\004\129\004\"\000\000\000\000\004\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\134\000\000\000\000\025\238")) and lhs = - (8, "\006\005\004\003\002\001\000\193\193\192\192\191\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\190\189\189\188\187\187\187\187\187\187\187\187\186\186\186\186\186\186\186\186\185\185\185\184\184\183\183\182\182\182\181\181\180\180\180\180\180\180\179\179\179\179\179\179\179\179\178\178\178\178\178\178\178\178\177\177\177\177\176\175\175\174\174\174\174\173\173\173\173\173\173\172\172\172\172\172\172\172\171\170\170\170\169\169\168\168\167\167\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\166\165\165\164\163\162\161\160\160\159\159\158\158\158\158\157\157\157\157\156\156\155\155\154\154\154\154\153\152\151\151\150\150\149\149\148\147\146\145\144\143\143\143\142\142\141\141\140\140\140\140\140\139\139\139\139\139\139\139\139\138\138\138\138\138\138\137\137\136\136\136\135\135\134\134\134\133\133\132\132\131\131\130\130\129\129\128\128\127\127~~}}||{{{zzzzyyxxwwvvvvvuuuutttsssssssrrrrrrrqqqqppooonnmmmmmmmmmllkkkkkkkkkkkjiihhgggggfeeddccccccccccccccbbaa```````````````````````````````__^^]]\\\\[[ZZYYXXWWVVUUTTTTTTTTTTTSRQPPPPPPPPPPOOONNNMMMMLLLLLLLLLKKJJJJJIIHHGFEEDDDDDCCBBAAA@@@@@@???>>==<<;;::999887766554433221100//...---,,,+++****)(''''''''''''''''''&&&&&%%%%%%%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$##\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \031\031\031\030\030\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\028\028\027\027\026\026\026\026\026\026\026\025\025\025\025\024\024\023\023\023\023\023\022\022\021\021\020\019\019\019\018\018\017\017\017\016\016\015\015\015\015\015\014\014\r\r\r\r\r\012\011\011\n\n\n\t\t\t\b\b\b\b\007\007") + (8, "\006\005\004\003\002\001\000\194\194\193\193\192\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\190\190\189\188\188\188\188\188\188\188\188\187\187\187\187\187\187\187\187\186\186\186\185\185\184\184\183\183\183\182\182\181\181\181\181\181\181\180\180\180\180\180\180\180\180\179\179\179\179\179\179\179\179\178\178\178\178\177\176\176\175\175\175\175\174\174\174\174\174\174\173\173\173\173\173\173\173\172\171\171\171\170\170\169\169\168\168\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\167\166\166\165\164\163\162\161\161\160\160\159\159\159\159\158\158\158\158\157\157\156\156\156\156\155\154\153\153\152\152\151\151\150\149\149\148\147\146\145\144\144\144\143\143\142\142\141\141\141\141\141\140\140\140\140\140\140\140\140\139\139\139\139\139\139\138\138\137\137\137\136\136\135\135\135\134\134\133\133\132\132\131\131\130\130\129\129\128\128\127\127~~}}|||{{{{zzyyxxwwwwwvvvvuuutttttttsssssssrrrrqqpppoonnnnnnnnnmmllkkkkkkkkkkkjiihhgggggfeeddccccccccccccccbbaa```````````````````````````````__^^]]\\\\[[ZZYYXXWWVVUUTTTTTTTTTTTSRQPPPPPPPPPPOOONNNMMMMLLLLLLLLLKKJJJJJIIHHGFEEDDDDDCCBBAAA@@@@@@???>>==<<;;::999887766554433221100//...---,,,+++****)(''''''''''''''''''&&&&&%%%%%%%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$##\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! \031\031\031\030\030\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\029\028\028\027\027\026\026\026\026\026\026\026\025\025\025\025\024\024\023\023\023\023\023\022\022\021\021\020\019\019\019\018\018\017\017\017\016\016\015\015\015\015\015\014\014\r\r\r\r\r\012\011\011\n\n\n\t\t\t\b\b\b\b\007\007") and goto = - ((16, "\000\025\001A\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000p\000\000\000\000\000T\000\176\000\022\001-\000\142\000\024\000u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000*\250\000\000\000\000\000\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\164\000\254\000\240\000\199\000\000\001\190\t\006\001\014\001\244\000T\000\000\000^\000\000\000>\002N\000\000\002,\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\023\003N\002\n\000\000\000\000\001`\000\164\000\000\000\000\000~\000\000\001z\000\000\bx\002d\000\000\001\164\000\228\000\000\000\000\002V\002P\001.\003\b\001\130\003N\003\212\003 \002\188\001\130\003.\003\018\b8\000\000\000\000\000\168\003\132\003\172\000\132\000\000\000\000\000\000\000\000\000\000\000\000\003\214\000\000\004~\000\000\000\168\t\022\000\000\000\000\003\160\003\240\003\142\025d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\003\186\004.\000\000\000\000\000\000\000\189\000\000\000\000\0048\000\127\006\000\005\000\0068\004\180\004\244\006,\000Q\000\011\006d\025\152\000\000\000\000\005b\006\202\t4\000\000\025\216\007x\t\244\n\016\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016+\012\006\026\000\000\n@\006\028\000\000\nr\026*\001\202\000\000\n\142\005\192\000\000\000\000\000\000\000#\000\000\000\002\000\000\006\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0048\003\162\000\000\000\000\000\134\000\000\002r\000\000\0048\005\140\0048\000\000\000\000\000\000\000\000\000\000\026f\000\000\0076\006\232\000\000\019*\007J/`\000\000\000\000\000\000\006\166\000\000\000\000\000\000\000\000\006|\000\000\000\000\000\000\000\000\000\000\n\200\000\000\000\000\000\000\000\000\000\000\000\000\0007\007P\000\000\000\000\000\000\006|\b\"\0268\007\238\007x#\140\000\000\004\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\166\000\000\000\000\000\000\000\000\t\026\026\248\000\000\000\000\bB\007\234\027\"\000\000\000\000\000\000\027@\b,\027X\000\000\b,\000\000\027\206\b,\000\000\027\230\b,\b,\000\000\000\000\b,\000\000\000\000\027\240\000\000\b,\028t\000\000\b,\t\146\000\000\000\000\n\016\000\000\000\000\000\000\000\000\b,\011V\000\000\000\000\000\000\b,\000\000\000\242\b\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\"J\000\000\b\182\000\000+F\006|\000\000\000\000\000\000\000\000\b\196\t6\n\216\b\156\b\176\b\190\b\216\000\180\t\018\000\004\b\214\000\000\000\000\000\000\000\000\000\143\001\172\t\156\002\240\b\224\002\002\000\000\001\198\0006\003L\000\250\n(\000\000\000\000/~\000\000/\154\t\220\000\000+Z\006|+\150\006|\000\000\t\198\000\000\t\210\000\000\000\000\t\230\000\000\000\000\000\000\n\236\000\000\002\222\001\198\000\000\000\000\t\218\000\000\000\000\000\000\000\000\000\000\000\000\001\198\000\000\000\000\001\198\000\000\b\224\000\212\000\000\000*\000\011\000\000\000*\000\000\000\000\0034\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000*\n\250\011n\n\172\nT\025\238\023X\000\000\t\218\t\166\011\246\t\230\t\200\005<\012H\000\000\000\000\000\000\000\000\000\000\011\024\004\190\000\000\000\000\000\000\t\254\t\204\0018\000*\003^\000\000\001\198\000\000\000\000\000\000\007x\000\000+\176\006|\012B\n\012\n\012\012p\n\022\nT\007\212\012N\b,\012\188\n2\n`*v\011\000\000\000\012\224\b,+\188\006|\n\234\000\000\000\000\000\000\000\000\000N\011\n\011\022\000\000\000\000(\160\r\020\n\154\np\028\176\b,\rv\n\162\n\136\rD\000\000\021h\000\000\000\000\028\140\028\212\005\156\000\000\000\000\000\000\000\000\021\216\000\000\000\000\000\000\004b\r\184\000\000\000\000\000\000\000\000\029F\024 \000\000\000\000\000\000\000\000\n\128\r\190\000\000\n\142\029\\\n\142\029z\n\142\000\000\030T\000\000\029\154\n\142\014\016\004D\014\022\000\000\000\000\029\168\n\142\030L\n\142\030b\n\142\030\160\n\142\030\178\n\142\030\240\n\142\031\006\n\142\031\020\n\142\031D\n\142\031R\n\142\031\170\n\142\031\184\n\142\031\232\n\142\031\246\n\142 \012\n\142 J\n\142 \\\n\142 \154\n\142 \176\n\142 \238\n\142\n\144\014b!\204\000N\011L\000\000\014\154%\130\000\000\014\214\000\000,8\000\000\006|\024\168\000\000\006|,:\006|\000\000\015(\000\000\000\000\000\000\015h\000\000\000\000\000\000\000\000\000\000\b,\000\000\000\000,D\000\000\006|\000\000\000\000\024\168\011R\000\000,T\006|\015p\000\000\000\000\n\252\000\000,`\006|\015\194\000\000\000\000\015\200\000\000\000\000\000\000,\244\006|\016\n\000\000\n\178\016\152\000\000\028\188\000\000\b,!\140\000\000\b,\"\n\000\000\b,\012\026\000\000\000\000\000\000\000\000\000\000\".\b,\005\022\006\028\000\000\000\000\000\000\n\142\016\218\000\000\000\000\000\000!\230\n\142\000\000\000\000\000\000\000\000\"\"\n\142\000\000\000\000\"n\n\142\000\000\000\000\"\188\n\142\000\000\000\000\000\000\"\164\000\000\000\000\"\212\n\142\000\000\000\000\"\244\n\142#V\n\142\000\000\000\000#z\n\142#\240\n\142\000\000\000\000$,\n\142\005@\016\224\000\000\000\000$B\n\142\017\"\000\000\000\000$\162\n\142$\208\n\142\000\000$\254\n\142\000\000\000\000%\b\n\142\000\000%^\n\142%\158\n\142\000\000%\188\n\142&\004\n\142\000\000&V\n\142\000\000&\\\n\142\000\000\006X\000\000\000\000\n\142\n\142\000\000&z\n\142\000\000&\170\n\142\000\000\n\238\000\000\000\000\017v\000\000\017\128\000\000\000\000\000\000\000N\011\134\000\000(\208\007\174\0048\017\190\000\000)\012\000\000\000\000\000\000)\030\000\000\000\000\017\220\000\000\018d\000\000\000\000\000\000\000\000\018\156\000\000\000\000\000\000&\184\n\142'\000\n\142\000\000\n\178\018\246\000\000\000\000\019\014\000\000\015\206\000\000\000\000\012H\000\000\000\000\000\000\0192\000\000\000\000\000\000\000\000\n\142\019j\000\000\019\128\000\000\000\000\000\000\000\000\012\020\000\000\000\000\000\000 \148\000\000\002\194\000\000\001\244\000\000\011\252\000\000\003,\000\000\000\000\000\000\000\000\000\000\000\000\011\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\142\000\000\012Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\212\002\164\000*\019\206\000\000\011r\n\228\000\000\004\136\004\238\000*\003\222\001\198\006 \000*\000\000\019\228\000\000\0052\000\000\011~\n\250\011z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\178\001P\000b\000\000\000\000\000\000\026~\000\0000\006\000\000\n\252\000\000\011\006\000\000\000\000\000\000\000\000\004\216\000\000\000\000\000\000\b\232\0048\000\000\0048\002P\000\000\t@\0048\0048\011*\000\000\020\130\000\000\011.\012\128\000\000\020\192\006\182\000\000\000\000\000\000\000\000\000\000\000\000\n\142\000\000\007\222\000\000\n\142\000\000\000\000\004,\000\000\001\198\000\000\005\006\000\000\001\198\000\000\005\026\001\198\000\000\000*\000\000\0114\b\206\003B\000\000\011\206\011\210\011V\011\246\012\130\006@\001\198\006\186\000\000\011d\000\000\007t\007\204\000\000\000\000\007\130\b\006\012B\011j\000\000\b\004\b\146\012\\\000\000\000\000\006P\0024&\224\b,\020\224\000\000\bb\002\210\012\028\011l\b\222\006\"\000\000\012X\011r\r\152\000\000-\004\006|\r\n\rB\000\000\b\180\000\000\012\196\011\132\012\234\r:\002\168\000\000\000\000\000\000\000\000\000\000\011\136\t\222\000\000\011\138\n\214\000\000\006~'\130\r0\r2\011\158\r\164\011\004\000\000\011\192\r\178\011&\000\000\rP\011\194\000\000\001R\r\196\011\140\000\000\r\248\000\000\011\178\000\000\007\004\001\198\012P\000\000\001\234\000\000\000\000\000\000\007h\001\198\r\238\011\206\000\000\000\000\b\004\004\160\014\002\000\000\000\000\r\200\011\210\b\212\006\022\000\000\r\242\011\226\r\228\r:\014\000\014 \011\244\015^\000\000\0148\001\214\000\000\000\000\000\000\000\000\000j\011\248\014\020-\028\006|\000\000\000\246\011\250\014\186\000\000\000\000\000\000\000\000\000\000\000\000-@\007\014\000\000\011\252\015\b\000\000\000\000\000\000\000\000\000\000\000\000\004b\000\000-h\006|\012\132\000\000\006|\012\012\003\204\000\000\000\000\012\014\012B\014\196\000\000\004\166\026\206\000\000\006\170\000\000\000\000\000\000\000\000-\168\006|\006|\000\000\000\000\b\n\000\000\014\234\000\000\006n\b\n\b\n\000\000\012X'@\006|-\180\006|\012\202\000\000\000\000\000\000\000\000\r\n\000\000\000\000\0016\000\000\t\n\014\200\012f\015\186\014\150\000\000\000\000\006\138\t\012\014\214\000\000\000\000\012l\015\198\014\176\000\000\000\000#4\000\000\001<\000\000-\196\020\196\006|\000\000-\240\b\228\000\000.\b\000\000\000\000\000\000\000\000\000\000\b\n\000\000\000\000\r$\014\242\012p\015\230\014\194\000\000\000\000.\024\r&\015\000\000\000\000\000\000\000'\158\000\000\000\000\000\000\000\000\000\000\000\000\r8\000\000\015\016\012\170\004|\000\000\015\226\015\164\rT\0150\000\000\000\000\0156\012\178\007\014\000\000\000\000\003\024\026*\007\170\000\000\000\000\000\000\014\220\015\004\012\238\000\000\015\012\014\220\000\000\015\196\rX\015J\000\000\000\000\000\000\006|\003\140\004\248\b\174\000\000\000\000\000\000\000\000\015\018\012\252\000\000\b\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006|\015\000\012\254\0166\015\014\000\000#\158\000q\r\024\014\232\000c\003\006\r8\015\134\000\000\016,\021\028\000\000\000\000\021Z\000\000\r\\\000\000\000\019\000\000\000\000\000\000\000\000\000\000\000\000-\200\006|\000\000\016.\021~\000\000\000\000\021\206\000\000\002\254\r<\015\214\000\000\000\000)Z\005@\015\152\000\000.d\006|\0222\000\000\000\000\022`\000\000\000\000\rj\000\000\b\020\000\000\000\000\000\000\000\000\000\000\000\000\t\146\000\000\000\000)v\022Z\015\154\000\000.\160\006|\022\160\000\000\000\000\023\000\000\000\000\000\rB\023\006\rp\000\000\rH\rL\002`\002\130\rT\b\216\r\\\015\232\022\196\r\240\000\000\r\144\r\148\015\146\000\000\0032*\154\000\000\005\132\000\000\r\164)\196)\208\005\216\014\248\005\222\000\000\006\022\006X\000\000\003\244\000\000\000\000\003\244\000\000\000\000\003\244\015\152\000\000\007\134\003\244\015\244\023\170\r\244\000\000\003\244\000\000\000\000.\170\000\000\000\000\000\000\003\244\000\000\000\000\014(\000\000\tj\005J\014.\000\000\r\172*\190\0148\000\000\000\000\000\000\000\000\014\\\000\000\000\000\006\022\000\000\003\244.\236\000\000\n:\003\244*\000\000\000\014\138\015t\r\180\016p\015H\000\000*:\014\164\015\130\000\000\000\000\000\000\026\136\b\156\000\000\000\000\000\000\000\000\000\000\000\000\n\128\014\166\000\000\015\144\000\000\000\000\000\000\000\000\014\168'\224\000\000\000\000\000\000\000\000\n\128\000\000\000\000\014\196'\244\000\000\000\000\000\000\000\000\000\000\000*\001\198\000\000\000\000\b,\000\000/\018\006|\000\000\n>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015F\r\216\n\158\000*\000\000\n\148\000\000\001\198\000\000\016d\000\000\000\000\000\000\000\000\000\000\b\024\000\000\000\000\000\000\000\000\000\000\000\000\016\012\001\182\015>\015\004\007\174\014J\000\000\004<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\018\bH\014N\000\000\006<\016p\016\"\014\200\000\000\000\000\016\022\003*\007V\000\000\000\000\000\000\014P\000\000\014\\\002 \000\000\000\000\0048\005V\000\000\000\000\000\000\000\000\000\000\t>\000\000\000\000\006\198\t\016\000\000\000\000/2\006|\006|\000\000/V\006|\t\198\000\000\000\000\000\000\006|\000\000\000\000\006\176\016(\014\214\000\000\000\000\016\"\t\208\002\030\000\000\000\000\000\000\000\000\b\226\016p\006\188\0166\014\242\000\000\000\000\0160\011F\003\192\000\000\000\000\000\000\000\000\001\198\000\000\tJ\000\000\000\000\000\000\023\178\000\000\024\024\000\000\000\000\000\000\000\000\000\000\b\026\000\000\000\000\000\000*h\000\000\006|\000\000\b\194\000\000\000\000\000\000\024v\b,\000\000\000\000\003\160\015\148\007`\000\000\000\000\000\000\000\000\000\000\000\000\011\024\000\000\000\000\000\000\000\000(J\000\000\014\246\000\000\000\000\000\000\000\000\004\004\005Z\024\\\025\006\000\000\000\000\015\006\025\016\000\000\000\000\000\000\015\012\025\026\000\000\000\000\000\000\000\000"), (16, "\006\t\005v\002\003\002\004\001\007\000;\001\182\001\b\006\172\000\134\006\150\001\182\000\143\006+\001\214\000?\002G\006\n\006\183\001\214\006\012\001\229\001\007\006\t\002H\002\003\002\004\000l\000\243\006\r\006\026\001\n\001D\000\246\001\182\001\207\001\225\002V\000h\002G\006\n\006\025\001\214\006\012\001\229\0007\006*\002H\000\134\001\242\001\218\000\139\006\r\006\026\001T\001\218\000\184\000\249\006\014\000\134\002V\006\158\001\199\001\227\000\134\001\219\000\144\001\199\001\026\004\020\001\219\005\239\001\242\001U\001e\001G\001W\001X\001\218\001\229\005\198\006\014\001\208\000\140\001\007\006\176\006\015\006}\001\007\0007\002X\001\027\002\233\001\219\006\016\005z\001\012\005\242\002\003\002\004\002\007\001\243\001\012\001\007\001\233\001\240\001\b\001\242\005\200\006\015\006\031\001\n\005\244\002X\001\012\001\n\001f\006\016\001g\002\181\006;\0007\005\201\002\007\001\243\006 \006\t\005\203\002\003\002\004\001\n\005\247\006\128\006\031\006\019\000h\006\185\005\245\006\021\000s\001!\001n\002G\006\n\006\025\004\021\006\012\001\021\006 \006\023\002H\001]\002Z\003\217\002`\006\r\006\026\006\019\001\221\001\243\002f\006\021\002\\\002V\006\024\001\021\004\198\001\026\000\134\006\178\006e\001\199\006\023\001\030\001\229\002Z\001\012\002`\000\184\001\007\001\012\002h\004\250\002f\006\014\002\\\002\006\006\024\006o\001\007\001\229\001\022\003\228\003\230\003\232\001\012\002\007\001\007\000@\001\244\001\b\000:\001\242\001p\002h\006\t\001\n\002\003\002\004\001\241\001\007\001q\006\015\001[\006Q\001\230\002X\004\205\001\242\003\233\006\016\002G\006\n\006\025\001\n\006\012\002\007\001\021\004\206\002H\000\189\001\021\004\230\000\243\006\r\006\026\006\031\000\243\001\146\001.\001\229\005:\002V\0007\004\222\0009\001\021\000{\002Z\000\188\006\135\006 \000\134\001\030\001\243\000\139\002[\001\030\002\\\000\189\006\019\001\026\000\249\006\014\006\021\002\016\001\187\006N\001\242\004\225\001\243\001\012\001\030\003\150\0018\006\023\004\229\000=\002Z\004t\002`\001\012\001\007\006Y\004\227\001\b\002f\004\149\002\\\001\012\006\024\006\015\000z\001\007\006\t\002X\002\003\002\004\002\233\006\016\000\128\004\225\001\012\004\228\006{\002\007\001\012\002h\000\189\001\n\002G\006\n\006\025\000\138\006\012\006\031\004\227\001\007\002H\001\182\001\243\001\222\001\021\006\r\006\026\004v\005:\001\214\005A\005B\006 \002V\001\021\001.\001\007\004\228\003\151\001\b\003\236\006\019\001\021\000\184\002\233\006\021\006\143\006\144\001\026\003\233\001\030\005K\000~\004|\006\014\001\021\006\023\004w\006!\002Z\003\237\002`\006\145\001\n\001\182\001\218\001\183\002f\001\030\002\\\0018\006\024\001\214\006]\006^\006\t\001\012\002\003\002\004\000\129\001\219\006w\006\015\006_\006`\0007\002X\001\012\002h\006v\006\016\002G\006\n\006\025\006a\006\012\002\007\006\154\003\148\002H\001\026\000\161\005o\004v\006\r\006\026\006\031\000\134\001\218\000\168\001\199\001\012\002V\000\189\001\003\005A\005B\001\213\000\184\001\007\001.\006 \001\b\001\219\001\229\000\166\006\155\001\021\001\012\000\137\006\019\005C\005S\006\014\006\021\000\184\005K\006\029\001\021\001\180\000\189\000\134\005\198\001\186\001\199\006\023\001\n\000\170\002Z\003\185\002`\003\154\001\242\001\030\004R\0018\002f\000\159\002\\\005\198\006\024\006\015\001\021\005:\006w\002X\000\165\000\243\003\239\006\016\005\200\006m\001\029\002\233\001\182\002\007\001\212\002h\006\t\001\021\002\003\002\004\001\214\001\026\005\201\006\031\000\189\005\200\003\242\005\203\002\233\006\213\006\214\005\226\002G\006\216\003\149\005=\006\012\005\146\006 \005\201\002H\001\240\001\243\001\030\005\203\006\r\006\218\006\019\005\219\001\012\005\148\006\021\004U\002V\005q\001\182\001\218\001\237\000\243\005:\000\176\000\184\006\023\001\214\006P\002Z\006\t\002`\002\003\002\004\006\233\001\219\001\221\002f\006\014\002\\\001\182\006\024\002\019\000\173\006\225\004\025\002G\006\226\001\214\005\198\006\012\003\149\005A\005B\002H\002\233\000\171\001.\002h\006\r\006\234\006]\006^\001\218\001\021\001\025\006\015\002V\005C\005S\002X\006_\006`\005K\006\016\000\189\000\175\005\200\001\219\000\189\002\007\000\184\006a\0007\001\218\000\189\001\007\006\221\006\014\001\b\001\030\005\201\0018\002\003\002\004\000\134\005\203\005$\001\199\001\219\005\210\000\182\005\229\004\198\001\182\006 \003\195\002G\006\168\001\241\005A\005B\001\214\001\n\006\019\002H\006\015\002\233\006\021\000\181\002X\006E\000\190\004\180\006\016\002\003\002\004\005R\002V\006\023\002\007\005K\002Z\000\198\002`\000\199\006\238\006\155\004\183\002G\002f\0063\002\\\001\182\006\024\004\011\000\211\002H\001\218\001P\001\026\001\214\001\024\003}\004\205\006 \006\t\001\012\002\003\002\004\002V\002h\000\189\001\219\006\019\004\206\000\212\002\233\006\021\004\213\006Z\000\219\002G\006\n\006'\000h\006\012\002\246\001\012\006\023\002H\002X\002Z\000\189\002`\006\r\006\026\001\218\002\003\002\004\002f\002\007\002\\\002V\006\024\003\198\000\189\001\007\005\205\006[\001\b\006\t\001\219\002\003\002\004\005:\003\004\000h\001\007\006\\\003\163\002h\004\198\002X\006\014\006\225\002]\002G\006\226\001\229\004\130\006\012\001.\002\007\001\n\002H\002\233\000\189\003\217\001\021\006\r\006\229\000\189\004\185\004\180\001\007\002\003\002\004\002V\002l\003\201\001\012\006\015\002Z\003\193\002`\002X\001\242\002]\005\142\006\016\002f\001\182\002\\\004\015\001\030\002\007\0018\003>\006\014\001\214\001\026\001\182\004\205\004\018\001Z\006\031\003\231\003\230\003\232\001\214\004\022\002h\005\233\004\206\002Z\002\006\002`\004\207\002\235\003\202\006 \003?\002f\001\213\002\\\002\007\006\015\003*\001\012\006\019\002X\005A\005B\006\021\006\016\001\218\002\003\002\004\001\243\001\012\002\007\006y\000\225\002h\006\023\001\218\006\232\002Z\005J\002`\001\219\006\t\005K\002\003\002\004\002f\003;\002\\\003>\006\024\001\219\000\184\006j\002\006\003\201\006 \001\012\002G\006\n\002\003\002\004\006\012\001.\002\007\006\019\002H\002h\002Z\006\021\001\021\006\r\006#\005\202\004\185\0007\002[\005\023\002\\\002V\006\023\001\021\003>\002Z\002\233\002`\001\007\002\233\000\233\001\b\002\233\002f\003A\002\\\000\184\006\024\001\030\000\184\0018\005\205\006\014\001I\001\229\001\240\005\024\005X\005\025\006w\001\021\000\253\001\000\001\007\002h\001\n\001\b\002\006\002Z\001\007\005\198\001\006\001\b\005\198\006\132\005\193\002[\002\007\002\\\003\197\006\015\000\221\001\242\001[\002X\005\246\001 \005\026\006\016\004\137\001\n\001\182\002\234\004 \002\007\004?\001\n\001\012\005\200\001\214\002\006\005\200\001\026\000\226\006&\003A\000\134\005:\005.\001\199\002\007\005\242\005\201\005:\005\027\005\201\002\233\005\203\002\233\006 \005\203\005\207\004\198\005\028\005\204\005\029\005\244\001\026\006\019\002Z\001\012\000\229\006\021\001\026\001\243\001\218\004\198\002[\003@\002\\\005Y\006\147\000\189\006\023\006\209\002\004\002Z\006\161\002`\001\015\001\219\005\245\004\198\001\213\002f\001\012\002\\\001\151\006\024\001\241\002\233\001\012\002Z\005\031\000\189\001+\001\012\005!\005+\003\252\002[\004\"\002\\\004\205\001.\002h\001U\002\024\005U\001W\001X\001\021\000\234\0044\004\206\005Z\0012\004\205\004\212\001\182\001\007\004s\000\189\005V\005A\005B\002\233\001\214\004\206\001.\005A\005B\004\238\001T\0017\001.\001\021\001\030\001T\0018\005C\005S\001\021\004\170\004\201\005K\005C\005S\003s\002\228\002\229\005K\001U\001e\001F\001W\001X\001U\001e\005\153\001W\001X\001\030\001\218\0018\005\023\0015\001T\001\030\001\182\0018\004{\006\210\000\189\001n\003i\0013\001\214\001\219\006n\004\005\004&\002\003\002\004\001]\002\233\001U\001e\004*\001W\001X\000\184\005\024\006\187\005\025\001f\002G\001g\002#\001M\001f\003\217\001g\002#\002H\003v\003{\0017\006[\006M\006J\004R\001\012\001\218\002\233\005\198\002\233\002V\006\\\005\157\001n\001\007\0007\005\026\001\b\001n\003\201\000\189\001\219\001f\001]\001g\002#\003\201\003l\001]\001p\000\189\004'\003l\0053\003\230\003\232\005\200\001q\001\141\001[\001\182\001\n\004\129\005\027\002\003\002\004\004/\001n\001\214\001d\005\201\003\220\005\028\000\189\005\029\005\203\001\021\001]\002G\005\214\004+\003l\004\214\002X\006W\006q\002H\006\164\001\007\005Y\001\007\005\001\006\195\002\007\0007\001p\005\023\002\233\001\026\002V\001p\004R\003Y\001q\001\218\001[\002\003\002\004\001q\001L\001[\003\201\005\031\006\189\002\233\001\n\005!\005+\002]\001\219\002G\002\003\002\004\005\024\006\169\005\025\001\012\005U\002H\001p\000\189\001\138\006\197\001\007\001\007\002G\001\b\001q\0068\001[\001\229\002V\005V\002H\003\217\002Z\004\208\002`\001\229\004\003\0040\001c\002X\002f\005\026\002\\\002V\002\233\002\233\003\217\001\n\006c\002\007\001m\001\182\004\024\004\136\004J\001\242\001\129\001.\001\145\001\214\004>\002h\001\007\001\242\001\021\001\b\001\012\001\012\005\027\001\012\005G\003\230\003\232\001\157\002]\001\168\002\233\005\028\004:\005\029\001\162\002X\003\254\003\247\001\026\005O\003\230\003\232\000\184\001\n\001\030\002\007\003\227\003\183\005Y\001\218\002X\004\231\004\239\004\180\001\167\002Z\001\175\002`\001\170\001T\002\007\001\243\001\220\002f\001\219\002\\\001\012\001\012\005\156\001\243\002]\005\031\001\021\001T\001\021\005!\005+\001\192\001U\001e\001\026\001W\001X\006\175\002h\002]\005U\000\184\001\148\006\153\000\189\005\180\001U\001e\001\194\001W\001X\002Z\001\030\003\133\003\235\005V\001\132\001\007\002\233\002f\001\b\002\\\001\012\001\"\006\127\005\198\002Z\006\131\002`\004\208\004\208\001\021\001\021\000\189\002f\001f\002\\\001g\001\135\003\217\002h\001\179\001\007\001#\001\n\001\b\001\254\001\201\001\"\001f\001A\001g\001\135\005\200\001\203\002h\001\007\001\030\003\241\001\b\001n\0017\001\"\002\001\001\206\002\015\001.\005\201\001#\001\n\001]\004W\005\203\001\021\001n\001?\005\232\004\185\006\140\003\230\003\232\001\026\001#\001\n\001]\001\007\002\003\002\004\001\b\001$\001\210\001\"\006\156\006\157\001\217\003\176\003\172\002\030\001(\001\030\002G\0018\000\189\002\003\002\004\000\184\001\026\000\189\002H\001\012\001\253\001#\001\n\005K\003\253\0064\002\000\002G\001=\003\162\001\026\002V\001p\001(\000\189\002H\000\189\001\229\002\014\005\198\001q\003\182\001[\002!\001\012\002\029\001p\001(\002V\002'\002 \005\242\002\233\001\182\001q\006C\001[\002<\001\012\001\026\001T\001\214\006?\001.\002&\001\242\005\244\005\200\000\189\002A\001\021\002\003\002\004\002\152\0016\002\233\001(\0022\002/\001U\001e\005\201\001W\001X\002X\002G\005\203\001\012\001.\001\137\005\251\005\245\002\233\002H\002\007\001\021\001\030\001\218\0018\0016\006\167\002X\001.\003\179\000\189\004Z\002V\003\184\0027\001\021\000\189\002\007\001\219\0016\0026\003\190\002;\001\243\000\189\002]\002@\001\030\001f\0018\001g\001\135\003\205\003\224\004b\002\236\000\189\001.\003\226\002e\000\189\001\030\002]\0018\001\021\002\003\002\004\002\156\0016\002\233\002\191\004f\002Z\001n\002`\002\198\003\244\002\227\003\248\002G\002f\004\023\002\\\001]\002\226\002X\003N\002H\002\233\002Z\001\030\002`\0018\003\165\000\189\002\007\003V\002f\004\029\002\\\002V\002h\000\189\002\003\002\004\004$\002\003\002\004\004-\004=\001T\003\142\004B\000\189\000\189\006\156\006\157\002G\002h\000\189\002]\004M\004m\004V\004Y\002H\002\003\002\004\002\005\001U\001e\003r\001W\001X\004`\001p\005K\000\189\002V\000\189\002G\004q\000\189\001q\003\152\001[\003\174\002Z\002H\003\133\003\189\004d\004i\002X\003m\002f\003\204\002\\\004~\000\189\004\135\002V\003\213\002\007\002\003\002\004\000\189\002\233\004\140\000\189\000\189\003\243\001f\000\189\001g\002#\002h\004\145\002G\004\155\004\161\004\172\000\189\001T\000\189\000\189\002H\003\250\002]\004\187\004\209\002X\003b\002\233\002\006\000\189\004#\001n\004\028\002V\004\030\002\007\001U\001e\002\007\001W\001X\001]\002\003\002\004\004!\003h\000\189\000\189\002X\002Z\004\192\002`\0042\000\189\004u\000\189\002G\002f\002\007\002\\\002]\004\216\002\233\000\189\002H\0041\002\003\002\004\004\233\004<\003S\004\243\000\189\005\014\000\189\000\189\000\189\002V\002h\001f\004\184\001g\002+\002]\000\189\000\189\002X\002Z\002B\002`\002Z\002\003\002\004\001p\002\233\002f\002\007\002\\\002[\004A\002\\\001q\005#\001[\001n\002G\005-\002\233\002\233\004C\002Z\000\189\002`\002H\001]\004\221\002h\002\233\002f\003K\002\\\002]\000\189\004I\002\003\002\004\002V\002\003\002\004\000\189\002X\002\233\000\189\002\233\000\189\002\233\0059\002.\002G\002h\002\007\002G\002\233\005M\005]\002\233\002H\004\226\002Z\002H\002`\004H\002S\004L\002\006\002_\002f\005c\002\\\002V\005\012\005\020\002V\000\189\002\007\002]\001p\000\189\002\003\002\004\005 \002\003\002\004\005g\001q\005\131\001[\002h\005\171\002X\004N\005\231\002G\005\176\005(\002G\005?\005\215\005p\002\007\002H\005\181\002Z\002H\002`\005\147\002n\000\189\005\173\002m\002f\004X\002\\\002V\000\189\000\189\002V\004c\004_\002\233\002\153\002\233\002X\004a\002]\002X\002Z\005\211\000\189\005\187\004e\002h\002\007\004h\002[\002\007\002\\\005\195\004l\002\207\001e\005\236\001W\001X\000\189\006\001\000\189\002\233\001T\000\189\002\233\002Z\000\189\002`\000\189\002\233\002\170\002]\000\189\002f\002]\002\\\000\189\006>\002\173\004p\002X\001U\002\174\002X\001W\001X\005\184\002\233\005\218\004\132\002\007\002\003\002\004\002\007\002h\002\212\002\228\002\229\002Z\004\131\002`\002Z\000\189\002`\000\189\002G\002f\004\134\002\\\002f\002\233\002\\\000\189\002H\005\230\002]\000\189\005\234\002]\002\161\000\189\001n\005\238\002\233\002\233\002\233\002V\002h\004\139\004\141\002h\001]\002\003\002\004\006X\004\242\006d\006r\000\189\002\233\005\243\002\233\002Z\006t\002`\002Z\002G\002`\002\233\001\\\002f\004\144\002\\\002f\002H\002\\\004\147\002\232\004\151\001]\002\172\004\159\002\233\005\255\002\233\001T\004\166\002V\002\003\002\004\004\177\002h\002\233\002\170\002h\002\233\006\006\006\020\006\027\002X\004\193\002\173\002G\001p\001U\002\174\002\175\001W\001X\002\007\002H\001q\006$\001[\006i\000\189\002\195\000\189\000\189\004\210\004\241\006\149\004\234\002V\000\189\004\235\002\177\004\240\004\244\002\003\002\004\001p\002\003\002\004\002]\006\163\002\153\006\219\004\245\001\139\002X\001[\005\022\002G\005\015\006\230\002G\005\016\006\235\005\021\002\007\002H\005*\005&\002H\002\207\001e\002\202\001W\001X\002\205\002Z\005'\002`\002V\002\003\002\004\002V\005)\002f\005T\002\\\001\\\0057\0058\002]\002X\005<\005>\002G\005@\005L\001]\005\\\005^\005_\002\007\002H\005d\005h\002h\005l\005~\002\211\005\133\005\137\005\161\002\212\002\228\002\229\002V\005\182\002Z\005\188\002`\005\206\005\212\005\216\006\b\002\175\002f\002]\002\\\006\002\006\003\006\007\006\022\002X\006=\006H\002X\006S\006U\001n\006g\006h\006l\002\007\006\148\002\176\002\007\002h\006\152\001]\001p\006\162\002\003\002\004\002Z\006\166\002`\006\204\001\139\000\000\001[\000\000\002f\000\000\002\\\000\000\002G\000\000\002]\002X\000\000\002]\000\000\000\000\002H\003z\000\000\000\000\000\000\002\007\002\214\000\000\000\000\002h\000\000\002\003\002\004\002V\002\003\002\004\000\000\000\000\000\000\000\000\000\000\002Z\000\000\002`\002Z\002G\002`\001p\002G\002f\002]\002\\\002f\002H\002\\\001q\002H\001[\000\000\002\239\000\000\000\000\003\028\000\000\000\000\000\000\002V\002\003\002\004\002V\002h\000\000\000\000\002h\000\000\000\000\000\000\002Z\000\000\002`\000\000\002G\000\000\000\000\000\000\002f\002X\002\\\000\000\002H\000\000\000\000\000\000\000\000\000\000\003!\002\007\000\000\000\000\000\000\000\000\000\000\002V\000\000\000\000\000\000\002h\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002X\000\000\002]\002X\002G\000\000\000\000\000\000\000\000\002G\002\007\000\000\002H\002\007\000\000\000\000\000\000\002H\003O\000\000\000\000\000\000\000\000\003Q\000\000\002V\002\003\002\004\000\000\002Z\002V\002`\000\000\000\000\000\000\002]\002X\002f\002]\002\\\002G\002\003\002\004\000\000\000\000\000\000\002\007\000\000\002H\000\000\000\000\000\000\000\000\000\000\003[\002G\000\000\000\000\002h\000\000\000\000\002V\002Z\002H\002`\002Z\000\000\002`\000\000\003d\002f\002]\002\\\002f\000\000\002\\\002V\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002\007\000\000\000\000\002h\000\000\002\007\002h\000\000\000\000\000\000\002Z\000\000\002`\000\000\000\000\000\000\000\000\000\000\002f\000\000\002\\\002\003\002\004\000\000\000\000\002]\002X\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\002G\002\007\000\000\000\000\002h\000\000\002X\000\000\002H\000\000\000\000\000\000\000\000\000\000\003g\001T\002\007\002Z\000\000\002`\000\000\002V\002Z\000\000\002`\002f\002]\002\\\000\000\000\000\002f\000\000\002\\\000\000\001U\001e\000\000\001W\001X\000\000\000\000\002]\000\000\000\000\000\000\000\000\002h\000\000\000\000\000\000\000\000\002h\000\000\002Z\000\000\002`\000\000\000\000\000\000\002\003\002\004\002f\000\000\002\\\000\000\000\000\000\000\000\000\002Z\000\000\002`\002\003\002\004\002G\002X\000\000\002f\001f\002\\\001g\002#\002H\002h\000\000\002\007\002G\000\000\003u\000\000\002\003\002\004\000\000\001\007\002H\002V\001\b\000\000\002h\000\000\003x\000\000\000\000\001n\002G\000\000\000\000\002V\000\000\000\000\002]\000\000\002H\001]\000\000\000\000\000\000\003k\002\003\002\004\001\n\000\000\003\130\000\000\000\000\002V\000\000\000\000\001,\002\003\002\004\000\000\002G\000\000\000\000\000\000\000\000\002Z\000\000\002`\002H\000\000\000\000\002G\000\000\002f\000\000\002\\\002X\000\000\003\135\002H\000\000\002V\000\000\000\000\000\000\001\026\002\007\000\000\002X\003\138\000\000\000\000\002V\001p\002h\000\000\002\003\002\004\002\007\000\000\000\000\001q\000\000\001[\000\000\000\000\002X\002\003\002\004\000\000\002G\002]\000\000\001\012\000\000\000\000\002\007\000\000\002H\000\000\000\000\002G\000\000\002]\003\187\000\000\000\000\000\000\000\000\002H\000\000\002V\000\000\000\000\002X\003\200\000\000\000\000\002Z\000\000\002`\002]\002V\000\000\002\007\002X\002f\000\000\002\\\000\000\002Z\000\000\002`\000\000\000\000\002\007\000\000\001.\002f\000\000\002\\\000\000\000\000\000\000\001\021\000\000\000\000\002h\002Z\002]\003\133\000\000\000\000\000\000\000\000\000\000\002f\000\000\002\\\002h\002]\000\000\000\000\000\000\002X\000\000\002\003\002\004\000\000\000\000\001\030\000\000\0014\000\000\002\007\002X\002Z\002h\003\133\000\000\002G\000\000\000\000\000\000\002f\002\007\002\\\002Z\002H\003\133\000\000\000\000\000\000\000\000\003\246\002f\000\000\002\\\002\153\002]\000\000\002V\000\000\000\000\000\000\002h\001\007\000\000\000\000\001\b\002]\000\000\0019\002\003\002\004\000\000\002h\002\207\001e\000\000\001W\001X\000\000\000\000\000\000\000\000\002Z\002G\002`\000\000\000\000\000\000\001;\001\n\002f\002H\002\\\002Z\004\196\002`\000\000\0048\000\000\002\003\002\004\002f\000\000\002\\\002V\000\000\000\000\000\000\000\000\000\000\002X\002h\000\000\002G\000\000\002\212\002\228\002\229\000\000\000\000\002\007\002H\002h\000\000\000\000\000\000\001\026\005k\000\000\000\000\002\003\002\004\000\000\000\000\002V\000\000\000\000\002\003\002\004\000\000\000\000\001n\000\000\001(\002G\002]\000\000\000\000\002\003\002\004\000\000\001]\002H\000\000\001\012\000\000\000\000\002X\005n\002D\000\000\000\000\002G\000\000\000\000\002V\000\000\002\007\000\000\000\000\002H\000\000\002Z\000\000\002`\000\000\005}\003\251\000\000\000\000\002f\000\000\002\\\002V\000\000\000\000\000\000\002X\002\003\002\004\000\000\000\000\002]\002\003\002\004\000\000\000\000\002\007\001.\000\000\000\000\002h\002G\001p\000\000\001\021\000\000\000\000\000\000\004\253\002H\001q\000\000\001[\000\000\002N\005\128\000\000\002X\002Z\000\000\002`\002]\002V\000\000\002\006\000\000\002f\002\007\002\\\000\000\001\030\000\000\0018\000\000\002\007\002X\000\000\002\003\002\004\000\000\000\000\000\000\000\000\000\000\000\000\002\007\000\000\002h\002Z\000\000\002`\002G\002]\000\000\000\000\000\000\002f\000\000\002\\\002H\002\003\002\004\000\000\000\000\001\007\005\141\000\000\001\b\000\000\000\000\002]\000\000\002V\000\000\002G\002X\000\000\002h\000\000\002Z\002\006\002`\002H\000\000\000\000\002\007\002Z\002f\005\144\002\\\002\007\001\n\002\003\002\004\002[\002V\002\\\002Z\000\000\002`\000\000\004\180\000\000\000\000\000\000\002f\002G\002\\\002h\000\000\002]\002\153\000\000\000\000\002H\000\000\005\166\000\000\000\000\000\000\005\165\000\000\000\000\000\000\000\000\002X\002h\002V\001\026\000\000\002\207\001e\000\000\001W\001X\002\007\000\000\002Z\000\000\002`\002\003\002\004\002Z\002\003\002\004\002f\000\000\002\\\002X\000\000\002[\000\000\002\\\000\000\002G\000\000\001\012\002G\002\007\000\000\002]\000\000\002H\000\000\000\000\002H\002h\000\000\005\168\000\000\000\000\005\172\002\212\002\228\002\229\002V\000\000\000\000\002V\000\000\002X\000\000\000\000\002]\002\003\002\004\000\000\002Z\000\000\002`\002\007\000\000\000\000\000\000\000\000\002f\000\000\002\\\001n\000\000\001.\000\000\000\000\000\000\000\000\000\000\003\146\001\021\001]\000\000\002Z\004\185\002`\003\155\000\000\002]\002h\000\000\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\153\000\000\002X\002\003\002\004\002X\000\000\001\030\005\183\0018\003\168\000\000\002\007\002h\000\000\002\007\002Z\002G\002`\002\207\001e\000\000\001W\001X\002f\002H\002\\\000\000\000\000\000\000\000\000\006\179\000\000\000\000\001p\000\000\000\000\002]\002V\000\000\002]\000\000\001q\000\000\001[\002h\002\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\003\002\004\003\159\000\000\002\003\002\004\000\000\002\212\002\228\002\229\002Z\000\000\002`\002Z\002G\002`\000\000\000\000\002f\000\000\002\\\002f\002H\002\\\000\000\000\000\002Y\000\000\006\181\000\000\000\000\003\149\006\t\001n\000\000\002V\000\000\002X\000\000\002h\000\000\000\000\002h\001]\000\000\000\000\006\225\002\007\001T\006\226\000\000\000\000\006\012\000\000\002Z\000\000\000\000\000\000\000\000\000\000\000\000\006\r\002[\000\000\002\\\000\000\000\000\001U\001e\005\217\001W\001X\002]\000\000\000\000\000\000\000\000\000\000\000\000\001\007\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\000\002X\000\000\006\014\000\000\002\006\000\000\000\000\001p\000\000\000\000\002\007\002Z\000\000\002`\002\007\001q\000\000\001[\001\n\002f\000\000\002\\\001f\000\000\001g\006\199\006\201\000\000\002\196\006\t\006\015\000\000\000\000\000\000\006\t\002]\000\000\000\000\006\016\006\t\002h\000\000\000\000\006\225\000\000\000\000\006\226\001n\006\225\006\012\006\228\006\226\000\000\006\225\006\012\001\026\006\226\001]\006\r\006\012\000\000\000\000\002Z\006\r\002`\000\000\002Z\000\000\006\r\006\018\002f\000\000\002\\\000\000\002[\000\000\002\\\000\000\006\019\001T\000\000\000\000\006\021\001\012\000\000\000\000\000\000\006\014\000\000\000\000\000\000\002h\006\014\006\023\000\000\000\000\000\000\006\014\001U\001e\000\000\001W\001X\000\000\002\003\002\004\000\000\000\000\006\024\001p\000\000\000\000\000\000\000\000\000\000\006\015\000\000\001q\002G\001[\006\015\000\000\000\000\006\016\000\000\006\015\002H\001.\006\016\000\000\000\000\000\000\000\000\006\016\001\021\006\227\002\003\002\004\002\167\002V\006\231\001f\000\000\001g\006.\006\236\000\000\002\003\002\004\000\000\002G\000\000\000\000\000\000\006\018\000\000\000\000\000\000\002H\006\018\001\030\002G\0018\006\019\006\018\000\000\001n\006\021\006\019\002H\000\000\002V\006\021\006\019\000\000\000\000\001]\006\021\006\023\000\000\000\000\000\000\002V\006\023\001\007\001T\000\000\001\b\006\023\000\000\0019\000\000\002X\006\024\000\000\000\000\000\000\000\000\006\024\000\000\000\000\000\000\002\007\006\024\001U\001e\000\000\001W\001X\000\000\001;\001\n\000\000\000\000\001\007\000\000\000\000\001\b\000\000\000\000\001\"\000\000\006\t\000\000\002X\000\000\001\007\002]\001p\001\b\000\000\000\000\000\000\000\000\002\007\002X\001q\000\000\001[\006\n\001'\001\n\006\012\000\000\000\000\002\007\000\000\001f\001\026\001g\001\140\006\r\000\000\001\n\002Z\000\000\004\006\000\000\000\000\002]\000\000\000\000\002f\003\220\002\\\001(\001\007\000\000\000\000\001\b\002]\000\000\001n\000\000\000\000\000\000\001\012\003\223\001\026\000\000\006\014\001T\001]\002h\000\000\000\000\002Z\000\000\004\002\000\000\001\026\000\000\000\000\001\n\002f\001(\002\\\002Z\004\196\003\171\001U\001e\001T\001W\001X\002f\001\012\002\\\006\015\000\000\000\000\000\000\000\000\000\000\000\000\002h\006\016\001T\001\012\000\000\001.\001U\001e\000\000\001W\001X\002h\001\021\000\000\001T\001\026\0016\006\017\000\000\001p\000\000\001U\001e\000\000\001W\001X\000\000\001q\001f\001[\001g\001v\006\018\001U\001e\001.\001W\001X\001\030\000\000\0018\006\019\001\021\001\012\000\000\006\021\0016\001.\000\000\001f\000\000\001g\001s\001n\001\021\000\000\006\023\000\000\000\000\000\000\000\000\000\000\000\000\001]\001f\000\000\001g\001i\001\030\000\000\0018\006\024\000\000\001T\001n\000\000\001f\000\000\001g\001l\001\030\000\000\003\227\000\000\001]\001T\000\000\001.\000\000\001n\001T\000\000\001U\001e\001\021\001W\001X\000\000\004\204\001]\000\000\001n\000\000\000\000\001U\001e\000\000\001W\001X\001U\001e\001]\001W\001X\000\000\001p\000\000\000\000\000\000\000\000\001\030\000\000\0018\001q\000\000\001[\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001p\001g\001o\000\000\000\000\000\000\000\000\000\000\001q\000\000\001[\001f\000\000\001g\001r\001p\001f\000\000\001g\001{\001T\000\000\000\000\001q\001n\001[\000\000\001p\000\000\000\000\000\000\002\003\002\004\000\000\001]\001q\001n\001[\000\000\001U\001e\001n\001W\001X\000\000\002G\001]\000\000\000\000\000\000\001T\001]\000\000\002H\000\000\000\000\001T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002V\002\003\002\004\001U\001e\000\000\001W\001X\000\000\001U\001e\000\000\001W\001X\000\000\002G\001f\000\000\001g\001~\001p\000\000\000\000\002H\000\000\000\000\000\000\000\000\001q\000\000\001[\000\000\001p\000\000\000\000\000\000\002V\001p\000\000\000\000\001q\001n\001[\000\000\000\000\001q\001f\001[\001g\002=\000\000\001]\001f\002X\001g\002\217\000\000\000\000\002\003\002\004\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\002\003\002\004\001n\002G\000\000\000\000\000\000\000\000\001n\000\000\000\000\002H\001]\000\000\002G\002\003\002\004\000\000\001]\002]\002X\000\000\002H\000\000\002V\000\000\000\000\000\000\000\000\002G\002\007\002\003\002\004\000\000\001p\002V\000\000\002H\002\003\002\004\000\000\000\000\001q\000\000\001[\002G\002Z\000\000\003C\000\000\002V\000\000\002G\002H\002f\002]\002\\\000\000\000\000\000\000\002H\000\000\000\000\000\000\001p\000\000\002V\000\000\000\000\000\000\001p\000\000\001q\002V\001[\002h\000\000\002X\001q\000\000\001[\000\000\002Z\000\000\003B\000\000\000\000\002\007\002X\000\000\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002h\002]\002\007\000\000\000\000\000\000\000\000\000\000\002X\002\003\002\004\000\000\002]\002\003\002\004\002X\000\000\000\000\002\007\000\000\002\003\002\004\000\000\002G\000\000\002\007\000\000\002]\002Z\000\000\002\237\002H\000\000\000\000\002G\002g\002f\000\000\002\\\002Z\000\000\002b\002H\002]\002V\000\000\000\000\002f\000\000\002\\\002]\002\003\002\004\000\000\002Z\002V\002d\002h\000\000\000\000\002\003\002\004\002f\000\000\002\\\002G\000\000\000\000\002h\000\000\002Z\000\000\002i\002H\002G\000\000\000\000\002Z\002f\002p\002\\\000\000\002H\002h\000\000\002f\002V\002\\\000\000\000\000\000\000\002\003\002\004\000\000\000\000\002V\000\000\002X\000\000\002h\000\000\002\006\002\003\002\004\000\000\002G\002h\002\007\002X\002\003\002\004\002\007\000\000\002H\000\000\000\000\002G\000\000\002\007\000\000\000\000\000\000\000\000\002G\002H\000\000\002V\000\000\000\000\000\000\000\000\002H\002]\002\003\002\004\000\000\000\000\002V\000\000\002X\002\003\002\004\000\000\002]\002V\000\000\000\000\002G\002X\002\007\000\000\000\000\000\000\000\000\002G\002H\000\000\000\000\002\007\002Z\000\000\002r\002H\002Z\000\000\000\000\000\000\002f\002V\002\\\002Z\002[\002t\002\\\002]\002V\000\000\000\000\002f\002X\002\\\000\000\000\000\002]\002\003\002\004\000\000\000\000\002h\002\007\002X\002\003\002\004\000\000\000\000\000\000\000\000\002X\002G\002h\002\007\002Z\000\000\002v\000\000\002G\002H\002\007\000\000\002f\002Z\002\\\002x\002H\002]\002\003\002\004\000\000\002f\002V\002\\\002X\002\003\002\004\000\000\002]\002V\000\000\002X\002G\002h\002\007\002]\002\003\002\004\000\000\002G\002H\002\007\002h\000\000\002Z\000\000\002z\002H\000\000\000\000\002G\000\000\002f\002V\002\\\002Z\000\000\002|\002H\002]\002V\000\000\002Z\002f\002~\002\\\002]\002\003\002\004\000\000\002f\002V\002\\\002h\000\000\002X\002\003\002\004\000\000\000\000\000\000\002G\002X\000\000\002h\002\007\002Z\000\000\002\128\002H\002G\002h\002\007\002Z\002f\002\130\002\\\000\000\002H\000\000\000\000\002f\002V\002\\\002\003\002\004\002X\002\003\002\004\000\000\002]\002V\000\000\002X\000\000\002h\002\007\002]\002\003\002\004\000\000\002G\002h\002\007\002X\000\000\003\146\000\000\000\000\002H\000\000\000\000\002G\003\155\002\007\000\000\000\000\002Z\000\000\002\132\002H\002]\002V\000\000\002Z\002f\002\134\002\\\002]\002\003\002\004\000\000\002f\002V\002\\\002X\003\156\000\000\000\000\002]\000\000\000\000\000\000\002G\002X\002\007\002h\000\000\002Z\000\000\002\136\002H\000\000\002h\002\007\002Z\002f\002\138\002\\\000\000\000\000\000\000\000\000\002f\002V\002\\\002Z\000\000\002\140\000\000\002]\000\000\002\006\000\000\002f\002X\002\\\002h\000\000\002]\000\000\000\000\003\159\000\000\002h\002\007\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002h\002\007\002Z\000\000\002\142\000\000\000\000\000\000\000\000\000\000\002f\002Z\002\\\002\144\001T\002]\003\149\000\000\000\000\002f\000\000\002\\\002X\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\002h\002\007\001U\001e\000\000\001W\001X\000\000\002Z\002h\000\000\002Z\000\000\002\146\000\000\001T\002[\000\000\002\\\002f\000\000\002\\\002Z\002\203\002\148\000\000\002]\002\003\002\004\000\000\002f\002\206\002\\\000\000\001U\002\174\000\000\001W\001X\000\000\002h\002G\000\000\000\000\000\000\001f\001T\001g\002\220\002H\000\000\002h\000\000\002Z\000\000\002\150\000\000\002\003\002\004\000\000\000\000\002f\002V\002\\\001T\001U\001e\000\000\001W\001X\001n\002G\000\000\000\000\000\000\000\000\000\000\000\000\001T\002H\001]\000\000\002h\001U\001e\000\000\001W\001X\000\000\000\000\000\000\000\000\002V\000\000\004\001\002\003\002\004\001U\002\174\000\000\001W\001X\001\\\000\000\000\000\000\000\000\000\000\000\001f\002G\001g\002\223\001]\000\000\000\000\002X\000\000\002H\000\000\000\000\000\000\000\000\002\003\002\004\000\000\002\007\001f\000\000\001g\002\231\002V\000\000\001p\001n\002\003\002\004\000\000\000\000\000\000\002\175\001q\000\000\001[\001]\003\006\002X\002\003\002\004\002G\000\000\002]\001n\000\000\000\000\000\000\002\007\002H\000\000\000\000\000\000\002G\001]\002\003\002\004\001p\001\\\000\000\000\000\002H\002V\000\000\000\000\001\139\000\000\001[\001]\002G\002Z\000\000\002\243\002]\002V\000\000\002X\002H\002f\000\000\002\\\000\000\000\000\000\000\000\000\000\000\002\007\000\000\001p\000\000\002V\000\000\000\000\000\000\001\007\002\175\001q\004\254\001[\002h\002Z\000\000\002\249\002\006\002\003\002\004\001p\000\000\002f\000\000\002\\\002]\000\000\002\007\001q\002X\001[\000\000\002G\000\000\001p\001\n\002\003\002\004\000\000\002\007\002H\002X\001\139\002h\001[\000\000\001T\000\000\000\000\000\000\002G\002\007\002Z\002V\002\253\001T\000\000\002X\002H\000\000\002f\000\000\002\\\000\000\002]\001U\001V\002\007\001W\001X\000\000\002V\005\000\000\000\001U\002\174\002]\001W\001X\002Z\000\000\002h\000\000\000\000\000\000\000\000\000\000\002[\000\000\002\\\000\000\002Z\002]\003\001\000\000\002\003\002\004\000\000\000\000\002f\005\003\002\\\000\000\002Z\000\000\003\t\002X\000\000\000\000\002G\000\000\002f\000\000\002\\\000\000\000\000\002\007\002H\000\000\002Z\002h\003\r\000\000\000\000\002X\002\003\002\004\002f\000\000\002\\\002V\000\000\002h\001\\\002\007\000\000\002\003\002\004\000\000\002G\000\000\002]\001\\\001]\000\000\000\000\000\000\002H\002h\000\000\002G\005\006\001]\000\000\000\000\000\000\000\000\000\000\002H\002]\002V\000\000\004\206\000\000\005\011\000\000\005\b\000\000\002Z\000\000\003\015\002V\000\000\000\000\000\000\000\000\002f\001\030\002\\\005\252\000\000\000\000\000\000\002X\002\003\002\004\002Z\000\000\003\019\000\000\000\000\000\000\000\000\002\007\002f\001p\002\\\002h\002G\000\000\000\000\000\000\000\000\001\139\001p\001[\002H\002\003\002\004\000\000\000\000\000\000\001\139\002X\001[\002h\000\000\000\000\002]\002V\000\000\002G\000\000\002\007\002X\005\254\000\000\000\000\000\000\002H\002\003\002\004\000\000\000\000\002\007\002\003\002\004\000\000\000\000\000\000\000\000\000\000\002V\000\000\002G\002Z\000\000\003\021\002]\002G\000\000\000\000\002H\002f\000\000\002\\\000\000\002H\000\000\002]\000\000\000\000\000\000\000\000\000\000\002V\000\000\000\000\000\000\000\000\002V\000\000\002X\000\000\002h\002Z\000\000\003\025\002\003\002\004\000\000\000\000\002\007\002f\000\000\002\\\002Z\000\000\003\031\000\000\000\000\000\000\002G\000\000\002f\002X\002\\\001T\000\000\000\000\002H\000\000\000\000\000\000\002h\002\007\000\000\002]\000\000\000\000\002\003\002\004\000\000\002V\000\000\002h\001U\002\159\002X\001W\001X\000\000\000\000\002X\002G\002\003\002\004\000\000\002\007\000\000\002]\000\000\002H\002\007\002Z\000\000\003$\000\000\000\000\002G\000\000\000\000\002f\000\000\002\\\002V\000\000\002H\000\000\000\000\000\000\000\000\000\000\002]\000\000\000\000\000\000\002Z\002]\003&\002V\002\003\002\004\002h\000\000\002f\002X\002\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002G\002\007\000\000\000\000\000\000\002Z\000\000\003)\002H\001\\\002Z\002h\003-\002f\000\000\002\\\000\000\000\000\002f\001]\002\\\002V\000\000\002X\000\000\000\000\002]\002\003\002\004\000\000\002\003\002\004\000\000\002\007\002h\000\000\000\000\000\000\002X\002h\000\000\002G\000\000\000\000\002G\002\003\002\004\000\000\002\007\002H\000\000\000\000\002H\002Z\000\000\0030\000\000\000\000\002]\002G\000\000\002f\002V\002\\\000\000\002V\000\000\002H\000\000\002\003\002\004\001p\000\000\002]\002X\000\000\002\003\002\004\000\000\001\139\002V\001[\002h\002G\002\007\002Z\000\000\0032\000\000\000\000\002G\002H\000\000\002f\000\000\002\\\000\000\001T\002H\000\000\002Z\000\000\0035\000\000\002V\000\000\000\000\000\000\002f\002]\002\\\002V\002\003\002\004\002h\002X\001U\001e\002X\001W\001X\000\000\000\000\000\000\000\000\002\007\002G\000\000\002\007\002h\000\000\000\000\000\000\002X\002H\000\000\002Z\000\000\0037\000\000\000\000\000\000\000\000\002\007\002f\000\000\002\\\002V\000\000\000\000\002]\001\007\000\000\002]\001\b\000\000\000\000\002X\000\000\001f\000\000\001g\0046\000\000\002X\002h\000\000\002\007\002]\000\000\000\000\000\000\000\000\000\000\002\007\005\023\000\000\002Z\001\n\003:\002Z\000\000\003=\000\000\001n\002f\000\000\002\\\002f\005\023\002\\\000\000\002]\000\000\001]\002Z\000\000\003F\000\000\002]\002X\000\000\005\024\002f\005\025\002\\\002h\000\000\000\000\002h\002\007\000\000\000\000\000\000\000\000\001\026\005\024\000\000\005\025\002Z\000\000\003I\006\t\000\000\002h\000\000\002Z\002f\003o\002\\\000\000\000\000\006\t\005\026\002f\002]\002\\\000\000\000\000\006\n\000\000\000\000\006\012\001\012\000\000\000\000\001p\005\026\002h\006\n\000\000\006\r\006\012\000\000\001q\002h\001[\000\000\000\000\000\000\005\027\006\r\002Z\000\000\003q\000\000\000\000\000\000\000\000\005\028\002f\005\029\002\\\000\000\005\027\006\t\000\000\000\000\000\000\000\000\006\014\000\000\000\000\005\028\000\000\005\029\005W\001.\000\000\000\000\006\014\002h\006\216\000\000\001\021\006\012\000\000\000\000\004\217\000\000\005\030\004\220\000\000\000\000\006\r\000\000\000\000\000\000\006\015\005\031\000\000\000\000\000\000\005!\005+\000\000\006\016\000\000\006\015\000\000\001\030\001T\0018\005\031\005U\000\000\006\016\005!\005+\000\000\000\000\000\000\006\028\006\014\000\000\000\000\000\000\000\000\005U\005V\001U\002\174\006%\001W\001X\001T\000\000\006\018\000\000\000\000\000\000\000\000\000\000\005V\000\000\000\000\006\019\006\018\000\000\000\000\006\021\006\015\000\000\000\000\001U\002\174\006\019\001W\001X\006\016\006\021\006\023\000\000\000\000\000\000\001T\000\000\000\000\000\000\000\000\000\000\006\023\006\217\000\000\001T\000\000\006\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001U\002\174\006\024\001W\001X\000\000\006\018\000\000\000\000\001U\002\174\000\000\001W\001X\001\\\006\019\000\000\000\000\000\000\006\021\001T\000\000\000\000\000\000\001]\000\000\000\000\000\000\000\000\000\000\006\023\000\000\000\000\000\000\001T\000\000\005\145\000\000\001\\\001U\002\174\000\000\001W\001X\000\000\006\024\000\000\000\000\001]\000\000\005\169\003\\\000\000\001U\002\174\000\000\001W\001X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\\\000\000\003_\000\000\000\000\001T\000\000\003\\\001p\001\\\001]\001T\000\000\000\000\000\000\000\000\001\139\000\000\001[\001]\000\000\000\000\000\000\000\000\001U\002\174\003^\001W\001X\000\000\001U\002\174\001p\001W\001X\001T\000\000\003\\\000\000\001\\\001\139\000\000\001[\000\000\000\000\000\000\003\\\000\000\000\000\001]\000\000\000\000\000\000\001\\\001U\002\174\003]\001W\001X\000\000\000\000\000\000\001p\001]\001T\003a\000\000\000\000\000\000\000\000\001\139\001p\001[\000\000\000\000\000\000\002\175\000\000\000\000\001\139\000\000\001[\000\000\001U\002\174\000\000\001W\001X\000\000\000\000\002\175\000\000\001\\\001\007\001T\000\000\001\b\000\000\001\\\000\000\000\000\001p\001]\000\000\000\000\000\000\000\000\000\000\001]\001\139\000\000\001[\000\000\001U\002\174\001p\001W\001X\001\007\000\000\001\n\001\b\001\\\001\139\000\000\001[\000\000\000\000\000\000\005\196\000\000\000\000\001]\000\000\000\000\005\196\001\007\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\005\191\001\\\000\000\000\000\001p\006\191\000\000\001\026\000\000\005\252\001p\001]\001\139\001\n\001[\000\000\001\007\000\000\001\139\001\b\001[\000\000\000\000\000\000\005\209\001\007\000\000\000\000\001\b\000\000\005\208\001\\\001\026\000\000\001p\001\012\000\000\000\000\005\252\000\000\000\000\001]\001\139\001\n\001[\000\000\000\000\000\000\000\000\000\000\001\026\000\000\001\n\000\000\001\007\005\253\000\000\001\b\000\000\000\000\001\012\000\000\000\000\001p\001\007\000\000\000\000\001\b\003`\000\000\000\000\001\139\000\000\001[\000\000\000\000\000\000\000\000\001\012\001.\001\026\001\n\000\000\000\000\006\005\000\000\001\021\000\000\000\000\001\026\006\192\001\n\000\000\001p\001\007\000\000\000\000\001\b\000\000\000\000\000\000\001\139\000\000\001[\001.\000\000\000\000\001\007\001\012\000\000\001\b\001\021\001\030\001\007\0018\004\204\001\b\001\012\001\026\000\000\000\000\001\n\001.\000\000\000\000\000\000\000\000\000\000\001\026\001\021\000\000\000\000\000\000\004\217\001\n\000\000\005\237\001\030\000\000\0018\001\n\000\000\000\000\000\000\000\000\000\000\001\012\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\030\001\012\0018\001\026\001\021\000\000\001.\000\000\006\174\000\000\000\000\000\000\000\000\001\021\000\000\000\000\001\026\001H\000\000\000\000\001\007\001\007\001\026\001\b\001\b\000\000\001\007\000\000\000\000\001\b\001\030\001\012\0018\000\000\001\007\001.\000\000\001\b\000\000\001\030\001\007\0018\001\021\001\b\001\012\001.\001\156\001\n\001\n\000\000\001\012\000\000\001\021\001\n\000\000\000\000\001\196\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\000\000\001\n\001\030\000\000\0018\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\030\000\000\0018\000\000\001\021\000\000\001\026\001\026\001\198\000\000\001.\000\000\001\026\000\000\000\000\000\000\001.\001\021\000\000\000\000\001\026\002\026\000\000\001\021\000\000\000\000\001\026\002-\000\000\000\000\001\030\000\000\0018\000\000\001\012\001\012\001\007\000\000\000\000\001\b\001\012\000\000\000\000\001\030\001\007\0018\000\000\001\b\001\012\001\030\000\000\0018\000\000\000\000\001\012\000\000\001\007\000\000\000\000\001\b\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\001\007\000\000\000\000\001\b\001.\001.\000\000\000\000\000\000\001\n\001.\001\021\001\021\000\000\000\000\002\164\002\169\001\021\001.\000\000\001\007\002\186\000\000\001\b\001.\001\021\001\026\001\n\000\000\002\193\000\000\001\021\000\000\000\000\001\026\002\200\000\000\001\030\001\030\0018\0018\000\000\000\000\001\030\000\000\0018\001\026\001\n\000\000\000\000\000\000\001\030\001\007\0018\001\012\001\b\000\000\001\030\001\007\0018\000\000\001\b\001\012\000\000\001\026\000\000\001\007\000\000\001\007\004\254\000\000\001\b\000\000\000\000\001\012\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\000\000\001\026\001\n\000\000\000\000\001\007\000\000\000\000\004\254\001\012\001\n\000\000\001\n\000\000\000\000\001.\000\000\001\007\000\000\000\000\004\254\000\000\001\021\001.\000\000\001\007\002\209\000\000\004\254\001\012\001\021\000\000\001\n\001\026\004E\001.\000\000\000\000\000\000\001\026\000\000\000\000\001\021\000\000\001\n\000\000\004\157\005\000\001\030\001\026\0018\000\000\001\n\001.\000\000\000\000\001\030\000\000\0018\000\000\001\021\001\012\000\000\001\007\004\169\000\000\001\b\001\012\001\030\005\000\0018\000\000\000\000\001.\000\000\005\003\000\000\001\012\000\000\000\000\001\021\005\000\000\000\000\000\004\182\000\000\001\030\000\000\0018\005\000\001\n\000\000\000\000\001\007\000\000\000\000\001\b\005\003\001\007\000\000\000\000\004\254\000\000\000\000\000\000\001.\001\030\000\000\0018\005\003\000\000\001.\001\021\000\000\000\000\000\000\004\203\005\003\001\021\000\000\001\n\001.\004\219\000\000\000\000\001\n\005\006\001\026\001\021\000\000\000\000\001\007\005y\000\000\004\254\000\000\000\000\004\206\001\030\005\n\0018\005\b\000\000\000\000\001\030\000\000\0018\000\000\005\006\000\000\001\007\000\000\001\030\001\b\001\030\001\012\0018\001\026\001\n\004\206\005\006\005\t\005\000\005\b\000\000\000\000\001\007\000\000\005\006\001\b\000\000\004\206\000\000\005\007\001\030\005\b\000\000\001\n\000\000\004\206\000\000\005\019\000\000\005\b\001\007\001\012\001\030\001\b\000\000\001\007\005\003\000\000\001\b\001\n\001\030\005\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\000\000\001\007\000\000\001\021\001\b\000\000\000\000\005\139\001\n\000\000\000\000\001\026\000\000\001\n\000\000\001\007\000\000\000\000\001\b\000\000\005\003\000\000\000\000\000\000\000\000\000\000\001.\001\026\001\n\001\030\000\000\0018\000\000\001\021\000\000\000\000\000\000\005\163\005\006\001\012\000\000\000\000\001\n\000\000\000\000\001\026\000\000\000\000\000\000\004\206\001\026\005\223\000\000\005\b\000\000\001\012\000\000\000\000\000\000\001\030\000\000\0018\000\000\000\000\001\030\001\026\000\000\000\000\000\000\001\007\000\000\005\006\001\b\001\012\000\000\000\000\000\000\000\000\001\012\001\026\000\000\000\000\004\206\001.\005\249\000\000\005\b\000\000\000\000\000\000\001\021\000\000\000\000\001\012\0061\000\000\001\n\001\030\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\001\012\000\000\000\000\006\134\000\000\000\000\000\000\000\000\000\000\001\030\001.\0018\000\000\000\000\000\000\001.\000\000\001\021\000\000\000\000\000\000\006\138\001\021\000\000\000\000\001\030\001\026\0018\000\000\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\000\000\001\030\001.\0018\000\000\000\000\001\030\000\000\001/\001\021\000\000\000\000\001\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\001\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\001\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\030\000\000\003\222")) + ((16, "\000\025\0017\000\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000*\000\000\000\000\001\136\000h\000&\000\243\002\b\000L\000K\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\131\000\000\000\000\000\000\000<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000,\250\000\000\000\000\001\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\148\001`\002v\000\203\000\000\002\156\t$\001j\002\210\000\025\000\000\000|\000\000\000Z\002\174\000\000\002X\000\000\000\000\000\000\000\000\000\000\000$\000\000\000\r\003\162\0074\000\000\000\000\000\190\003\148\000\000\000\000\000\b\000\000\001\020\000\000+`\002\216\000\000\002\222\001B\000\000\000\000\003*\003f\000\222\003\016\000&\003\162\004&\001\176\003h\001\128\003f\003\138\t\208\000\000\000\000\005F\003n\004\026\000\173\000\000\000\000\000\000\000\000\000\000\000\000\004F\000\000\005\226\000\000\005F\n\016\000\000\000\000\003\130\004L\003\236\028\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\000\004.\004^\004\178\000\000\000\000\000\000\000\000\000\191\000\000\000\000\005B\000%\005l\005h\006\194\004\176\004\228\005t\001~\002\168\006\014\029\020\000\000\000\000\005\006\006\018\nD\000\000\029V\004\168\nd\n\164\000\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\224,\252\005\244\000\000\n\168\006 \000\000\011<\029r\000Q\000\000\011L\005\202\000\000\000\000\000\000\006T\000\000\004\228\000\000\006J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\018\002\030\000\000\000\000\001\160\000\000\r\230\000\000\001\018\005@\001\018\000\000\000\000\000\000\000\000\000\000\029\174\000\000\006\030\006\176\000\000\021\170\006D\006\246\000\000\000\000\000\000\006J\000\000\000\000\000\000\000\000\003\130\000\000\000\000\000\000\000\000\000\000\011\166\000\000\000\000\000\000\000\000\000\000\000\000\004f\006\228\000\000\000\000\000\000\003\130\007<\029\234\006\178\006T-(\000\000\001\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\000\000\000\000\007\208\029\252\000\000\000\000\006\214\006h\030\156\000\000\000\000\000\000\030\190\006\212\030\208\000\000\006\212\000\000\030\220\006\212\000\000\031B\006\212\006\212\000\000\000\000\006\212\000\000\000\000\031v\000\000\006\212\031\166\000\000\006\212\bz\000\000\000\000\n\164\000\000\000\000\000\000\000\000\006\212\011\148\000\000\000\000\000\000\006\212\000\000\001z\007\234\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\n\000\000\007\178\000\000-X\003\130\000\000\000\000\000\000\000\000\007\208\bJ\011\240\007\200\b.\b6\006z\004\240\006\188\000G\b\172\000\000\000\000\000I\000?\006\196\000f\b\162\001\158\000\000\000e\000\230\003R\002\230\t\254\000\000\000\000\019\"\000\0001\234\t\164\000\000-d\003\130-\160\003\130\000\000\tV\000\000\tx\000\000\000\000\t\140\000\000\000\000\000\000\nf\000\000\001\220\000e\000\000\000\000\tL\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000e\000\000\b\162\005\\\000\000\000}\002\168\000\000\000}\000\000\000\000\002v\000e\000\000\000\000\000\000\000\000\000\000\000\000\000}\012 \012H\nf\n8\031\176\015\144\000\000\t\232\007\020\012\148\n\004\0070\nl\027\002\000\000\000\000\000\000\000\000\000\000\0118\b\128\000\000\000\000\000\000\n\016\007b\006*\000}\003\210\000\000\000e\000\000\000\000\000\000\004\168\000\000-\194\003\130\012\238\n\024\007n\012\244\n4\007\196\002\250\r\186\006\212\rH\n<\007\216,<\n\244\000\000\003n\006\212.D\003\130\n\248\000\000\000\000\000\000\000\000\000\144\n\234\n\250\000\000\000\000\007|\rh\n\130\b& \n\006\212\r\168\n\134\bH\027<\000\000&B\000\000\000\000\014\b\031\232\0246\000\000\000\000\000\000\000\000)\004\000\000\000\000\000\000\004\150\014f\000\000\000\000\000\000\000\000 L,\208\000\000\000\000\000\000\000\000\n|\014\194\000\000\n\154 \170\n\154 \176\n\154\000\0000\232\000\000 \216\n\154\014\242\003\152\015 \000\000\000\000!\000\n\154!\b\n\154!d\n\154!\190\n\154!\200\n\154\" \n\154\"N\n\154\"|\n\154\"\172\n\154#\002\n\154# \n\154#v\n\154#\166\n\154#\196\n\154#\214\n\154$\006\n\154$z\n\154$\170\n\154%\n\n\154%:\n\154\bn\006\002\002\004\000\144\011L\000\000\000\130.n\000\000\015~\000\000.^\000\000\003\130\003x\000\000\003\130.h\003\130\000\000\015\172\000\000\000\000\000\000\015\236\000\000\000\000\000\000\000\000\000\000\006\212\000\000\000\000.\198\000\000\003\130\000\000\000\000\003x\011R\000\000.\208\003\130\016\006\000\000\000\000\n\246\000\000.\210\003\130\016H\000\000\000\000\016|\000\000\000\000\000\000/$\003\130\016\158\000\000\n\218\016\224\000\000%\\\000\000\006\212%\150\000\000\006\212%\252\000\000\006\212\012@\000\000\000\000\000\000\000\000\000\000&&\006\212\005V\006\176\000\000\000\000\000\000\n\154\017\004\000\000\000\000\000\000&\004\n\154\000\000\000\000\000\000\000\000\017T\000\000\000\000\000\000\n\154\017\194\000\000\018\020\000\000\000\000\000\000\018`\000\000\000\000\000\000\000\0001\136\000\000\000\000\018h\000\000\000\000\000\000&\148\n\154\018\156\000\000\000\000\000\000&\204\n\154\018\248\000\000\000\000&\238\n\154\n\154\000\000\006n\019l\000\000\000\000'\028\n\154\019\186\000\000\000\000'\\\n\154't\n\154\000\000'\172\n\154\000\000\000\000\019\210\000\000\000\000(6\n\154\020\020\000\000\000\000(<\n\154\020,\000\000\000\000(t\n\154\000\000(\146\n\154\000\000\0038\000\000\000\000\n\154\000\000\000\000\020x\000\000\000\000\020\160\000\000\000\000\011,\000\000\000\000\020\238\000\000\021,\000\000\000\000\000\000\000\144\011\194\000\000)&\006\174\001\018\021L\000\000*(\000\000\000\000\000\000*p\000\000\000\000\021\212\000\000\022\002\000\000\000\000\000\000\000\000\022$\000\000\000\000\000\000(\198\n\154(\212\n\154\000\000\n\218\022d\000\000\000\000\022\196\000\000\023\030\000\000\000\000\027\002\000\000\000\000\000\000\0238\000\000\000\000\000\000\000\000\023l\000\000\000\000\000\000\000\000\0128\000\000\000\000\000\000,N\000\000\002\024\000\000\002\190\000\000\011\228\000\000\002H\000\000\000\000\000\000\000\000\000\000\000\000\0118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\012@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bx\006\142\000}\023\140\000\000\011v\b\164\011\234\001\186\006\154\000}\003\218\000e\b\130\000}\000\000\023\174\000\000\003\174\000\000\011|\b\200\011z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\194\002V\000\207\000\000\000\000\000\000,T\000\0001\242\000\000\tZ\000\000\tf\000\000\000\000\000\000\000\000\001Z\000\000\000\000\000\000\b\198\001\018\000\000\001\018\004\146\000\000\nN\001\018\001\018\t\162\000\000\023\222\000\000\t\230\012\144\000\000\024\136\006\240\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\007b\000\000\n\154\000\000\000\000\004T\000\000\000e\000\000\0058\000\000\000e\000\000\005B\000e\000\000\000}\000\000\n\022\b\138\000a\000\000\011\204\011\248\n6\012\024\012\176\005\138\000e\006\244\000\000\n@\012\196\012\210\006\188\007\228\012\190\nz\012\238\006\212\b\180\012\214\000\000\000\000\0072\tt\000\000\0066\002\156)\182\006\212\024\018\000\000\b\014\002\218\012\154\n\150\b\244\000\186\000\000\012\192\n\164\014\000\000\000/0\003\130\rn\r\168\000\000\t\148\000\000\r*\n\188\r\"\rH\002p\000\000\000\000\000\000\000\000\000\000\n\192\t\166\000\000\n\212\t\190\000\000\006\248\017\244\rN\rT\n\226\r\196\t\214\000\000\n\232\r\198\n(\000\000\r`\n\240\r\222\000\000\r\218\000\000\nh\000\000\r\230\000\000\007\128\000e\r\194\011\000\r\244\000\000\007\130\002\130\r\206\000\000\000\000\003l\014\006\n~\000\000\007\208\000e\n\240\000\000\003\246\000\000\r\162\011\n\t\242\002\188\000\000\r\168\011\026\r\156\rH\r\176\r\178\011\"\014\242\000\000\r\216\001\182\000\000\000\000\000\000\000\000\000\206\011,\r\178/B\003\130\000\000\000\181\011F\014R\000\000\000\000\000\000\000\000\000\000\000\000/N\003\130\000\000\011V\014\158\000\000\000\000\000\000\000\000\000\000\000\000\017\014\000\000/\160\003\130\011\178\000\000\003\130\011Z\002(\000\000\000\000\011l\011\162\014R\000\000\0030,\146\000\000\002\178\000\000\000\000\000\000\000\000/\254\003\130\003\130\000\000\000\000\0042\000\000\014T\000\000\b \0042\0042\000\000\011\168,d\003\1300\n\003\130\011\180\000\000\000\000\000\000\000\000\011\224\000\000\000\000\000\130\000\000\005F\0142\011\180\015*\014\b\000\000\000\000\t6\005\232\014F\000\000\000\000\011\182\0158\014,\000\000\000\000%n\000\000\001\218\000\000'\156\024:\003\130\000\000/\148\003\184\000\0000^\000\000\000\000\000\000\000\000\000\000\0042\000\000\000\000\011\240\014h\011\184\015`\0146\000\000\000\0000z\012R\014t\000\000\000\000\000\000 T\000\000\000\000\000\000\000\000\000\000\000\000\012n\000\000\014\130\011\198\004L\000\000\015X\015\n\012r\014\138\000\000\000\000\014\148\011\228\004\228\000\000\000\000\007\182\029r\003\014\000\000\000\000\000\000\0146\014\\\012\b\000\000\014`\0146\000\000\015\028\012\144\014\162\000\000\000\000\000\000\003\130\005t\005\254\tp\000\000\000\000\000\000\000\000\014h\012\014\000\000\n(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\130\014V\012\026\015\144\014h\000\000*\140\000F\012 \014D\003\248\0004\0128\014\232\000\000\015\140\024\226\000\000\000\000\025\018\000\000\012\196\000\000\004\150\000\000\000\000\000\000\000\000\000\000\000\0000\028\003\130\000\000\015\142\025:\000\000\000\000\025j\000\000\002\\\012T\015B\000\000\000\000\019H%V\015\004\000\0000\198\003\130\025\136\000\000\000\000\025\224\000\000\000\000\012\226\000\000\005\208\000\000\000\000\000\000\000\000\000\000\000\000*\186\000\000\000\000+2*\226\015\006\000\0000\228\003\130\026\002\000\000\000\000\026Z\000\000\000\000\012X\026\136\012\234\000\000\012Z\012r\001\150\004\166\012|\b\238\012\152\015T\026\172\012\254\000\000\012\174\012\180\014\250\000\000\007\240,\214\000\000\007&\000\000\012\182+N+\\\br\014n\t4\000\0001\026\0038\000\000\005\160\000\000\000\000\005\160\000\000\000\000\005\160\015\016\000\000\011\142\005\160\015p\0270\r\000\000\000\005\160\000\000\000\0001\"\000\000\000\000\000\000\005\160\000\000\000\000\r\\\000\000\r\250\b\140\rf\000\000\012\184,\226\r\128\000\000\000\000\000\000\000\000\r\142\000\000\000\000\004X\000\000\005\1601B\000\000\014x\005\160+\150\000\000\r\146\014\238\012\232\015\228\014\186\000\000,\b\r\148\014\244\000\000\000\000\000\000#\216\007\200\000\000\000\000\000\000\000\000\000\000\000\000\n|\r\158\000\000\015\006\000\000\000\000\000\000\000\000\r\182)\164\000\000\000\000\000\000\000\000\n|\000\000\000\000\r\216)\250\000\000\000\000\000\000\000\000\000\000\000}\000e\000\000\000\000\006\212\000\0001Z\003\130\000\000\005\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\188\r\026\n\030\000}\000\000\nV\000\000\000e\000\000\015\228\000\000\000\000\000\000\000\000\000\000\b\176\000\000\000\000\000\000\000\000\000\000\000\000\015\140\000e\014\188\014\\\b$\r:\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014h\b\208\r^\000\000\007\252\015\242\015\170\r\224\000\000\000\000\015\158\000%\003\142\000\000\000\000\000\000\rh\000\000\rl\001\026\000\000\000\000\001\018\001D\000\000\000\000\000\000\000\000\000\000\014\254\000\000\000\000\n&\007\168\000\000\000\0001\196\003\130\003\130\000\0001\208\003\130\011(\000\000\000\000\000\000\003\130\000\000\000\000\007\218\015\176\014H\000\000\000\000\015\164\007L\0016\000\000\000\000\000\000\000\000\n4\015\242\bb\015\198\014V\000\000\000\000\015\186\b\242\005\\\000\000\000\000\000\000\000\000\000e\000\000\005\248\000\000\000\000\000\000\027J\000\000\027b\000\000\000\000\000\000\000\000\000\000\b\206\000\000\000\000\000\000\t\144\000\000\003\130\000\000\tp\000\000\000\000\000\000\028$\006\212\000\000\000\000\004\014\015$\001p\000\000\000\000\000\000\000\000\000\000\000\000\0118\000\000\000\000\000\000\000\000)b\000\000\014b\000\000\000\000\000\000\000\000\004L\005\166\027\230\028\026\000\000\000\000\014r\028\150\000\000\000\000\000\000\014\132\028\194\000\000\000\000\000\000\000\000"), (16, "\006\016\003\223\002\b\002\t\001\187\000\139\006\179\006\165\001\204\002\238\001\187\000;\0062\001\219\006`\006\157\002L\006\017\006\190\001\219\006\019\002\238\001\245\002\238\002M\001\014\001\232\000\189\006\132\006\020\006!\006\016\004\229\002\b\002\t\000\139\001\245\002[\000\148\005v\006X\003\234\003\236\003\238\0007\000?\006t\002L\006\017\006 \001\223\006\019\001\017\000q\0007\002M\001\223\004\232\006\021\000m\006\020\006!\000\139\004\027\001\224\000\144\001\234\000\\\002[\001\187\001\224\001\230\004\234\000\189\001\187\004y\001\227\004\031\001\219\000\139\001[\000\149\001\204\001\219\000`\0007\006\022\001[\002\175\006\021\002]\004\235\0061\006\183\006\023\001\247\002\178\000\145\000\193\001\\\002\179\002\012\001^\001_\006d\006e\001\\\001l\001\019\001^\001_\006&\001\185\006f\006g\001\223\001\014\006\022\001\019\001\015\001\223\002]\001\226\001\212\006h\006\023\006'\001\246\000\139\001\224\006l\001\204\002\012\001\019\001\224\006\026\006d\006e\006\192\001\218\006\028\001\246\006&\001\017\001\n\006f\006g\001\248\000\189\001m\006\030\001n\002\186\002_\005x\002e\006h\006'\001 \001\014\005A\002k\001\014\002a\002\238\006\031\006\026\001c\000m\001\028\001\213\006\028\005\205\006\016\001u\002\b\002\t\001\245\001d\000d\001!\006\030\002m\001\014\002_\001d\002e\004\236\001a\002L\006\017\006 \002k\006\019\002a\001%\006\031\002M\006\216\002\t\005\207\000:\006\020\006!\006\016\002\180\002\b\002\t\001\226\001\019\002[\0009\004\232\002m\005\208\000\194\002\238\004\205\004E\005\210\002L\006\017\006 \005\254\006\019\002\182\002\238\004\234\002M\001\014\001w\006\021\001\"\006\020\006!\006v\000\139\001w\001\146\000\144\001b\002[\000=\000\250\001W\001x\004\235\001b\000\253\005H\005I\001\019\001\019\0015\006\130\001\019\001\017\006}\001\014\006\022\001\028\005\001\006\021\002]\006\150\006\151\006U\006\023\004\212\005R\006a\004\156\001\000\001[\002\012\001\234\001\019\003\223\006\128\004\213\006\161\002\208\001\246\004\237\006&\001\017\001%\002\238\001?\002\211\006\022\000x\001\\\002\179\002]\001^\001_\006\217\006\023\006'\006b\004\026\000\250\001\028\001\247\002\012\001\028\001\153\006\026\006c\006\162\003\154\001\187\006\028\001\188\006&\000\189\003\237\003\236\003\238\001\014\001\219\001\019\006\030\006\185\001b\002_\001\028\002e\006~\006'\001\000\006~\003\204\002k\003\160\002a\001\019\006\031\006\026\005\205\006W\000\127\001\187\006\028\001\217\006\016\000\133\002\b\002\t\003\239\001\019\001\219\006~\006\030\002m\001\248\002_\001\223\002e\001c\000\143\002L\006\017\006 \002k\006\019\002a\005\207\006\031\002M\001d\001\224\001\028\003\156\006\020\006!\006\016\003\207\002\b\002\t\000\250\005\208\002[\000\189\000\194\002m\005\210\000@\001\223\004\205\005\233\002\238\002L\006\017\006 \001[\006\019\002\180\001%\0007\002M\001\028\001\224\006\021\000\250\006\020\006!\006(\000\139\003\155\000\173\001\204\001\019\002[\001\\\001l\005\153\001^\001_\001\187\002\238\001\242\001w\001\234\004X\002\b\002\t\001%\001\219\005\155\001\146\006\022\001b\003\155\006\021\002]\003\157\003r\006$\006\023\004\212\000\139\000\128\001\191\001\204\004\127\002\012\003G\000\194\001\238\000\142\004\213\001\247\001[\001\031\004\220\006&\001m\004\205\001n\002(\000\131\006\022\001\028\001\014\001\223\002]\001\015\0007\003\242\006\023\006'\001\\\001l\004\144\001^\001_\002\012\001\014\001\224\006\026\001\015\001u\000\250\004[\006\028\000\175\006&\000\134\003\243\000\194\001\017\0007\001d\003\223\006\030\001\014\003u\002_\005\b\002e\002\201\006'\000\194\001\248\001\017\002k\006\135\002a\001\218\006\031\006\026\001\192\002\011\000\164\001m\006\028\001n\0020\002\238\004\208\004\205\000\194\001\017\002\012\002\238\006\030\002m\001!\002_\006\016\002e\002\b\002\t\005:\003\236\003\238\002k\001\218\002a\001u\006\031\001!\006\220\006\221\001w\002L\006\223\004\136\000\194\006\019\001d\003I\001x\002M\001b\000\166\001\019\002m\006\020\006\225\006\016\000\171\002\b\002\t\006\240\000\139\002[\005+\001\204\000\170\001\019\004\212\004\177\0023\006\232\002_\002L\006\233\006u\000\181\006\019\003\208\004\213\002`\002M\002a\004\214\006\021\001\019\006\020\006\241\000\176\001\187\004\138\002\024\005}\001\187\002[\003\201\000\180\0015\001\219\001w\000\186\001\014\001\219\002\238\001\028\006b\001\158\001x\002\172\001b\000\203\0015\006\022\004\139\006c\006\021\002]\001K\001\028\000\194\006\023\000\178\006\142\003\207\005\246\001\\\002\029\002\012\001^\001_\001%\003\239\001?\001>\006\228\001\223\001\028\000\194\000\139\001\223\0055\001\204\001\014\006\022\001%\002q\001?\002]\000\187\001\224\005\249\006\023\006'\001\224\001\187\001[\004\017\004\221\002\012\004\138\001N\006\026\001%\001\219\006\245\005\251\006\028\003|\002\233\002\234\000\195\004\007\005\253\000\204\001\\\002\179\006\030\001^\001_\002_\006:\002e\000\217\006'\002\b\002\t\005\129\002k\001\014\002a\005\252\006\031\006\026\001u\001\019\002\251\000\216\006\028\005\249\006\016\001\223\002\b\002\t\000\189\001d\000\220\006B\006\030\002m\000\194\002_\001\234\002e\005\251\001\224\002L\006\017\006.\002k\006\019\002a\004\215\006\031\002M\003\012\003\127\003\132\005\205\006\020\006!\006\016\000\194\002\b\002\t\000\194\001\019\002[\001\249\005\252\002m\001\247\002\238\001c\000\194\006\232\001\028\002L\006\233\005\160\002\238\006\019\003\245\002\238\001d\002M\005\207\001w\006\021\005A\006\020\006\236\004\028\002\b\002\t\001x\001\234\001b\002[\001\187\005\208\004\021\003\248\002\011\001\187\005\210\004\024\002L\001\219\005\226\002\158\002\180\001\019\001\219\002\012\002M\006\022\001\028\000\232\006\021\002]\006L\001\235\001\248\006\023\001\247\004\238\000\226\002[\002\212\001l\002\012\001^\001_\002\240\000\240\001w\006\175\005\236\005\164\001\187\006&\004&\001\029\001\146\001\223\001b\006\022\000\228\001\219\001\223\002]\000\233\002\238\0007\006\023\006'\001\014\005A\001\224\001\015\002\238\002\012\001\028\001\224\006\026\002_\006\162\006\239\001P\006\028\002\217\002\233\002\234\002`\000m\002a\001\248\005H\005I\006\030\002]\001\004\002_\001\017\002e\001\223\006'\000\194\001'\004\215\002k\002\012\002a\005Y\006\031\006\026\001u\005R\001\234\001\224\006\028\001\014\006\016\001\007\002\b\002\t\004\246\001d\000\194\006;\006\030\002m\000\194\002_\006\182\002e\002b\001\r\002L\006\017\001!\002k\006\019\002a\002\021\006\031\002M\001\247\000\236\005\030\000\241\006\020\006*\002\237\005\212\005\249\001<\001\014\001\014\002[\001\015\001\015\002m\002_\001\022\002e\005H\005I\001\234\001\019\005\251\002k\002\238\002a\001\234\001:\005\031\005_\005 \001w\006\021\0033\005Q\001T\001\017\001\017\005R\001x\001\014\001b\004\215\001\015\002m\001k\003\191\005\252\0012\001\247\001>\001\248\003\199\0019\001\175\001\247\002\238\001[\002\238\005!\006\022\000\194\003D\000\194\002]\001(\001\019\001\017\006\023\000\194\001[\004-\001\028\001!\001!\002\012\001\\\001l\002\239\001^\001_\001M\004:\0042\005A\006-\005\"\001\177\000\194\001\\\002\179\001\184\001^\001_\006\160\005#\000\194\005$\001%\004\011\006'\001\248\001\019\001\019\001!\001\014\000\194\001\248\001\015\006\026\004\002\001\148\004(\005`\006\028\000\194\003\207\001\028\006\152\001m\001S\001n\002(\001\014\006\030\000\189\001\015\002_\003\207\002e\0047\002\003\001\017\001\019\001\145\002k\005&\002a\001j\006\031\006q\005(\0052\003b\001u\002\006\0015\0015\000\194\005A\001\017\005\\\000\194\001\028\001\028\001d\002m\001c\005a\003u\001t\0007\001\187\001\187\004x\004~\005]\005A\001d\001!\002\020\001\219\001\219\005H\005I\003\207\002#\0015\002\238\001%\001%\0016\001?\005D\001\028\006\163\006\164\001!\005J\005Z\000\189\001\014\000\194\005R\001\015\003e\005\200\001\136\001\019\002\b\002\t\006\154\001\187\001\152\004\135\005R\000\194\001w\001\223\001\223\001%\001\219\001?\002L\003h\001x\001\019\001b\001\017\002&\001w\002M\001\224\001\224\001[\001\164\000\189\003\134\001\146\002,\001b\000\194\004.\001\019\002[\005A\005\030\000\194\005H\005I\001\169\001\014\0015\001\\\001l\004\004\001^\001_\001\223\001\028\005\205\004\205\004X\005J\005Z\001!\005H\005I\005R\003\253\0015\006\138\001\224\005\031\006\194\005 \006T\001\028\002A\006\168\001\234\005J\005Z\0007\001\234\001%\005R\001?\005\207\005\030\000\194\000m\002\238\005\240\001\019\002F\001m\002]\001n\002(\000\194\000\189\005\208\001%\005!\001?\003\203\005\210\002\012\001\247\004\030\005\217\004\212\001\247\002\157\006\174\005\031\006\176\005 \003\190\003\189\001u\006^\004\213\001\174\005\205\001\180\004\219\004@\002\b\002\t\005\"\001d\002b\005H\005I\003u\001\234\0015\000\194\005#\003\196\005$\002L\001\019\001\028\0043\005!\004X\005J\005Z\002M\001\014\005\207\005R\001\015\000\194\006\202\005`\003\211\002_\001\248\002e\004D\002[\001\248\001\247\005\208\002k\001\225\002a\001%\005\210\001?\005\"\000\194\005\214\002\b\002\t\001\017\000\194\005&\006\196\005#\001w\005$\005(\0052\002\238\002m\005\212\002L\001x\001\197\001b\001\028\005\\\006\204\000\189\002M\004\205\005`\000\194\001\199\002\238\006Q\006\163\006\164\006j\002\b\002\t\005]\002[\002\238\006\198\001\206\001!\002]\001\248\003\223\000\194\003\241\005\205\002L\005&\002\238\005R\006\139\002\012\005(\0052\002M\003\230\001\208\006\171\002\b\002\t\002\238\003\232\005\\\005\187\006?\0048\001\211\002[\001\019\001\215\001\014\001\222\002L\005\207\004\212\001[\002b\005]\002\b\002\t\002M\004P\005N\003\236\003\238\004\213\004\t\005\208\002]\004\245\004]\003\250\005\210\002[\001\\\001l\005\211\001^\001_\002\012\003\169\002\238\004`\002_\001\155\002e\003\182\001[\001\187\001\234\004\143\002k\0015\002a\004h\001\014\000\194\001\219\001\015\001\028\002]\001)\000\194\006\199\002b\003\254\001\\\001l\003\178\001^\001_\002\012\002m\002\238\003\223\006F\001\139\001m\001\247\001n\001\142\001*\001\017\001\019\002\238\001%\002]\001?\001H\004\029\001\019\002_\000\194\002e\001\223\004l\002b\002\012\001\187\002k\006J\002a\001u\001\019\002\002\004#\002\011\001\219\001\224\001m\004*\001n\001\142\001d\005V\003\236\003\238\002\012\002\005\001!\002m\003\168\002b\002_\002\019\003\001\000\194\004t\002\"\001\014\001\248\002k\001\015\002a\001u\001)\001/\001\014\004\133\0040\001\015\002\238\002%\001)\001\223\001d\002+\0027\001\019\002_\000\194\002e\002m\004C\001\028\001*\001\017\002k\001\224\002a\004H\0024\001F\001*\001\017\001w\000\194\001[\002<\002_\001+\000\194\004S\001x\004\\\001b\002;\002`\002m\002a\003\247\002@\001\014\002E\004_\001\015\001\\\001l\001)\001^\001_\004f\0015\001!\004j\004\137\001\144\001w\004o\001\028\000\194\001!\003\223\001=\002\241\001x\004{\001b\001*\001\017\001/\004\142\002\b\002\t\000\194\001D\002j\002\161\001/\004\147\002\196\000\194\001\019\004\152\002\203\001%\002L\001?\004\162\001m\001\019\001n\001\142\000\194\002M\000\194\002\b\002\t\002\238\002\238\004\003\004\168\006\147\003\236\003\238\000\194\001!\002[\002\232\004\179\002L\004\194\000\194\002\231\001u\000\194\002\b\002\t\002M\000\194\004\216\002\238\000\189\001/\003\188\001d\0015\000\194\003W\002\238\002L\002[\000\194\001\028\0015\001\019\003_\001=\002M\003\148\000\194\001\028\003\158\003\180\000\194\001=\005\205\004\199\003\185\000\194\004\223\002[\004\191\004\228\002\b\002\t\004\240\004\250\005\021\001%\002]\001?\000\194\003\195\003\197\005*\003\210\001%\002L\001?\000\194\002\012\000\194\003\219\005\207\004\233\002M\001w\002\238\0015\0054\000\194\003\171\005\019\002]\001x\001\028\001b\005\208\002[\001=\003\249\002\238\005\210\002\238\002\012\002b\005\221\005@\002\b\002\t\005T\002\b\002\t\002]\004\000\004)\005d\000\194\002\238\005j\000\194\001%\002L\001?\002\012\002L\000\194\000\194\000\194\002b\002M\005n\002_\002M\002e\000\194\003{\004\"\004$\003v\002k\005\027\002a\002[\002\238\005\138\002[\005\178\005\238\002b\000\194\002]\004'\002\b\002\t\005'\002_\005/\002e\002\238\005\183\002m\002\012\002\238\002k\005\222\002a\002L\000\194\002\b\002\t\000\194\005F\002\238\002\238\002M\002_\000\194\003\001\005\188\000\194\003k\0046\002L\002k\002m\002a\002b\002[\004,\005\218\002M\000\194\005\194\005\202\005\243\002]\003\\\005w\002]\0045\002\b\002\t\0041\002[\002m\000\194\002\012\000\194\000\194\002\012\001[\0044\005\154\002_\002L\002e\005\180\004B\006\b\002\238\000\194\002k\002M\002a\002\238\000\194\005\191\005\225\003T\001\\\001l\002b\001^\001_\002b\002[\004G\002\238\001\014\000\194\002]\001\015\002m\006E\002\238\004I\002\238\002\238\002\b\002\t\000\194\002\012\002\238\000\194\000\194\000\194\002]\004O\002_\006_\002e\002_\002L\002e\002\238\001\017\002k\002\012\002a\002k\002M\002a\001m\005\237\001n\002(\002b\006k\005\241\000\194\003L\002\238\006y\002[\006{\002\238\004N\002m\002]\004R\002m\005\245\002b\004T\004^\002\b\002\t\001u\005\250\002\012\006\006\006\r\001!\002_\000\194\002e\006\027\004i\001d\002L\004e\002k\003q\002a\004g\004k\004n\002M\006\"\002_\000\194\002e\004\130\002X\002b\004s\004v\002k\004\129\002a\002[\001\019\002m\004|\004\128\006+\002]\002\238\000\194\006p\000\189\002\b\002\t\000\194\002\238\000\194\004\132\002\012\002m\004\141\002\238\002_\004\146\002e\004\148\002L\004\249\004\151\002\238\002k\001w\002a\004\154\002M\005\205\002\b\002\t\002\238\001x\002d\001b\004\158\002b\004\166\004\173\001$\002[\004\184\001\014\002L\002m\001\015\001\028\002]\004\200\004\217\004\248\002M\002\b\002\t\004\241\006\156\005\207\002s\002\012\004\242\004\247\004\251\006\170\002_\002[\003\001\002L\000\189\006\226\001\017\005\208\002k\001%\002a\002M\005\210\006\237\004\252\005\029\005\239\002r\005\022\005\023\002b\005\028\006\242\0051\002[\005-\005.\0050\005\205\002m\002]\005[\005>\005?\005C\005E\002\b\002\t\005G\005S\005c\002\012\005e\001!\005f\002\b\002\t\002_\005k\002e\002L\005o\005s\005\133\002]\002k\005\207\002a\002M\002\b\002\t\005\140\005\144\005\168\002\166\002\012\002b\003\152\005\189\005\195\005\208\002[\001\019\002L\003\161\005\210\002m\002]\005\213\006\002\005\219\002M\005\223\006\015\006\t\006\n\006\014\002\177\002\012\006\029\002b\006D\001[\002_\002[\002e\006O\003\174\006Z\006\\\002\175\002k\006n\002a\002\b\002\t\006o\006s\002\178\006\155\006\159\001\\\002\179\002b\001^\001_\006\134\002_\002L\002e\006\169\006\173\002m\001\028\002]\002k\002M\002a\006\211\000\000\000\000\000\000\002\200\002\011\000\000\002\012\000\000\002\b\002\t\002[\002_\000\000\002e\000\000\003\165\000\000\002m\002]\002k\001%\002a\002L\000\000\000\000\000\000\000\000\000\000\000\000\002\012\002M\002b\000\000\000\000\002\b\002\t\002\207\000\000\000\000\000\000\002m\000\000\000\000\002[\003\155\000\000\000\000\000\000\002L\000\000\001c\002\b\002\t\000\000\002b\000\000\002M\000\000\002_\000\000\002e\001d\002\210\002]\000\000\002L\002k\002_\002a\002[\000\000\000\000\000\000\002M\002\012\002`\000\000\002a\000\000\002\216\000\000\002_\000\000\002e\002\b\002\t\002[\002m\002\180\002k\000\000\002a\000\000\000\000\000\000\000\000\002]\000\000\002L\002b\000\000\000\000\002\b\002\t\000\000\000\000\002M\002\012\002\181\000\000\002m\000\000\002\219\001w\001\014\000\000\002L\001\015\000\000\002[\000\000\001\146\002]\001b\002M\000\000\002_\000\000\002e\000\000\002\244\000\000\002b\002\012\002k\000\000\002a\002[\000\000\002]\000\000\001\017\002\b\002\t\000\000\000\000\000\000\000\000\000\000\000\000\002\012\004\187\000\000\000\000\000\000\002m\002L\000\000\002b\002_\000\000\002e\000\000\000\000\002M\000\000\004\190\002k\000\000\002a\000\000\000\000\002]\000\000\002\254\002b\000\000\002[\001!\000\000\000\000\000\000\000\000\002\012\000\000\002_\000\000\002e\002m\000\000\002]\000\000\000\000\002k\000\000\002a\000\000\002\b\002\t\000\000\000\000\002\012\002_\000\000\002e\000\000\000\000\001\019\002b\000\000\002k\002L\002a\000\000\002m\000\000\000\000\000\000\000\000\002M\005\030\000\000\000\000\000\000\000\000\000\000\002b\000\000\000\000\003\003\002]\002m\002[\000\000\000\000\002_\000\000\002e\002\b\002\t\000\000\002\012\000\000\002k\000\000\002a\000\000\005\031\000\000\005 \000\000\0015\002L\002_\000\000\002e\000\000\000\000\001\028\000\000\002M\002k\004\192\002a\002m\000\000\002b\000\000\000\000\000\000\003\005\000\000\000\000\002[\000\000\000\000\002\b\002\t\005!\000\000\002\b\002\t\002m\000\000\001%\002]\001?\000\000\000\000\000\000\002L\000\000\000\000\002_\002L\003\001\002\012\000\000\002M\000\000\000\000\002k\002M\002a\000\000\005\"\002\b\002\t\003\t\000\000\000\000\002[\003\017\000\000\005#\002[\005$\000\000\000\000\000\000\002L\002b\002m\000\000\000\000\000\000\002]\000\000\002M\000\000\000\000\000\000\005^\000\000\000\000\000\000\000\000\002\012\003\023\000\000\000\000\002[\000\000\000\000\000\000\000\000\000\000\000\000\002_\000\000\003\001\000\000\002\b\002\t\000\000\005&\002k\000\000\002a\000\000\005(\0052\002b\000\000\002]\000\000\002L\000\000\002]\000\000\005\\\000\000\000\000\000\000\002M\002\012\000\000\002m\000\000\002\012\001\014\000\000\000\000\001\015\003\029\005]\000\000\002[\000\000\002_\000\000\003\001\000\000\001[\002]\000\000\000\000\002k\000\000\002a\002b\000\000\000\000\000\000\002b\002\012\000\000\001\017\000\000\005\152\002\b\002\t\001\\\002\179\000\000\001^\001_\000\000\002m\000\000\000\000\000\000\000\000\000\000\002L\000\000\000\000\002_\000\000\003\001\002b\002_\002M\003\001\000\000\002k\000\000\002a\003%\002k\002]\002a\000\000\000\000\001!\002[\000\000\000\000\000\000\002\b\002\t\002\012\000\000\000\000\000\000\000\000\002m\002_\000\000\003\001\002m\002\b\002\t\002L\000\000\002k\000\000\002a\000\000\000\000\000\000\002M\000\000\001\019\000\000\002L\002b\003*\000\000\000\000\001c\000\000\000\000\002M\002[\000\000\002m\000\000\000\000\000\000\000\000\001d\000\000\0036\002\b\002\t\002[\000\000\002]\000\000\000\000\000\000\000\000\002_\000\000\003!\002\b\002\t\002L\002\012\000\000\002k\000\000\002a\000\000\000\000\002M\0015\002\180\000\000\002L\000\000\000\000\000\000\001\028\000\000\003;\000\000\002M\002[\000\000\000\000\002m\000\000\002b\000\000\000\000\002]\003@\000\000\000\000\002[\000\000\001w\002\b\002\t\000\000\000\000\002\012\002]\001%\001\146\001\196\001b\000\000\000\000\000\000\000\000\002L\000\000\002\012\002_\000\000\002e\002\b\002\t\002M\000\000\000\000\002k\000\000\002a\000\000\002b\000\000\000\000\003O\000\000\002L\002[\000\000\000\000\002]\000\000\000\000\002b\002M\000\000\000\000\000\000\002m\000\000\000\000\002\012\002]\000\000\003R\000\000\000\000\002[\002_\000\000\002e\002\b\002\t\002\012\000\000\000\000\002k\000\000\002a\000\000\002_\000\000\003\001\000\000\000\000\002L\002b\000\000\002k\000\000\002a\000\000\000\000\002M\000\000\000\000\000\000\002m\002b\003X\002]\000\000\002\b\002\t\000\000\000\000\002[\000\000\000\000\002m\000\000\002\012\000\000\002_\000\000\003\001\002L\000\000\002\b\002\t\002]\002k\000\000\002a\002M\002_\000\000\003\001\000\000\000\000\003Z\002\012\002L\002k\000\000\002a\002b\002[\000\000\000\000\002M\000\000\002m\000\000\000\000\000\000\003d\000\000\000\000\000\000\000\000\000\000\000\000\002[\002m\000\000\002b\000\000\000\000\002]\000\000\000\000\000\000\002_\000\000\003\001\000\000\000\000\000\000\000\000\002\012\002k\001\014\002a\000\000\001\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002_\000\000\003!\002\b\002\t\000\000\000\000\002]\002k\002m\002a\000\000\002b\000\000\000\000\000\000\001\017\002L\002\012\000\000\000\000\000\000\000\000\002]\0013\002M\002\b\002\t\000\000\002m\000\000\003m\000\000\000\000\002\012\000\000\000\000\000\000\002[\002_\002L\002e\000\000\002b\001[\000\000\000\000\002k\002M\002a\000\000\000\000\000\000\001!\003p\000\000\000\000\000\000\000\000\002b\000\000\002[\000\000\001\\\001l\000\000\001^\001_\002m\000\000\002_\000\000\002e\000\000\000\000\002\b\002\t\000\000\002k\000\000\002a\000\000\001\019\000\000\000\000\000\000\002_\000\000\002e\002L\000\000\002]\000\000\000\000\002k\000\000\002a\002M\000\000\002m\000\000\000\000\002\012\003~\000\000\000\000\001m\000\000\001n\002(\002[\000\000\000\000\000\000\002]\002m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\t\002\012\0015\002b\000\000\000\000\000\000\001u\000\000\001\028\000\000\000\000\000\000\002L\000\000\000\000\000\000\000\000\001d\000\000\000\000\002M\003t\000\000\000\000\000\000\002b\003\129\000\000\000\000\002_\000\000\002e\000\000\002[\001%\000\000\001;\002k\002]\002a\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\000\000\002\012\000\000\000\000\002_\000\000\002e\000\000\002\b\002\t\002m\000\000\002k\000\000\002a\002\212\001l\000\000\001^\001_\000\000\001w\002L\000\000\000\000\000\000\002b\000\000\000\000\001x\002M\001b\000\000\002m\002\b\002\t\000\000\000\000\002]\000\000\003\139\000\000\000\000\002[\000\000\000\000\000\000\000\000\002L\002\012\002\b\002\t\000\000\002_\000\000\002e\002M\002\217\002\233\002\234\000\000\002k\000\000\002a\002L\000\000\003\144\002\b\002\t\002[\000\000\000\000\002M\000\000\002b\000\000\000\000\000\000\003\193\000\000\000\000\002L\002m\001u\000\000\002[\000\000\000\000\000\000\002M\000\000\002\b\002\t\000\000\001d\003\206\002]\000\000\000\000\000\000\000\000\002_\002[\002e\000\000\002L\000\000\002\012\000\000\002k\000\000\002a\000\000\002M\000\000\000\000\000\000\002\b\002\t\003\252\003\131\000\000\002]\000\000\000\000\000\000\002[\000\000\000\000\000\000\002m\002L\002b\002\012\000\000\002\b\002\t\000\000\002]\002M\000\000\000\000\000\000\000\000\001\014\004>\001w\001\015\000\000\002\012\001@\000\000\002[\000\000\001x\002]\001b\003G\002b\002_\000\000\003\001\000\000\000\000\000\000\000\000\002\012\002k\000\000\002a\001B\001\017\000\000\000\000\002b\000\000\004\203\002\158\000\000\002]\000\000\003H\000\000\000\000\000\000\002_\000\000\003\001\002m\000\000\002\012\002b\000\000\002k\000\000\002a\002\212\001l\000\000\001^\001_\002_\000\000\002e\000\000\002]\000\000\000\000\001!\002k\000\000\002a\000\000\000\000\002m\002b\002\012\000\000\002_\000\000\002e\002\b\002\t\002\011\000\000\001/\002k\000\000\002a\000\000\002m\000\000\000\000\000\000\002\012\002L\000\000\001\019\002\217\002\233\002\234\002b\002_\002M\002e\002\b\002\t\002m\000\000\005r\002k\000\000\002a\000\000\000\000\000\000\002[\000\000\000\000\002L\000\000\000\000\003J\000\000\001u\002\b\002\t\002M\002_\000\000\002e\002m\000\000\005u\000\000\001d\002k\000\000\002a\002L\002[\0015\000\000\000\000\000\000\000\000\002_\002M\001\028\002\b\002\t\000\000\005\004\005\132\002`\000\000\002a\002m\000\000\000\000\002[\004\001\000\000\002L\002\b\002\t\000\000\000\000\000\000\002]\000\000\002M\000\000\000\000\001%\000\000\001?\005\135\002L\000\000\002\012\000\000\000\000\000\000\002[\000\000\002M\001w\000\000\000\000\000\000\000\000\005\148\002]\000\000\001x\000\000\001b\000\000\002[\000\000\000\000\000\000\000\000\002\012\002b\000\000\000\000\002\b\002\t\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002L\000\000\002\012\002\b\002\t\000\000\000\000\002b\002M\000\000\002_\000\000\002e\000\000\005\151\002]\000\000\002L\002k\000\000\002a\002[\000\000\000\000\000\000\002M\002\012\002b\000\000\000\000\002]\005\172\000\000\000\000\002_\000\000\002e\000\000\002[\002m\000\000\002\012\002k\000\000\002a\000\000\000\000\002\b\002\t\000\000\000\000\002b\000\000\000\000\002_\000\000\002e\000\000\000\000\000\000\000\000\002L\002k\002m\002a\000\000\002b\000\000\000\000\002M\002\b\002\t\000\000\000\000\002]\005\175\000\000\000\000\002_\000\000\002e\000\000\002[\002m\002L\002\012\002k\000\000\002a\002\158\000\000\002]\002M\002_\000\000\002e\000\000\000\000\005\179\000\000\000\000\002k\002\012\002a\000\000\002[\000\000\002m\002\212\001l\002b\001^\001_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002m\000\000\000\000\000\000\000\000\002b\000\000\000\000\000\000\002\b\002\t\000\000\000\000\002]\000\000\002_\000\000\002e\000\000\000\000\000\000\000\000\000\000\002k\002\012\002a\000\000\000\000\002\217\002\233\002\234\002\n\002_\002\158\002e\000\000\002]\000\000\002\b\002\t\002k\000\000\002a\000\000\002m\002\b\002\t\002\012\000\000\002b\000\000\000\000\002\212\001l\001u\001^\001_\002\b\002\t\002L\002G\002m\000\000\000\000\000\000\001d\000\000\002M\000\000\000\000\000\000\002L\002b\006\186\000\000\000\000\002_\000\000\002e\002M\002[\000\000\000\000\000\000\002k\006\188\002a\000\000\000\000\000\000\000\000\005\190\002[\000\000\002\217\002\233\002\234\002\011\000\000\002_\000\000\002e\000\000\000\000\000\000\002m\000\000\002k\002\012\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\001u\006\016\000\000\000\000\000\000\001x\002\011\001b\002m\000\000\000\000\001d\000\000\002]\000\000\006\232\000\000\002\012\006\233\000\000\000\000\006\019\000\000\000\000\002\012\002]\000\000\006\016\000\000\000\000\006\020\000\000\000\000\000\000\000\000\001[\002\012\005\224\000\000\000\000\002_\006\232\000\000\000\000\006\233\000\000\000\000\006\019\002`\002b\002a\000\000\000\000\000\000\001\\\001l\006\020\001^\001_\006\021\000\000\002b\000\000\001w\000\000\000\000\000\000\000\000\000\000\002_\000\000\001x\000\000\001b\000\000\000\000\002_\002`\002e\002a\000\000\000\000\000\000\000\000\002k\006\021\002a\006\022\002_\006\016\002e\000\000\000\000\000\000\000\000\006\023\002k\001m\002a\001n\006\206\006\208\000\000\006\232\000\000\002m\006\233\000\000\006\235\006\019\000\000\006\016\000\000\006\022\000\000\000\000\000\000\002m\006\020\000\000\000\000\006\023\001u\000\000\000\000\006\232\000\000\006\025\006\233\000\000\000\000\006\019\000\000\001d\006\234\000\000\006\026\000\000\001[\000\000\006\020\006\028\000\000\000\000\000\000\000\000\000\000\006\021\000\000\000\000\000\000\006\030\000\000\006\025\002\b\002\t\000\000\001\\\001l\000\000\001^\001_\006\026\000\000\000\000\000\000\006\031\006\028\002L\006\021\000\000\000\000\000\000\000\000\000\000\006\022\002M\006\030\000\000\000\000\000\000\000\000\000\000\006\023\000\000\001w\000\000\002\b\002\t\002[\000\000\000\000\006\031\001x\000\000\001b\006\238\006\022\000\000\000\000\001m\002L\001n\0065\000\000\006\023\000\000\000\000\001\014\002M\000\000\001\015\000\000\000\000\001@\006\025\000\000\000\000\006\243\000\000\000\000\000\000\002[\000\000\006\026\001u\000\000\000\000\000\000\006\028\000\000\000\000\000\000\000\000\001B\001\017\001d\006\025\001\014\006\030\000\000\001\015\002]\000\000\001)\000\000\006\026\000\000\000\000\000\000\000\000\006\028\000\000\002\012\006\031\000\000\000\000\000\000\000\000\000\000\000\000\006\030\001[\000\000\001.\001\017\000\000\000\000\000\000\000\000\000\000\001[\001!\000\000\000\000\002]\006\031\000\000\002b\000\000\000\000\001\\\001l\000\000\001^\001_\002\012\000\000\001w\001/\001\\\001l\000\000\001^\001_\000\000\001x\000\000\001b\000\000\000\000\001\019\001!\000\000\000\000\002_\000\000\004\012\000\000\000\000\000\000\002b\000\000\002k\000\000\002a\000\000\000\000\000\000\001/\000\000\000\000\000\000\000\000\001m\000\000\001n\001\147\000\000\000\000\000\000\001\019\000\000\001m\002m\001n\001}\000\000\002_\000\000\004\b\000\000\000\000\000\000\000\000\0015\002k\000\000\002a\001u\000\000\001[\001\028\000\000\000\000\000\000\001=\000\000\001u\000\000\001d\000\000\000\000\000\000\000\000\000\000\000\000\002m\001[\001d\001\\\001l\000\000\001^\001_\0015\000\000\001[\001%\000\000\001?\000\000\001\028\001[\000\000\000\000\001=\001\\\001l\000\000\001^\001_\000\000\000\000\000\000\000\000\001\\\001l\000\000\001^\001_\000\000\001\\\001l\000\000\001^\001_\000\000\001%\000\000\001?\000\000\001w\001m\000\000\001n\001z\000\000\000\000\000\000\001x\001w\001b\000\000\000\000\000\000\000\000\000\000\000\000\001x\001m\001b\001n\001p\001[\000\000\000\000\000\000\001u\001m\000\000\001n\001s\000\000\000\000\001m\000\000\001n\001v\001d\000\000\000\000\000\000\001\\\001l\001u\001^\001_\000\000\000\000\001[\000\000\000\000\000\000\001u\000\000\001d\000\000\000\000\000\000\001u\000\000\000\000\000\000\000\000\001d\000\000\000\000\000\000\001\\\001l\001d\001^\001_\001[\000\000\000\000\000\000\002\b\002\t\000\000\000\000\000\000\000\000\000\000\000\000\001m\000\000\001n\001y\000\000\001w\002L\001\\\001l\000\000\001^\001_\000\000\001x\002M\001b\000\000\000\000\000\000\000\000\002\b\002\t\001w\000\000\000\000\001u\001m\002[\001n\001\130\001x\001w\001b\000\000\002L\000\000\001d\001w\001[\001x\000\000\001b\002M\000\000\000\000\001x\000\000\001b\000\000\000\000\001m\001u\001n\001\133\000\000\002[\000\000\001\\\001l\000\000\001^\001_\001d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\b\002\t\005\030\000\000\000\000\001u\000\000\000\000\000\000\000\000\002]\000\000\000\000\000\000\002L\000\000\001d\000\000\001w\000\000\000\000\002\012\002M\000\000\000\000\000\000\001x\000\000\001b\005\031\001m\005 \001n\002B\000\000\002[\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\001w\000\000\002b\002\b\002\t\002\012\002\b\002\t\001x\000\000\001b\001u\000\000\000\000\000\000\000\000\005!\002L\000\000\000\000\002L\000\000\001d\000\000\001w\002M\002\b\002\t\002M\002_\002b\003\177\001x\000\000\001b\000\000\000\000\002k\002[\002a\002L\002[\000\000\005\"\002]\000\000\002\b\002\t\002M\000\000\002\b\002\t\005#\000\000\005$\002\012\000\000\002_\002m\003K\002L\002[\000\000\000\000\002L\002k\000\000\002a\002M\000\000\005%\000\000\002M\000\000\001w\000\000\000\000\000\000\000\000\000\000\002b\002[\001x\000\000\001b\002[\002m\000\000\000\000\000\000\000\000\002]\000\000\005&\002]\000\000\002\b\002\t\005(\0052\000\000\000\000\002\012\000\000\000\000\002\012\000\000\002_\005\\\002\242\002L\000\000\000\000\000\000\002]\002k\000\000\002a\002M\000\000\000\000\000\000\000\000\005]\000\000\002\012\000\000\002b\000\000\000\000\002b\002[\000\000\000\000\002]\000\000\002m\000\000\002]\000\000\000\000\002\b\002\t\000\000\000\000\002\012\002\b\002\t\000\000\002\012\002b\000\000\000\000\000\000\002_\002L\002g\002_\000\000\002i\002L\000\000\002k\002M\002a\002k\000\000\002a\002M\000\000\002b\000\000\000\000\000\000\002b\000\000\002[\002_\000\000\002n\000\000\002[\000\000\002m\002]\002k\002m\002a\000\000\000\000\002\b\002\t\000\000\000\000\000\000\002\012\000\000\002_\000\000\002u\000\000\002_\000\000\002w\002L\002k\002m\002a\000\000\002k\000\000\002a\002M\002\b\002\t\000\000\000\000\000\000\000\000\000\000\002b\000\000\000\000\000\000\000\000\002[\002m\002L\000\000\002]\002m\000\000\000\000\000\000\002]\002M\002\b\002\t\000\000\000\000\002\012\000\000\000\000\000\000\000\000\002\012\000\000\002_\002[\002y\002L\000\000\000\000\000\000\000\000\002k\000\000\002a\002M\000\000\002\b\002\t\000\000\000\000\000\000\002b\000\000\000\000\000\000\000\000\002b\002[\000\000\000\000\002L\000\000\002m\000\000\002]\000\000\000\000\000\000\002M\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\000\000\000\002_\000\000\002{\002[\000\000\002_\000\000\002}\002k\002]\002a\002\b\002\t\002k\000\000\002a\000\000\000\000\000\000\000\000\002\012\000\000\002b\000\000\000\000\002L\002\b\002\t\000\000\002m\000\000\000\000\002]\002M\002m\000\000\000\000\000\000\000\000\000\000\002L\000\000\000\000\002\012\000\000\002b\002[\000\000\002M\002_\000\000\002\127\000\000\000\000\000\000\000\000\002]\002k\000\000\002a\000\000\002[\000\000\000\000\000\000\000\000\000\000\002\012\002b\002\b\002\t\000\000\002_\000\000\002\129\000\000\000\000\000\000\002m\000\000\002k\000\000\002a\002L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002M\002b\002\b\002\t\002_\000\000\002\131\000\000\002]\000\000\002m\000\000\002k\002[\002a\000\000\002L\002\b\002\t\002\012\000\000\000\000\000\000\002]\002M\006\016\002\b\002\t\002_\000\000\002\133\002L\000\000\002m\002\012\000\000\002k\002[\002a\002M\002L\000\000\006\017\000\000\002b\006\019\000\000\000\000\002M\000\000\002\b\002\t\002[\000\000\006\020\000\000\000\000\002m\000\000\002b\000\000\002[\000\000\000\000\002L\000\000\002]\000\000\000\000\000\000\000\000\002_\002M\002\135\000\000\000\000\000\000\002\012\000\000\002k\000\000\002a\000\000\006\021\000\000\002[\002_\000\000\002\137\000\000\002]\000\000\000\000\000\000\002k\000\000\002a\000\000\000\000\000\000\002m\002\012\002b\000\000\000\000\002]\000\000\000\000\002\b\002\t\000\000\006\022\000\000\000\000\002]\002m\002\012\000\000\000\000\006\023\000\000\000\000\002L\000\000\000\000\002\012\002b\000\000\000\000\002_\002M\002\139\002\b\002\t\000\000\000\000\006\024\002k\002]\002a\000\000\002b\000\000\002[\000\000\000\000\002L\000\000\000\000\002\012\002b\006\025\000\000\002_\002M\002\141\000\000\000\000\002m\000\000\006\026\002k\000\000\002a\000\000\006\028\000\000\002[\002_\000\000\002\143\000\000\000\000\000\000\002b\006\030\002k\002_\002a\002\145\002\b\002\t\002m\000\000\000\000\002k\000\000\002a\000\000\000\000\006\031\000\000\000\000\000\000\002L\000\000\002]\002m\000\000\000\000\000\000\002_\002M\002\147\002\b\002\t\002m\002\012\000\000\002k\000\000\002a\000\000\000\000\000\000\002[\000\000\000\000\002L\000\000\002]\000\000\001[\000\000\000\000\001\014\002M\000\000\001\015\000\000\002m\002\012\002b\000\000\000\000\000\000\000\000\001\014\000\000\002[\005\005\001\\\001l\000\000\001^\001_\000\000\000\000\000\000\000\000\000\000\001[\001\017\000\000\000\000\000\000\002b\000\000\000\000\002_\000\000\002\149\004\187\000\000\001\017\000\000\000\000\002k\002]\002a\001\\\001l\000\000\001^\001_\000\000\000\000\005\149\000\000\002\012\000\000\000\000\000\000\002_\001m\002\151\001n\002\222\002m\001!\000\000\002k\002]\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\007\001[\002\012\002b\002\b\002\t\000\000\000\000\001u\000\000\000\000\002m\001m\000\000\001n\002\225\000\000\001\019\002L\001d\001\\\001l\001[\001^\001_\000\000\002M\002b\000\000\005\n\002_\000\000\002\153\000\000\000\000\002\b\002\t\001u\002k\002[\002a\001\\\001l\000\000\001^\001_\000\000\000\000\001d\000\000\000\000\000\000\000\000\000\000\002_\000\000\002\155\002I\000\000\002m\000\000\0015\002k\001m\002a\001n\002\228\000\000\001\028\000\000\000\000\001w\004\192\000\000\000\000\000\000\002\b\002\t\000\000\001x\005\r\001b\000\000\002m\001m\000\000\001n\002\236\001u\000\000\002L\004\213\002]\005\018\001%\005\015\001?\000\000\002M\001d\001w\000\000\000\000\002\012\002\b\002\t\001%\000\000\001x\001u\001b\002[\000\000\000\000\000\000\000\000\000\000\000\000\002L\000\000\001d\002\b\002\t\002\011\000\000\000\000\002M\000\000\002b\000\000\000\000\000\000\000\000\000\000\002\012\002L\000\000\000\000\000\000\002[\000\000\000\000\000\000\002M\002\b\002\t\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\000\000\002_\002[\002\248\002L\001x\000\000\001b\000\000\002k\002]\002a\002M\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\002\012\002\b\002\t\000\000\002[\001x\000\000\001b\000\000\002m\000\000\002_\000\000\002\b\002\t\002L\000\000\002]\000\000\002`\000\000\002a\000\000\002M\000\000\002b\000\000\002L\002\012\000\000\000\000\000\000\000\000\000\000\002]\002M\002[\000\000\000\000\000\000\001\014\002\b\002\t\005\005\000\000\002\012\000\000\000\000\002[\000\000\000\000\000\000\002_\002b\003\021\002L\000\000\002]\000\000\000\000\002k\000\000\002a\002M\000\000\000\000\000\000\001\017\002\012\000\000\002b\000\000\000\000\000\000\000\000\000\000\002[\000\000\000\000\000\000\002_\002m\003\027\000\000\000\000\000\000\000\000\000\000\002k\002]\002a\000\000\000\000\002b\000\000\000\000\000\000\002_\000\000\003 \002\012\002]\000\000\000\000\005\007\002k\000\000\002a\000\000\002m\002\b\002\t\002\012\002\b\002\t\000\000\000\000\000\000\000\000\000\000\002_\000\000\003(\000\000\002L\002b\002m\002L\002k\002]\002a\000\000\002M\005\n\000\000\002M\000\000\002b\000\000\000\000\002\012\002\b\002\t\000\000\000\000\002[\000\000\000\000\002[\002m\000\000\000\000\002_\000\000\003-\002L\002\b\002\t\000\000\000\000\002k\000\000\002a\002M\002_\002b\003/\000\000\000\000\000\000\002L\000\000\002k\000\000\002a\000\000\002[\000\000\002M\000\000\000\000\002m\002\b\002\t\005\r\000\000\000\000\000\000\000\000\002\b\002\t\002[\002_\002m\0032\004\213\002L\005\017\002]\005\015\002k\002]\002a\002L\002M\000\000\000\000\000\000\000\000\002\012\001%\002M\002\012\002\b\002\t\000\000\000\000\002[\000\000\000\000\000\000\002m\000\000\000\000\002[\000\000\000\000\000\000\000\000\002]\000\000\001[\000\000\000\000\002b\002S\000\000\002b\000\000\000\000\002\012\000\000\000\000\000\000\002]\000\000\000\000\000\000\000\000\000\000\001\\\002\179\000\000\001^\001_\002\012\000\000\000\000\006\016\000\000\000\000\002_\000\000\0039\002_\002b\003>\000\000\000\000\002k\002]\002a\002k\000\000\002a\006\223\000\000\002]\006\019\000\000\002b\002\012\000\000\000\000\000\000\000\000\000\000\006\020\002\012\000\000\002m\006\016\002_\002m\003C\000\000\000\000\000\000\000\000\000\000\002k\002\011\002a\001[\000\000\000\000\002b\002_\006\017\003F\000\000\006\019\002\012\002b\000\000\002k\006\021\002a\001c\000\000\006\020\002m\001\\\001l\000\000\001^\001_\000\000\000\000\001d\000\000\000\000\000\000\002_\006\016\003x\002m\000\000\000\000\000\000\002_\002k\003z\002a\006\022\000\000\000\000\000\000\002k\006\021\002a\006\017\006\023\000\000\006\019\000\000\003e\000\000\000\000\000\000\001[\000\000\002m\006\020\002_\001m\006\224\001n\004<\002m\000\000\000\000\002`\000\000\002a\003g\000\000\006\022\000\000\001\\\002\179\001w\001^\001_\006\025\006\023\000\000\000\000\000\000\001\146\001u\001b\006\021\006\026\000\000\000\000\001[\000\000\006\028\000\000\000\000\001d\006#\000\000\000\000\000\000\000\000\000\000\006\030\000\000\001[\000\000\000\000\000\000\000\000\001\\\002\179\006\025\001^\001_\006\022\000\000\000\000\006\031\000\000\000\000\006\026\000\000\006\023\001\\\002\179\006\028\001^\001_\000\000\000\000\000\000\000\000\000\000\001\014\000\000\006\030\001\015\000\000\000\000\006,\000\000\001c\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\006\031\000\000\001d\001\014\006\025\001x\001\015\001b\000\000\000\000\001\017\000\000\000\000\006\026\000\000\000\000\000\000\000\000\006\028\000\000\004\187\000\000\000\000\000\000\000\000\000\000\000\000\001c\006\030\003e\001\017\000\000\000\000\000\000\000\000\005\163\000\000\001[\001d\000\000\004\187\001c\000\000\006\031\000\000\000\000\000\000\001!\003f\000\000\000\000\001[\001d\005\176\001w\005\173\001\\\002\179\001[\001^\001_\000\000\001\146\000\000\001b\003e\001\014\001!\000\000\001\015\001\\\002\179\000\000\001^\001_\000\000\001\019\001\\\002\179\006\003\001^\001_\000\000\000\000\003j\000\000\000\000\001[\000\000\000\000\001w\000\000\000\000\001\017\000\000\000\000\001\019\000\000\001\146\000\000\001b\000\000\000\000\003\226\001w\000\000\001\\\002\179\000\000\001^\001_\000\000\001\146\000\000\001b\000\000\000\000\006x\000\000\000\000\0015\000\000\000\000\000\000\001c\006\005\000\000\001\028\000\000\000\000\001!\004\192\000\000\000\000\000\000\001d\000\000\000\000\001c\000\000\0015\000\000\000\000\000\000\001[\001c\000\000\001\028\000\000\001d\000\000\004\192\000\000\001%\000\000\001?\001d\000\000\000\000\001\019\000\000\000\000\002\180\001\\\002\179\000\000\001^\001_\000\000\000\000\001[\000\000\000\000\001%\001c\001?\005\203\000\000\002\b\002\t\000\000\000\000\000\000\005\203\000\000\001d\000\000\001w\001\014\001\\\002\179\001\015\001^\001_\000\000\001\146\001\014\001b\000\000\001\015\003\152\001w\000\000\0015\000\000\000\000\000\000\003\161\001w\001\146\001\028\001b\006\003\000\000\000\000\001\017\001\146\000\000\001b\001\014\000\000\005\216\001\015\001\017\000\000\003\226\000\000\000\000\005\215\000\000\003\162\001c\000\000\000\000\000\000\000\000\001%\001w\003\233\003\229\000\000\000\000\001d\002\b\002\t\001\146\001\017\001b\000\000\000\000\000\000\004\203\001!\001\014\000\000\000\000\001\015\001c\006\004\001\014\001!\000\000\001\015\000\000\000\000\002^\002\011\000\000\001d\006\003\000\000\001\014\001\014\000\000\001\015\001\015\000\000\003\165\000\000\000\000\001\017\001\019\000\000\001!\000\000\005\198\001\017\000\000\001[\001\019\000\000\000\000\000\000\000\000\001w\003i\000\000\000\000\001\017\001\017\000\000\000\000\001\146\000\000\001b\000\000\003\155\001\\\001]\000\000\001^\001_\001\019\000\000\000\000\006\012\000\000\001!\001\014\000\000\001w\001\015\000\000\001!\001\014\0015\000\000\001\015\001\146\002_\001b\002\011\001\028\0015\000\000\001!\001!\002`\000\000\002a\001\028\000\000\002\012\000\000\004\224\001\017\001\019\004\227\000\000\000\000\000\000\001\017\001\019\000\000\001\014\000\000\0015\001\015\001%\000\000\003\233\000\000\000\000\001\028\001\019\001\019\001%\004\211\001?\000\000\000\000\001\014\000\000\000\000\001\015\001c\000\000\000\000\000\000\000\000\000\000\001\017\001!\000\000\000\000\000\000\001d\000\000\001!\001%\0015\001?\000\000\000\000\002_\000\000\0015\001\028\001\017\000\000\000\000\004\211\002`\001\028\002a\000\000\000\000\004\224\0015\0015\005\244\001\019\000\000\000\000\000\000\001\028\001\028\001\019\001!\006\181\001O\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001!\001\014\000\000\001w\001\015\000\000\001%\001%\001?\001?\000\000\001\146\001\019\001b\001\014\000\000\001[\001\015\000\000\001\014\0015\000\000\001\015\000\000\000\000\000\000\0015\001\028\001\017\001\019\000\000\001\163\000\000\001\028\000\000\001\\\002\164\001\201\001^\001_\000\000\001\017\000\000\000\000\000\000\000\000\001\017\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\001?\0015\000\000\000\000\001%\000\000\001?\000\000\001\028\000\000\001!\001\014\001\203\000\000\001\015\000\000\001\014\001\014\0015\001\015\001\015\000\000\000\000\001!\000\000\001\028\000\000\000\000\001!\002\031\000\000\000\000\000\000\000\000\001%\000\000\001?\000\000\001\017\001\019\000\000\000\000\000\000\001\017\001\017\000\000\000\000\000\000\001c\000\000\000\000\001%\001\019\001?\000\000\000\000\000\000\001\019\001\014\001d\000\000\001\015\000\000\000\000\001\014\000\000\000\000\001\015\000\000\000\000\000\000\000\000\000\000\001\014\000\000\001!\001\015\000\000\000\000\001\014\001!\001!\001\015\0015\000\000\001\017\000\000\000\000\000\000\000\000\001\028\001\017\000\000\000\000\0022\000\000\0015\000\000\000\000\000\000\001\017\0015\000\000\001\028\001\019\000\000\001\017\002\169\001\028\001\019\001\019\001w\002\174\000\000\001\014\000\000\001%\005\005\001?\001\146\001\014\001b\001!\001\015\000\000\000\000\000\000\000\000\001!\001%\000\000\001?\000\000\000\000\001%\000\000\001?\001!\000\000\000\000\000\000\001\017\000\000\001!\000\000\000\000\000\000\001\017\0015\000\000\000\000\001\019\000\000\0015\0015\001\028\000\000\001\019\000\000\002\191\001\028\001\028\000\000\000\000\002\198\002\205\001\019\001\014\000\000\000\000\001\015\000\000\001\019\001\014\000\000\000\000\001\015\000\000\005\007\000\000\000\000\001%\001\014\001?\001!\001\015\001%\001%\001?\001?\000\000\000\000\000\000\000\000\001\017\0015\000\000\000\000\000\000\000\000\001\017\0015\001\028\000\000\000\000\000\000\002\214\005\n\001\028\001\017\0015\000\000\004K\001\019\000\000\001\014\0015\001\028\005\005\000\000\000\000\004\164\000\000\001\028\000\000\000\000\000\000\004\176\001%\001\014\001?\001!\005\005\000\000\001%\000\000\001?\001!\000\000\000\000\000\000\000\000\001\017\001%\000\000\001?\001!\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\000\000\001\017\0015\005\r\000\000\001\019\000\000\000\000\000\000\001\028\000\000\001\019\001\014\004\189\004\213\001\015\005\016\000\000\005\015\000\000\001\019\000\000\002\b\002\t\005\007\000\000\000\000\001\014\000\000\001%\001\015\000\000\000\000\000\000\000\000\001%\000\000\001?\005\007\001\017\000\000\000\000\000\000\000\000\002l\000\000\000\000\002\b\002\t\0015\000\000\000\000\000\000\005\n\001\017\0015\001\028\000\000\001\014\000\000\004\210\005\005\001\028\000\000\0015\000\000\004\226\005\n\000\000\003G\000\000\001\028\000\000\000\000\001\014\005\128\001!\005\005\000\000\000\000\000\000\000\000\001%\000\000\001?\001\017\001\014\000\000\001%\001\015\001?\001!\000\000\005\209\000\000\000\000\000\000\001%\000\000\001?\000\000\001\017\002\b\002\t\005\r\001\019\000\000\000\000\000\000\000\000\002\011\000\000\000\000\001\017\000\000\004\213\000\000\005\014\005\r\005\015\001\019\002\012\005\007\000\000\003\014\000\000\000\000\000\000\000\000\004\213\001%\005\026\000\000\005\015\000\000\002\011\000\000\000\000\005\007\001\014\000\000\000\000\001\015\000\000\001%\001\014\002\012\000\000\001\015\0015\001!\005\n\000\000\000\000\000\000\000\000\001\028\000\000\001\014\000\000\005\146\001\015\001\014\000\000\0015\001\015\001\017\005\n\000\000\000\000\000\000\001\028\001\017\002_\003J\005\170\000\000\000\000\000\000\001\019\000\000\002`\001%\002a\001?\001\017\000\000\000\000\000\000\001\017\002\011\000\000\000\000\000\000\000\000\000\000\000\000\001%\002_\001?\000\000\002\012\005\r\001!\000\000\000\000\002`\000\000\002a\001!\000\000\000\000\000\000\004\213\000\000\005\230\000\000\005\015\005\r\000\000\000\000\000\000\001!\0015\000\000\000\000\001!\000\000\001%\004\213\001\028\006\000\001\019\005\015\0068\000\000\000\000\000\000\001\019\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\001\019\000\000\002_\000\000\001\019\001%\000\000\001?\000\000\000\000\002`\000\000\002a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\000\000\000\000\000\000\000\000\000\000\0015\001\028\000\000\000\000\000\000\006\141\000\000\001\028\000\000\000\000\000\000\006\145\000\000\0015\000\000\000\000\000\000\0015\000\000\000\000\001\028\000\000\000\000\000\000\001\028\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\001%\000\000\001?\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\001\198\000\000\001%\000\000\003\228")) and semantic_action = [| @@ -1287,9 +1309,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3552 "parsing/parser.mly" +# 3579 "parsing/parser.mly" ( "+" ) -# 1293 "parsing/parser.ml" +# 1315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1312,9 +1334,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3553 "parsing/parser.mly" +# 3580 "parsing/parser.mly" ( "+." ) -# 1318 "parsing/parser.ml" +# 1340 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1337,9 +1359,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = -# 3125 "parsing/parser.mly" +# 3148 "parsing/parser.mly" ( _1 ) -# 1343 "parsing/parser.ml" +# 1365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1384,24 +1406,24 @@ module Tables = struct let _endpos = _endpos_tyvar_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3128 "parsing/parser.mly" +# 3151 "parsing/parser.mly" ( Ptyp_alias(ty, tyvar) ) -# 1390 "parsing/parser.ml" +# 1412 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1399 "parsing/parser.ml" +# 1421 "parsing/parser.ml" in -# 3130 "parsing/parser.mly" +# 3153 "parsing/parser.mly" ( _1 ) -# 1405 "parsing/parser.ml" +# 1427 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1447,30 +1469,30 @@ module Tables = struct let _v : (let_binding) = let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 1453 "parsing/parser.ml" +# 1475 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 1462 "parsing/parser.ml" +# 1484 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2405 "parsing/parser.mly" +# 2428 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklb ~loc:_sloc false body attrs ) -# 1474 "parsing/parser.ml" +# 1496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1507,9 +1529,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = -# 3186 "parsing/parser.mly" +# 3209 "parsing/parser.mly" ( _2 ) -# 1513 "parsing/parser.ml" +# 1535 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1570,23 +1592,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 1576 "parsing/parser.ml" +# 1598 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1584 "parsing/parser.ml" +# 1606 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 1590 "parsing/parser.ml" +# 1612 "parsing/parser.ml" in let _3 = @@ -1594,24 +1616,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 1600 "parsing/parser.ml" +# 1622 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 1606 "parsing/parser.ml" +# 1628 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3188 "parsing/parser.mly" +# 3211 "parsing/parser.mly" ( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 ) -# 1615 "parsing/parser.ml" +# 1637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1642,24 +1664,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3191 "parsing/parser.mly" +# 3214 "parsing/parser.mly" ( Ptyp_var _2 ) -# 1648 "parsing/parser.ml" +# 1670 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1657 "parsing/parser.ml" +# 1679 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1663 "parsing/parser.ml" +# 1685 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1683,23 +1705,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3193 "parsing/parser.mly" +# 3216 "parsing/parser.mly" ( Ptyp_any ) -# 1689 "parsing/parser.ml" +# 1711 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1697 "parsing/parser.ml" +# 1719 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1703 "parsing/parser.ml" +# 1725 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1728,35 +1750,35 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1734 "parsing/parser.ml" +# 1756 "parsing/parser.ml" in let tys = -# 3238 "parsing/parser.mly" +# 3261 "parsing/parser.mly" ( [] ) -# 1740 "parsing/parser.ml" +# 1762 "parsing/parser.ml" in -# 3196 "parsing/parser.mly" +# 3219 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1745 "parsing/parser.ml" +# 1767 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1754 "parsing/parser.ml" +# 1776 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1760 "parsing/parser.ml" +# 1782 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1792,20 +1814,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1798 "parsing/parser.ml" +# 1820 "parsing/parser.ml" in let tys = -# 3240 "parsing/parser.mly" +# 3263 "parsing/parser.mly" ( [ty] ) -# 1804 "parsing/parser.ml" +# 1826 "parsing/parser.ml" in -# 3196 "parsing/parser.mly" +# 3219 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1809 "parsing/parser.ml" +# 1831 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -1813,15 +1835,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1819 "parsing/parser.ml" +# 1841 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1825 "parsing/parser.ml" +# 1847 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1872,9 +1894,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 1878 "parsing/parser.ml" +# 1900 "parsing/parser.ml" in let tys = @@ -1882,24 +1904,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 1886 "parsing/parser.ml" +# 1908 "parsing/parser.ml" in -# 932 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 1891 "parsing/parser.ml" +# 1913 "parsing/parser.ml" in -# 3242 "parsing/parser.mly" +# 3265 "parsing/parser.mly" ( tys ) -# 1897 "parsing/parser.ml" +# 1919 "parsing/parser.ml" in -# 3196 "parsing/parser.mly" +# 3219 "parsing/parser.mly" ( Ptyp_constr(tid, tys) ) -# 1903 "parsing/parser.ml" +# 1925 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -1907,15 +1929,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1913 "parsing/parser.ml" +# 1935 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1919 "parsing/parser.ml" +# 1941 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -1953,24 +1975,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3198 "parsing/parser.mly" +# 3221 "parsing/parser.mly" ( let (f, c) = _2 in Ptyp_object (f, c) ) -# 1959 "parsing/parser.ml" +# 1981 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 1968 "parsing/parser.ml" +# 1990 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 1974 "parsing/parser.ml" +# 1996 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2001,24 +2023,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3200 "parsing/parser.mly" +# 3223 "parsing/parser.mly" ( Ptyp_object ([], Closed) ) -# 2007 "parsing/parser.ml" +# 2029 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2016 "parsing/parser.ml" +# 2038 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2022 "parsing/parser.ml" +# 2044 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2054,20 +2076,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2060 "parsing/parser.ml" +# 2082 "parsing/parser.ml" in let tys = -# 3238 "parsing/parser.mly" +# 3261 "parsing/parser.mly" ( [] ) -# 2066 "parsing/parser.ml" +# 2088 "parsing/parser.ml" in -# 3204 "parsing/parser.mly" +# 3227 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2071 "parsing/parser.ml" +# 2093 "parsing/parser.ml" in let _startpos__1_ = _startpos__2_ in @@ -2075,15 +2097,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2081 "parsing/parser.ml" +# 2103 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2087 "parsing/parser.ml" +# 2109 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2126,20 +2148,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2132 "parsing/parser.ml" +# 2154 "parsing/parser.ml" in let tys = -# 3240 "parsing/parser.mly" +# 3263 "parsing/parser.mly" ( [ty] ) -# 2138 "parsing/parser.ml" +# 2160 "parsing/parser.ml" in -# 3204 "parsing/parser.mly" +# 3227 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2143 "parsing/parser.ml" +# 2165 "parsing/parser.ml" in let _startpos__1_ = _startpos_ty_ in @@ -2147,15 +2169,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2153 "parsing/parser.ml" +# 2175 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2159 "parsing/parser.ml" +# 2181 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2213,9 +2235,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 2219 "parsing/parser.ml" +# 2241 "parsing/parser.ml" in let tys = @@ -2223,24 +2245,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2227 "parsing/parser.ml" +# 2249 "parsing/parser.ml" in -# 932 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 2232 "parsing/parser.ml" +# 2254 "parsing/parser.ml" in -# 3242 "parsing/parser.mly" +# 3265 "parsing/parser.mly" ( tys ) -# 2238 "parsing/parser.ml" +# 2260 "parsing/parser.ml" in -# 3204 "parsing/parser.mly" +# 3227 "parsing/parser.mly" ( Ptyp_class(cid, tys) ) -# 2244 "parsing/parser.ml" +# 2266 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -2248,15 +2270,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2254 "parsing/parser.ml" +# 2276 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2260 "parsing/parser.ml" +# 2282 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2294,24 +2316,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3207 "parsing/parser.mly" +# 3230 "parsing/parser.mly" ( Ptyp_variant([_2], Closed, None) ) -# 2300 "parsing/parser.ml" +# 2322 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2309 "parsing/parser.ml" +# 2331 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2315 "parsing/parser.ml" +# 2337 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2361,24 +2383,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2365 "parsing/parser.ml" +# 2387 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 2370 "parsing/parser.ml" +# 2392 "parsing/parser.ml" in -# 3252 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( _1 ) -# 2376 "parsing/parser.ml" +# 2398 "parsing/parser.ml" in -# 3209 "parsing/parser.mly" +# 3232 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, None) ) -# 2382 "parsing/parser.ml" +# 2404 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2386,15 +2408,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2392 "parsing/parser.ml" +# 2414 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2398 "parsing/parser.ml" +# 2420 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2451,24 +2473,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2455 "parsing/parser.ml" +# 2477 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 2460 "parsing/parser.ml" +# 2482 "parsing/parser.ml" in -# 3252 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( _1 ) -# 2466 "parsing/parser.ml" +# 2488 "parsing/parser.ml" in -# 3211 "parsing/parser.mly" +# 3234 "parsing/parser.mly" ( Ptyp_variant(_2 :: _4, Closed, None) ) -# 2472 "parsing/parser.ml" +# 2494 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -2476,15 +2498,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2482 "parsing/parser.ml" +# 2504 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2488 "parsing/parser.ml" +# 2510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2534,24 +2556,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2538 "parsing/parser.ml" +# 2560 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 2543 "parsing/parser.ml" +# 2565 "parsing/parser.ml" in -# 3252 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( _1 ) -# 2549 "parsing/parser.ml" +# 2571 "parsing/parser.ml" in -# 3213 "parsing/parser.mly" +# 3236 "parsing/parser.mly" ( Ptyp_variant(_3, Open, None) ) -# 2555 "parsing/parser.ml" +# 2577 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2559,15 +2581,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2565 "parsing/parser.ml" +# 2587 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2571 "parsing/parser.ml" +# 2593 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2598,24 +2620,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3215 "parsing/parser.mly" +# 3238 "parsing/parser.mly" ( Ptyp_variant([], Open, None) ) -# 2604 "parsing/parser.ml" +# 2626 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2613 "parsing/parser.ml" +# 2635 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2619 "parsing/parser.ml" +# 2641 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2665,24 +2687,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2669 "parsing/parser.ml" +# 2691 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 2674 "parsing/parser.ml" +# 2696 "parsing/parser.ml" in -# 3252 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( _1 ) -# 2680 "parsing/parser.ml" +# 2702 "parsing/parser.ml" in -# 3217 "parsing/parser.mly" +# 3240 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, Some []) ) -# 2686 "parsing/parser.ml" +# 2708 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -2690,15 +2712,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2696 "parsing/parser.ml" +# 2718 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2702 "parsing/parser.ml" +# 2724 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2763,18 +2785,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2767 "parsing/parser.ml" +# 2789 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 2772 "parsing/parser.ml" +# 2794 "parsing/parser.ml" in -# 3280 "parsing/parser.mly" +# 3303 "parsing/parser.mly" ( _1 ) -# 2778 "parsing/parser.ml" +# 2800 "parsing/parser.ml" in let _3 = @@ -2782,24 +2804,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 2786 "parsing/parser.ml" +# 2808 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 2791 "parsing/parser.ml" +# 2813 "parsing/parser.ml" in -# 3252 "parsing/parser.mly" +# 3275 "parsing/parser.mly" ( _1 ) -# 2797 "parsing/parser.ml" +# 2819 "parsing/parser.ml" in -# 3219 "parsing/parser.mly" +# 3242 "parsing/parser.mly" ( Ptyp_variant(_3, Closed, Some _5) ) -# 2803 "parsing/parser.ml" +# 2825 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -2807,15 +2829,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2813 "parsing/parser.ml" +# 2835 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2819 "parsing/parser.ml" +# 2841 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2839,23 +2861,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 3221 "parsing/parser.mly" +# 3244 "parsing/parser.mly" ( Ptyp_extension _1 ) -# 2845 "parsing/parser.ml" +# 2867 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 2853 "parsing/parser.ml" +# 2875 "parsing/parser.ml" in -# 3223 "parsing/parser.mly" +# 3246 "parsing/parser.mly" ( _1 ) -# 2859 "parsing/parser.ml" +# 2881 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2879,23 +2901,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (string Asttypes.loc) = let _1 = let _1 = -# 3619 "parsing/parser.mly" +# 3646 "parsing/parser.mly" ( _1 ) -# 2885 "parsing/parser.ml" +# 2907 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 800 "parsing/parser.mly" +# 822 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 2893 "parsing/parser.ml" +# 2915 "parsing/parser.ml" in -# 3621 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( _1 ) -# 2899 "parsing/parser.ml" +# 2921 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2933,24 +2955,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (string Asttypes.loc) = let _1 = let _1 = -# 3620 "parsing/parser.mly" +# 3647 "parsing/parser.mly" ( _1 ^ "." ^ _3.txt ) -# 2939 "parsing/parser.ml" +# 2961 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 800 "parsing/parser.mly" +# 822 "parsing/parser.mly" ( mkloc _1 (make_loc _sloc) ) -# 2948 "parsing/parser.ml" +# 2970 "parsing/parser.ml" in -# 3621 "parsing/parser.mly" +# 3648 "parsing/parser.mly" ( _1 ) -# 2954 "parsing/parser.ml" +# 2976 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -2997,9 +3019,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3625 "parsing/parser.mly" +# 3652 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 3003 "parsing/parser.ml" +# 3025 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3022,9 +3044,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.class_expr) = -# 1692 "parsing/parser.mly" +# 1712 "parsing/parser.mly" ( _1 ) -# 3028 "parsing/parser.ml" +# 3050 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3063,18 +3085,18 @@ module Tables = struct let _v : (Parsetree.class_expr) = let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3069 "parsing/parser.ml" +# 3091 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1694 "parsing/parser.mly" +# 1714 "parsing/parser.mly" ( wrap_class_attrs ~loc:_sloc _3 _2 ) -# 3078 "parsing/parser.ml" +# 3100 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3114,9 +3136,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1696 "parsing/parser.mly" +# 1716 "parsing/parser.mly" ( class_of_let_bindings ~loc:_sloc _1 _3 ) -# 3120 "parsing/parser.ml" +# 3142 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3179,34 +3201,34 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 3185 "parsing/parser.ml" +# 3207 "parsing/parser.ml" in let _4 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3193 "parsing/parser.ml" +# 3215 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined1_ in let _3 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 3200 "parsing/parser.ml" +# 3222 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1698 "parsing/parser.mly" +# 1718 "parsing/parser.mly" ( let loc = (_startpos__2_, _endpos__4_) in let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) ) -# 3210 "parsing/parser.ml" +# 3232 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3276,37 +3298,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 3282 "parsing/parser.ml" +# 3304 "parsing/parser.ml" in let _4 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3290 "parsing/parser.ml" +# 3312 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 3299 "parsing/parser.ml" +# 3321 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1698 "parsing/parser.mly" +# 1718 "parsing/parser.mly" ( let loc = (_startpos__2_, _endpos__4_) in let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) ) -# 3310 "parsing/parser.ml" +# 3332 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3336,9 +3358,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = -# 1702 "parsing/parser.mly" +# 1722 "parsing/parser.mly" ( Cl.attr _1 _2 ) -# 3342 "parsing/parser.ml" +# 3364 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3373,18 +3395,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 3377 "parsing/parser.ml" +# 3399 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 3382 "parsing/parser.ml" +# 3404 "parsing/parser.ml" in -# 1705 "parsing/parser.mly" +# 1725 "parsing/parser.mly" ( Pcl_apply(_1, _2) ) -# 3388 "parsing/parser.ml" +# 3410 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -3392,15 +3414,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3398 "parsing/parser.ml" +# 3420 "parsing/parser.ml" in -# 1708 "parsing/parser.mly" +# 1728 "parsing/parser.mly" ( _1 ) -# 3404 "parsing/parser.ml" +# 3426 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3424,23 +3446,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1707 "parsing/parser.mly" +# 1727 "parsing/parser.mly" ( Pcl_extension _1 ) -# 3430 "parsing/parser.ml" +# 3452 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 3438 "parsing/parser.ml" +# 3460 "parsing/parser.ml" in -# 1708 "parsing/parser.mly" +# 1728 "parsing/parser.mly" ( _1 ) -# 3444 "parsing/parser.ml" +# 3466 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3493,33 +3515,33 @@ module Tables = struct let _v : (Parsetree.class_field) = let _6 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3499 "parsing/parser.ml" +# 3521 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3508 "parsing/parser.ml" +# 3530 "parsing/parser.ml" in let _2 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 3514 "parsing/parser.ml" +# 3536 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1757 "parsing/parser.mly" +# 1777 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 3523 "parsing/parser.ml" +# 3545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3579,36 +3601,36 @@ module Tables = struct let _v : (Parsetree.class_field) = let _6 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3585 "parsing/parser.ml" +# 3607 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _3 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3594 "parsing/parser.ml" +# 3616 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 3602 "parsing/parser.ml" +# 3624 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1757 "parsing/parser.mly" +# 1777 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs ) -# 3612 "parsing/parser.ml" +# 3634 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3649,9 +3671,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _3 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3655 "parsing/parser.ml" +# 3677 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3659,11 +3681,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1760 "parsing/parser.mly" +# 1780 "parsing/parser.mly" ( let v, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs ) -# 3667 "parsing/parser.ml" +# 3689 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3704,9 +3726,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _3 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3710 "parsing/parser.ml" +# 3732 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -3714,11 +3736,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1764 "parsing/parser.mly" +# 1784 "parsing/parser.mly" ( let meth, attrs = _2 in let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs ) -# 3722 "parsing/parser.ml" +# 3744 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3764,28 +3786,28 @@ module Tables = struct let _v : (Parsetree.class_field) = let _4 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3770 "parsing/parser.ml" +# 3792 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3779 "parsing/parser.ml" +# 3801 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1768 "parsing/parser.mly" +# 1788 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 3789 "parsing/parser.ml" +# 3811 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3831,28 +3853,28 @@ module Tables = struct let _v : (Parsetree.class_field) = let _4 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3837 "parsing/parser.ml" +# 3859 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 3846 "parsing/parser.ml" +# 3868 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1771 "parsing/parser.mly" +# 1791 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs ) -# 3856 "parsing/parser.ml" +# 3878 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3884,9 +3906,9 @@ module Tables = struct let _v : (Parsetree.class_field) = let _2 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 3890 "parsing/parser.ml" +# 3912 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -3894,10 +3916,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1774 "parsing/parser.mly" +# 1794 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs ) -# 3901 "parsing/parser.ml" +# 3923 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3921,23 +3943,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_field) = let _1 = let _1 = -# 1777 "parsing/parser.mly" +# 1797 "parsing/parser.mly" ( Pcf_attribute _1 ) -# 3927 "parsing/parser.ml" +# 3949 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 821 "parsing/parser.mly" +# 843 "parsing/parser.mly" ( mkcf ~loc:_sloc _1 ) -# 3935 "parsing/parser.ml" +# 3957 "parsing/parser.ml" in -# 1778 "parsing/parser.mly" +# 1798 "parsing/parser.mly" ( _1 ) -# 3941 "parsing/parser.ml" +# 3963 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -3967,9 +3989,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = -# 1672 "parsing/parser.mly" +# 1692 "parsing/parser.mly" ( _2 ) -# 3973 "parsing/parser.ml" +# 3995 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4014,24 +4036,24 @@ module Tables = struct let _endpos = _endpos__4_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1675 "parsing/parser.mly" +# 1695 "parsing/parser.mly" ( Pcl_constraint(_4, _2) ) -# 4020 "parsing/parser.ml" +# 4042 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4029 "parsing/parser.ml" +# 4051 "parsing/parser.ml" in -# 1678 "parsing/parser.mly" +# 1698 "parsing/parser.mly" ( _1 ) -# 4035 "parsing/parser.ml" +# 4057 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4062,24 +4084,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1677 "parsing/parser.mly" +# 1697 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) ) -# 4068 "parsing/parser.ml" +# 4090 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4077 "parsing/parser.ml" +# 4099 "parsing/parser.ml" in -# 1678 "parsing/parser.mly" +# 1698 "parsing/parser.mly" ( _1 ) -# 4083 "parsing/parser.ml" +# 4105 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4117,24 +4139,24 @@ module Tables = struct let _endpos = _endpos_e_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1733 "parsing/parser.mly" +# 1753 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 4123 "parsing/parser.ml" +# 4145 "parsing/parser.ml" in let _endpos__1_ = _endpos_e_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4132 "parsing/parser.ml" +# 4154 "parsing/parser.ml" in -# 1734 "parsing/parser.mly" +# 1754 "parsing/parser.mly" ( _1 ) -# 4138 "parsing/parser.ml" +# 4160 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4165,24 +4187,24 @@ module Tables = struct let _endpos = _endpos_e_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1733 "parsing/parser.mly" +# 1753 "parsing/parser.mly" ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) ) -# 4171 "parsing/parser.ml" +# 4193 "parsing/parser.ml" in let _endpos__1_ = _endpos_e_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 4180 "parsing/parser.ml" +# 4202 "parsing/parser.ml" in -# 1734 "parsing/parser.mly" +# 1754 "parsing/parser.mly" ( _1 ) -# 4186 "parsing/parser.ml" +# 4208 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4201,17 +4223,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 4207 "parsing/parser.ml" +# 4229 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3439 "parsing/parser.mly" +# 3466 "parsing/parser.mly" ( Lident _1 ) -# 4215 "parsing/parser.ml" +# 4237 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4242,9 +4264,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 4248 "parsing/parser.ml" +# 4270 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -4252,9 +4274,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3440 "parsing/parser.mly" +# 3467 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 4258 "parsing/parser.ml" +# 4280 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4294,9 +4316,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1742 "parsing/parser.mly" +# 1762 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 4300 "parsing/parser.ml" +# 4322 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4348,24 +4370,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 1744 "parsing/parser.mly" +# 1764 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 4354 "parsing/parser.ml" +# 4376 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 4363 "parsing/parser.ml" +# 4385 "parsing/parser.ml" in -# 1745 "parsing/parser.mly" +# 1765 "parsing/parser.mly" ( _1 ) -# 4369 "parsing/parser.ml" +# 4391 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4384,9 +4406,9 @@ module Tables = struct let _symbolstartpos = _endpos in let _sloc = (_symbolstartpos, _endpos) in -# 1747 "parsing/parser.mly" +# 1767 "parsing/parser.mly" ( ghpat ~loc:_sloc Ppat_any ) -# 4390 "parsing/parser.ml" +# 4412 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4423,9 +4445,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type) = -# 1872 "parsing/parser.mly" +# 1892 "parsing/parser.mly" ( _2 ) -# 4429 "parsing/parser.ml" +# 4451 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4442,24 +4464,24 @@ module Tables = struct let _endpos = _startpos in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 1873 "parsing/parser.mly" +# 1893 "parsing/parser.mly" ( Ptyp_any ) -# 4448 "parsing/parser.ml" +# 4470 "parsing/parser.ml" in let _endpos__1_ = _endpos__0_ in let _endpos = _endpos__1_ in let _symbolstartpos = _endpos in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 4457 "parsing/parser.ml" +# 4479 "parsing/parser.ml" in -# 1874 "parsing/parser.mly" +# 1894 "parsing/parser.mly" ( _1 ) -# 4463 "parsing/parser.ml" +# 4485 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4505,28 +4527,28 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 4511 "parsing/parser.ml" +# 4533 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 4520 "parsing/parser.ml" +# 4542 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1882 "parsing/parser.mly" +# 1902 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs ) -# 4530 "parsing/parser.ml" +# 4552 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4584,9 +4606,9 @@ module Tables = struct let ty : (Parsetree.core_type) = Obj.magic ty in let _3 : unit = Obj.magic _3 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 4590 "parsing/parser.ml" +# 4612 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let flags : (Asttypes.mutable_flag * Asttypes.virtual_flag) = Obj.magic flags in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -4597,9 +4619,9 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 4603 "parsing/parser.ml" +# 4625 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined3_ in @@ -4607,44 +4629,44 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let label = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 4613 "parsing/parser.ml" +# 4635 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4621 "parsing/parser.ml" +# 4643 "parsing/parser.ml" in -# 1907 "parsing/parser.mly" +# 1927 "parsing/parser.mly" ( let mut, virt = flags in label, mut, virt, ty ) -# 4630 "parsing/parser.ml" +# 4652 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 4638 "parsing/parser.ml" +# 4660 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1885 "parsing/parser.mly" +# 1905 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs ) -# 4648 "parsing/parser.ml" +# 4670 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4702,9 +4724,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 4708 "parsing/parser.ml" +# 4730 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.private_flag * Asttypes.virtual_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -4715,53 +4737,53 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _7 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 4721 "parsing/parser.ml" +# 4743 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in let _6 = let _1 = _1_inlined3 in -# 3091 "parsing/parser.mly" +# 3114 "parsing/parser.mly" ( _1 ) -# 4730 "parsing/parser.ml" +# 4752 "parsing/parser.ml" in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 4738 "parsing/parser.ml" +# 4760 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4746 "parsing/parser.ml" +# 4768 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 4754 "parsing/parser.ml" +# 4776 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1889 "parsing/parser.mly" +# 1909 "parsing/parser.mly" ( let (p, v) = _3 in let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs ) -# 4765 "parsing/parser.ml" +# 4787 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4807,28 +4829,28 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _4 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 4813 "parsing/parser.ml" +# 4835 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 4822 "parsing/parser.ml" +# 4844 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1893 "parsing/parser.mly" +# 1913 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs ) -# 4832 "parsing/parser.ml" +# 4854 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4860,9 +4882,9 @@ module Tables = struct let _v : (Parsetree.class_type_field) = let _2 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 4866 "parsing/parser.ml" +# 4888 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -4870,10 +4892,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1896 "parsing/parser.mly" +# 1916 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs ) -# 4877 "parsing/parser.ml" +# 4899 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4897,23 +4919,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_type_field) = let _1 = let _1 = -# 1899 "parsing/parser.mly" +# 1919 "parsing/parser.mly" ( Pctf_attribute _1 ) -# 4903 "parsing/parser.ml" +# 4925 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 819 "parsing/parser.mly" +# 841 "parsing/parser.mly" ( mkctf ~loc:_sloc _1 ) -# 4911 "parsing/parser.ml" +# 4933 "parsing/parser.ml" in -# 1900 "parsing/parser.mly" +# 1920 "parsing/parser.mly" ( _1 ) -# 4917 "parsing/parser.ml" +# 4939 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -4942,42 +4964,42 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 4948 "parsing/parser.ml" +# 4970 "parsing/parser.ml" in let tys = let tys = -# 1858 "parsing/parser.mly" +# 1878 "parsing/parser.mly" ( [] ) -# 4955 "parsing/parser.ml" +# 4977 "parsing/parser.ml" in -# 1864 "parsing/parser.mly" +# 1884 "parsing/parser.mly" ( tys ) -# 4960 "parsing/parser.ml" +# 4982 "parsing/parser.ml" in -# 1841 "parsing/parser.mly" +# 1861 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 4966 "parsing/parser.ml" +# 4988 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 4975 "parsing/parser.ml" +# 4997 "parsing/parser.ml" in -# 1844 "parsing/parser.mly" +# 1864 "parsing/parser.mly" ( _1 ) -# 4981 "parsing/parser.ml" +# 5003 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5028,9 +5050,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5034 "parsing/parser.ml" +# 5056 "parsing/parser.ml" in let tys = @@ -5039,30 +5061,30 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 5043 "parsing/parser.ml" +# 5065 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 5048 "parsing/parser.ml" +# 5070 "parsing/parser.ml" in -# 1860 "parsing/parser.mly" +# 1880 "parsing/parser.mly" ( params ) -# 5054 "parsing/parser.ml" +# 5076 "parsing/parser.ml" in -# 1864 "parsing/parser.mly" +# 1884 "parsing/parser.mly" ( tys ) -# 5060 "parsing/parser.ml" +# 5082 "parsing/parser.ml" in -# 1841 "parsing/parser.mly" +# 1861 "parsing/parser.mly" ( Pcty_constr (cid, tys) ) -# 5066 "parsing/parser.ml" +# 5088 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -5070,15 +5092,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5076 "parsing/parser.ml" +# 5098 "parsing/parser.ml" in -# 1844 "parsing/parser.mly" +# 1864 "parsing/parser.mly" ( _1 ) -# 5082 "parsing/parser.ml" +# 5104 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5102,23 +5124,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.class_type) = let _1 = let _1 = -# 1843 "parsing/parser.mly" +# 1863 "parsing/parser.mly" ( Pcty_extension _1 ) -# 5108 "parsing/parser.ml" +# 5130 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 5116 "parsing/parser.ml" +# 5138 "parsing/parser.ml" in -# 1844 "parsing/parser.mly" +# 1864 "parsing/parser.mly" ( _1 ) -# 5122 "parsing/parser.ml" +# 5144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5175,44 +5197,44 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 5179 "parsing/parser.ml" +# 5201 "parsing/parser.ml" in -# 1878 "parsing/parser.mly" +# 1898 "parsing/parser.mly" ( _1 ) -# 5184 "parsing/parser.ml" +# 5206 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 765 "parsing/parser.mly" +# 787 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 5193 "parsing/parser.ml" +# 5215 "parsing/parser.ml" in -# 1868 "parsing/parser.mly" +# 1888 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 5199 "parsing/parser.ml" +# 5221 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 5207 "parsing/parser.ml" +# 5229 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1846 "parsing/parser.mly" +# 1866 "parsing/parser.mly" ( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) ) -# 5216 "parsing/parser.ml" +# 5238 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5269,43 +5291,43 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 5273 "parsing/parser.ml" +# 5295 "parsing/parser.ml" in -# 1878 "parsing/parser.mly" +# 1898 "parsing/parser.mly" ( _1 ) -# 5278 "parsing/parser.ml" +# 5300 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 765 "parsing/parser.mly" +# 787 "parsing/parser.mly" ( extra_csig _startpos _endpos _1 ) -# 5287 "parsing/parser.ml" +# 5309 "parsing/parser.ml" in -# 1868 "parsing/parser.mly" +# 1888 "parsing/parser.mly" ( Csig.mk _1 _2 ) -# 5293 "parsing/parser.ml" +# 5315 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 5301 "parsing/parser.ml" +# 5323 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1848 "parsing/parser.mly" +# 1868 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 5309 "parsing/parser.ml" +# 5331 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5335,9 +5357,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.class_type) = -# 1850 "parsing/parser.mly" +# 1870 "parsing/parser.mly" ( Cty.attr _1 _2 ) -# 5341 "parsing/parser.ml" +# 5363 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5400,34 +5422,34 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5406 "parsing/parser.ml" +# 5428 "parsing/parser.ml" in let _4 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 5414 "parsing/parser.ml" +# 5436 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined1_ in let _3 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 5421 "parsing/parser.ml" +# 5443 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1852 "parsing/parser.mly" +# 1872 "parsing/parser.mly" ( let loc = (_startpos__2_, _endpos__4_) in let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) ) -# 5431 "parsing/parser.ml" +# 5453 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5497,37 +5519,37 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5503 "parsing/parser.ml" +# 5525 "parsing/parser.ml" in let _4 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 5511 "parsing/parser.ml" +# 5533 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 5520 "parsing/parser.ml" +# 5542 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1852 "parsing/parser.mly" +# 1872 "parsing/parser.mly" ( let loc = (_startpos__2_, _endpos__4_) in let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) ) -# 5531 "parsing/parser.ml" +# 5553 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5564,9 +5586,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.class_expr) = -# 1712 "parsing/parser.mly" +# 1732 "parsing/parser.mly" ( _2 ) -# 5570 "parsing/parser.ml" +# 5592 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5605,9 +5627,9 @@ module Tables = struct let _v : (Parsetree.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1714 "parsing/parser.mly" +# 1734 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 5611 "parsing/parser.ml" +# 5633 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5636,42 +5658,42 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5642 "parsing/parser.ml" +# 5664 "parsing/parser.ml" in let tys = let tys = -# 1858 "parsing/parser.mly" +# 1878 "parsing/parser.mly" ( [] ) -# 5649 "parsing/parser.ml" +# 5671 "parsing/parser.ml" in -# 1864 "parsing/parser.mly" +# 1884 "parsing/parser.mly" ( tys ) -# 5654 "parsing/parser.ml" +# 5676 "parsing/parser.ml" in -# 1717 "parsing/parser.mly" +# 1737 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5660 "parsing/parser.ml" +# 5682 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5669 "parsing/parser.ml" +# 5691 "parsing/parser.ml" in -# 1724 "parsing/parser.mly" +# 1744 "parsing/parser.mly" ( _1 ) -# 5675 "parsing/parser.ml" +# 5697 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5722,9 +5744,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 5728 "parsing/parser.ml" +# 5750 "parsing/parser.ml" in let tys = @@ -5733,30 +5755,30 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 5737 "parsing/parser.ml" +# 5759 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 5742 "parsing/parser.ml" +# 5764 "parsing/parser.ml" in -# 1860 "parsing/parser.mly" +# 1880 "parsing/parser.mly" ( params ) -# 5748 "parsing/parser.ml" +# 5770 "parsing/parser.ml" in -# 1864 "parsing/parser.mly" +# 1884 "parsing/parser.mly" ( tys ) -# 5754 "parsing/parser.ml" +# 5776 "parsing/parser.ml" in -# 1717 "parsing/parser.mly" +# 1737 "parsing/parser.mly" ( Pcl_constr(cid, tys) ) -# 5760 "parsing/parser.ml" +# 5782 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -5764,15 +5786,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5770 "parsing/parser.ml" +# 5792 "parsing/parser.ml" in -# 1724 "parsing/parser.mly" +# 1744 "parsing/parser.mly" ( _1 ) -# 5776 "parsing/parser.ml" +# 5798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5831,43 +5853,43 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 5835 "parsing/parser.ml" +# 5857 "parsing/parser.ml" in -# 1751 "parsing/parser.mly" +# 1771 "parsing/parser.mly" ( _1 ) -# 5840 "parsing/parser.ml" +# 5862 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 764 "parsing/parser.mly" +# 786 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 5849 "parsing/parser.ml" +# 5871 "parsing/parser.ml" in -# 1738 "parsing/parser.mly" +# 1758 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 5855 "parsing/parser.ml" +# 5877 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 5863 "parsing/parser.ml" +# 5885 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1719 "parsing/parser.mly" +# 1739 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 5871 "parsing/parser.ml" +# 5893 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -5875,15 +5897,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5881 "parsing/parser.ml" +# 5903 "parsing/parser.ml" in -# 1724 "parsing/parser.mly" +# 1744 "parsing/parser.mly" ( _1 ) -# 5887 "parsing/parser.ml" +# 5909 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -5935,24 +5957,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.class_expr) = let _1 = let _1 = -# 1721 "parsing/parser.mly" +# 1741 "parsing/parser.mly" ( Pcl_constraint(_2, _4) ) -# 5941 "parsing/parser.ml" +# 5963 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 5950 "parsing/parser.ml" +# 5972 "parsing/parser.ml" in -# 1724 "parsing/parser.mly" +# 1744 "parsing/parser.mly" ( _1 ) -# 5956 "parsing/parser.ml" +# 5978 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6007,9 +6029,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1723 "parsing/parser.mly" +# 1743 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 6013 "parsing/parser.ml" +# 6035 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -6017,15 +6039,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 823 "parsing/parser.mly" +# 845 "parsing/parser.mly" ( mkclass ~loc:_sloc _1 ) -# 6023 "parsing/parser.ml" +# 6045 "parsing/parser.ml" in -# 1724 "parsing/parser.mly" +# 1744 "parsing/parser.mly" ( _1 ) -# 6029 "parsing/parser.ml" +# 6051 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6082,44 +6104,44 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 6086 "parsing/parser.ml" +# 6108 "parsing/parser.ml" in -# 1751 "parsing/parser.mly" +# 1771 "parsing/parser.mly" ( _1 ) -# 6091 "parsing/parser.ml" +# 6113 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 764 "parsing/parser.mly" +# 786 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 6100 "parsing/parser.ml" +# 6122 "parsing/parser.ml" in -# 1738 "parsing/parser.mly" +# 1758 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 6106 "parsing/parser.ml" +# 6128 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 6114 "parsing/parser.ml" +# 6136 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1726 "parsing/parser.mly" +# 1746 "parsing/parser.mly" ( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) ) -# 6123 "parsing/parser.ml" +# 6145 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6142,9 +6164,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.class_type) = -# 1829 "parsing/parser.mly" +# 1849 "parsing/parser.mly" ( _1 ) -# 6148 "parsing/parser.ml" +# 6170 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6190,14 +6212,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3154 "parsing/parser.mly" +# 3177 "parsing/parser.mly" ( Optional label ) -# 6196 "parsing/parser.ml" +# 6218 "parsing/parser.ml" in -# 1835 "parsing/parser.mly" +# 1855 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6201 "parsing/parser.ml" +# 6223 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -6205,15 +6227,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6211 "parsing/parser.ml" +# 6233 "parsing/parser.ml" in -# 1836 "parsing/parser.mly" +# 1856 "parsing/parser.mly" ( _1 ) -# 6217 "parsing/parser.ml" +# 6239 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6260,9 +6282,9 @@ module Tables = struct let domain : (Parsetree.core_type) = Obj.magic domain in let _2 : unit = Obj.magic _2 in let label : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 6266 "parsing/parser.ml" +# 6288 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -6270,14 +6292,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3156 "parsing/parser.mly" +# 3179 "parsing/parser.mly" ( Labelled label ) -# 6276 "parsing/parser.ml" +# 6298 "parsing/parser.ml" in -# 1835 "parsing/parser.mly" +# 1855 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6281 "parsing/parser.ml" +# 6303 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -6285,15 +6307,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6291 "parsing/parser.ml" +# 6313 "parsing/parser.ml" in -# 1836 "parsing/parser.mly" +# 1856 "parsing/parser.mly" ( _1 ) -# 6297 "parsing/parser.ml" +# 6319 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6332,14 +6354,14 @@ module Tables = struct let _v : (Parsetree.class_type) = let _1 = let _1 = let label = -# 3158 "parsing/parser.mly" +# 3181 "parsing/parser.mly" ( Nolabel ) -# 6338 "parsing/parser.ml" +# 6360 "parsing/parser.ml" in -# 1835 "parsing/parser.mly" +# 1855 "parsing/parser.mly" ( Pcty_arrow(label, domain, codomain) ) -# 6343 "parsing/parser.ml" +# 6365 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in @@ -6347,15 +6369,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 817 "parsing/parser.mly" +# 839 "parsing/parser.mly" ( mkcty ~loc:_sloc _1 ) -# 6353 "parsing/parser.ml" +# 6375 "parsing/parser.ml" in -# 1836 "parsing/parser.mly" +# 1856 "parsing/parser.mly" ( _1 ) -# 6359 "parsing/parser.ml" +# 6381 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6438,9 +6460,9 @@ module Tables = struct let csig : (Parsetree.class_type) = Obj.magic csig in let _8 : unit = Obj.magic _8 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 6444 "parsing/parser.ml" +# 6466 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -6456,9 +6478,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 6462 "parsing/parser.ml" +# 6484 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -6468,24 +6490,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 6474 "parsing/parser.ml" +# 6496 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 6482 "parsing/parser.ml" +# 6504 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1974 "parsing/parser.mly" +# 1994 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -6493,19 +6515,19 @@ module Tables = struct ext, Ci.mk id csig ~virt ~params ~attrs ~loc ~docs ) -# 6497 "parsing/parser.ml" +# 6519 "parsing/parser.ml" in -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 6503 "parsing/parser.ml" +# 6525 "parsing/parser.ml" in -# 1962 "parsing/parser.mly" +# 1982 "parsing/parser.mly" ( _1 ) -# 6509 "parsing/parser.ml" +# 6531 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6524,17 +6546,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 6530 "parsing/parser.ml" +# 6552 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3435 "parsing/parser.mly" +# 3462 "parsing/parser.mly" ( Lident _1 ) -# 6538 "parsing/parser.ml" +# 6560 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6565,9 +6587,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 6571 "parsing/parser.ml" +# 6593 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -6575,9 +6597,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3436 "parsing/parser.mly" +# 3463 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 6581 "parsing/parser.ml" +# 6603 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6596,17 +6618,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 606 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string * char option) -# 6602 "parsing/parser.ml" +# 6624 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3326 "parsing/parser.mly" +# 3349 "parsing/parser.mly" ( let (n, m) = _1 in Pconst_integer (n, m) ) -# 6610 "parsing/parser.ml" +# 6632 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6625,17 +6647,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 565 "parsing/parser.mly" +# 587 "parsing/parser.mly" (char) -# 6631 "parsing/parser.ml" +# 6653 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3327 "parsing/parser.mly" +# 3350 "parsing/parser.mly" ( Pconst_char _1 ) -# 6639 "parsing/parser.ml" +# 6661 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6654,17 +6676,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 658 "parsing/parser.mly" +# 680 "parsing/parser.mly" (string * string option) -# 6660 "parsing/parser.ml" +# 6682 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3328 "parsing/parser.mly" +# 3351 "parsing/parser.mly" ( let (s, d) = _1 in Pconst_string (s, d) ) -# 6668 "parsing/parser.ml" +# 6690 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6683,17 +6705,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 585 "parsing/parser.mly" +# 607 "parsing/parser.mly" (string * char option) -# 6689 "parsing/parser.ml" +# 6711 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3329 "parsing/parser.mly" +# 3352 "parsing/parser.mly" ( let (f, m) = _1 in Pconst_float (f, m) ) -# 6697 "parsing/parser.ml" +# 6719 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6712,17 +6734,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 6718 "parsing/parser.ml" +# 6740 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3389 "parsing/parser.mly" +# 3416 "parsing/parser.mly" ( _1 ) -# 6726 "parsing/parser.ml" +# 6748 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6752,9 +6774,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (string) = -# 3390 "parsing/parser.mly" +# 3417 "parsing/parser.mly" ( "[]" ) -# 6758 "parsing/parser.ml" +# 6780 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6784,9 +6806,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (string) = -# 3391 "parsing/parser.mly" +# 3418 "parsing/parser.mly" ( "()" ) -# 6790 "parsing/parser.ml" +# 6812 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6823,9 +6845,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (string) = -# 3392 "parsing/parser.mly" +# 3419 "parsing/parser.mly" ( "::" ) -# 6829 "parsing/parser.ml" +# 6851 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6848,9 +6870,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3393 "parsing/parser.mly" +# 3420 "parsing/parser.mly" ( "false" ) -# 6854 "parsing/parser.ml" +# 6876 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6873,9 +6895,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3394 "parsing/parser.mly" +# 3421 "parsing/parser.mly" ( "true" ) -# 6879 "parsing/parser.ml" +# 6901 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6898,9 +6920,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3402 "parsing/parser.mly" +# 3429 "parsing/parser.mly" ( _1 ) -# 6904 "parsing/parser.ml" +# 6926 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6951,9 +6973,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Longident.t) = -# 3403 "parsing/parser.mly" +# 3430 "parsing/parser.mly" ( Ldot(_1,"::") ) -# 6957 "parsing/parser.ml" +# 6979 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -6983,9 +7005,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Longident.t) = -# 3404 "parsing/parser.mly" +# 3431 "parsing/parser.mly" ( Lident "[]" ) -# 6989 "parsing/parser.ml" +# 7011 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7015,9 +7037,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Longident.t) = -# 3405 "parsing/parser.mly" +# 3432 "parsing/parser.mly" ( Lident "()" ) -# 7021 "parsing/parser.ml" +# 7043 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7054,9 +7076,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3406 "parsing/parser.mly" +# 3433 "parsing/parser.mly" ( Lident "::" ) -# 7060 "parsing/parser.ml" +# 7082 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7079,9 +7101,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3407 "parsing/parser.mly" +# 3434 "parsing/parser.mly" ( Lident "false" ) -# 7085 "parsing/parser.ml" +# 7107 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7104,9 +7126,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3408 "parsing/parser.mly" +# 3435 "parsing/parser.mly" ( Lident "true" ) -# 7110 "parsing/parser.ml" +# 7132 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7143,9 +7165,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.core_type * Parsetree.core_type) = -# 1918 "parsing/parser.mly" +# 1938 "parsing/parser.mly" ( _1, _3 ) -# 7149 "parsing/parser.ml" +# 7171 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7170,26 +7192,26 @@ module Tables = struct let _v : (Parsetree.constructor_arguments) = let tys = let xs = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 7176 "parsing/parser.ml" +# 7198 "parsing/parser.ml" in # 253 "menhir/standard.mly" ( List.rev xs ) -# 7181 "parsing/parser.ml" +# 7203 "parsing/parser.ml" in -# 908 "parsing/parser.mly" +# 930 "parsing/parser.mly" ( xs ) -# 7187 "parsing/parser.ml" +# 7209 "parsing/parser.ml" in -# 2961 "parsing/parser.mly" +# 2984 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 7193 "parsing/parser.ml" +# 7215 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7228,26 +7250,26 @@ module Tables = struct let _v : (Parsetree.constructor_arguments) = let tys = let xs = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 7234 "parsing/parser.ml" +# 7256 "parsing/parser.ml" in # 253 "menhir/standard.mly" ( List.rev xs ) -# 7239 "parsing/parser.ml" +# 7261 "parsing/parser.ml" in -# 908 "parsing/parser.mly" +# 930 "parsing/parser.mly" ( xs ) -# 7245 "parsing/parser.ml" +# 7267 "parsing/parser.ml" in -# 2961 "parsing/parser.mly" +# 2984 "parsing/parser.mly" ( Pcstr_tuple tys ) -# 7251 "parsing/parser.ml" +# 7273 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7284,9 +7306,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.constructor_arguments) = -# 2963 "parsing/parser.mly" +# 2986 "parsing/parser.mly" ( Pcstr_record _2 ) -# 7290 "parsing/parser.ml" +# 7312 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7309,9 +7331,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constructor_declaration list) = -# 2882 "parsing/parser.mly" +# 2905 "parsing/parser.mly" ( [] ) -# 7315 "parsing/parser.ml" +# 7337 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7334,14 +7356,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.constructor_declaration list) = let cs = -# 993 "parsing/parser.mly" +# 1015 "parsing/parser.mly" ( List.rev xs ) -# 7340 "parsing/parser.ml" +# 7362 "parsing/parser.ml" in -# 2884 "parsing/parser.mly" +# 2907 "parsing/parser.mly" ( cs ) -# 7345 "parsing/parser.ml" +# 7367 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7364,14 +7386,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 7370 "parsing/parser.ml" +# 7392 "parsing/parser.ml" in -# 3106 "parsing/parser.mly" +# 3129 "parsing/parser.mly" ( _1 ) -# 7375 "parsing/parser.ml" +# 7397 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7401,9 +7423,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type) = -# 3108 "parsing/parser.mly" +# 3131 "parsing/parser.mly" ( Typ.attr _1 _2 ) -# 7407 "parsing/parser.ml" +# 7429 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7426,9 +7448,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.direction_flag) = -# 3489 "parsing/parser.mly" +# 3516 "parsing/parser.mly" ( Upto ) -# 7432 "parsing/parser.ml" +# 7454 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7451,9 +7473,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.direction_flag) = -# 3490 "parsing/parser.mly" +# 3517 "parsing/parser.mly" ( Downto ) -# 7457 "parsing/parser.ml" +# 7479 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7476,9 +7498,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2065 "parsing/parser.mly" +# 2085 "parsing/parser.mly" ( _1 ) -# 7482 "parsing/parser.ml" +# 7504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7541,11 +7563,7 @@ module Tables = struct let _7 : (Parsetree.expression) = Obj.magic _7 in let _6 : unit = Obj.magic _6 in let _5 : (Parsetree.module_expr) = Obj.magic _5 in - let _1_inlined3 : ( -# 666 "parsing/parser.mly" - (string) -# 7548 "parsing/parser.ml" - ) = Obj.magic _1_inlined3 in + let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in @@ -7560,9 +7578,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7566 "parsing/parser.ml" +# 7584 "parsing/parser.ml" in let _3 = @@ -7570,21 +7588,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 7576 "parsing/parser.ml" +# 7594 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 7582 "parsing/parser.ml" +# 7600 "parsing/parser.ml" in -# 2110 "parsing/parser.mly" +# 2133 "parsing/parser.mly" ( Pexp_letmodule(_4, _5, _7), _3 ) -# 7588 "parsing/parser.ml" +# 7606 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7592,10 +7610,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7599 "parsing/parser.ml" +# 7617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7679,9 +7697,9 @@ module Tables = struct let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 7685 "parsing/parser.ml" +# 7703 "parsing/parser.ml" in let _endpos__3_ = _endpos__1_inlined1_ in @@ -7690,19 +7708,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 7696 "parsing/parser.ml" +# 7714 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2946 "parsing/parser.mly" +# 2969 "parsing/parser.mly" ( let args, res = _2 in Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) ) -# 7706 "parsing/parser.ml" +# 7724 "parsing/parser.ml" in let _3 = @@ -7710,21 +7728,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 7716 "parsing/parser.ml" +# 7734 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 7722 "parsing/parser.ml" +# 7740 "parsing/parser.ml" in -# 2112 "parsing/parser.mly" +# 2135 "parsing/parser.mly" ( Pexp_letexception(_4, _6), _3 ) -# 7728 "parsing/parser.ml" +# 7746 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -7732,10 +7750,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7739 "parsing/parser.ml" +# 7757 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7805,28 +7823,28 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 7811 "parsing/parser.ml" +# 7829 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 7817 "parsing/parser.ml" +# 7835 "parsing/parser.ml" in let _3 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 7823 "parsing/parser.ml" +# 7841 "parsing/parser.ml" in -# 2114 "parsing/parser.mly" +# 2137 "parsing/parser.mly" ( let open_loc = make_loc (_startpos__2_, _endpos__5_) in let od = Opn.mk _5 ~override:_3 ~loc:open_loc in Pexp_open(od, _7), _4 ) -# 7830 "parsing/parser.ml" +# 7848 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7834,10 +7852,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7841 "parsing/parser.ml" +# 7859 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7914,31 +7932,31 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 7920 "parsing/parser.ml" +# 7938 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 7926 "parsing/parser.ml" +# 7944 "parsing/parser.ml" in let _3 = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 7934 "parsing/parser.ml" +# 7952 "parsing/parser.ml" in -# 2114 "parsing/parser.mly" +# 2137 "parsing/parser.mly" ( let open_loc = make_loc (_startpos__2_, _endpos__5_) in let od = Opn.mk _5 ~override:_3 ~loc:open_loc in Pexp_open(od, _7), _4 ) -# 7942 "parsing/parser.ml" +# 7960 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -7946,10 +7964,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 7953 "parsing/parser.ml" +# 7971 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -7998,18 +8016,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 8002 "parsing/parser.ml" +# 8020 "parsing/parser.ml" in -# 965 "parsing/parser.mly" +# 987 "parsing/parser.mly" ( xs ) -# 8007 "parsing/parser.ml" +# 8025 "parsing/parser.ml" in -# 2446 "parsing/parser.mly" +# 2469 "parsing/parser.mly" ( xs ) -# 8013 "parsing/parser.ml" +# 8031 "parsing/parser.ml" in let _2 = @@ -8017,21 +8035,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8023 "parsing/parser.ml" +# 8041 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8029 "parsing/parser.ml" +# 8047 "parsing/parser.ml" in -# 2118 "parsing/parser.mly" +# 2141 "parsing/parser.mly" ( Pexp_function _3, _2 ) -# 8035 "parsing/parser.ml" +# 8053 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8039,10 +8057,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8046 "parsing/parser.ml" +# 8064 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8098,22 +8116,22 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8104 "parsing/parser.ml" +# 8122 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8110 "parsing/parser.ml" +# 8128 "parsing/parser.ml" in -# 2120 "parsing/parser.mly" +# 2143 "parsing/parser.mly" ( let (l,o,p) = _3 in Pexp_fun(l, o, p, _4), _2 ) -# 8117 "parsing/parser.ml" +# 8135 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -8121,10 +8139,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8128 "parsing/parser.ml" +# 8146 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8197,33 +8215,33 @@ module Tables = struct let _endpos = _endpos__7_ in let _v : (Parsetree.expression) = let _1 = let _5 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 8203 "parsing/parser.ml" +# 8221 "parsing/parser.ml" in let _2 = let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8212 "parsing/parser.ml" +# 8230 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8218 "parsing/parser.ml" +# 8236 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2123 "parsing/parser.mly" +# 2146 "parsing/parser.mly" ( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 ) -# 8227 "parsing/parser.ml" +# 8245 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8231,10 +8249,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8238 "parsing/parser.ml" +# 8256 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8297,18 +8315,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 8301 "parsing/parser.ml" +# 8319 "parsing/parser.ml" in -# 965 "parsing/parser.mly" +# 987 "parsing/parser.mly" ( xs ) -# 8306 "parsing/parser.ml" +# 8324 "parsing/parser.ml" in -# 2446 "parsing/parser.mly" +# 2469 "parsing/parser.mly" ( xs ) -# 8312 "parsing/parser.ml" +# 8330 "parsing/parser.ml" in let _2 = @@ -8316,21 +8334,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8322 "parsing/parser.ml" +# 8340 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8328 "parsing/parser.ml" +# 8346 "parsing/parser.ml" in -# 2125 "parsing/parser.mly" +# 2148 "parsing/parser.mly" ( Pexp_match(_3, _5), _2 ) -# 8334 "parsing/parser.ml" +# 8352 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8338,10 +8356,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8345 "parsing/parser.ml" +# 8363 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8404,18 +8422,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 8408 "parsing/parser.ml" +# 8426 "parsing/parser.ml" in -# 965 "parsing/parser.mly" +# 987 "parsing/parser.mly" ( xs ) -# 8413 "parsing/parser.ml" +# 8431 "parsing/parser.ml" in -# 2446 "parsing/parser.mly" +# 2469 "parsing/parser.mly" ( xs ) -# 8419 "parsing/parser.ml" +# 8437 "parsing/parser.ml" in let _2 = @@ -8423,21 +8441,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8429 "parsing/parser.ml" +# 8447 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8435 "parsing/parser.ml" +# 8453 "parsing/parser.ml" in -# 2127 "parsing/parser.mly" +# 2150 "parsing/parser.mly" ( Pexp_try(_3, _5), _2 ) -# 8441 "parsing/parser.ml" +# 8459 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -8445,10 +8463,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8452 "parsing/parser.ml" +# 8470 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8511,21 +8529,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8517 "parsing/parser.ml" +# 8535 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8523 "parsing/parser.ml" +# 8541 "parsing/parser.ml" in -# 2129 "parsing/parser.mly" +# 2152 "parsing/parser.mly" ( syntax_error() ) -# 8529 "parsing/parser.ml" +# 8547 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -8533,10 +8551,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8540 "parsing/parser.ml" +# 8558 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8613,21 +8631,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8619 "parsing/parser.ml" +# 8637 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8625 "parsing/parser.ml" +# 8643 "parsing/parser.ml" in -# 2131 "parsing/parser.mly" +# 2154 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, Some _7), _2 ) -# 8631 "parsing/parser.ml" +# 8649 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -8635,10 +8653,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8642 "parsing/parser.ml" +# 8660 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8701,21 +8719,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8707 "parsing/parser.ml" +# 8725 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8713 "parsing/parser.ml" +# 8731 "parsing/parser.ml" in -# 2133 "parsing/parser.mly" +# 2156 "parsing/parser.mly" ( Pexp_ifthenelse(_3, _5, None), _2 ) -# 8719 "parsing/parser.ml" +# 8737 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -8723,10 +8741,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8730 "parsing/parser.ml" +# 8748 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8796,21 +8814,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8802 "parsing/parser.ml" +# 8820 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8808 "parsing/parser.ml" +# 8826 "parsing/parser.ml" in -# 2135 "parsing/parser.mly" +# 2158 "parsing/parser.mly" ( Pexp_while(_3, _5), _2 ) -# 8814 "parsing/parser.ml" +# 8832 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -8818,10 +8836,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8825 "parsing/parser.ml" +# 8843 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8919,21 +8937,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8925 "parsing/parser.ml" +# 8943 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 8931 "parsing/parser.ml" +# 8949 "parsing/parser.ml" in -# 2138 "parsing/parser.mly" +# 2161 "parsing/parser.mly" ( Pexp_for(_3, _5, _7, _6, _9), _2 ) -# 8937 "parsing/parser.ml" +# 8955 "parsing/parser.ml" in let _endpos__1_ = _endpos__10_ in @@ -8941,10 +8959,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 8948 "parsing/parser.ml" +# 8966 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -8993,21 +9011,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 8999 "parsing/parser.ml" +# 9017 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 9005 "parsing/parser.ml" +# 9023 "parsing/parser.ml" in -# 2140 "parsing/parser.mly" +# 2163 "parsing/parser.mly" ( Pexp_assert _3, _2 ) -# 9011 "parsing/parser.ml" +# 9029 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -9015,10 +9033,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9022 "parsing/parser.ml" +# 9040 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9067,21 +9085,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 9073 "parsing/parser.ml" +# 9091 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 9079 "parsing/parser.ml" +# 9097 "parsing/parser.ml" in -# 2142 "parsing/parser.mly" +# 2165 "parsing/parser.mly" ( Pexp_lazy _3, _2 ) -# 9085 "parsing/parser.ml" +# 9103 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -9089,10 +9107,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9096 "parsing/parser.ml" +# 9114 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9157,27 +9175,27 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 9161 "parsing/parser.ml" +# 9179 "parsing/parser.ml" in -# 1751 "parsing/parser.mly" +# 1771 "parsing/parser.mly" ( _1 ) -# 9166 "parsing/parser.ml" +# 9184 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 764 "parsing/parser.mly" +# 786 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 9175 "parsing/parser.ml" +# 9193 "parsing/parser.ml" in -# 1738 "parsing/parser.mly" +# 1758 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 9181 "parsing/parser.ml" +# 9199 "parsing/parser.ml" in let _2 = @@ -9185,21 +9203,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 9191 "parsing/parser.ml" +# 9209 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 9197 "parsing/parser.ml" +# 9215 "parsing/parser.ml" in -# 2144 "parsing/parser.mly" +# 2167 "parsing/parser.mly" ( Pexp_object _3, _2 ) -# 9203 "parsing/parser.ml" +# 9221 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -9207,10 +9225,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9214 "parsing/parser.ml" +# 9232 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9275,27 +9293,27 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 9279 "parsing/parser.ml" +# 9297 "parsing/parser.ml" in -# 1751 "parsing/parser.mly" +# 1771 "parsing/parser.mly" ( _1 ) -# 9284 "parsing/parser.ml" +# 9302 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 764 "parsing/parser.mly" +# 786 "parsing/parser.mly" ( extra_cstr _startpos _endpos _1 ) -# 9293 "parsing/parser.ml" +# 9311 "parsing/parser.ml" in -# 1738 "parsing/parser.mly" +# 1758 "parsing/parser.mly" ( Cstr.mk _1 _2 ) -# 9299 "parsing/parser.ml" +# 9317 "parsing/parser.ml" in let _2 = @@ -9303,23 +9321,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 9309 "parsing/parser.ml" +# 9327 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 9315 "parsing/parser.ml" +# 9333 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2146 "parsing/parser.mly" +# 2169 "parsing/parser.mly" ( unclosed "object" _loc__1_ "end" _loc__4_ ) -# 9323 "parsing/parser.ml" +# 9341 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -9327,10 +9345,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2067 "parsing/parser.mly" +# 2087 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 9334 "parsing/parser.ml" +# 9352 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9365,18 +9383,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 9369 "parsing/parser.ml" +# 9387 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 9374 "parsing/parser.ml" +# 9392 "parsing/parser.ml" in -# 2150 "parsing/parser.mly" +# 2173 "parsing/parser.mly" ( Pexp_apply(_1, _2) ) -# 9380 "parsing/parser.ml" +# 9398 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -9384,15 +9402,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9390 "parsing/parser.ml" +# 9408 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9396 "parsing/parser.ml" +# 9414 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9421,24 +9439,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 9425 "parsing/parser.ml" +# 9443 "parsing/parser.ml" in -# 932 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 9430 "parsing/parser.ml" +# 9448 "parsing/parser.ml" in -# 2473 "parsing/parser.mly" +# 2496 "parsing/parser.mly" ( es ) -# 9436 "parsing/parser.ml" +# 9454 "parsing/parser.ml" in -# 2152 "parsing/parser.mly" +# 2175 "parsing/parser.mly" ( Pexp_tuple(_1) ) -# 9442 "parsing/parser.ml" +# 9460 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -9446,15 +9464,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9452 "parsing/parser.ml" +# 9470 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9458 "parsing/parser.ml" +# 9476 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9490,15 +9508,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 9496 "parsing/parser.ml" +# 9514 "parsing/parser.ml" in -# 2154 "parsing/parser.mly" +# 2177 "parsing/parser.mly" ( Pexp_construct(_1, Some _2) ) -# 9502 "parsing/parser.ml" +# 9520 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -9506,15 +9524,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9512 "parsing/parser.ml" +# 9530 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9518 "parsing/parser.ml" +# 9536 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9545,24 +9563,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2156 "parsing/parser.mly" +# 2179 "parsing/parser.mly" ( Pexp_variant(_1, Some _2) ) -# 9551 "parsing/parser.ml" +# 9569 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9560 "parsing/parser.ml" +# 9578 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9566 "parsing/parser.ml" +# 9584 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9594,9 +9612,9 @@ module Tables = struct } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in let op : ( -# 596 "parsing/parser.mly" +# 618 "parsing/parser.mly" (string) -# 9600 "parsing/parser.ml" +# 9618 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9606,24 +9624,24 @@ module Tables = struct let _1 = let op = let _1 = -# 3367 "parsing/parser.mly" +# 3390 "parsing/parser.mly" ( op ) -# 9612 "parsing/parser.ml" +# 9630 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9621 "parsing/parser.ml" +# 9639 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9627 "parsing/parser.ml" +# 9645 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9631,15 +9649,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9637 "parsing/parser.ml" +# 9655 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9643 "parsing/parser.ml" +# 9661 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9671,9 +9689,9 @@ module Tables = struct } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in let op : ( -# 597 "parsing/parser.mly" +# 619 "parsing/parser.mly" (string) -# 9677 "parsing/parser.ml" +# 9695 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9683,24 +9701,24 @@ module Tables = struct let _1 = let op = let _1 = -# 3368 "parsing/parser.mly" +# 3391 "parsing/parser.mly" ( op ) -# 9689 "parsing/parser.ml" +# 9707 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9698 "parsing/parser.ml" +# 9716 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9704 "parsing/parser.ml" +# 9722 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9708,15 +9726,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9714 "parsing/parser.ml" +# 9732 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9720 "parsing/parser.ml" +# 9738 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9748,9 +9766,9 @@ module Tables = struct } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in let op : ( -# 598 "parsing/parser.mly" +# 620 "parsing/parser.mly" (string) -# 9754 "parsing/parser.ml" +# 9772 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9760,24 +9778,24 @@ module Tables = struct let _1 = let op = let _1 = -# 3369 "parsing/parser.mly" +# 3392 "parsing/parser.mly" ( op ) -# 9766 "parsing/parser.ml" +# 9784 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9775 "parsing/parser.ml" +# 9793 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9781 "parsing/parser.ml" +# 9799 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9785,15 +9803,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9791 "parsing/parser.ml" +# 9809 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9797 "parsing/parser.ml" +# 9815 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9825,9 +9843,9 @@ module Tables = struct } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in let op : ( -# 599 "parsing/parser.mly" +# 621 "parsing/parser.mly" (string) -# 9831 "parsing/parser.ml" +# 9849 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9837,24 +9855,24 @@ module Tables = struct let _1 = let op = let _1 = -# 3370 "parsing/parser.mly" +# 3393 "parsing/parser.mly" ( op ) -# 9843 "parsing/parser.ml" +# 9861 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9852 "parsing/parser.ml" +# 9870 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9858 "parsing/parser.ml" +# 9876 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9862,15 +9880,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9868 "parsing/parser.ml" +# 9886 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9874 "parsing/parser.ml" +# 9892 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9902,9 +9920,9 @@ module Tables = struct } = _menhir_stack in let e2 : (Parsetree.expression) = Obj.magic e2 in let op : ( -# 600 "parsing/parser.mly" +# 622 "parsing/parser.mly" (string) -# 9908 "parsing/parser.ml" +# 9926 "parsing/parser.ml" ) = Obj.magic op in let e1 : (Parsetree.expression) = Obj.magic e1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -9914,24 +9932,24 @@ module Tables = struct let _1 = let op = let _1 = -# 3371 "parsing/parser.mly" +# 3394 "parsing/parser.mly" ( op ) -# 9920 "parsing/parser.ml" +# 9938 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 9929 "parsing/parser.ml" +# 9947 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 9935 "parsing/parser.ml" +# 9953 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -9939,15 +9957,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 9945 "parsing/parser.ml" +# 9963 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 9951 "parsing/parser.ml" +# 9969 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -9987,23 +10005,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3372 "parsing/parser.mly" +# 3395 "parsing/parser.mly" ("+") -# 9993 "parsing/parser.ml" +# 10011 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10001 "parsing/parser.ml" +# 10019 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10007 "parsing/parser.ml" +# 10025 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10011,15 +10029,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10017 "parsing/parser.ml" +# 10035 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10023 "parsing/parser.ml" +# 10041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10059,23 +10077,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3373 "parsing/parser.mly" +# 3396 "parsing/parser.mly" ("+.") -# 10065 "parsing/parser.ml" +# 10083 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10073 "parsing/parser.ml" +# 10091 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10079 "parsing/parser.ml" +# 10097 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10083,15 +10101,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10089 "parsing/parser.ml" +# 10107 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10095 "parsing/parser.ml" +# 10113 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10131,23 +10149,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3374 "parsing/parser.mly" +# 3397 "parsing/parser.mly" ("+=") -# 10137 "parsing/parser.ml" +# 10155 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10145 "parsing/parser.ml" +# 10163 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10151 "parsing/parser.ml" +# 10169 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10155,15 +10173,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10161 "parsing/parser.ml" +# 10179 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10167 "parsing/parser.ml" +# 10185 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10203,23 +10221,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3375 "parsing/parser.mly" +# 3398 "parsing/parser.mly" ("-") -# 10209 "parsing/parser.ml" +# 10227 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10217 "parsing/parser.ml" +# 10235 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10223 "parsing/parser.ml" +# 10241 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10227,15 +10245,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10233 "parsing/parser.ml" +# 10251 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10239 "parsing/parser.ml" +# 10257 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10275,23 +10293,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3376 "parsing/parser.mly" +# 3399 "parsing/parser.mly" ("-.") -# 10281 "parsing/parser.ml" +# 10299 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10289 "parsing/parser.ml" +# 10307 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10295 "parsing/parser.ml" +# 10313 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10299,15 +10317,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10305 "parsing/parser.ml" +# 10323 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10311 "parsing/parser.ml" +# 10329 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10347,23 +10365,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3377 "parsing/parser.mly" +# 3400 "parsing/parser.mly" ("*") -# 10353 "parsing/parser.ml" +# 10371 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10361 "parsing/parser.ml" +# 10379 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10367 "parsing/parser.ml" +# 10385 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10371,15 +10389,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10377 "parsing/parser.ml" +# 10395 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10383 "parsing/parser.ml" +# 10401 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10419,23 +10437,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3378 "parsing/parser.mly" +# 3401 "parsing/parser.mly" ("%") -# 10425 "parsing/parser.ml" +# 10443 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10433 "parsing/parser.ml" +# 10451 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10439 "parsing/parser.ml" +# 10457 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10443,15 +10461,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10449 "parsing/parser.ml" +# 10467 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10455 "parsing/parser.ml" +# 10473 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10491,23 +10509,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3379 "parsing/parser.mly" +# 3402 "parsing/parser.mly" ("=") -# 10497 "parsing/parser.ml" +# 10515 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10505 "parsing/parser.ml" +# 10523 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10511 "parsing/parser.ml" +# 10529 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10515,15 +10533,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10521 "parsing/parser.ml" +# 10539 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10527 "parsing/parser.ml" +# 10545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10563,23 +10581,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3380 "parsing/parser.mly" +# 3403 "parsing/parser.mly" ("<") -# 10569 "parsing/parser.ml" +# 10587 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10577 "parsing/parser.ml" +# 10595 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10583 "parsing/parser.ml" +# 10601 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10587,15 +10605,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10593 "parsing/parser.ml" +# 10611 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10599 "parsing/parser.ml" +# 10617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10635,23 +10653,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3381 "parsing/parser.mly" +# 3404 "parsing/parser.mly" (">") -# 10641 "parsing/parser.ml" +# 10659 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10649 "parsing/parser.ml" +# 10667 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10655 "parsing/parser.ml" +# 10673 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10659,15 +10677,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10665 "parsing/parser.ml" +# 10683 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10671 "parsing/parser.ml" +# 10689 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10707,23 +10725,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3382 "parsing/parser.mly" +# 3405 "parsing/parser.mly" ("or") -# 10713 "parsing/parser.ml" +# 10731 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10721 "parsing/parser.ml" +# 10739 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10727 "parsing/parser.ml" +# 10745 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10731,15 +10749,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10737 "parsing/parser.ml" +# 10755 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10743 "parsing/parser.ml" +# 10761 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10779,23 +10797,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3383 "parsing/parser.mly" +# 3406 "parsing/parser.mly" ("||") -# 10785 "parsing/parser.ml" +# 10803 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10793 "parsing/parser.ml" +# 10811 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10799 "parsing/parser.ml" +# 10817 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10803,15 +10821,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10809 "parsing/parser.ml" +# 10827 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10815 "parsing/parser.ml" +# 10833 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10851,23 +10869,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3384 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ("&") -# 10857 "parsing/parser.ml" +# 10875 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10865 "parsing/parser.ml" +# 10883 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10871 "parsing/parser.ml" +# 10889 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10875,15 +10893,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10881 "parsing/parser.ml" +# 10899 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10887 "parsing/parser.ml" +# 10905 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10923,23 +10941,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3385 "parsing/parser.mly" +# 3408 "parsing/parser.mly" ("&&") -# 10929 "parsing/parser.ml" +# 10947 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 10937 "parsing/parser.ml" +# 10955 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 10943 "parsing/parser.ml" +# 10961 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -10947,15 +10965,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 10953 "parsing/parser.ml" +# 10971 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 10959 "parsing/parser.ml" +# 10977 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -10995,23 +11013,23 @@ module Tables = struct let _1 = let op = let _1 = -# 3386 "parsing/parser.mly" +# 3409 "parsing/parser.mly" (":=") -# 11001 "parsing/parser.ml" +# 11019 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 11009 "parsing/parser.ml" +# 11027 "parsing/parser.ml" in -# 2158 "parsing/parser.mly" +# 2181 "parsing/parser.mly" ( mkinfix e1 op e2 ) -# 11015 "parsing/parser.ml" +# 11033 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in @@ -11019,15 +11037,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11025 "parsing/parser.ml" +# 11043 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 11031 "parsing/parser.ml" +# 11049 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11060,9 +11078,9 @@ module Tables = struct let _1 = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2160 "parsing/parser.mly" +# 2183 "parsing/parser.mly" ( mkuminus ~oploc:_loc__1_ _1 _2 ) -# 11066 "parsing/parser.ml" +# 11084 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -11070,15 +11088,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11076 "parsing/parser.ml" +# 11094 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 11082 "parsing/parser.ml" +# 11100 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11111,9 +11129,9 @@ module Tables = struct let _1 = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2162 "parsing/parser.mly" +# 2185 "parsing/parser.mly" ( mkuplus ~oploc:_loc__1_ _1 _2 ) -# 11117 "parsing/parser.ml" +# 11135 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -11121,15 +11139,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 11127 "parsing/parser.ml" +# 11145 "parsing/parser.ml" in -# 2070 "parsing/parser.mly" +# 2090 "parsing/parser.mly" ( _1 ) -# 11133 "parsing/parser.ml" +# 11151 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11169,9 +11187,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2072 "parsing/parser.mly" +# 2092 "parsing/parser.mly" ( expr_of_let_bindings ~loc:_sloc _1 _3 ) -# 11175 "parsing/parser.ml" +# 11193 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11211,9 +11229,9 @@ module Tables = struct let _3 : unit = Obj.magic _3 in let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in let _1 : ( -# 602 "parsing/parser.mly" +# 624 "parsing/parser.mly" (string) -# 11217 "parsing/parser.ml" +# 11235 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -11223,9 +11241,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11229 "parsing/parser.ml" +# 11247 "parsing/parser.ml" in let _startpos_pbop_op_ = _startpos__1_ in @@ -11233,13 +11251,13 @@ module Tables = struct let _symbolstartpos = _startpos_pbop_op_ in let _sloc = (_symbolstartpos, _endpos) in -# 2074 "parsing/parser.mly" +# 2094 "parsing/parser.mly" ( let (pbop_pat, pbop_exp, rev_ands) = bindings in let ands = List.rev rev_ands in let pbop_loc = make_loc _sloc in let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in mkexp ~loc:_sloc (Pexp_letop{ let_; ands; body}) ) -# 11243 "parsing/parser.ml" +# 11261 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11280,9 +11298,9 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2080 "parsing/parser.mly" +# 2100 "parsing/parser.mly" ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) ) -# 11286 "parsing/parser.ml" +# 11304 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11315,35 +11333,35 @@ module Tables = struct let _3 : (Parsetree.expression) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 11321 "parsing/parser.ml" +# 11339 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 11330 "parsing/parser.ml" +# 11348 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11338 "parsing/parser.ml" +# 11356 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2082 "parsing/parser.mly" +# 2102 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) ) -# 11347 "parsing/parser.ml" +# 11365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11399,18 +11417,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 11405 "parsing/parser.ml" +# 11423 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2084 "parsing/parser.mly" +# 2104 "parsing/parser.mly" ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) ) -# 11414 "parsing/parser.ml" +# 11432 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11478,9 +11496,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2086 "parsing/parser.mly" +# 2106 "parsing/parser.mly" ( array_set ~loc:_sloc _1 _4 _7 ) -# 11484 "parsing/parser.ml" +# 11502 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11548,9 +11566,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2088 "parsing/parser.mly" +# 2108 "parsing/parser.mly" ( string_set ~loc:_sloc _1 _4 _7 ) -# 11554 "parsing/parser.ml" +# 11572 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11618,9 +11636,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2090 "parsing/parser.mly" +# 2110 "parsing/parser.mly" ( bigarray_set ~loc:_sloc _1 _4 _7 ) -# 11624 "parsing/parser.ml" +# 11642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11648,9 +11666,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -11677,24 +11695,29 @@ module Tables = struct let _7 : (Parsetree.expression) = Obj.magic _7 in let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 11686 "parsing/parser.ml" +# 11704 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 11713 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2092 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "[]<-")) _1 _4 _7 ) -# 11698 "parsing/parser.ml" +# 2112 "parsing/parser.mly" + ( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 ) +# 11721 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11722,9 +11745,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -11751,24 +11774,29 @@ module Tables = struct let _7 : (Parsetree.expression) = Obj.magic _7 in let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 11760 "parsing/parser.ml" +# 11783 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 11792 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2094 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "()<-")) _1 _4 _7 ) -# 11772 "parsing/parser.ml" +# 2114 "parsing/parser.mly" + ( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 ) +# 11800 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11796,9 +11824,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -11825,24 +11853,29 @@ module Tables = struct let _7 : (Parsetree.expression) = Obj.magic _7 in let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 11834 "parsing/parser.ml" +# 11862 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 11871 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2096 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Lident ("." ^ _2 ^ "{}<-")) _1 _4 _7 ) -# 11846 "parsing/parser.ml" +# 2116 "parsing/parser.mly" + ( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 ) +# 11879 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11870,9 +11903,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -11911,12 +11944,12 @@ module Tables = struct let _9 : (Parsetree.expression) = Obj.magic _9 in let _8 : unit = Obj.magic _8 in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 11920 "parsing/parser.ml" +# 11953 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -11924,13 +11957,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__9_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 11964 "parsing/parser.ml" + in + let _endpos = _endpos__9_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2098 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Ldot(_3,"." ^ _4 ^ "[]<-")) _1 _6 _9 ) -# 11934 "parsing/parser.ml" +# 2119 "parsing/parser.mly" + ( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 ) +# 11972 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -11958,9 +11996,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -11999,12 +12037,12 @@ module Tables = struct let _9 : (Parsetree.expression) = Obj.magic _9 in let _8 : unit = Obj.magic _8 in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 12008 "parsing/parser.ml" +# 12046 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -12012,13 +12050,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__9_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 12057 "parsing/parser.ml" + in + let _endpos = _endpos__9_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2100 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "()<-")) _1 _6 _9 ) -# 12022 "parsing/parser.ml" +# 2122 "parsing/parser.mly" + ( dotop_set ~loc:_sloc (ldot _3) paren _4 _1 _6 _9 ) +# 12065 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12046,9 +12089,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -12087,12 +12130,12 @@ module Tables = struct let _9 : (Parsetree.expression) = Obj.magic _9 in let _8 : unit = Obj.magic _8 in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 12096 "parsing/parser.ml" +# 12139 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -12100,13 +12143,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__9_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__9_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 12150 "parsing/parser.ml" + in + let _endpos = _endpos__9_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2102 "parsing/parser.mly" - ( dotop_set ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "{}<-")) _1 _6 _9 ) -# 12110 "parsing/parser.ml" +# 2125 "parsing/parser.mly" + ( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 ) +# 12158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12136,9 +12184,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2104 "parsing/parser.mly" +# 2127 "parsing/parser.mly" ( Exp.attr _1 _2 ) -# 12142 "parsing/parser.ml" +# 12190 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12162,9 +12210,9 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2106 "parsing/parser.mly" +# 2129 "parsing/parser.mly" ( not_expecting _loc__1_ "wildcard \"_\"" ) -# 12168 "parsing/parser.ml" +# 12216 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12180,9 +12228,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (string Asttypes.loc option) = -# 3645 "parsing/parser.mly" +# 3672 "parsing/parser.mly" ( None ) -# 12186 "parsing/parser.ml" +# 12234 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12212,9 +12260,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (string Asttypes.loc option) = -# 3646 "parsing/parser.mly" +# 3673 "parsing/parser.mly" ( Some _2 ) -# 12218 "parsing/parser.ml" +# 12266 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12258,9 +12306,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.extension) = -# 3656 "parsing/parser.mly" +# 3683 "parsing/parser.mly" ( (_2, _3) ) -# 12264 "parsing/parser.ml" +# 12312 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12313,9 +12361,9 @@ module Tables = struct let _v : (Parsetree.extension_constructor) = let attrs = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 12319 "parsing/parser.ml" +# 12367 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined3_ in @@ -12325,9 +12373,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12331 "parsing/parser.ml" +# 12379 "parsing/parser.ml" in let cid = @@ -12336,19 +12384,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12342 "parsing/parser.ml" +# 12390 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3030 "parsing/parser.mly" +# 3053 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 12352 "parsing/parser.ml" +# 12400 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12394,9 +12442,9 @@ module Tables = struct let _v : (Parsetree.extension_constructor) = let attrs = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 12400 "parsing/parser.ml" +# 12448 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -12406,9 +12454,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12412 "parsing/parser.ml" +# 12460 "parsing/parser.ml" in let cid = @@ -12416,25 +12464,25 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 12422 "parsing/parser.ml" +# 12470 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = -# 3465 "parsing/parser.mly" +# 3492 "parsing/parser.mly" ( () ) -# 12429 "parsing/parser.ml" +# 12477 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in let _sloc = (_symbolstartpos, _endpos) in -# 3030 "parsing/parser.mly" +# 3053 "parsing/parser.mly" ( let info = symbol_info _endpos in Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info ) -# 12438 "parsing/parser.ml" +# 12486 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12481,10 +12529,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3633 "parsing/parser.mly" +# 3660 "parsing/parser.mly" ( mark_symbol_docs _sloc; Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 12488 "parsing/parser.ml" +# 12536 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12500,14 +12548,14 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * Asttypes.variance) list) = let params = -# 1858 "parsing/parser.mly" +# 1878 "parsing/parser.mly" ( [] ) -# 12506 "parsing/parser.ml" +# 12554 "parsing/parser.ml" in -# 1683 "parsing/parser.mly" +# 1703 "parsing/parser.mly" ( params ) -# 12511 "parsing/parser.ml" +# 12559 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12548,24 +12596,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 12552 "parsing/parser.ml" +# 12600 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 12557 "parsing/parser.ml" +# 12605 "parsing/parser.ml" in -# 1860 "parsing/parser.mly" +# 1880 "parsing/parser.mly" ( params ) -# 12563 "parsing/parser.ml" +# 12611 "parsing/parser.ml" in -# 1683 "parsing/parser.mly" +# 1703 "parsing/parser.mly" ( params ) -# 12569 "parsing/parser.ml" +# 12617 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12588,9 +12636,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2432 "parsing/parser.mly" +# 2455 "parsing/parser.mly" ( _1 ) -# 12594 "parsing/parser.ml" +# 12642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12630,9 +12678,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2434 "parsing/parser.mly" +# 2457 "parsing/parser.mly" ( mkexp_constraint ~loc:_sloc _3 _1 ) -# 12636 "parsing/parser.ml" +# 12684 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12662,9 +12710,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2458 "parsing/parser.mly" +# 2481 "parsing/parser.mly" ( _2 ) -# 12668 "parsing/parser.ml" +# 12716 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12709,24 +12757,24 @@ module Tables = struct let _endpos = _endpos__4_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2460 "parsing/parser.mly" +# 2483 "parsing/parser.mly" ( Pexp_constraint (_4, _2) ) -# 12715 "parsing/parser.ml" +# 12763 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 12724 "parsing/parser.ml" +# 12772 "parsing/parser.ml" in -# 2461 "parsing/parser.mly" +# 2484 "parsing/parser.mly" ( _1 ) -# 12730 "parsing/parser.ml" +# 12778 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12759,12 +12807,12 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2464 "parsing/parser.mly" +# 2487 "parsing/parser.mly" ( let (l,o,p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) ) -# 12768 "parsing/parser.ml" +# 12816 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12815,17 +12863,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.expression) = let _3 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 12821 "parsing/parser.ml" +# 12869 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2469 "parsing/parser.mly" +# 2492 "parsing/parser.mly" ( mk_newtypes ~loc:_sloc _3 _5 ) -# 12829 "parsing/parser.ml" +# 12877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12848,9 +12896,9 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.core_type) = -# 3142 "parsing/parser.mly" +# 3165 "parsing/parser.mly" ( ty ) -# 12854 "parsing/parser.ml" +# 12902 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12896,19 +12944,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 768 "parsing/parser.mly" +# 790 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 12902 "parsing/parser.ml" +# 12950 "parsing/parser.ml" in let label = -# 3154 "parsing/parser.mly" +# 3177 "parsing/parser.mly" ( Optional label ) -# 12907 "parsing/parser.ml" +# 12955 "parsing/parser.ml" in -# 3148 "parsing/parser.mly" +# 3171 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 12912 "parsing/parser.ml" +# 12960 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -12916,15 +12964,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 12922 "parsing/parser.ml" +# 12970 "parsing/parser.ml" in -# 3150 "parsing/parser.mly" +# 3173 "parsing/parser.mly" ( _1 ) -# 12928 "parsing/parser.ml" +# 12976 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -12971,9 +13019,9 @@ module Tables = struct let _1 : (Parsetree.core_type) = Obj.magic _1 in let _2 : unit = Obj.magic _2 in let label : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 12977 "parsing/parser.ml" +# 13025 "parsing/parser.ml" ) = Obj.magic label in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_label_ in @@ -12981,19 +13029,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 768 "parsing/parser.mly" +# 790 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 12987 "parsing/parser.ml" +# 13035 "parsing/parser.ml" in let label = -# 3156 "parsing/parser.mly" +# 3179 "parsing/parser.mly" ( Labelled label ) -# 12992 "parsing/parser.ml" +# 13040 "parsing/parser.ml" in -# 3148 "parsing/parser.mly" +# 3171 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 12997 "parsing/parser.ml" +# 13045 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in @@ -13001,15 +13049,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 13007 "parsing/parser.ml" +# 13055 "parsing/parser.ml" in -# 3150 "parsing/parser.mly" +# 3173 "parsing/parser.mly" ( _1 ) -# 13013 "parsing/parser.ml" +# 13061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13048,19 +13096,19 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let domain = -# 768 "parsing/parser.mly" +# 790 "parsing/parser.mly" ( extra_rhs_core_type _1 ~pos:_endpos__1_ ) -# 13054 "parsing/parser.ml" +# 13102 "parsing/parser.ml" in let label = -# 3158 "parsing/parser.mly" +# 3181 "parsing/parser.mly" ( Nolabel ) -# 13059 "parsing/parser.ml" +# 13107 "parsing/parser.ml" in -# 3148 "parsing/parser.mly" +# 3171 "parsing/parser.mly" ( Ptyp_arrow(label, domain, codomain) ) -# 13064 "parsing/parser.ml" +# 13112 "parsing/parser.ml" in let _endpos__1_ = _endpos_codomain_ in @@ -13068,15 +13116,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 13074 "parsing/parser.ml" +# 13122 "parsing/parser.ml" in -# 3150 "parsing/parser.mly" +# 3173 "parsing/parser.mly" ( _1 ) -# 13080 "parsing/parser.ml" +# 13128 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13105,26 +13153,10 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in - let _v : (string Asttypes.loc * Parsetree.module_type option) = let x = - let _1 = -# 1113 "parsing/parser.mly" - ("*") -# 13113 "parsing/parser.ml" - in - let _endpos__1_ = _endpos__2_ in - let _endpos = _endpos__1_ in - let _symbolstartpos = _startpos__1_ in - let _sloc = (_symbolstartpos, _endpos) in - -# 770 "parsing/parser.mly" - ( mkrhs _1 _sloc ) -# 13122 "parsing/parser.ml" - - in - -# 1114 "parsing/parser.mly" - ( x, None ) -# 13128 "parsing/parser.ml" + let _v : (Parsetree.functor_parameter) = +# 1136 "parsing/parser.mly" + ( Unit ) +# 13160 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13169,80 +13201,26 @@ module Tables = struct let _5 : unit = Obj.magic _5 in let mty : (Parsetree.module_type) = Obj.magic mty in let _3 : unit = Obj.magic _3 in - let _1_inlined1 : (string) = Obj.magic _1_inlined1 in + let _1_inlined1 : (string option) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (string Asttypes.loc * Parsetree.module_type option) = let x = + let _v : (Parsetree.functor_parameter) = let x = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13186 "parsing/parser.ml" +# 13218 "parsing/parser.ml" in -# 1117 "parsing/parser.mly" - ( x, Some mty ) -# 13192 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - MenhirLib.EngineTypes.next = _menhir_stack; - }); - (fun _menhir_env -> - let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in - let { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = x; - MenhirLib.EngineTypes.startp = _startpos_x_; - MenhirLib.EngineTypes.endp = _endpos_x_; - MenhirLib.EngineTypes.next = _menhir_stack; - } = _menhir_stack in - let x : ( -# 666 "parsing/parser.mly" - (string) -# 13213 "parsing/parser.ml" - ) = Obj.magic x in - let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos_x_ in - let _endpos = _endpos_x_ in - let _v : (string) = -# 1123 "parsing/parser.mly" - ( x ) -# 13221 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - MenhirLib.EngineTypes.next = _menhir_stack; - }); - (fun _menhir_env -> - let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in - let { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = _1; - MenhirLib.EngineTypes.startp = _startpos__1_; - MenhirLib.EngineTypes.endp = _endpos__1_; - MenhirLib.EngineTypes.next = _menhir_stack; - } = _menhir_stack in - let _1 : unit = Obj.magic _1 in - let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos__1_ in - let _endpos = _endpos__1_ in - let _v : (string) = -# 1126 "parsing/parser.mly" - ( "_" ) -# 13246 "parsing/parser.ml" +# 1139 "parsing/parser.mly" + ( Named (x, mty) ) +# 13224 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13258,9 +13236,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 2950 "parsing/parser.mly" +# 2973 "parsing/parser.mly" ( (Pcstr_tuple [],None) ) -# 13264 "parsing/parser.ml" +# 13242 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13290,9 +13268,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 2951 "parsing/parser.mly" +# 2974 "parsing/parser.mly" ( (_2,None) ) -# 13296 "parsing/parser.ml" +# 13274 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13336,9 +13314,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 2953 "parsing/parser.mly" +# 2976 "parsing/parser.mly" ( (_2,Some _4) ) -# 13342 "parsing/parser.ml" +# 13320 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13368,9 +13346,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) = -# 2955 "parsing/parser.mly" +# 2978 "parsing/parser.mly" ( (Pcstr_tuple [],Some _2) ) -# 13374 "parsing/parser.ml" +# 13352 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13418,9 +13396,9 @@ module Tables = struct Docstrings.info) = let attrs = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 13424 "parsing/parser.ml" +# 13402 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined2_ in @@ -13430,23 +13408,23 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13436 "parsing/parser.ml" +# 13414 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2898 "parsing/parser.mly" +# 2921 "parsing/parser.mly" ( let args, res = args_res in let info = symbol_info _endpos in let loc = make_loc _sloc in cid, args, res, attrs, loc, info ) -# 13450 "parsing/parser.ml" +# 13428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13487,9 +13465,9 @@ module Tables = struct Docstrings.info) = let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 13493 "parsing/parser.ml" +# 13471 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined1_ in @@ -13498,29 +13476,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13504 "parsing/parser.ml" +# 13482 "parsing/parser.ml" in let _startpos_cid_ = _startpos__1_ in let _1 = -# 3465 "parsing/parser.mly" +# 3492 "parsing/parser.mly" ( () ) -# 13511 "parsing/parser.ml" +# 13489 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos_cid_ in let _sloc = (_symbolstartpos, _endpos) in -# 2898 "parsing/parser.mly" +# 2921 "parsing/parser.mly" ( let args, res = args_res in let info = symbol_info _endpos in let loc = make_loc _sloc in cid, args, res, attrs, loc, info ) -# 13524 "parsing/parser.ml" +# 13502 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13591,9 +13569,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined3 : unit = Obj.magic _1_inlined3 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 13597 "parsing/parser.ml" +# 13575 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -13606,9 +13584,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 13612 "parsing/parser.ml" +# 13590 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -13617,26 +13595,26 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 13621 "parsing/parser.ml" +# 13599 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 13626 "parsing/parser.ml" +# 13604 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 13632 "parsing/parser.ml" +# 13610 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined3 in -# 2849 "parsing/parser.mly" +# 2872 "parsing/parser.mly" ( _2 ) -# 13640 "parsing/parser.ml" +# 13618 "parsing/parser.ml" in let id = @@ -13645,29 +13623,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13651 "parsing/parser.ml" +# 13629 "parsing/parser.ml" in let flag = -# 3485 "parsing/parser.mly" +# 3512 "parsing/parser.mly" ( Recursive ) -# 13657 "parsing/parser.ml" +# 13635 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 13664 "parsing/parser.ml" +# 13642 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2786 "parsing/parser.mly" +# 2809 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13676,7 +13654,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13680 "parsing/parser.ml" +# 13658 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13753,9 +13731,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined4 : unit = Obj.magic _1_inlined4 in let _1_inlined3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 13759 "parsing/parser.ml" +# 13737 "parsing/parser.ml" ) = Obj.magic _1_inlined3 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined2 : unit = Obj.magic _1_inlined2 in @@ -13769,9 +13747,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined5 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 13775 "parsing/parser.ml" +# 13753 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined5_ in @@ -13780,26 +13758,26 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 13784 "parsing/parser.ml" +# 13762 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 13789 "parsing/parser.ml" +# 13767 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 13795 "parsing/parser.ml" +# 13773 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined4 in -# 2849 "parsing/parser.mly" +# 2872 "parsing/parser.mly" ( _2 ) -# 13803 "parsing/parser.ml" +# 13781 "parsing/parser.ml" in let id = @@ -13808,9 +13786,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13814 "parsing/parser.ml" +# 13792 "parsing/parser.ml" in let flag = @@ -13819,24 +13797,24 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3486 "parsing/parser.mly" +# 3513 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 13825 "parsing/parser.ml" +# 13803 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 13833 "parsing/parser.ml" +# 13811 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2786 "parsing/parser.mly" +# 2809 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13845,7 +13823,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13849 "parsing/parser.ml" +# 13827 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -13909,9 +13887,9 @@ module Tables = struct let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 13915 "parsing/parser.ml" +# 13893 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -13924,9 +13902,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 13930 "parsing/parser.ml" +# 13908 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -13935,18 +13913,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 13939 "parsing/parser.ml" +# 13917 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 13944 "parsing/parser.ml" +# 13922 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 13950 "parsing/parser.ml" +# 13928 "parsing/parser.ml" in let id = @@ -13955,29 +13933,29 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 13961 "parsing/parser.ml" +# 13939 "parsing/parser.ml" in let flag = -# 3481 "parsing/parser.mly" +# 3508 "parsing/parser.mly" ( Recursive ) -# 13967 "parsing/parser.ml" +# 13945 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 13974 "parsing/parser.ml" +# 13952 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2786 "parsing/parser.mly" +# 2809 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -13986,7 +13964,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 13990 "parsing/parser.ml" +# 13968 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14056,9 +14034,9 @@ module Tables = struct let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14062 "parsing/parser.ml" +# 14040 "parsing/parser.ml" ) = Obj.magic _1_inlined3 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined2 : unit = Obj.magic _1_inlined2 in @@ -14072,9 +14050,9 @@ module Tables = struct Parsetree.type_declaration) = let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 14078 "parsing/parser.ml" +# 14056 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -14083,18 +14061,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 14087 "parsing/parser.ml" +# 14065 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 14092 "parsing/parser.ml" +# 14070 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 14098 "parsing/parser.ml" +# 14076 "parsing/parser.ml" in let id = @@ -14103,32 +14081,32 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14109 "parsing/parser.ml" +# 14087 "parsing/parser.ml" in let flag = let _1 = _1_inlined2 in -# 3482 "parsing/parser.mly" +# 3509 "parsing/parser.mly" ( Nonrecursive ) -# 14117 "parsing/parser.ml" +# 14095 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 14125 "parsing/parser.ml" +# 14103 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2786 "parsing/parser.mly" +# 2809 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -14137,7 +14115,7 @@ module Tables = struct (flag, ext), Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ) -# 14141 "parsing/parser.ml" +# 14119 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14156,17 +14134,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 14162 "parsing/parser.ml" +# 14140 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.label) = -# 3342 "parsing/parser.mly" +# 3365 "parsing/parser.mly" ( _1 ) -# 14170 "parsing/parser.ml" +# 14148 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14185,17 +14163,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14191 "parsing/parser.ml" +# 14169 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.label) = -# 3343 "parsing/parser.mly" +# 3366 "parsing/parser.mly" ( _1 ) -# 14199 "parsing/parser.ml" +# 14177 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14225,13 +14203,63 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 746 "parsing/parser.mly" +# 768 "parsing/parser.mly" (Parsetree.structure) -# 14231 "parsing/parser.ml" +# 14209 "parsing/parser.ml" ) = -# 1025 "parsing/parser.mly" +# 1047 "parsing/parser.mly" ( _1 ) -# 14235 "parsing/parser.ml" +# 14213 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + MenhirLib.EngineTypes.next = _menhir_stack; + }); + (fun _menhir_env -> + let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in + let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in + let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in + let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in + let _endpos = _startpos in + let _v : (string) = +# 3412 "parsing/parser.mly" + ( "" ) +# 14231 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + MenhirLib.EngineTypes.next = _menhir_stack; + }); + (fun _menhir_env -> + let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in + let { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _2; + MenhirLib.EngineTypes.startp = _startpos__2_; + MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; + MenhirLib.EngineTypes.next = _menhir_stack; + }; + } = _menhir_stack in + let _2 : unit = Obj.magic _2 in + let _1 : unit = Obj.magic _1 in + let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in + let _startpos = _startpos__1_ in + let _endpos = _endpos__2_ in + let _v : (string) = +# 3413 "parsing/parser.mly" + ( ";.." ) +# 14263 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14261,13 +14289,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 748 "parsing/parser.mly" +# 770 "parsing/parser.mly" (Parsetree.signature) -# 14267 "parsing/parser.ml" +# 14295 "parsing/parser.ml" ) = -# 1031 "parsing/parser.mly" +# 1053 "parsing/parser.mly" ( _1 ) -# 14271 "parsing/parser.ml" +# 14299 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14311,9 +14339,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.extension) = -# 3659 "parsing/parser.mly" +# 3686 "parsing/parser.mly" ( (_2, _3) ) -# 14317 "parsing/parser.ml" +# 14345 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14359,9 +14387,9 @@ module Tables = struct let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in let _3 : unit = Obj.magic _3 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14365 "parsing/parser.ml" +# 14393 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -14370,34 +14398,34 @@ module Tables = struct let _v : (Parsetree.label_declaration) = let _5 = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 14376 "parsing/parser.ml" +# 14404 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3095 "parsing/parser.mly" +# 3118 "parsing/parser.mly" ( _1 ) -# 14385 "parsing/parser.ml" +# 14413 "parsing/parser.ml" in let _2 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 14393 "parsing/parser.ml" +# 14421 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14401 "parsing/parser.ml" +# 14429 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -14408,10 +14436,10 @@ module Tables = struct _startpos__2_ in let _sloc = (_symbolstartpos, _endpos) in -# 2972 "parsing/parser.mly" +# 2995 "parsing/parser.mly" ( let info = symbol_info _endpos in Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info ) -# 14415 "parsing/parser.ml" +# 14443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14471,9 +14499,9 @@ module Tables = struct let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in let _3 : unit = Obj.magic _3 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14477 "parsing/parser.ml" +# 14505 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -14482,43 +14510,43 @@ module Tables = struct let _v : (Parsetree.label_declaration) = let _7 = let _1 = _1_inlined4 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 14488 "parsing/parser.ml" +# 14516 "parsing/parser.ml" in let _endpos__7_ = _endpos__1_inlined4_ in let _5 = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 14497 "parsing/parser.ml" +# 14525 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3095 "parsing/parser.mly" +# 3118 "parsing/parser.mly" ( _1 ) -# 14506 "parsing/parser.ml" +# 14534 "parsing/parser.ml" in let _2 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 14514 "parsing/parser.ml" +# 14542 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14522 "parsing/parser.ml" +# 14550 "parsing/parser.ml" in let _startpos__2_ = _startpos__1_inlined1_ in @@ -14529,14 +14557,14 @@ module Tables = struct _startpos__2_ in let _sloc = (_symbolstartpos, _endpos) in -# 2977 "parsing/parser.mly" +# 3000 "parsing/parser.mly" ( let info = match rhs_info _endpos__5_ with | Some _ as info_before_semi -> info_before_semi | None -> symbol_info _endpos in Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info ) -# 14540 "parsing/parser.ml" +# 14568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14559,9 +14587,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.label_declaration list) = -# 2966 "parsing/parser.mly" +# 2989 "parsing/parser.mly" ( [_1] ) -# 14565 "parsing/parser.ml" +# 14593 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14584,9 +14612,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.label_declaration list) = -# 2967 "parsing/parser.mly" +# 2990 "parsing/parser.mly" ( [_1] ) -# 14590 "parsing/parser.ml" +# 14618 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14616,9 +14644,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.label_declaration list) = -# 2968 "parsing/parser.mly" +# 2991 "parsing/parser.mly" ( _1 :: _2 ) -# 14622 "parsing/parser.ml" +# 14650 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14637,9 +14665,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14643 "parsing/parser.ml" +# 14671 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -14650,24 +14678,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14656 "parsing/parser.ml" +# 14684 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2053 "parsing/parser.mly" +# 2073 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 14665 "parsing/parser.ml" +# 14693 "parsing/parser.ml" in -# 2045 "parsing/parser.mly" +# 2065 "parsing/parser.mly" ( x ) -# 14671 "parsing/parser.ml" +# 14699 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14700,9 +14728,9 @@ module Tables = struct let cty : (Parsetree.core_type) = Obj.magic cty in let _2 : unit = Obj.magic _2 in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14706 "parsing/parser.ml" +# 14734 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -14713,18 +14741,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 14719 "parsing/parser.ml" +# 14747 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2053 "parsing/parser.mly" +# 2073 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 14728 "parsing/parser.ml" +# 14756 "parsing/parser.ml" in let _startpos_x_ = _startpos__1_ in @@ -14732,11 +14760,11 @@ module Tables = struct let _symbolstartpos = _startpos_x_ in let _sloc = (_symbolstartpos, _endpos) in -# 2047 "parsing/parser.mly" +# 2067 "parsing/parser.mly" ( let lab, pat = x in lab, mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) ) -# 14740 "parsing/parser.ml" +# 14768 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14755,17 +14783,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14761 "parsing/parser.ml" +# 14789 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3411 "parsing/parser.mly" +# 3438 "parsing/parser.mly" ( Lident _1 ) -# 14769 "parsing/parser.ml" +# 14797 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14796,9 +14824,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14802 "parsing/parser.ml" +# 14830 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -14806,9 +14834,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3412 "parsing/parser.mly" +# 3439 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 14812 "parsing/parser.ml" +# 14840 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14831,9 +14859,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.arg_label * Parsetree.expression) = -# 2327 "parsing/parser.mly" +# 2350 "parsing/parser.mly" ( (Nolabel, _1) ) -# 14837 "parsing/parser.ml" +# 14865 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14859,17 +14887,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 607 "parsing/parser.mly" +# 629 "parsing/parser.mly" (string) -# 14865 "parsing/parser.ml" +# 14893 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.arg_label * Parsetree.expression) = -# 2329 "parsing/parser.mly" +# 2352 "parsing/parser.mly" ( (Labelled _1, _2) ) -# 14873 "parsing/parser.ml" +# 14901 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14894,9 +14922,9 @@ module Tables = struct }; } = _menhir_stack in let label : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14900 "parsing/parser.ml" +# 14928 "parsing/parser.ml" ) = Obj.magic label in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -14904,10 +14932,10 @@ module Tables = struct let _endpos = _endpos_label_ in let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in -# 2331 "parsing/parser.mly" +# 2354 "parsing/parser.mly" ( let loc = _loc_label_ in (Labelled label, mkexpvar ~loc label) ) -# 14911 "parsing/parser.ml" +# 14939 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14932,9 +14960,9 @@ module Tables = struct }; } = _menhir_stack in let label : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 14938 "parsing/parser.ml" +# 14966 "parsing/parser.ml" ) = Obj.magic label in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -14942,10 +14970,10 @@ module Tables = struct let _endpos = _endpos_label_ in let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in -# 2334 "parsing/parser.mly" +# 2357 "parsing/parser.mly" ( let loc = _loc_label_ in (Optional label, mkexpvar ~loc label) ) -# 14949 "parsing/parser.ml" +# 14977 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -14971,17 +14999,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 637 "parsing/parser.mly" +# 659 "parsing/parser.mly" (string) -# 14977 "parsing/parser.ml" +# 15005 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.arg_label * Parsetree.expression) = -# 2337 "parsing/parser.mly" +# 2360 "parsing/parser.mly" ( (Optional _1, _2) ) -# 14985 "parsing/parser.ml" +# 15013 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15034,15 +15062,15 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 = let _1 = _1_inlined1 in -# 2041 "parsing/parser.mly" +# 2061 "parsing/parser.mly" ( _1 ) -# 15040 "parsing/parser.ml" +# 15068 "parsing/parser.ml" in -# 2015 "parsing/parser.mly" +# 2035 "parsing/parser.mly" ( (Optional (fst _3), _4, snd _3) ) -# 15046 "parsing/parser.ml" +# 15074 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15067,9 +15095,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 15073 "parsing/parser.ml" +# 15101 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -15082,24 +15110,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 15088 "parsing/parser.ml" +# 15116 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2053 "parsing/parser.mly" +# 2073 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 15097 "parsing/parser.ml" +# 15125 "parsing/parser.ml" in -# 2017 "parsing/parser.mly" +# 2037 "parsing/parser.mly" ( (Optional (fst _2), None, snd _2) ) -# 15103 "parsing/parser.ml" +# 15131 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15146,9 +15174,9 @@ module Tables = struct let _3 : (Parsetree.pattern) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 637 "parsing/parser.mly" +# 659 "parsing/parser.mly" (string) -# 15152 "parsing/parser.ml" +# 15180 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -15156,15 +15184,15 @@ module Tables = struct let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 = let _1 = _1_inlined1 in -# 2041 "parsing/parser.mly" +# 2061 "parsing/parser.mly" ( _1 ) -# 15162 "parsing/parser.ml" +# 15190 "parsing/parser.ml" in -# 2019 "parsing/parser.mly" +# 2039 "parsing/parser.mly" ( (Optional _1, _4, _3) ) -# 15168 "parsing/parser.ml" +# 15196 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15190,17 +15218,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.pattern) = Obj.magic _2 in let _1 : ( -# 637 "parsing/parser.mly" +# 659 "parsing/parser.mly" (string) -# 15196 "parsing/parser.ml" +# 15224 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2021 "parsing/parser.mly" +# 2041 "parsing/parser.mly" ( (Optional _1, None, _2) ) -# 15204 "parsing/parser.ml" +# 15232 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15244,9 +15272,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2023 "parsing/parser.mly" +# 2043 "parsing/parser.mly" ( (Labelled (fst _3), None, snd _3) ) -# 15250 "parsing/parser.ml" +# 15278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15271,9 +15299,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 15277 "parsing/parser.ml" +# 15305 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -15286,24 +15314,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 15292 "parsing/parser.ml" +# 15320 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2053 "parsing/parser.mly" +# 2073 "parsing/parser.mly" ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) ) -# 15301 "parsing/parser.ml" +# 15329 "parsing/parser.ml" in -# 2025 "parsing/parser.mly" +# 2045 "parsing/parser.mly" ( (Labelled (fst _2), None, snd _2) ) -# 15307 "parsing/parser.ml" +# 15335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15329,17 +15357,17 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.pattern) = Obj.magic _2 in let _1 : ( -# 607 "parsing/parser.mly" +# 629 "parsing/parser.mly" (string) -# 15335 "parsing/parser.ml" +# 15363 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2027 "parsing/parser.mly" +# 2047 "parsing/parser.mly" ( (Labelled _1, None, _2) ) -# 15343 "parsing/parser.ml" +# 15371 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15362,9 +15390,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = -# 2029 "parsing/parser.mly" +# 2049 "parsing/parser.mly" ( (Nolabel, None, _1) ) -# 15368 "parsing/parser.ml" +# 15396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15398,15 +15426,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2344 "parsing/parser.mly" +# 2367 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15404 "parsing/parser.ml" +# 15432 "parsing/parser.ml" in -# 2348 "parsing/parser.mly" +# 2371 "parsing/parser.mly" ( (_1, _2) ) -# 15410 "parsing/parser.ml" +# 15438 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15454,16 +15482,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2344 "parsing/parser.mly" +# 2367 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15460 "parsing/parser.ml" +# 15488 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2350 "parsing/parser.mly" +# 2373 "parsing/parser.mly" ( let v = _1 in (* PR#7344 *) let t = match _2 with @@ -15476,7 +15504,7 @@ module Tables = struct let patloc = (_startpos__1_, _endpos__2_) in (ghpat ~loc:patloc (Ppat_constraint(v, typ)), mkexp_constraint ~loc:_sloc _4 _2) ) -# 15480 "parsing/parser.ml" +# 15508 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15545,18 +15573,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 15549 "parsing/parser.ml" +# 15577 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 15554 "parsing/parser.ml" +# 15582 "parsing/parser.ml" in -# 3077 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 15560 "parsing/parser.ml" +# 15588 "parsing/parser.ml" in let _startpos__3_ = _startpos_xs_ in @@ -15565,19 +15593,19 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2344 "parsing/parser.mly" +# 2367 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15571 "parsing/parser.ml" +# 15599 "parsing/parser.ml" in -# 2366 "parsing/parser.mly" +# 2389 "parsing/parser.mly" ( let typloc = (_startpos__3_, _endpos__5_) in let patloc = (_startpos__1_, _endpos__5_) in (ghpat ~loc:patloc (Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))), _7) ) -# 15581 "parsing/parser.ml" +# 15609 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15649,30 +15677,30 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__8_ in let _v : (Parsetree.pattern * Parsetree.expression) = let _4 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 15655 "parsing/parser.ml" +# 15683 "parsing/parser.ml" in let _1 = let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2344 "parsing/parser.mly" +# 2367 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 15664 "parsing/parser.ml" +# 15692 "parsing/parser.ml" in let _endpos = _endpos__8_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2372 "parsing/parser.mly" +# 2395 "parsing/parser.mly" ( let exp, poly = wrap_type_annotation ~loc:_sloc _4 _6 _8 in let loc = (_startpos__1_, _endpos__6_) in (ghpat ~loc (Ppat_constraint(_1, poly)), exp) ) -# 15676 "parsing/parser.ml" +# 15704 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15709,9 +15737,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2377 "parsing/parser.mly" +# 2400 "parsing/parser.mly" ( (_1, _3) ) -# 15715 "parsing/parser.ml" +# 15743 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15762,10 +15790,10 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2379 "parsing/parser.mly" +# 2402 "parsing/parser.mly" ( let loc = (_startpos__1_, _endpos__3_) in (ghpat ~loc (Ppat_constraint(_1, _3)), _5) ) -# 15769 "parsing/parser.ml" +# 15797 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15826,36 +15854,36 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 15832 "parsing/parser.ml" +# 15860 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 15841 "parsing/parser.ml" +# 15869 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2395 "parsing/parser.mly" +# 2418 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 15853 "parsing/parser.ml" +# 15881 "parsing/parser.ml" in -# 2385 "parsing/parser.mly" +# 2408 "parsing/parser.mly" ( _1 ) -# 15859 "parsing/parser.ml" +# 15887 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15885,9 +15913,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (let_bindings) = -# 2386 "parsing/parser.mly" +# 2409 "parsing/parser.mly" ( addlb _1 _2 ) -# 15891 "parsing/parser.ml" +# 15919 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -15941,41 +15969,41 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 15947 "parsing/parser.ml" +# 15975 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 15956 "parsing/parser.ml" +# 15984 "parsing/parser.ml" in let ext = -# 3649 "parsing/parser.mly" +# 3676 "parsing/parser.mly" ( None ) -# 15962 "parsing/parser.ml" +# 15990 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2395 "parsing/parser.mly" +# 2418 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 15973 "parsing/parser.ml" +# 16001 "parsing/parser.ml" in -# 2385 "parsing/parser.mly" +# 2408 "parsing/parser.mly" ( _1 ) -# 15979 "parsing/parser.ml" +# 16007 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16043,18 +16071,18 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 16049 "parsing/parser.ml" +# 16077 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let attrs1 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 16058 "parsing/parser.ml" +# 16086 "parsing/parser.ml" in let ext = @@ -16063,27 +16091,27 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3650 "parsing/parser.mly" +# 3677 "parsing/parser.mly" ( not_expecting _loc "extension" ) -# 16069 "parsing/parser.ml" +# 16097 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2395 "parsing/parser.mly" +# 2418 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs) ) -# 16081 "parsing/parser.ml" +# 16109 "parsing/parser.ml" in -# 2385 "parsing/parser.mly" +# 2408 "parsing/parser.mly" ( _1 ) -# 16087 "parsing/parser.ml" +# 16115 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16113,9 +16141,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (let_bindings) = -# 2386 "parsing/parser.mly" +# 2409 "parsing/parser.mly" ( addlb _1 _2 ) -# 16119 "parsing/parser.ml" +# 16147 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16138,9 +16166,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2057 "parsing/parser.mly" +# 2077 "parsing/parser.mly" ( _1 ) -# 16144 "parsing/parser.ml" +# 16172 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16178,24 +16206,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2059 "parsing/parser.mly" +# 2079 "parsing/parser.mly" ( Ppat_constraint(_1, _3) ) -# 16184 "parsing/parser.ml" +# 16212 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 16193 "parsing/parser.ml" +# 16221 "parsing/parser.ml" in -# 2060 "parsing/parser.mly" +# 2080 "parsing/parser.mly" ( _1 ) -# 16199 "parsing/parser.ml" +# 16227 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16229,15 +16257,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2344 "parsing/parser.mly" +# 2367 "parsing/parser.mly" ( mkpatvar ~loc:_sloc _1 ) -# 16235 "parsing/parser.ml" +# 16263 "parsing/parser.ml" in -# 2412 "parsing/parser.mly" +# 2435 "parsing/parser.mly" ( (pat, exp) ) -# 16241 "parsing/parser.ml" +# 16269 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16288,10 +16316,10 @@ module Tables = struct let _startpos = _startpos_pat_ in let _endpos = _endpos_exp_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2414 "parsing/parser.mly" +# 2437 "parsing/parser.mly" ( let loc = (_startpos_pat_, _endpos_typ_) in (ghpat ~loc (Ppat_constraint(pat, typ)), exp) ) -# 16295 "parsing/parser.ml" +# 16323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16328,9 +16356,9 @@ module Tables = struct let _startpos = _startpos_pat_ in let _endpos = _endpos_exp_ in let _v : (Parsetree.pattern * Parsetree.expression) = -# 2417 "parsing/parser.mly" +# 2440 "parsing/parser.mly" ( (pat, exp) ) -# 16334 "parsing/parser.ml" +# 16362 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16353,10 +16381,10 @@ module Tables = struct let _startpos = _startpos_body_ in let _endpos = _endpos_body_ in let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = -# 2421 "parsing/parser.mly" +# 2444 "parsing/parser.mly" ( let let_pat, let_exp = body in let_pat, let_exp, [] ) -# 16360 "parsing/parser.ml" +# 16388 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16388,9 +16416,9 @@ module Tables = struct } = _menhir_stack in let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in let _1 : ( -# 603 "parsing/parser.mly" +# 625 "parsing/parser.mly" (string) -# 16394 "parsing/parser.ml" +# 16422 "parsing/parser.ml" ) = Obj.magic _1 in let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -16401,22 +16429,22 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16407 "parsing/parser.ml" +# 16435 "parsing/parser.ml" in let _endpos = _endpos_body_ in let _symbolstartpos = _startpos_bindings_ in let _sloc = (_symbolstartpos, _endpos) in -# 2424 "parsing/parser.mly" +# 2447 "parsing/parser.mly" ( let let_pat, let_exp, rev_ands = bindings in let pbop_pat, pbop_exp = body in let pbop_loc = make_loc _sloc in let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in let_pat, let_exp, and_ :: rev_ands ) -# 16420 "parsing/parser.ml" +# 16448 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16434,7 +16462,7 @@ module Tables = struct let _v : (Parsetree.class_declaration list) = # 211 "menhir/standard.mly" ( [] ) -# 16438 "parsing/parser.ml" +# 16466 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16498,9 +16526,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.class_expr) = Obj.magic body in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 16504 "parsing/parser.ml" +# 16532 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16513,9 +16541,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 16519 "parsing/parser.ml" +# 16547 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16525,24 +16553,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16531 "parsing/parser.ml" +# 16559 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 16539 "parsing/parser.ml" +# 16567 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1661 "parsing/parser.mly" +# 1681 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16550,13 +16578,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs ) -# 16554 "parsing/parser.ml" +# 16582 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 16560 "parsing/parser.ml" +# 16588 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16574,7 +16602,7 @@ module Tables = struct let _v : (Parsetree.class_description list) = # 211 "menhir/standard.mly" ( [] ) -# 16578 "parsing/parser.ml" +# 16606 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16645,9 +16673,9 @@ module Tables = struct let cty : (Parsetree.class_type) = Obj.magic cty in let _6 : unit = Obj.magic _6 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 16651 "parsing/parser.ml" +# 16679 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16660,9 +16688,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 16666 "parsing/parser.ml" +# 16694 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16672,24 +16700,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16678 "parsing/parser.ml" +# 16706 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 16686 "parsing/parser.ml" +# 16714 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1952 "parsing/parser.mly" +# 1972 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16697,13 +16725,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs ) -# 16701 "parsing/parser.ml" +# 16729 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 16707 "parsing/parser.ml" +# 16735 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16721,7 +16749,7 @@ module Tables = struct let _v : (Parsetree.class_type_declaration list) = # 211 "menhir/standard.mly" ( [] ) -# 16725 "parsing/parser.ml" +# 16753 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16792,9 +16820,9 @@ module Tables = struct let csig : (Parsetree.class_type) = Obj.magic csig in let _6 : unit = Obj.magic _6 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 16798 "parsing/parser.ml" +# 16826 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -16807,9 +16835,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 16813 "parsing/parser.ml" +# 16841 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -16819,24 +16847,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16825 "parsing/parser.ml" +# 16853 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 16833 "parsing/parser.ml" +# 16861 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1991 "parsing/parser.mly" +# 2011 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -16844,13 +16872,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs ) -# 16848 "parsing/parser.ml" +# 16876 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 16854 "parsing/parser.ml" +# 16882 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16868,7 +16896,7 @@ module Tables = struct let _v : (Parsetree.module_binding list) = # 211 "menhir/standard.mly" ( [] ) -# 16872 "parsing/parser.ml" +# 16900 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16919,11 +16947,7 @@ module Tables = struct let xs : (Parsetree.module_binding list) = Obj.magic xs in let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.module_expr) = Obj.magic body in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 16926 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -16933,50 +16957,50 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 16939 "parsing/parser.ml" +# 16963 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 16951 "parsing/parser.ml" +# 16975 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 16959 "parsing/parser.ml" +# 16983 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1342 "parsing/parser.mly" +# 1363 "parsing/parser.mly" ( let loc = make_loc _sloc in let attrs = attrs1 @ attrs2 in let docs = symbol_docs _sloc in let text = symbol_text _symbolstartpos in - Mb.mk uid body ~attrs ~loc ~text ~docs + Mb.mk name body ~attrs ~loc ~text ~docs ) -# 16974 "parsing/parser.ml" +# 16998 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 16980 "parsing/parser.ml" +# 17004 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -16994,7 +17018,7 @@ module Tables = struct let _v : (Parsetree.module_declaration list) = # 211 "menhir/standard.mly" ( [] ) -# 16998 "parsing/parser.ml" +# 17022 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17052,11 +17076,7 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let mty : (Parsetree.module_type) = Obj.magic mty in let _4 : unit = Obj.magic _4 in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 17059 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -17066,50 +17086,50 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 17072 "parsing/parser.ml" +# 17092 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17084 "parsing/parser.ml" +# 17104 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 17092 "parsing/parser.ml" +# 17112 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1619 "parsing/parser.mly" +# 1639 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let docs = symbol_docs _sloc in let loc = make_loc _sloc in let text = symbol_text _symbolstartpos in - Md.mk uid mty ~attrs ~loc ~text ~docs + Md.mk name mty ~attrs ~loc ~text ~docs ) -# 17107 "parsing/parser.ml" +# 17127 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17113 "parsing/parser.ml" +# 17133 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17127,7 +17147,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "menhir/standard.mly" ( [] ) -# 17131 "parsing/parser.ml" +# 17151 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17159,7 +17179,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "menhir/standard.mly" ( x :: xs ) -# 17163 "parsing/parser.ml" +# 17183 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17177,7 +17197,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "menhir/standard.mly" ( [] ) -# 17181 "parsing/parser.ml" +# 17201 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17242,9 +17262,9 @@ module Tables = struct let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 17248 "parsing/parser.ml" +# 17268 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -17257,9 +17277,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 17263 "parsing/parser.ml" +# 17283 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -17268,18 +17288,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 17272 "parsing/parser.ml" +# 17292 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 17277 "parsing/parser.ml" +# 17297 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 17283 "parsing/parser.ml" +# 17303 "parsing/parser.ml" in let id = @@ -17288,24 +17308,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17294 "parsing/parser.ml" +# 17314 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 17302 "parsing/parser.ml" +# 17322 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2803 "parsing/parser.mly" +# 2826 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -17314,13 +17334,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 17318 "parsing/parser.ml" +# 17338 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17324 "parsing/parser.ml" +# 17344 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17338,7 +17358,7 @@ module Tables = struct let _v : (Parsetree.type_declaration list) = # 211 "menhir/standard.mly" ( [] ) -# 17342 "parsing/parser.ml" +# 17362 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17410,9 +17430,9 @@ module Tables = struct let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in let _1_inlined3 : unit = Obj.magic _1_inlined3 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 17416 "parsing/parser.ml" +# 17436 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -17425,9 +17445,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 17431 "parsing/parser.ml" +# 17451 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -17436,26 +17456,26 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 17440 "parsing/parser.ml" +# 17460 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 17445 "parsing/parser.ml" +# 17465 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 17451 "parsing/parser.ml" +# 17471 "parsing/parser.ml" in let kind_priv_manifest = let _1 = _1_inlined3 in -# 2849 "parsing/parser.mly" +# 2872 "parsing/parser.mly" ( _2 ) -# 17459 "parsing/parser.ml" +# 17479 "parsing/parser.ml" in let id = @@ -17464,24 +17484,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 17470 "parsing/parser.ml" +# 17490 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 17478 "parsing/parser.ml" +# 17498 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2803 "parsing/parser.mly" +# 2826 "parsing/parser.mly" ( let (kind, priv, manifest) = kind_priv_manifest in let docs = symbol_docs _sloc in @@ -17490,13 +17510,13 @@ module Tables = struct let text = symbol_text _symbolstartpos in Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text ) -# 17494 "parsing/parser.ml" +# 17514 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17500 "parsing/parser.ml" +# 17520 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17514,7 +17534,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 211 "menhir/standard.mly" ( [] ) -# 17518 "parsing/parser.ml" +# 17538 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17546,7 +17566,7 @@ module Tables = struct let _v : (Parsetree.attributes) = # 213 "menhir/standard.mly" ( x :: xs ) -# 17550 "parsing/parser.ml" +# 17570 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17564,7 +17584,7 @@ module Tables = struct let _v : (Parsetree.signature_item list list) = # 211 "menhir/standard.mly" ( [] ) -# 17568 "parsing/parser.ml" +# 17588 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17597,21 +17617,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 780 "parsing/parser.mly" +# 802 "parsing/parser.mly" ( text_sig _startpos ) -# 17603 "parsing/parser.ml" +# 17623 "parsing/parser.ml" in -# 1480 "parsing/parser.mly" +# 1501 "parsing/parser.mly" ( _1 ) -# 17609 "parsing/parser.ml" +# 17629 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17615 "parsing/parser.ml" +# 17635 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17644,21 +17664,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 778 "parsing/parser.mly" +# 800 "parsing/parser.mly" ( text_sig _startpos @ [_1] ) -# 17650 "parsing/parser.ml" +# 17670 "parsing/parser.ml" in -# 1480 "parsing/parser.mly" +# 1501 "parsing/parser.mly" ( _1 ) -# 17656 "parsing/parser.ml" +# 17676 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17662 "parsing/parser.ml" +# 17682 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17676,7 +17696,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "menhir/standard.mly" ( [] ) -# 17680 "parsing/parser.ml" +# 17700 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17709,40 +17729,40 @@ module Tables = struct let _1 = let ys = let items = -# 840 "parsing/parser.mly" +# 862 "parsing/parser.mly" ( [] ) -# 17715 "parsing/parser.ml" +# 17735 "parsing/parser.ml" in -# 1225 "parsing/parser.mly" +# 1247 "parsing/parser.mly" ( items ) -# 17720 "parsing/parser.ml" +# 17740 "parsing/parser.ml" in let xs = let _startpos = _startpos__1_ in -# 776 "parsing/parser.mly" +# 798 "parsing/parser.mly" ( text_str _startpos ) -# 17728 "parsing/parser.ml" +# 17748 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 17734 "parsing/parser.ml" +# 17754 "parsing/parser.ml" in -# 1241 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( _1 ) -# 17740 "parsing/parser.ml" +# 17760 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17746 "parsing/parser.ml" +# 17766 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17794,70 +17814,70 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 17800 "parsing/parser.ml" +# 17820 "parsing/parser.ml" in -# 1232 "parsing/parser.mly" +# 1254 "parsing/parser.mly" ( mkstrexp e attrs ) -# 17805 "parsing/parser.ml" +# 17825 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 774 "parsing/parser.mly" +# 796 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 17813 "parsing/parser.ml" +# 17833 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 793 "parsing/parser.mly" +# 815 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 17823 "parsing/parser.ml" +# 17843 "parsing/parser.ml" in -# 842 "parsing/parser.mly" +# 864 "parsing/parser.mly" ( x ) -# 17829 "parsing/parser.ml" +# 17849 "parsing/parser.ml" in -# 1225 "parsing/parser.mly" +# 1247 "parsing/parser.mly" ( items ) -# 17835 "parsing/parser.ml" +# 17855 "parsing/parser.ml" in let xs = let _startpos = _startpos__1_ in -# 776 "parsing/parser.mly" +# 798 "parsing/parser.mly" ( text_str _startpos ) -# 17843 "parsing/parser.ml" +# 17863 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 17849 "parsing/parser.ml" +# 17869 "parsing/parser.ml" in -# 1241 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( _1 ) -# 17855 "parsing/parser.ml" +# 17875 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17861 "parsing/parser.ml" +# 17881 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17890,21 +17910,21 @@ module Tables = struct let _1 = let _startpos = _startpos__1_ in -# 774 "parsing/parser.mly" +# 796 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 17896 "parsing/parser.ml" +# 17916 "parsing/parser.ml" in -# 1241 "parsing/parser.mly" +# 1263 "parsing/parser.mly" ( _1 ) -# 17902 "parsing/parser.ml" +# 17922 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17908 "parsing/parser.ml" +# 17928 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17922,7 +17942,7 @@ module Tables = struct let _v : (Parsetree.class_type_field list list) = # 211 "menhir/standard.mly" ( [] ) -# 17926 "parsing/parser.ml" +# 17946 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17954,15 +17974,15 @@ module Tables = struct let _v : (Parsetree.class_type_field list list) = let x = let _startpos = _startpos__1_ in -# 788 "parsing/parser.mly" +# 810 "parsing/parser.mly" ( text_csig _startpos @ [_1] ) -# 17960 "parsing/parser.ml" +# 17980 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 17966 "parsing/parser.ml" +# 17986 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -17980,7 +18000,7 @@ module Tables = struct let _v : (Parsetree.class_field list list) = # 211 "menhir/standard.mly" ( [] ) -# 17984 "parsing/parser.ml" +# 18004 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18012,15 +18032,15 @@ module Tables = struct let _v : (Parsetree.class_field list list) = let x = let _startpos = _startpos__1_ in -# 786 "parsing/parser.mly" +# 808 "parsing/parser.mly" ( text_cstr _startpos @ [_1] ) -# 18018 "parsing/parser.ml" +# 18038 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18024 "parsing/parser.ml" +# 18044 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18038,7 +18058,7 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = # 211 "menhir/standard.mly" ( [] ) -# 18042 "parsing/parser.ml" +# 18062 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18070,15 +18090,15 @@ module Tables = struct let _v : (Parsetree.structure_item list list) = let x = let _startpos = _startpos__1_ in -# 774 "parsing/parser.mly" +# 796 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 18076 "parsing/parser.ml" +# 18096 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18082 "parsing/parser.ml" +# 18102 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18096,7 +18116,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase list list) = # 211 "menhir/standard.mly" ( [] ) -# 18100 "parsing/parser.ml" +# 18120 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18129,32 +18149,32 @@ module Tables = struct let _1 = let x = let _1 = -# 840 "parsing/parser.mly" +# 862 "parsing/parser.mly" ( [] ) -# 18135 "parsing/parser.ml" +# 18155 "parsing/parser.ml" in -# 1070 "parsing/parser.mly" +# 1092 "parsing/parser.mly" ( _1 ) -# 18140 "parsing/parser.ml" +# 18160 "parsing/parser.ml" in # 183 "menhir/standard.mly" ( x ) -# 18146 "parsing/parser.ml" +# 18166 "parsing/parser.ml" in -# 1082 "parsing/parser.mly" +# 1104 "parsing/parser.mly" ( _1 ) -# 18152 "parsing/parser.ml" +# 18172 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18158 "parsing/parser.ml" +# 18178 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18206,58 +18226,58 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 18212 "parsing/parser.ml" +# 18232 "parsing/parser.ml" in -# 1232 "parsing/parser.mly" +# 1254 "parsing/parser.mly" ( mkstrexp e attrs ) -# 18217 "parsing/parser.ml" +# 18237 "parsing/parser.ml" in -# 784 "parsing/parser.mly" +# 806 "parsing/parser.mly" ( Ptop_def [_1] ) -# 18223 "parsing/parser.ml" +# 18243 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 782 "parsing/parser.mly" +# 804 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18231 "parsing/parser.ml" +# 18251 "parsing/parser.ml" in -# 842 "parsing/parser.mly" +# 864 "parsing/parser.mly" ( x ) -# 18237 "parsing/parser.ml" +# 18257 "parsing/parser.ml" in -# 1070 "parsing/parser.mly" +# 1092 "parsing/parser.mly" ( _1 ) -# 18243 "parsing/parser.ml" +# 18263 "parsing/parser.ml" in # 183 "menhir/standard.mly" ( x ) -# 18249 "parsing/parser.ml" +# 18269 "parsing/parser.ml" in -# 1082 "parsing/parser.mly" +# 1104 "parsing/parser.mly" ( _1 ) -# 18255 "parsing/parser.ml" +# 18275 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18261 "parsing/parser.ml" +# 18281 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18289,27 +18309,27 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase list list) = let x = let _1 = let _1 = -# 784 "parsing/parser.mly" +# 806 "parsing/parser.mly" ( Ptop_def [_1] ) -# 18295 "parsing/parser.ml" +# 18315 "parsing/parser.ml" in let _startpos = _startpos__1_ in -# 782 "parsing/parser.mly" +# 804 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18301 "parsing/parser.ml" +# 18321 "parsing/parser.ml" in -# 1082 "parsing/parser.mly" +# 1104 "parsing/parser.mly" ( _1 ) -# 18307 "parsing/parser.ml" +# 18327 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18313 "parsing/parser.ml" +# 18333 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18344,29 +18364,29 @@ module Tables = struct let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 793 "parsing/parser.mly" +# 815 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 18351 "parsing/parser.ml" +# 18371 "parsing/parser.ml" in let _startpos = _startpos__1_ in -# 782 "parsing/parser.mly" +# 804 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 18358 "parsing/parser.ml" +# 18378 "parsing/parser.ml" in -# 1082 "parsing/parser.mly" +# 1104 "parsing/parser.mly" ( _1 ) -# 18364 "parsing/parser.ml" +# 18384 "parsing/parser.ml" in # 213 "menhir/standard.mly" ( x :: xs ) -# 18370 "parsing/parser.ml" +# 18390 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18405,7 +18425,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 124 "menhir/standard.mly" ( None ) -# 18409 "parsing/parser.ml" +# 18429 "parsing/parser.ml" in let x = let label = @@ -18413,9 +18433,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18419 "parsing/parser.ml" +# 18439 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18423,7 +18443,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2692 "parsing/parser.mly" +# 2715 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18434,13 +18454,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18438 "parsing/parser.ml" +# 18458 "parsing/parser.ml" in -# 1009 "parsing/parser.mly" +# 1031 "parsing/parser.mly" ( [x], None ) -# 18444 "parsing/parser.ml" +# 18464 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18486,7 +18506,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = # 126 "menhir/standard.mly" ( Some x ) -# 18490 "parsing/parser.ml" +# 18510 "parsing/parser.ml" in let x = let label = @@ -18494,9 +18514,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18500 "parsing/parser.ml" +# 18520 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18504,7 +18524,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2692 "parsing/parser.mly" +# 2715 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18515,13 +18535,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18519 "parsing/parser.ml" +# 18539 "parsing/parser.ml" in -# 1009 "parsing/parser.mly" +# 1031 "parsing/parser.mly" ( [x], None ) -# 18525 "parsing/parser.ml" +# 18545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18584,9 +18604,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18590 "parsing/parser.ml" +# 18610 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18594,7 +18614,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2692 "parsing/parser.mly" +# 2715 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18605,13 +18625,13 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18609 "parsing/parser.ml" +# 18629 "parsing/parser.ml" in -# 1011 "parsing/parser.mly" +# 1033 "parsing/parser.mly" ( [x], Some y ) -# 18615 "parsing/parser.ml" +# 18635 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18667,9 +18687,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18673 "parsing/parser.ml" +# 18693 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -18677,7 +18697,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2692 "parsing/parser.mly" +# 2715 "parsing/parser.mly" ( let pat = match opat with | None -> @@ -18688,14 +18708,14 @@ module Tables = struct in label, mkpat_opt_constraint ~loc:_sloc pat octy ) -# 18692 "parsing/parser.ml" +# 18712 "parsing/parser.ml" in -# 1015 "parsing/parser.mly" +# 1037 "parsing/parser.mly" ( let xs, y = tail in x :: xs, y ) -# 18699 "parsing/parser.ml" +# 18719 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18732,9 +18752,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.case) = -# 2450 "parsing/parser.mly" +# 2473 "parsing/parser.mly" ( Exp.case _1 _3 ) -# 18738 "parsing/parser.ml" +# 18758 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18785,9 +18805,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.case) = -# 2452 "parsing/parser.mly" +# 2475 "parsing/parser.mly" ( Exp.case _1 ~guard:_3 _5 ) -# 18791 "parsing/parser.ml" +# 18811 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18825,9 +18845,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2454 "parsing/parser.mly" +# 2477 "parsing/parser.mly" ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) ) -# 18831 "parsing/parser.ml" +# 18851 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18888,9 +18908,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 18894 "parsing/parser.ml" +# 18914 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -18899,49 +18919,49 @@ module Tables = struct let _6 = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 18905 "parsing/parser.ml" +# 18925 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 18914 "parsing/parser.ml" +# 18934 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3095 "parsing/parser.mly" +# 3118 "parsing/parser.mly" ( _1 ) -# 18923 "parsing/parser.ml" +# 18943 "parsing/parser.ml" in let _1 = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 18930 "parsing/parser.ml" +# 18950 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 18938 "parsing/parser.ml" +# 18958 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3305 "parsing/parser.mly" +# 3328 "parsing/parser.mly" ( let info = match rhs_info _endpos__4_ with | Some _ as info_before_semi -> info_before_semi @@ -18949,13 +18969,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 18953 "parsing/parser.ml" +# 18973 "parsing/parser.ml" in -# 3286 "parsing/parser.mly" +# 3309 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 18959 "parsing/parser.ml" +# 18979 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -18996,15 +19016,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3316 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 19002 "parsing/parser.ml" +# 19022 "parsing/parser.ml" in -# 3286 "parsing/parser.mly" +# 3309 "parsing/parser.mly" ( let (f, c) = tail in (head :: f, c) ) -# 19008 "parsing/parser.ml" +# 19028 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19058,9 +19078,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19064 "parsing/parser.ml" +# 19084 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -19069,49 +19089,49 @@ module Tables = struct let _6 = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19075 "parsing/parser.ml" +# 19095 "parsing/parser.ml" in let _endpos__6_ = _endpos__1_inlined3_ in let _4 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19084 "parsing/parser.ml" +# 19104 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3095 "parsing/parser.mly" +# 3118 "parsing/parser.mly" ( _1 ) -# 19093 "parsing/parser.ml" +# 19113 "parsing/parser.ml" in let _1 = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19100 "parsing/parser.ml" +# 19120 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19108 "parsing/parser.ml" +# 19128 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3305 "parsing/parser.mly" +# 3328 "parsing/parser.mly" ( let info = match rhs_info _endpos__4_ with | Some _ as info_before_semi -> info_before_semi @@ -19119,13 +19139,13 @@ module Tables = struct in let attrs = add_info_attrs info (_4 @ _6) in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 19123 "parsing/parser.ml" +# 19143 "parsing/parser.ml" in -# 3289 "parsing/parser.mly" +# 3312 "parsing/parser.mly" ( [head], Closed ) -# 19129 "parsing/parser.ml" +# 19149 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19159,15 +19179,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3316 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 19165 "parsing/parser.ml" +# 19185 "parsing/parser.ml" in -# 3289 "parsing/parser.mly" +# 3312 "parsing/parser.mly" ( [head], Closed ) -# 19171 "parsing/parser.ml" +# 19191 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19207,9 +19227,9 @@ module Tables = struct let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19213 "parsing/parser.ml" +# 19233 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -19218,50 +19238,50 @@ module Tables = struct let _4 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19224 "parsing/parser.ml" +# 19244 "parsing/parser.ml" in let _endpos__4_ = _endpos__1_inlined2_ in let _3 = let _1 = _1_inlined1 in -# 3095 "parsing/parser.mly" +# 3118 "parsing/parser.mly" ( _1 ) -# 19233 "parsing/parser.ml" +# 19253 "parsing/parser.ml" in let _1 = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19240 "parsing/parser.ml" +# 19260 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19248 "parsing/parser.ml" +# 19268 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3298 "parsing/parser.mly" +# 3321 "parsing/parser.mly" ( let info = symbol_info _endpos in let attrs = add_info_attrs info _4 in Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 ) -# 19259 "parsing/parser.ml" +# 19279 "parsing/parser.ml" in -# 3292 "parsing/parser.mly" +# 3315 "parsing/parser.mly" ( [head], Closed ) -# 19265 "parsing/parser.ml" +# 19285 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19288,15 +19308,15 @@ module Tables = struct let _symbolstartpos = _startpos_ty_ in let _sloc = (_symbolstartpos, _endpos) in -# 3316 "parsing/parser.mly" +# 3339 "parsing/parser.mly" ( Of.inherit_ ~loc:(make_loc _sloc) ty ) -# 19294 "parsing/parser.ml" +# 19314 "parsing/parser.ml" in -# 3292 "parsing/parser.mly" +# 3315 "parsing/parser.mly" ( [head], Closed ) -# 19300 "parsing/parser.ml" +# 19320 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19319,9 +19339,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.object_field list * Asttypes.closed_flag) = -# 3294 "parsing/parser.mly" +# 3317 "parsing/parser.mly" ( [], Open ) -# 19325 "parsing/parser.ml" +# 19345 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19366,9 +19386,9 @@ module Tables = struct let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19372 "parsing/parser.ml" +# 19392 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let private_ : (Asttypes.private_flag) = Obj.magic private_ in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -19380,41 +19400,41 @@ module Tables = struct Parsetree.attributes) = let ty = let _1 = _1_inlined2 in -# 3091 "parsing/parser.mly" +# 3114 "parsing/parser.mly" ( _1 ) -# 19386 "parsing/parser.ml" +# 19406 "parsing/parser.ml" in let label = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19394 "parsing/parser.ml" +# 19414 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19402 "parsing/parser.ml" +# 19422 "parsing/parser.ml" in let attrs = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19408 "parsing/parser.ml" +# 19428 "parsing/parser.ml" in let _1 = -# 3541 "parsing/parser.mly" +# 3568 "parsing/parser.mly" ( Fresh ) -# 19413 "parsing/parser.ml" +# 19433 "parsing/parser.ml" in -# 1799 "parsing/parser.mly" +# 1819 "parsing/parser.mly" ( (label, private_, Cfk_virtual ty), attrs ) -# 19418 "parsing/parser.ml" +# 19438 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19452,9 +19472,9 @@ module Tables = struct } = _menhir_stack in let _5 : (Parsetree.expression) = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19458 "parsing/parser.ml" +# 19478 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -19466,36 +19486,36 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19472 "parsing/parser.ml" +# 19492 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19480 "parsing/parser.ml" +# 19500 "parsing/parser.ml" in let _2 = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19486 "parsing/parser.ml" +# 19506 "parsing/parser.ml" in let _1 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 19491 "parsing/parser.ml" +# 19511 "parsing/parser.ml" in -# 1801 "parsing/parser.mly" +# 1821 "parsing/parser.mly" ( let e = _5 in let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in (_4, _3, Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 ) -# 19499 "parsing/parser.ml" +# 19519 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19539,9 +19559,9 @@ module Tables = struct } = _menhir_stack in let _5 : (Parsetree.expression) = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19545 "parsing/parser.ml" +# 19565 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -19554,39 +19574,39 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19560 "parsing/parser.ml" +# 19580 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19568 "parsing/parser.ml" +# 19588 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19576 "parsing/parser.ml" +# 19596 "parsing/parser.ml" in let _1 = -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 19582 "parsing/parser.ml" +# 19602 "parsing/parser.ml" in -# 1801 "parsing/parser.mly" +# 1821 "parsing/parser.mly" ( let e = _5 in let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in (_4, _3, Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 ) -# 19590 "parsing/parser.ml" +# 19610 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19645,9 +19665,9 @@ module Tables = struct let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19651 "parsing/parser.ml" +# 19671 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -19659,45 +19679,45 @@ module Tables = struct Parsetree.attributes) = let _6 = let _1 = _1_inlined2 in -# 3091 "parsing/parser.mly" +# 3114 "parsing/parser.mly" ( _1 ) -# 19665 "parsing/parser.ml" +# 19685 "parsing/parser.ml" in let _startpos__6_ = _startpos__1_inlined2_ in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19674 "parsing/parser.ml" +# 19694 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19682 "parsing/parser.ml" +# 19702 "parsing/parser.ml" in let _2 = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19688 "parsing/parser.ml" +# 19708 "parsing/parser.ml" in let _1 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 19693 "parsing/parser.ml" +# 19713 "parsing/parser.ml" in -# 1807 "parsing/parser.mly" +# 1827 "parsing/parser.mly" ( let poly_exp = let loc = (_startpos__6_, _endpos__8_) in ghexp ~loc (Pexp_poly(_8, Some _6)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 19701 "parsing/parser.ml" +# 19721 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19762,9 +19782,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19768 "parsing/parser.ml" +# 19788 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -19777,48 +19797,48 @@ module Tables = struct Parsetree.attributes) = let _6 = let _1 = _1_inlined3 in -# 3091 "parsing/parser.mly" +# 3114 "parsing/parser.mly" ( _1 ) -# 19783 "parsing/parser.ml" +# 19803 "parsing/parser.ml" in let _startpos__6_ = _startpos__1_inlined3_ in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19792 "parsing/parser.ml" +# 19812 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19800 "parsing/parser.ml" +# 19820 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19808 "parsing/parser.ml" +# 19828 "parsing/parser.ml" in let _1 = -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 19814 "parsing/parser.ml" +# 19834 "parsing/parser.ml" in -# 1807 "parsing/parser.mly" +# 1827 "parsing/parser.mly" ( let poly_exp = let loc = (_startpos__6_, _endpos__8_) in ghexp ~loc (Pexp_poly(_8, Some _6)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 19822 "parsing/parser.ml" +# 19842 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -19898,9 +19918,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 19904 "parsing/parser.ml" +# 19924 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -19910,38 +19930,38 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag * Parsetree.class_field_kind) * Parsetree.attributes) = let _7 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 19916 "parsing/parser.ml" +# 19936 "parsing/parser.ml" in let _startpos__7_ = _startpos_xs_ in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 19924 "parsing/parser.ml" +# 19944 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 19932 "parsing/parser.ml" +# 19952 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 19939 "parsing/parser.ml" +# 19959 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 19945 "parsing/parser.ml" +# 19965 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__11_ in @@ -19957,7 +19977,7 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1813 "parsing/parser.mly" +# 1833 "parsing/parser.mly" ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in let poly_exp = let exp, poly = @@ -19968,7 +19988,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 19972 "parsing/parser.ml" +# 19992 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20054,9 +20074,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 20060 "parsing/parser.ml" +# 20080 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.private_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -20067,41 +20087,41 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag * Parsetree.class_field_kind) * Parsetree.attributes) = let _7 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 20073 "parsing/parser.ml" +# 20093 "parsing/parser.ml" in let _startpos__7_ = _startpos_xs_ in let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 20081 "parsing/parser.ml" +# 20101 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20089 "parsing/parser.ml" +# 20109 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 20098 "parsing/parser.ml" +# 20118 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 20105 "parsing/parser.ml" +# 20125 "parsing/parser.ml" in let _endpos = _endpos__11_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -20116,7 +20136,7 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1813 "parsing/parser.mly" +# 1833 "parsing/parser.mly" ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in let poly_exp = let exp, poly = @@ -20127,7 +20147,7 @@ module Tables = struct ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in (_4, _3, Cfk_concrete (_1, poly_exp)), _2 ) -# 20131 "parsing/parser.ml" +# 20151 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20146,17 +20166,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 20152 "parsing/parser.ml" +# 20172 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3423 "parsing/parser.mly" +# 3450 "parsing/parser.mly" ( Lident _1 ) -# 20160 "parsing/parser.ml" +# 20180 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20187,9 +20207,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 20193 "parsing/parser.ml" +# 20213 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20197,9 +20217,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3424 "parsing/parser.mly" +# 3451 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 20203 "parsing/parser.ml" +# 20223 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20246,9 +20266,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3426 "parsing/parser.mly" +# 3453 "parsing/parser.mly" ( lapply ~loc:_sloc _1 _3 ) -# 20252 "parsing/parser.ml" +# 20272 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20286,9 +20306,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 3428 "parsing/parser.mly" +# 3455 "parsing/parser.mly" ( expecting _loc__3_ "module path" ) -# 20292 "parsing/parser.ml" +# 20312 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20307,17 +20327,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 20313 "parsing/parser.ml" +# 20333 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3419 "parsing/parser.mly" +# 3446 "parsing/parser.mly" ( Lident _1 ) -# 20321 "parsing/parser.ml" +# 20341 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20348,9 +20368,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 20354 "parsing/parser.ml" +# 20374 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -20358,9 +20378,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3420 "parsing/parser.mly" +# 3447 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 20364 "parsing/parser.ml" +# 20384 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20390,9 +20410,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = -# 1301 "parsing/parser.mly" +# 1323 "parsing/parser.mly" ( me ) -# 20396 "parsing/parser.ml" +# 20416 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20437,24 +20457,24 @@ module Tables = struct let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1304 "parsing/parser.mly" +# 1326 "parsing/parser.mly" ( Pmod_constraint(me, mty) ) -# 20443 "parsing/parser.ml" +# 20463 "parsing/parser.ml" in let _endpos__1_ = _endpos_me_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 20452 "parsing/parser.ml" +# 20472 "parsing/parser.ml" in -# 1308 "parsing/parser.mly" +# 1329 "parsing/parser.mly" ( _1 ) -# 20458 "parsing/parser.ml" +# 20478 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20479,31 +20499,30 @@ module Tables = struct }; } = _menhir_stack in let body : (Parsetree.module_expr) = Obj.magic body in - let arg : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic arg in + let arg : (Parsetree.functor_parameter) = Obj.magic arg in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_arg_ in let _endpos = _endpos_body_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1306 "parsing/parser.mly" - ( let (x, mty) = arg in - Pmod_functor(x, mty, body) ) -# 20492 "parsing/parser.ml" +# 1328 "parsing/parser.mly" + ( Pmod_functor(arg, body) ) +# 20511 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 20501 "parsing/parser.ml" +# 20520 "parsing/parser.ml" in -# 1308 "parsing/parser.mly" +# 1329 "parsing/parser.mly" ( _1 ) -# 20507 "parsing/parser.ml" +# 20526 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20533,9 +20552,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_mty_ in let _v : (Parsetree.module_type) = -# 1545 "parsing/parser.mly" +# 1566 "parsing/parser.mly" ( mty ) -# 20539 "parsing/parser.ml" +# 20558 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20560,31 +20579,30 @@ module Tables = struct }; } = _menhir_stack in let body : (Parsetree.module_type) = Obj.magic body in - let arg : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic arg in + let arg : (Parsetree.functor_parameter) = Obj.magic arg in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_arg_ in let _endpos = _endpos_body_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1548 "parsing/parser.mly" - ( let (x, mty) = arg in - Pmty_functor(x, mty, body) ) -# 20573 "parsing/parser.ml" +# 1569 "parsing/parser.mly" + ( Pmty_functor(arg, body) ) +# 20591 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 815 "parsing/parser.mly" +# 837 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 20582 "parsing/parser.ml" +# 20600 "parsing/parser.ml" in -# 1551 "parsing/parser.mly" +# 1571 "parsing/parser.mly" ( _1 ) -# 20588 "parsing/parser.ml" +# 20606 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20630,18 +20648,18 @@ module Tables = struct let _v : (Parsetree.module_expr) = let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 20636 "parsing/parser.ml" +# 20654 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1140 "parsing/parser.mly" +# 1162 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_structure s) ) -# 20645 "parsing/parser.ml" +# 20663 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20687,17 +20705,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 20693 "parsing/parser.ml" +# 20711 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1142 "parsing/parser.mly" +# 1164 "parsing/parser.mly" ( unclosed "struct" _loc__1_ "end" _loc__4_ ) -# 20701 "parsing/parser.ml" +# 20719 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20741,7 +20759,7 @@ module Tables = struct } = _menhir_stack in let me : (Parsetree.module_expr) = Obj.magic me in let _4 : unit = Obj.magic _4 in - let _1_inlined2 : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic _1_inlined2 in + let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -20750,30 +20768,30 @@ module Tables = struct let _v : (Parsetree.module_expr) = let args = let _1 = _1_inlined2 in -# 1106 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 20756 "parsing/parser.ml" +# 20774 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 20764 "parsing/parser.ml" +# 20782 "parsing/parser.ml" in let _endpos = _endpos_me_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1144 "parsing/parser.mly" +# 1166 "parsing/parser.mly" ( wrap_mod_attrs ~loc:_sloc attrs ( - List.fold_left (fun acc (x, mty) -> - mkmod ~loc:_sloc (Pmod_functor (x, mty, acc)) + List.fold_left (fun acc arg -> + mkmod ~loc:_sloc (Pmod_functor (arg, acc)) ) me args ) ) -# 20777 "parsing/parser.ml" +# 20795 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20796,9 +20814,9 @@ module Tables = struct let _startpos = _startpos_me_ in let _endpos = _endpos_me_ in let _v : (Parsetree.module_expr) = -# 1150 "parsing/parser.mly" +# 1172 "parsing/parser.mly" ( me ) -# 20802 "parsing/parser.ml" +# 20820 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20828,9 +20846,9 @@ module Tables = struct let _startpos = _startpos_me_ in let _endpos = _endpos_attr_ in let _v : (Parsetree.module_expr) = -# 1152 "parsing/parser.mly" +# 1174 "parsing/parser.mly" ( Mod.attr me attr ) -# 20834 "parsing/parser.ml" +# 20852 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20859,30 +20877,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 20865 "parsing/parser.ml" +# 20883 "parsing/parser.ml" in -# 1156 "parsing/parser.mly" +# 1178 "parsing/parser.mly" ( Pmod_ident x ) -# 20871 "parsing/parser.ml" +# 20889 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 20880 "parsing/parser.ml" +# 20898 "parsing/parser.ml" in -# 1168 "parsing/parser.mly" +# 1190 "parsing/parser.mly" ( _1 ) -# 20886 "parsing/parser.ml" +# 20904 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20913,24 +20931,24 @@ module Tables = struct let _endpos = _endpos_me2_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1159 "parsing/parser.mly" +# 1181 "parsing/parser.mly" ( Pmod_apply(me1, me2) ) -# 20919 "parsing/parser.ml" +# 20937 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 20928 "parsing/parser.ml" +# 20946 "parsing/parser.ml" in -# 1168 "parsing/parser.mly" +# 1190 "parsing/parser.mly" ( _1 ) -# 20934 "parsing/parser.ml" +# 20952 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -20972,10 +20990,10 @@ module Tables = struct let _symbolstartpos = _startpos_me1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1162 "parsing/parser.mly" +# 1184 "parsing/parser.mly" ( (* TODO review mkmod location *) Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) ) -# 20979 "parsing/parser.ml" +# 20997 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in @@ -20983,15 +21001,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 20989 "parsing/parser.ml" +# 21007 "parsing/parser.ml" in -# 1168 "parsing/parser.mly" +# 1190 "parsing/parser.mly" ( _1 ) -# 20995 "parsing/parser.ml" +# 21013 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21015,24 +21033,78 @@ module Tables = struct let _endpos = _endpos_ex_ in let _v : (Parsetree.module_expr) = let _1 = let _1 = -# 1166 "parsing/parser.mly" +# 1188 "parsing/parser.mly" ( Pmod_extension ex ) -# 21021 "parsing/parser.ml" +# 21039 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 813 "parsing/parser.mly" +# 835 "parsing/parser.mly" ( mkmod ~loc:_sloc _1 ) -# 21030 "parsing/parser.ml" +# 21048 "parsing/parser.ml" in -# 1168 "parsing/parser.mly" +# 1190 "parsing/parser.mly" ( _1 ) -# 21036 "parsing/parser.ml" +# 21054 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + MenhirLib.EngineTypes.next = _menhir_stack; + }); + (fun _menhir_env -> + let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in + let { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = x; + MenhirLib.EngineTypes.startp = _startpos_x_; + MenhirLib.EngineTypes.endp = _endpos_x_; + MenhirLib.EngineTypes.next = _menhir_stack; + } = _menhir_stack in + let x : ( +# 688 "parsing/parser.mly" + (string) +# 21075 "parsing/parser.ml" + ) = Obj.magic x in + let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in + let _startpos = _startpos_x_ in + let _endpos = _endpos_x_ in + let _v : (string option) = +# 1145 "parsing/parser.mly" + ( Some x ) +# 21083 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + MenhirLib.EngineTypes.next = _menhir_stack; + }); + (fun _menhir_env -> + let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in + let { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; + MenhirLib.EngineTypes.next = _menhir_stack; + } = _menhir_stack in + let _1 : unit = Obj.magic _1 in + let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in + let _startpos = _startpos__1_ in + let _endpos = _endpos__1_ in + let _v : (string option) = +# 1148 "parsing/parser.mly" + ( None ) +# 21108 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21090,9 +21162,9 @@ module Tables = struct let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 21096 "parsing/parser.ml" +# 21168 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in @@ -21103,9 +21175,9 @@ module Tables = struct let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 21109 "parsing/parser.ml" +# 21181 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -21115,9 +21187,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21121 "parsing/parser.ml" +# 21193 "parsing/parser.ml" in let uid = @@ -21126,31 +21198,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21132 "parsing/parser.ml" +# 21204 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21140 "parsing/parser.ml" +# 21212 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1581 "parsing/parser.mly" +# 1601 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Ms.mk uid body ~attrs ~loc ~docs, ext ) -# 21154 "parsing/parser.ml" +# 21226 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21201,9 +21273,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 21207 "parsing/parser.ml" +# 21279 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _2 : (string Asttypes.loc option) = Obj.magic _2 in @@ -21217,24 +21289,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21223 "parsing/parser.ml" +# 21295 "parsing/parser.ml" in let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21231 "parsing/parser.ml" +# 21303 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in -# 1588 "parsing/parser.mly" +# 1608 "parsing/parser.mly" ( expecting _loc__6_ "module path" ) -# 21238 "parsing/parser.ml" +# 21310 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21280,18 +21352,18 @@ module Tables = struct let _v : (Parsetree.module_type) = let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21286 "parsing/parser.ml" +# 21358 "parsing/parser.ml" in let _endpos = _endpos__4_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1433 "parsing/parser.mly" +# 1454 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs (Pmty_signature s) ) -# 21295 "parsing/parser.ml" +# 21367 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21337,17 +21409,17 @@ module Tables = struct let _v : (Parsetree.module_type) = let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21343 "parsing/parser.ml" +# 21415 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1435 "parsing/parser.mly" +# 1456 "parsing/parser.mly" ( unclosed "sig" _loc__1_ "end" _loc__4_ ) -# 21351 "parsing/parser.ml" +# 21423 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21391,7 +21463,7 @@ module Tables = struct } = _menhir_stack in let mty : (Parsetree.module_type) = Obj.magic mty in let _4 : unit = Obj.magic _4 in - let _1_inlined2 : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic _1_inlined2 in + let _1_inlined2 : (Parsetree.functor_parameter list) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -21400,30 +21472,30 @@ module Tables = struct let _v : (Parsetree.module_type) = let args = let _1 = _1_inlined2 in -# 1106 "parsing/parser.mly" +# 1128 "parsing/parser.mly" ( _1 ) -# 21406 "parsing/parser.ml" +# 21478 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21414 "parsing/parser.ml" +# 21486 "parsing/parser.ml" in let _endpos = _endpos_mty_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1439 "parsing/parser.mly" +# 1460 "parsing/parser.mly" ( wrap_mty_attrs ~loc:_sloc attrs ( - List.fold_left (fun acc (x, mty) -> - mkmty ~loc:_sloc (Pmty_functor (x, mty, acc)) + List.fold_left (fun acc arg -> + mkmty ~loc:_sloc (Pmty_functor (arg, acc)) ) mty args ) ) -# 21427 "parsing/parser.ml" +# 21499 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21476,18 +21548,18 @@ module Tables = struct let _v : (Parsetree.module_type) = let _4 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21482 "parsing/parser.ml" +# 21554 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1445 "parsing/parser.mly" +# 1466 "parsing/parser.mly" ( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) ) -# 21491 "parsing/parser.ml" +# 21563 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21524,9 +21596,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.module_type) = -# 1447 "parsing/parser.mly" +# 1468 "parsing/parser.mly" ( _2 ) -# 21530 "parsing/parser.ml" +# 21602 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21565,9 +21637,9 @@ module Tables = struct let _v : (Parsetree.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1449 "parsing/parser.mly" +# 1470 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 21571 "parsing/parser.ml" +# 21643 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21597,9 +21669,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.module_type) = -# 1451 "parsing/parser.mly" +# 1472 "parsing/parser.mly" ( Mty.attr _1 _2 ) -# 21603 "parsing/parser.ml" +# 21675 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21628,30 +21700,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21634 "parsing/parser.ml" +# 21706 "parsing/parser.ml" in -# 1454 "parsing/parser.mly" +# 1475 "parsing/parser.mly" ( Pmty_ident _1 ) -# 21640 "parsing/parser.ml" +# 21712 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 815 "parsing/parser.mly" +# 837 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 21649 "parsing/parser.ml" +# 21721 "parsing/parser.ml" in -# 1465 "parsing/parser.mly" +# 1486 "parsing/parser.mly" ( _1 ) -# 21655 "parsing/parser.ml" +# 21727 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21689,24 +21761,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1457 "parsing/parser.mly" - ( Pmty_functor(mknoloc "_", Some _1, _3) ) -# 21695 "parsing/parser.ml" +# 1478 "parsing/parser.mly" + ( Pmty_functor(Named (mknoloc None, _1), _3) ) +# 21767 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 815 "parsing/parser.mly" +# 837 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 21704 "parsing/parser.ml" +# 21776 "parsing/parser.ml" in -# 1465 "parsing/parser.mly" +# 1486 "parsing/parser.mly" ( _1 ) -# 21710 "parsing/parser.ml" +# 21782 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21748,18 +21820,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 21752 "parsing/parser.ml" +# 21824 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 21757 "parsing/parser.ml" +# 21829 "parsing/parser.ml" in -# 1459 "parsing/parser.mly" +# 1480 "parsing/parser.mly" ( Pmty_with(_1, _3) ) -# 21763 "parsing/parser.ml" +# 21835 "parsing/parser.ml" in let _endpos__1_ = _endpos_xs_ in @@ -21767,15 +21839,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 815 "parsing/parser.mly" +# 837 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 21773 "parsing/parser.ml" +# 21845 "parsing/parser.ml" in -# 1465 "parsing/parser.mly" +# 1486 "parsing/parser.mly" ( _1 ) -# 21779 "parsing/parser.ml" +# 21851 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21799,23 +21871,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.module_type) = let _1 = let _1 = -# 1463 "parsing/parser.mly" +# 1484 "parsing/parser.mly" ( Pmty_extension _1 ) -# 21805 "parsing/parser.ml" +# 21877 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 815 "parsing/parser.mly" +# 837 "parsing/parser.mly" ( mkmty ~loc:_sloc _1 ) -# 21813 "parsing/parser.ml" +# 21885 "parsing/parser.ml" in -# 1465 "parsing/parser.mly" +# 1486 "parsing/parser.mly" ( _1 ) -# 21819 "parsing/parser.ml" +# 21891 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21882,9 +21954,9 @@ module Tables = struct let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 21888 "parsing/parser.ml" +# 21960 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -21894,31 +21966,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 21900 "parsing/parser.ml" +# 21972 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 21908 "parsing/parser.ml" +# 21980 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1379 "parsing/parser.mly" +# 1400 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Mtd.mk id ?typ ~attrs ~loc ~docs, ext ) -# 21922 "parsing/parser.ml" +# 21994 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21941,9 +22013,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3431 "parsing/parser.mly" +# 3458 "parsing/parser.mly" ( Lident _1 ) -# 21947 "parsing/parser.ml" +# 22019 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21980,9 +22052,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3432 "parsing/parser.mly" +# 3459 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 21986 "parsing/parser.ml" +# 22058 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -21998,9 +22070,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.mutable_flag) = -# 3501 "parsing/parser.mly" +# 3528 "parsing/parser.mly" ( Immutable ) -# 22004 "parsing/parser.ml" +# 22076 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22023,9 +22095,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag) = -# 3502 "parsing/parser.mly" +# 3529 "parsing/parser.mly" ( Mutable ) -# 22029 "parsing/parser.ml" +# 22101 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22041,9 +22113,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3510 "parsing/parser.mly" +# 3537 "parsing/parser.mly" ( Immutable, Concrete ) -# 22047 "parsing/parser.ml" +# 22119 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22066,9 +22138,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3512 "parsing/parser.mly" +# 3539 "parsing/parser.mly" ( Mutable, Concrete ) -# 22072 "parsing/parser.ml" +# 22144 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22091,9 +22163,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3514 "parsing/parser.mly" +# 3541 "parsing/parser.mly" ( Immutable, Virtual ) -# 22097 "parsing/parser.ml" +# 22169 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22123,9 +22195,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3517 "parsing/parser.mly" +# 3544 "parsing/parser.mly" ( Mutable, Virtual ) -# 22129 "parsing/parser.ml" +# 22201 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22155,9 +22227,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = -# 3517 "parsing/parser.mly" +# 3544 "parsing/parser.mly" ( Mutable, Virtual ) -# 22161 "parsing/parser.ml" +# 22233 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22187,9 +22259,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.label) = -# 3474 "parsing/parser.mly" +# 3501 "parsing/parser.mly" ( _2 ) -# 22193 "parsing/parser.ml" +# 22265 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22208,9 +22280,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 22214 "parsing/parser.ml" +# 22286 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22220,15 +22292,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22226 "parsing/parser.ml" +# 22298 "parsing/parser.ml" in # 221 "menhir/standard.mly" ( [ x ] ) -# 22232 "parsing/parser.ml" +# 22304 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22254,9 +22326,9 @@ module Tables = struct } = _menhir_stack in let xs : (string Asttypes.loc list) = Obj.magic xs in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 22260 "parsing/parser.ml" +# 22332 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -22266,15 +22338,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 22272 "parsing/parser.ml" +# 22344 "parsing/parser.ml" in # 223 "menhir/standard.mly" ( x :: xs ) -# 22278 "parsing/parser.ml" +# 22350 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22293,22 +22365,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let s : ( -# 658 "parsing/parser.mly" +# 680 "parsing/parser.mly" (string * string option) -# 22299 "parsing/parser.ml" +# 22371 "parsing/parser.ml" ) = Obj.magic s in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_s_ in let _endpos = _endpos_s_ in let _v : (string list) = let x = -# 3470 "parsing/parser.mly" +# 3497 "parsing/parser.mly" ( fst s ) -# 22307 "parsing/parser.ml" +# 22379 "parsing/parser.ml" in # 221 "menhir/standard.mly" ( [ x ] ) -# 22312 "parsing/parser.ml" +# 22384 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22334,22 +22406,22 @@ module Tables = struct } = _menhir_stack in let xs : (string list) = Obj.magic xs in let s : ( -# 658 "parsing/parser.mly" +# 680 "parsing/parser.mly" (string * string option) -# 22340 "parsing/parser.ml" +# 22412 "parsing/parser.ml" ) = Obj.magic s in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_s_ in let _endpos = _endpos_xs_ in let _v : (string list) = let x = -# 3470 "parsing/parser.mly" +# 3497 "parsing/parser.mly" ( fst s ) -# 22348 "parsing/parser.ml" +# 22420 "parsing/parser.ml" in # 223 "menhir/standard.mly" ( x :: xs ) -# 22353 "parsing/parser.ml" +# 22425 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22372,14 +22444,14 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22378 "parsing/parser.ml" +# 22450 "parsing/parser.ml" in -# 2823 "parsing/parser.mly" +# 2846 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 22383 "parsing/parser.ml" +# 22455 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22409,14 +22481,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22415 "parsing/parser.ml" +# 22487 "parsing/parser.ml" in -# 2823 "parsing/parser.mly" +# 2846 "parsing/parser.mly" ( (Ptype_abstract, priv, Some ty) ) -# 22420 "parsing/parser.ml" +# 22492 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22439,26 +22511,26 @@ module Tables = struct let _startpos = _startpos_cs_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22445 "parsing/parser.ml" +# 22517 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22451 "parsing/parser.ml" +# 22523 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22456 "parsing/parser.ml" +# 22528 "parsing/parser.ml" in -# 2827 "parsing/parser.mly" +# 2850 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 22462 "parsing/parser.ml" +# 22534 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22488,26 +22560,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22494 "parsing/parser.ml" +# 22566 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22500 "parsing/parser.ml" +# 22572 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22505 "parsing/parser.ml" +# 22577 "parsing/parser.ml" in -# 2827 "parsing/parser.mly" +# 2850 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 22511 "parsing/parser.ml" +# 22583 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22544,33 +22616,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22550 "parsing/parser.ml" +# 22622 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 22557 "parsing/parser.ml" +# 22629 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 22562 "parsing/parser.ml" +# 22634 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22568 "parsing/parser.ml" +# 22640 "parsing/parser.ml" in -# 2827 "parsing/parser.mly" +# 2850 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 22574 "parsing/parser.ml" +# 22646 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22614,33 +22686,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_cs_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22620 "parsing/parser.ml" +# 22692 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 22627 "parsing/parser.ml" +# 22699 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 22632 "parsing/parser.ml" +# 22704 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22638 "parsing/parser.ml" +# 22710 "parsing/parser.ml" in -# 2827 "parsing/parser.mly" +# 2850 "parsing/parser.mly" ( (Ptype_variant cs, priv, oty) ) -# 22644 "parsing/parser.ml" +# 22716 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22663,26 +22735,26 @@ module Tables = struct let _startpos = _startpos__3_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22669 "parsing/parser.ml" +# 22741 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22675 "parsing/parser.ml" +# 22747 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22680 "parsing/parser.ml" +# 22752 "parsing/parser.ml" in -# 2831 "parsing/parser.mly" +# 2854 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 22686 "parsing/parser.ml" +# 22758 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22712,26 +22784,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22718 "parsing/parser.ml" +# 22790 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22724 "parsing/parser.ml" +# 22796 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22729 "parsing/parser.ml" +# 22801 "parsing/parser.ml" in -# 2831 "parsing/parser.mly" +# 2854 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 22735 "parsing/parser.ml" +# 22807 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22768,33 +22840,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22774 "parsing/parser.ml" +# 22846 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 22781 "parsing/parser.ml" +# 22853 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 22786 "parsing/parser.ml" +# 22858 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22792 "parsing/parser.ml" +# 22864 "parsing/parser.ml" in -# 2831 "parsing/parser.mly" +# 2854 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 22798 "parsing/parser.ml" +# 22870 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22838,33 +22910,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__3_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22844 "parsing/parser.ml" +# 22916 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 22851 "parsing/parser.ml" +# 22923 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 22856 "parsing/parser.ml" +# 22928 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22862 "parsing/parser.ml" +# 22934 "parsing/parser.ml" in -# 2831 "parsing/parser.mly" +# 2854 "parsing/parser.mly" ( (Ptype_open, priv, oty) ) -# 22868 "parsing/parser.ml" +# 22940 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22901,26 +22973,26 @@ module Tables = struct let _startpos = _startpos__3_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 22907 "parsing/parser.ml" +# 22979 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22913 "parsing/parser.ml" +# 22985 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22918 "parsing/parser.ml" +# 22990 "parsing/parser.ml" in -# 2835 "parsing/parser.mly" +# 2858 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 22924 "parsing/parser.ml" +# 22996 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -22964,26 +23036,26 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 22970 "parsing/parser.ml" +# 23042 "parsing/parser.ml" in let oty = let _1 = # 124 "menhir/standard.mly" ( None ) -# 22976 "parsing/parser.ml" +# 23048 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 22981 "parsing/parser.ml" +# 23053 "parsing/parser.ml" in -# 2835 "parsing/parser.mly" +# 2858 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 22987 "parsing/parser.ml" +# 23059 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23034,33 +23106,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 23040 "parsing/parser.ml" +# 23112 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 23047 "parsing/parser.ml" +# 23119 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 23052 "parsing/parser.ml" +# 23124 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 23058 "parsing/parser.ml" +# 23130 "parsing/parser.ml" in -# 2835 "parsing/parser.mly" +# 2858 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23064 "parsing/parser.ml" +# 23136 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23118,33 +23190,33 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos__5_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 23124 "parsing/parser.ml" +# 23196 "parsing/parser.ml" in let oty = let _1 = let x = # 191 "menhir/standard.mly" ( x ) -# 23131 "parsing/parser.ml" +# 23203 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 23136 "parsing/parser.ml" +# 23208 "parsing/parser.ml" in -# 2839 "parsing/parser.mly" +# 2862 "parsing/parser.mly" ( _1 ) -# 23142 "parsing/parser.ml" +# 23214 "parsing/parser.ml" in -# 2835 "parsing/parser.mly" +# 2858 "parsing/parser.mly" ( (Ptype_record ls, priv, oty) ) -# 23148 "parsing/parser.ml" +# 23220 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23197,37 +23269,37 @@ module Tables = struct let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 23203 "parsing/parser.ml" +# 23275 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 23212 "parsing/parser.ml" +# 23284 "parsing/parser.ml" in let override = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 23218 "parsing/parser.ml" +# 23290 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1398 "parsing/parser.mly" +# 1419 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Opn.mk me ~override ~attrs ~loc ~docs, ext ) -# 23231 "parsing/parser.ml" +# 23303 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23287,40 +23359,40 @@ module Tables = struct let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 23293 "parsing/parser.ml" +# 23365 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let attrs1 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 23302 "parsing/parser.ml" +# 23374 "parsing/parser.ml" in let override = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 23310 "parsing/parser.ml" +# 23382 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1398 "parsing/parser.mly" +# 1419 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Opn.mk me ~override ~attrs ~loc ~docs, ext ) -# 23324 "parsing/parser.ml" +# 23396 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23373,9 +23445,9 @@ module Tables = struct let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 23379 "parsing/parser.ml" +# 23451 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -23385,36 +23457,36 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 23391 "parsing/parser.ml" +# 23463 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 23399 "parsing/parser.ml" +# 23471 "parsing/parser.ml" in let override = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 23405 "parsing/parser.ml" +# 23477 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1413 "parsing/parser.mly" +# 1434 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Opn.mk id ~override ~attrs ~loc ~docs, ext ) -# 23418 "parsing/parser.ml" +# 23490 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23474,9 +23546,9 @@ module Tables = struct let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 23480 "parsing/parser.ml" +# 23552 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -23486,39 +23558,39 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 23492 "parsing/parser.ml" +# 23564 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined2 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 23500 "parsing/parser.ml" +# 23572 "parsing/parser.ml" in let override = let _1 = _1_inlined1 in -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 23508 "parsing/parser.ml" +# 23580 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1413 "parsing/parser.mly" +# 1434 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Opn.mk id ~override ~attrs ~loc ~docs, ext ) -# 23522 "parsing/parser.ml" +# 23594 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23537,17 +23609,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 644 "parsing/parser.mly" +# 666 "parsing/parser.mly" (string) -# 23543 "parsing/parser.ml" +# 23615 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3353 "parsing/parser.mly" +# 3376 "parsing/parser.mly" ( _1 ) -# 23551 "parsing/parser.ml" +# 23623 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23566,17 +23638,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 602 "parsing/parser.mly" +# 624 "parsing/parser.mly" (string) -# 23572 "parsing/parser.ml" +# 23644 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3354 "parsing/parser.mly" +# 3377 "parsing/parser.mly" ( _1 ) -# 23580 "parsing/parser.ml" +# 23652 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23595,60 +23667,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 603 "parsing/parser.mly" +# 625 "parsing/parser.mly" (string) -# 23601 "parsing/parser.ml" +# 23673 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3355 "parsing/parser.mly" +# 3378 "parsing/parser.mly" ( _1 ) -# 23609 "parsing/parser.ml" - in - { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = Obj.repr _v; - MenhirLib.EngineTypes.startp = _startpos; - MenhirLib.EngineTypes.endp = _endpos; - MenhirLib.EngineTypes.next = _menhir_stack; - }); - (fun _menhir_env -> - let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in - let { - MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _3; - MenhirLib.EngineTypes.startp = _startpos__3_; - MenhirLib.EngineTypes.endp = _endpos__3_; - MenhirLib.EngineTypes.next = { - MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _2; - MenhirLib.EngineTypes.startp = _startpos__2_; - MenhirLib.EngineTypes.endp = _endpos__2_; - MenhirLib.EngineTypes.next = { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = _1; - MenhirLib.EngineTypes.startp = _startpos__1_; - MenhirLib.EngineTypes.endp = _endpos__1_; - MenhirLib.EngineTypes.next = _menhir_stack; - }; - }; - } = _menhir_stack in - let _3 : unit = Obj.magic _3 in - let _2 : unit = Obj.magic _2 in - let _1 : ( -# 601 "parsing/parser.mly" - (string) -# 23644 "parsing/parser.ml" - ) = Obj.magic _1 in - let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in - let _startpos = _startpos__1_ in - let _endpos = _endpos__3_ in - let _v : (string) = -# 3356 "parsing/parser.mly" - ( "."^ _1 ^"()" ) -# 23652 "parsing/parser.ml" +# 23681 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23685,20 +23714,20 @@ module Tables = struct }; } = _menhir_stack in let _4 : unit = Obj.magic _4 in - let _3 : unit = Obj.magic _3 in + let _3 : (string) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 23694 "parsing/parser.ml" +# 23723 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (string) = -# 3357 "parsing/parser.mly" - ( "."^ _1 ^ "()<-" ) -# 23702 "parsing/parser.ml" +# 3379 "parsing/parser.mly" + ( "."^ _1 ^"(" ^ _3 ^ ")" ) +# 23731 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23711,37 +23740,51 @@ module Tables = struct let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in let { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _3; - MenhirLib.EngineTypes.startp = _startpos__3_; - MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.semv = _5; + MenhirLib.EngineTypes.startp = _startpos__5_; + MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _2; - MenhirLib.EngineTypes.startp = _startpos__2_; - MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.semv = _4; + MenhirLib.EngineTypes.startp = _startpos__4_; + MenhirLib.EngineTypes.endp = _endpos__4_; MenhirLib.EngineTypes.next = { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = _1; - MenhirLib.EngineTypes.startp = _startpos__1_; - MenhirLib.EngineTypes.endp = _endpos__1_; - MenhirLib.EngineTypes.next = _menhir_stack; + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _3; + MenhirLib.EngineTypes.startp = _startpos__3_; + MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _2; + MenhirLib.EngineTypes.startp = _startpos__2_; + MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; + MenhirLib.EngineTypes.next = _menhir_stack; + }; + }; }; }; } = _menhir_stack in - let _3 : unit = Obj.magic _3 in + let _5 : unit = Obj.magic _5 in + let _4 : unit = Obj.magic _4 in + let _3 : (string) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 23737 "parsing/parser.ml" +# 23780 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in - let _endpos = _endpos__3_ in + let _endpos = _endpos__5_ in let _v : (string) = -# 3358 "parsing/parser.mly" - ( "."^ _1 ^"[]" ) -# 23745 "parsing/parser.ml" +# 3380 "parsing/parser.mly" + ( "."^ _1 ^ "(" ^ _3 ^ ")<-" ) +# 23788 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23778,20 +23821,20 @@ module Tables = struct }; } = _menhir_stack in let _4 : unit = Obj.magic _4 in - let _3 : unit = Obj.magic _3 in + let _3 : (string) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 23787 "parsing/parser.ml" +# 23830 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (string) = -# 3359 "parsing/parser.mly" - ( "."^ _1 ^ "[]<-" ) -# 23795 "parsing/parser.ml" +# 3381 "parsing/parser.mly" + ( "."^ _1 ^"[" ^ _3 ^ "]" ) +# 23838 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23804,37 +23847,51 @@ module Tables = struct let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in let { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _3; - MenhirLib.EngineTypes.startp = _startpos__3_; - MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.semv = _5; + MenhirLib.EngineTypes.startp = _startpos__5_; + MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _2; - MenhirLib.EngineTypes.startp = _startpos__2_; - MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.semv = _4; + MenhirLib.EngineTypes.startp = _startpos__4_; + MenhirLib.EngineTypes.endp = _endpos__4_; MenhirLib.EngineTypes.next = { - MenhirLib.EngineTypes.state = _menhir_s; - MenhirLib.EngineTypes.semv = _1; - MenhirLib.EngineTypes.startp = _startpos__1_; - MenhirLib.EngineTypes.endp = _endpos__1_; - MenhirLib.EngineTypes.next = _menhir_stack; + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _3; + MenhirLib.EngineTypes.startp = _startpos__3_; + MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _2; + MenhirLib.EngineTypes.startp = _startpos__2_; + MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; + MenhirLib.EngineTypes.next = _menhir_stack; + }; + }; }; }; } = _menhir_stack in - let _3 : unit = Obj.magic _3 in + let _5 : unit = Obj.magic _5 in + let _4 : unit = Obj.magic _4 in + let _3 : (string) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 23830 "parsing/parser.ml" +# 23887 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in - let _endpos = _endpos__3_ in + let _endpos = _endpos__5_ in let _v : (string) = -# 3360 "parsing/parser.mly" - ( "."^ _1 ^"{}" ) -# 23838 "parsing/parser.ml" +# 3382 "parsing/parser.mly" + ( "."^ _1 ^ "[" ^ _3 ^ "]<-" ) +# 23895 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23871,20 +23928,77 @@ module Tables = struct }; } = _menhir_stack in let _4 : unit = Obj.magic _4 in - let _3 : unit = Obj.magic _3 in + let _3 : (string) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 23880 "parsing/parser.ml" +# 23937 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (string) = -# 3361 "parsing/parser.mly" - ( "."^ _1 ^ "{}<-" ) -# 23888 "parsing/parser.ml" +# 3383 "parsing/parser.mly" + ( "."^ _1 ^"{" ^ _3 ^ "}" ) +# 23945 "parsing/parser.ml" + in + { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = Obj.repr _v; + MenhirLib.EngineTypes.startp = _startpos; + MenhirLib.EngineTypes.endp = _endpos; + MenhirLib.EngineTypes.next = _menhir_stack; + }); + (fun _menhir_env -> + let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in + let { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _5; + MenhirLib.EngineTypes.startp = _startpos__5_; + MenhirLib.EngineTypes.endp = _endpos__5_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _4; + MenhirLib.EngineTypes.startp = _startpos__4_; + MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _3; + MenhirLib.EngineTypes.startp = _startpos__3_; + MenhirLib.EngineTypes.endp = _endpos__3_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _; + MenhirLib.EngineTypes.semv = _2; + MenhirLib.EngineTypes.startp = _startpos__2_; + MenhirLib.EngineTypes.endp = _endpos__2_; + MenhirLib.EngineTypes.next = { + MenhirLib.EngineTypes.state = _menhir_s; + MenhirLib.EngineTypes.semv = _1; + MenhirLib.EngineTypes.startp = _startpos__1_; + MenhirLib.EngineTypes.endp = _endpos__1_; + MenhirLib.EngineTypes.next = _menhir_stack; + }; + }; + }; + }; + } = _menhir_stack in + let _5 : unit = Obj.magic _5 in + let _4 : unit = Obj.magic _4 in + let _3 : (string) = Obj.magic _3 in + let _2 : unit = Obj.magic _2 in + let _1 : ( +# 623 "parsing/parser.mly" + (string) +# 23994 "parsing/parser.ml" + ) = Obj.magic _1 in + let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in + let _startpos = _startpos__1_ in + let _endpos = _endpos__5_ in + let _v : (string) = +# 3384 "parsing/parser.mly" + ( "."^ _1 ^ "{" ^ _3 ^ "}<-" ) +# 24002 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23903,17 +24017,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 655 "parsing/parser.mly" +# 677 "parsing/parser.mly" (string) -# 23909 "parsing/parser.ml" +# 24023 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3362 "parsing/parser.mly" +# 3385 "parsing/parser.mly" ( _1 ) -# 23917 "parsing/parser.ml" +# 24031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23936,9 +24050,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3363 "parsing/parser.mly" +# 3386 "parsing/parser.mly" ( "!" ) -# 23942 "parsing/parser.ml" +# 24056 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23957,22 +24071,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let op : ( -# 596 "parsing/parser.mly" +# 618 "parsing/parser.mly" (string) -# 23963 "parsing/parser.ml" +# 24077 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in let _endpos = _endpos_op_ in let _v : (string) = let _1 = -# 3367 "parsing/parser.mly" +# 3390 "parsing/parser.mly" ( op ) -# 23971 "parsing/parser.ml" +# 24085 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 23976 "parsing/parser.ml" +# 24090 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -23991,22 +24105,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let op : ( -# 597 "parsing/parser.mly" +# 619 "parsing/parser.mly" (string) -# 23997 "parsing/parser.ml" +# 24111 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in let _endpos = _endpos_op_ in let _v : (string) = let _1 = -# 3368 "parsing/parser.mly" +# 3391 "parsing/parser.mly" ( op ) -# 24005 "parsing/parser.ml" +# 24119 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24010 "parsing/parser.ml" +# 24124 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24025,22 +24139,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let op : ( -# 598 "parsing/parser.mly" +# 620 "parsing/parser.mly" (string) -# 24031 "parsing/parser.ml" +# 24145 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in let _endpos = _endpos_op_ in let _v : (string) = let _1 = -# 3369 "parsing/parser.mly" +# 3392 "parsing/parser.mly" ( op ) -# 24039 "parsing/parser.ml" +# 24153 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24044 "parsing/parser.ml" +# 24158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24059,22 +24173,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let op : ( -# 599 "parsing/parser.mly" +# 621 "parsing/parser.mly" (string) -# 24065 "parsing/parser.ml" +# 24179 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in let _endpos = _endpos_op_ in let _v : (string) = let _1 = -# 3370 "parsing/parser.mly" +# 3393 "parsing/parser.mly" ( op ) -# 24073 "parsing/parser.ml" +# 24187 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24078 "parsing/parser.ml" +# 24192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24093,22 +24207,22 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let op : ( -# 600 "parsing/parser.mly" +# 622 "parsing/parser.mly" (string) -# 24099 "parsing/parser.ml" +# 24213 "parsing/parser.ml" ) = Obj.magic op in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_op_ in let _endpos = _endpos_op_ in let _v : (string) = let _1 = -# 3371 "parsing/parser.mly" +# 3394 "parsing/parser.mly" ( op ) -# 24107 "parsing/parser.ml" +# 24221 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24112 "parsing/parser.ml" +# 24226 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24131,14 +24245,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3372 "parsing/parser.mly" +# 3395 "parsing/parser.mly" ("+") -# 24137 "parsing/parser.ml" +# 24251 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24142 "parsing/parser.ml" +# 24256 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24161,14 +24275,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3373 "parsing/parser.mly" +# 3396 "parsing/parser.mly" ("+.") -# 24167 "parsing/parser.ml" +# 24281 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24172 "parsing/parser.ml" +# 24286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24191,14 +24305,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3374 "parsing/parser.mly" +# 3397 "parsing/parser.mly" ("+=") -# 24197 "parsing/parser.ml" +# 24311 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24202 "parsing/parser.ml" +# 24316 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24221,14 +24335,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3375 "parsing/parser.mly" +# 3398 "parsing/parser.mly" ("-") -# 24227 "parsing/parser.ml" +# 24341 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24232 "parsing/parser.ml" +# 24346 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24251,14 +24365,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3376 "parsing/parser.mly" +# 3399 "parsing/parser.mly" ("-.") -# 24257 "parsing/parser.ml" +# 24371 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24262 "parsing/parser.ml" +# 24376 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24281,14 +24395,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3377 "parsing/parser.mly" +# 3400 "parsing/parser.mly" ("*") -# 24287 "parsing/parser.ml" +# 24401 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24292 "parsing/parser.ml" +# 24406 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24311,14 +24425,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3378 "parsing/parser.mly" +# 3401 "parsing/parser.mly" ("%") -# 24317 "parsing/parser.ml" +# 24431 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24322 "parsing/parser.ml" +# 24436 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24341,14 +24455,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3379 "parsing/parser.mly" +# 3402 "parsing/parser.mly" ("=") -# 24347 "parsing/parser.ml" +# 24461 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24352 "parsing/parser.ml" +# 24466 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24371,14 +24485,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3380 "parsing/parser.mly" +# 3403 "parsing/parser.mly" ("<") -# 24377 "parsing/parser.ml" +# 24491 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24382 "parsing/parser.ml" +# 24496 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24401,14 +24515,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3381 "parsing/parser.mly" +# 3404 "parsing/parser.mly" (">") -# 24407 "parsing/parser.ml" +# 24521 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24412 "parsing/parser.ml" +# 24526 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24431,14 +24545,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3382 "parsing/parser.mly" +# 3405 "parsing/parser.mly" ("or") -# 24437 "parsing/parser.ml" +# 24551 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24442 "parsing/parser.ml" +# 24556 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24461,14 +24575,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3383 "parsing/parser.mly" +# 3406 "parsing/parser.mly" ("||") -# 24467 "parsing/parser.ml" +# 24581 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24472 "parsing/parser.ml" +# 24586 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24491,14 +24605,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3384 "parsing/parser.mly" +# 3407 "parsing/parser.mly" ("&") -# 24497 "parsing/parser.ml" +# 24611 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24502 "parsing/parser.ml" +# 24616 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24521,14 +24635,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3385 "parsing/parser.mly" +# 3408 "parsing/parser.mly" ("&&") -# 24527 "parsing/parser.ml" +# 24641 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24532 "parsing/parser.ml" +# 24646 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24551,14 +24665,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = let _1 = -# 3386 "parsing/parser.mly" +# 3409 "parsing/parser.mly" (":=") -# 24557 "parsing/parser.ml" +# 24671 "parsing/parser.ml" in -# 3364 "parsing/parser.mly" +# 3387 "parsing/parser.mly" ( _1 ) -# 24562 "parsing/parser.ml" +# 24676 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24581,9 +24695,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (bool) = -# 3271 "parsing/parser.mly" +# 3294 "parsing/parser.mly" ( true ) -# 24587 "parsing/parser.ml" +# 24701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24599,9 +24713,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (bool) = -# 3272 "parsing/parser.mly" +# 3295 "parsing/parser.mly" ( false ) -# 24605 "parsing/parser.ml" +# 24719 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24619,7 +24733,7 @@ module Tables = struct let _v : (unit option) = # 114 "menhir/standard.mly" ( None ) -# 24623 "parsing/parser.ml" +# 24737 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24644,7 +24758,7 @@ module Tables = struct let _v : (unit option) = # 116 "menhir/standard.mly" ( Some x ) -# 24648 "parsing/parser.ml" +# 24762 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24662,7 +24776,7 @@ module Tables = struct let _v : (unit option) = # 114 "menhir/standard.mly" ( None ) -# 24666 "parsing/parser.ml" +# 24780 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24687,7 +24801,7 @@ module Tables = struct let _v : (unit option) = # 116 "menhir/standard.mly" ( Some x ) -# 24691 "parsing/parser.ml" +# 24805 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24705,7 +24819,7 @@ module Tables = struct let _v : (string Asttypes.loc option) = # 114 "menhir/standard.mly" ( None ) -# 24709 "parsing/parser.ml" +# 24823 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24730,9 +24844,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 24736 "parsing/parser.ml" +# 24850 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -24745,21 +24859,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 24751 "parsing/parser.ml" +# 24865 "parsing/parser.ml" in # 183 "menhir/standard.mly" ( x ) -# 24757 "parsing/parser.ml" +# 24871 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 24763 "parsing/parser.ml" +# 24877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24777,7 +24891,7 @@ module Tables = struct let _v : (Parsetree.core_type option) = # 114 "menhir/standard.mly" ( None ) -# 24781 "parsing/parser.ml" +# 24895 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24809,12 +24923,12 @@ module Tables = struct let _v : (Parsetree.core_type option) = let x = # 183 "menhir/standard.mly" ( x ) -# 24813 "parsing/parser.ml" +# 24927 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 24818 "parsing/parser.ml" +# 24932 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24832,7 +24946,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "menhir/standard.mly" ( None ) -# 24836 "parsing/parser.ml" +# 24950 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24864,12 +24978,12 @@ module Tables = struct let _v : (Parsetree.expression option) = let x = # 183 "menhir/standard.mly" ( x ) -# 24868 "parsing/parser.ml" +# 24982 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 24873 "parsing/parser.ml" +# 24987 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24887,7 +25001,7 @@ module Tables = struct let _v : (Parsetree.module_type option) = # 114 "menhir/standard.mly" ( None ) -# 24891 "parsing/parser.ml" +# 25005 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24919,12 +25033,12 @@ module Tables = struct let _v : (Parsetree.module_type option) = let x = # 183 "menhir/standard.mly" ( x ) -# 24923 "parsing/parser.ml" +# 25037 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 24928 "parsing/parser.ml" +# 25042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24942,7 +25056,7 @@ module Tables = struct let _v : (Parsetree.pattern option) = # 114 "menhir/standard.mly" ( None ) -# 24946 "parsing/parser.ml" +# 25060 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24974,12 +25088,12 @@ module Tables = struct let _v : (Parsetree.pattern option) = let x = # 183 "menhir/standard.mly" ( x ) -# 24978 "parsing/parser.ml" +# 25092 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 24983 "parsing/parser.ml" +# 25097 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -24997,7 +25111,7 @@ module Tables = struct let _v : (Parsetree.expression option) = # 114 "menhir/standard.mly" ( None ) -# 25001 "parsing/parser.ml" +# 25115 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25029,12 +25143,12 @@ module Tables = struct let _v : (Parsetree.expression option) = let x = # 183 "menhir/standard.mly" ( x ) -# 25033 "parsing/parser.ml" +# 25147 "parsing/parser.ml" in # 116 "menhir/standard.mly" ( Some x ) -# 25038 "parsing/parser.ml" +# 25152 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25052,7 +25166,7 @@ module Tables = struct let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) = # 114 "menhir/standard.mly" ( None ) -# 25056 "parsing/parser.ml" +# 25170 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25077,7 +25191,7 @@ module Tables = struct let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) = # 116 "menhir/standard.mly" ( Some x ) -# 25081 "parsing/parser.ml" +# 25195 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25096,17 +25210,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 637 "parsing/parser.mly" +# 659 "parsing/parser.mly" (string) -# 25102 "parsing/parser.ml" +# 25216 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3556 "parsing/parser.mly" +# 3583 "parsing/parser.mly" ( _1 ) -# 25110 "parsing/parser.ml" +# 25224 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25138,18 +25252,18 @@ module Tables = struct } = _menhir_stack in let _3 : unit = Obj.magic _3 in let _2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 25144 "parsing/parser.ml" +# 25258 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (string) = -# 3557 "parsing/parser.mly" +# 3584 "parsing/parser.mly" ( _2 ) -# 25153 "parsing/parser.ml" +# 25267 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25203,9 +25317,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1177 "parsing/parser.mly" +# 1199 "parsing/parser.mly" ( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) ) -# 25209 "parsing/parser.ml" +# 25323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25258,9 +25372,9 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1179 "parsing/parser.mly" +# 1201 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 25264 "parsing/parser.ml" +# 25378 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25297,9 +25411,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.module_expr) = -# 1182 "parsing/parser.mly" +# 1204 "parsing/parser.mly" ( me (* TODO consider reloc *) ) -# 25303 "parsing/parser.ml" +# 25417 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25338,9 +25452,9 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1184 "parsing/parser.mly" +# 1206 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 25344 "parsing/parser.ml" +# 25458 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25391,25 +25505,25 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.module_expr) = let e = -# 1201 "parsing/parser.mly" +# 1223 "parsing/parser.mly" ( e ) -# 25397 "parsing/parser.ml" +# 25511 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25404 "parsing/parser.ml" +# 25518 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1188 "parsing/parser.mly" +# 1210 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 25413 "parsing/parser.ml" +# 25527 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25478,23 +25592,23 @@ module Tables = struct let ty = let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 25484 "parsing/parser.ml" +# 25598 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 25492 "parsing/parser.ml" +# 25606 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 25498 "parsing/parser.ml" +# 25612 "parsing/parser.ml" in let _endpos_ty_ = _endpos__1_ in @@ -25502,26 +25616,26 @@ module Tables = struct let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1203 "parsing/parser.mly" +# 1225 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) ) -# 25508 "parsing/parser.ml" +# 25622 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25516 "parsing/parser.ml" +# 25630 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1188 "parsing/parser.mly" +# 1210 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 25525 "parsing/parser.ml" +# 25639 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25605,72 +25719,72 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 25611 "parsing/parser.ml" +# 25725 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 25619 "parsing/parser.ml" +# 25733 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 25625 "parsing/parser.ml" +# 25739 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_inlined1_ in let ty1 = let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 25634 "parsing/parser.ml" +# 25748 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 25642 "parsing/parser.ml" +# 25756 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 25648 "parsing/parser.ml" +# 25762 "parsing/parser.ml" in let _endpos = _endpos_ty2_ in let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1205 "parsing/parser.mly" +# 1227 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) ) -# 25657 "parsing/parser.ml" +# 25771 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25665 "parsing/parser.ml" +# 25779 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1188 "parsing/parser.mly" +# 1210 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 25674 "parsing/parser.ml" +# 25788 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25739,23 +25853,23 @@ module Tables = struct let ty2 = let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 25745 "parsing/parser.ml" +# 25859 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 25753 "parsing/parser.ml" +# 25867 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 25759 "parsing/parser.ml" +# 25873 "parsing/parser.ml" in let _endpos_ty2_ = _endpos__1_ in @@ -25763,26 +25877,26 @@ module Tables = struct let _startpos = _startpos_e_ in let _loc = (_startpos, _endpos) in -# 1207 "parsing/parser.mly" +# 1229 "parsing/parser.mly" ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) ) -# 25769 "parsing/parser.ml" +# 25883 "parsing/parser.ml" in let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25777 "parsing/parser.ml" +# 25891 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1188 "parsing/parser.mly" +# 1210 "parsing/parser.mly" ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) ) -# 25786 "parsing/parser.ml" +# 25900 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25842,17 +25956,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25848 "parsing/parser.ml" +# 25962 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1190 "parsing/parser.mly" +# 1212 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 25856 "parsing/parser.ml" +# 25970 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25912,17 +26026,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25918 "parsing/parser.ml" +# 26032 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1192 "parsing/parser.mly" +# 1214 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 25926 "parsing/parser.ml" +# 26040 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -25975,17 +26089,17 @@ module Tables = struct let _v : (Parsetree.module_expr) = let _3 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 25981 "parsing/parser.ml" +# 26095 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1194 "parsing/parser.mly" +# 1216 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 25989 "parsing/parser.ml" +# 26103 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26015,13 +26129,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 754 "parsing/parser.mly" +# 776 "parsing/parser.mly" (Parsetree.core_type) -# 26021 "parsing/parser.ml" +# 26135 "parsing/parser.ml" ) = -# 1087 "parsing/parser.mly" +# 1109 "parsing/parser.mly" ( _1 ) -# 26025 "parsing/parser.ml" +# 26139 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26051,13 +26165,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 756 "parsing/parser.mly" +# 778 "parsing/parser.mly" (Parsetree.expression) -# 26057 "parsing/parser.ml" +# 26171 "parsing/parser.ml" ) = -# 1092 "parsing/parser.mly" +# 1114 "parsing/parser.mly" ( _1 ) -# 26061 "parsing/parser.ml" +# 26175 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26087,13 +26201,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 758 "parsing/parser.mly" +# 780 "parsing/parser.mly" (Parsetree.pattern) -# 26093 "parsing/parser.ml" +# 26207 "parsing/parser.ml" ) = -# 1097 "parsing/parser.mly" +# 1119 "parsing/parser.mly" ( _1 ) -# 26097 "parsing/parser.ml" +# 26211 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26135,15 +26249,15 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2558 "parsing/parser.mly" +# 2581 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 26141 "parsing/parser.ml" +# 26255 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26147 "parsing/parser.ml" +# 26261 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26173,14 +26287,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = -# 2560 "parsing/parser.mly" +# 2583 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 26179 "parsing/parser.ml" +# 26293 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26184 "parsing/parser.ml" +# 26298 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26203,14 +26317,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = -# 2562 "parsing/parser.mly" +# 2585 "parsing/parser.mly" ( _1 ) -# 26209 "parsing/parser.ml" +# 26323 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26214 "parsing/parser.ml" +# 26328 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26255,15 +26369,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26261 "parsing/parser.ml" +# 26375 "parsing/parser.ml" in -# 2565 "parsing/parser.mly" +# 2588 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 26267 "parsing/parser.ml" +# 26381 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -26271,21 +26385,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26277 "parsing/parser.ml" +# 26391 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26283 "parsing/parser.ml" +# 26397 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26289 "parsing/parser.ml" +# 26403 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26326,9 +26440,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2567 "parsing/parser.mly" +# 2590 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 26332 "parsing/parser.ml" +# 26446 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -26336,21 +26450,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26342 "parsing/parser.ml" +# 26456 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26348 "parsing/parser.ml" +# 26462 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26354 "parsing/parser.ml" +# 26468 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26375,29 +26489,29 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2569 "parsing/parser.mly" +# 2592 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 26381 "parsing/parser.ml" +# 26495 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26389 "parsing/parser.ml" +# 26503 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26395 "parsing/parser.ml" +# 26509 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26401 "parsing/parser.ml" +# 26515 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26438,9 +26552,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2571 "parsing/parser.mly" +# 2594 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 26444 "parsing/parser.ml" +# 26558 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -26448,21 +26562,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26454 "parsing/parser.ml" +# 26568 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26460 "parsing/parser.ml" +# 26574 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26466 "parsing/parser.ml" +# 26580 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26501,30 +26615,30 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2573 "parsing/parser.mly" +# 2596 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 26507 "parsing/parser.ml" +# 26621 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26516 "parsing/parser.ml" +# 26630 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26522 "parsing/parser.ml" +# 26636 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26528 "parsing/parser.ml" +# 26642 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26565,9 +26679,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2575 "parsing/parser.mly" +# 2598 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 26571 "parsing/parser.ml" +# 26685 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -26575,21 +26689,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26581 "parsing/parser.ml" +# 26695 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 26587 "parsing/parser.ml" +# 26701 "parsing/parser.ml" in -# 2546 "parsing/parser.mly" +# 2569 "parsing/parser.mly" ( _1 ) -# 26593 "parsing/parser.ml" +# 26707 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26637,24 +26751,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 26643 "parsing/parser.ml" +# 26757 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 26649 "parsing/parser.ml" +# 26763 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2548 "parsing/parser.mly" +# 2571 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2) -# 26658 "parsing/parser.ml" +# 26772 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26691,9 +26805,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2672 "parsing/parser.mly" +# 2695 "parsing/parser.mly" ( _3 :: _1 ) -# 26697 "parsing/parser.ml" +# 26811 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26730,9 +26844,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2673 "parsing/parser.mly" +# 2696 "parsing/parser.mly" ( [_3; _1] ) -# 26736 "parsing/parser.ml" +# 26850 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26770,9 +26884,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2674 "parsing/parser.mly" +# 2697 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 26776 "parsing/parser.ml" +# 26890 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26809,9 +26923,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2672 "parsing/parser.mly" +# 2695 "parsing/parser.mly" ( _3 :: _1 ) -# 26815 "parsing/parser.ml" +# 26929 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26848,9 +26962,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = -# 2673 "parsing/parser.mly" +# 2696 "parsing/parser.mly" ( [_3; _1] ) -# 26854 "parsing/parser.ml" +# 26968 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26888,9 +27002,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2674 "parsing/parser.mly" +# 2697 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 26894 "parsing/parser.ml" +# 27008 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26913,9 +27027,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2581 "parsing/parser.mly" +# 2604 "parsing/parser.mly" ( _1 ) -# 26919 "parsing/parser.ml" +# 27033 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -26951,15 +27065,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 26957 "parsing/parser.ml" +# 27071 "parsing/parser.ml" in -# 2584 "parsing/parser.mly" +# 2607 "parsing/parser.mly" ( Ppat_construct(_1, Some _2) ) -# 26963 "parsing/parser.ml" +# 27077 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -26967,15 +27081,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 26973 "parsing/parser.ml" +# 27087 "parsing/parser.ml" in -# 2587 "parsing/parser.mly" +# 2610 "parsing/parser.mly" ( _1 ) -# 26979 "parsing/parser.ml" +# 27093 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27006,24 +27120,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2586 "parsing/parser.mly" +# 2609 "parsing/parser.mly" ( Ppat_variant(_1, Some _2) ) -# 27012 "parsing/parser.ml" +# 27126 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27021 "parsing/parser.ml" +# 27135 "parsing/parser.ml" in -# 2587 "parsing/parser.mly" +# 2610 "parsing/parser.mly" ( _1 ) -# 27027 "parsing/parser.ml" +# 27141 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27071,24 +27185,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 27077 "parsing/parser.ml" +# 27191 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 27083 "parsing/parser.ml" +# 27197 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2589 "parsing/parser.mly" +# 2612 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2) -# 27092 "parsing/parser.ml" +# 27206 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27130,15 +27244,15 @@ module Tables = struct let _loc__2_ = (_startpos__2_, _endpos__2_) in let _sloc = (_symbolstartpos, _endpos) in -# 2558 "parsing/parser.mly" +# 2581 "parsing/parser.mly" ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) ) -# 27136 "parsing/parser.ml" +# 27250 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27142 "parsing/parser.ml" +# 27256 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27168,14 +27282,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = -# 2560 "parsing/parser.mly" +# 2583 "parsing/parser.mly" ( Pat.attr _1 _2 ) -# 27174 "parsing/parser.ml" +# 27288 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27179 "parsing/parser.ml" +# 27293 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27198,14 +27312,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = -# 2562 "parsing/parser.mly" +# 2585 "parsing/parser.mly" ( _1 ) -# 27204 "parsing/parser.ml" +# 27318 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27209 "parsing/parser.ml" +# 27323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27250,15 +27364,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27256 "parsing/parser.ml" +# 27370 "parsing/parser.ml" in -# 2565 "parsing/parser.mly" +# 2588 "parsing/parser.mly" ( Ppat_alias(_1, _3) ) -# 27262 "parsing/parser.ml" +# 27376 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -27266,21 +27380,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27272 "parsing/parser.ml" +# 27386 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27278 "parsing/parser.ml" +# 27392 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27284 "parsing/parser.ml" +# 27398 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27321,9 +27435,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2567 "parsing/parser.mly" +# 2590 "parsing/parser.mly" ( expecting _loc__3_ "identifier" ) -# 27327 "parsing/parser.ml" +# 27441 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27331,21 +27445,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27337 "parsing/parser.ml" +# 27451 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27343 "parsing/parser.ml" +# 27457 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27349 "parsing/parser.ml" +# 27463 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27370,29 +27484,29 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2569 "parsing/parser.mly" +# 2592 "parsing/parser.mly" ( Ppat_tuple(List.rev _1) ) -# 27376 "parsing/parser.ml" +# 27490 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27384 "parsing/parser.ml" +# 27498 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27390 "parsing/parser.ml" +# 27504 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27396 "parsing/parser.ml" +# 27510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27433,9 +27547,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2571 "parsing/parser.mly" +# 2594 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27439 "parsing/parser.ml" +# 27553 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27443,21 +27557,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27449 "parsing/parser.ml" +# 27563 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27455 "parsing/parser.ml" +# 27569 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27461 "parsing/parser.ml" +# 27575 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27496,30 +27610,30 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _1 = -# 2573 "parsing/parser.mly" +# 2596 "parsing/parser.mly" ( Ppat_or(_1, _3) ) -# 27502 "parsing/parser.ml" +# 27616 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27511 "parsing/parser.ml" +# 27625 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27517 "parsing/parser.ml" +# 27631 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27523 "parsing/parser.ml" +# 27637 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27560,9 +27674,9 @@ module Tables = struct let _1 = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2575 "parsing/parser.mly" +# 2598 "parsing/parser.mly" ( expecting _loc__3_ "pattern" ) -# 27566 "parsing/parser.ml" +# 27680 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -27570,21 +27684,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27576 "parsing/parser.ml" +# 27690 "parsing/parser.ml" in -# 2576 "parsing/parser.mly" +# 2599 "parsing/parser.mly" ( _1 ) -# 27582 "parsing/parser.ml" +# 27696 "parsing/parser.ml" in -# 2553 "parsing/parser.mly" +# 2576 "parsing/parser.mly" ( _1 ) -# 27588 "parsing/parser.ml" +# 27702 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27603,9 +27717,9 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 27609 "parsing/parser.ml" +# 27723 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -27617,30 +27731,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 27623 "parsing/parser.ml" +# 27737 "parsing/parser.ml" in -# 2034 "parsing/parser.mly" +# 2054 "parsing/parser.mly" ( Ppat_var _1 ) -# 27629 "parsing/parser.ml" +# 27743 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27638 "parsing/parser.ml" +# 27752 "parsing/parser.ml" in -# 2036 "parsing/parser.mly" +# 2056 "parsing/parser.mly" ( _1 ) -# 27644 "parsing/parser.ml" +# 27758 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27664,23 +27778,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2035 "parsing/parser.mly" +# 2055 "parsing/parser.mly" ( Ppat_any ) -# 27670 "parsing/parser.ml" +# 27784 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 27678 "parsing/parser.ml" +# 27792 "parsing/parser.ml" in -# 2036 "parsing/parser.mly" +# 2056 "parsing/parser.mly" ( _1 ) -# 27684 "parsing/parser.ml" +# 27798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27703,9 +27817,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.payload) = -# 3662 "parsing/parser.mly" +# 3689 "parsing/parser.mly" ( PStr _1 ) -# 27709 "parsing/parser.ml" +# 27823 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27735,9 +27849,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3663 "parsing/parser.mly" +# 3690 "parsing/parser.mly" ( PSig _2 ) -# 27741 "parsing/parser.ml" +# 27855 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27767,9 +27881,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3664 "parsing/parser.mly" +# 3691 "parsing/parser.mly" ( PTyp _2 ) -# 27773 "parsing/parser.ml" +# 27887 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27799,9 +27913,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.payload) = -# 3665 "parsing/parser.mly" +# 3692 "parsing/parser.mly" ( PPat (_2, None) ) -# 27805 "parsing/parser.ml" +# 27919 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27845,9 +27959,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.payload) = -# 3666 "parsing/parser.mly" +# 3693 "parsing/parser.mly" ( PPat (_2, Some _4) ) -# 27851 "parsing/parser.ml" +# 27965 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27870,9 +27984,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = -# 3085 "parsing/parser.mly" +# 3108 "parsing/parser.mly" ( _1 ) -# 27876 "parsing/parser.ml" +# 27990 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27915,24 +28029,24 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 27919 "parsing/parser.ml" +# 28033 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 27924 "parsing/parser.ml" +# 28038 "parsing/parser.ml" in -# 3077 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 27930 "parsing/parser.ml" +# 28044 "parsing/parser.ml" in -# 3081 "parsing/parser.mly" +# 3104 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 27936 "parsing/parser.ml" +# 28050 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in @@ -27940,15 +28054,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 27946 "parsing/parser.ml" +# 28060 "parsing/parser.ml" in -# 3087 "parsing/parser.mly" +# 3110 "parsing/parser.mly" ( _1 ) -# 27952 "parsing/parser.ml" +# 28066 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -27971,14 +28085,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 27977 "parsing/parser.ml" +# 28091 "parsing/parser.ml" in -# 3085 "parsing/parser.mly" +# 3108 "parsing/parser.mly" ( _1 ) -# 27982 "parsing/parser.ml" +# 28096 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28017,33 +28131,33 @@ module Tables = struct let _v : (Parsetree.core_type) = let _1 = let _1 = let _3 = -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 28023 "parsing/parser.ml" +# 28137 "parsing/parser.ml" in let _1 = let _1 = let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 28030 "parsing/parser.ml" +# 28144 "parsing/parser.ml" in -# 872 "parsing/parser.mly" +# 894 "parsing/parser.mly" ( xs ) -# 28035 "parsing/parser.ml" +# 28149 "parsing/parser.ml" in -# 3077 "parsing/parser.mly" +# 3100 "parsing/parser.mly" ( _1 ) -# 28041 "parsing/parser.ml" +# 28155 "parsing/parser.ml" in -# 3081 "parsing/parser.mly" +# 3104 "parsing/parser.mly" ( Ptyp_poly(_1, _3) ) -# 28047 "parsing/parser.ml" +# 28161 "parsing/parser.ml" in let _startpos__1_ = _startpos_xs_ in @@ -28051,15 +28165,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 28057 "parsing/parser.ml" +# 28171 "parsing/parser.ml" in -# 3087 "parsing/parser.mly" +# 3110 "parsing/parser.mly" ( _1 ) -# 28063 "parsing/parser.ml" +# 28177 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28106,9 +28220,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3629 "parsing/parser.mly" +# 3656 "parsing/parser.mly" ( Attr.mk ~loc:(make_loc _sloc) _2 _3 ) -# 28112 "parsing/parser.ml" +# 28226 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28189,9 +28303,9 @@ module Tables = struct let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 28195 "parsing/parser.ml" +# 28309 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -28201,30 +28315,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 28207 "parsing/parser.ml" +# 28321 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 28215 "parsing/parser.ml" +# 28329 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2733 "parsing/parser.mly" +# 2756 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Val.mk id ty ~prim ~attrs ~loc ~docs, ext ) -# 28228 "parsing/parser.ml" +# 28342 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28240,14 +28354,14 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.private_flag) = let _1 = -# 3497 "parsing/parser.mly" +# 3524 "parsing/parser.mly" ( Public ) -# 28246 "parsing/parser.ml" +# 28360 "parsing/parser.ml" in -# 3494 "parsing/parser.mly" +# 3521 "parsing/parser.mly" ( _1 ) -# 28251 "parsing/parser.ml" +# 28365 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28270,14 +28384,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = let _1 = -# 3498 "parsing/parser.mly" +# 3525 "parsing/parser.mly" ( Private ) -# 28276 "parsing/parser.ml" +# 28390 "parsing/parser.ml" in -# 3494 "parsing/parser.mly" +# 3521 "parsing/parser.mly" ( _1 ) -# 28281 "parsing/parser.ml" +# 28395 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28293,9 +28407,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3520 "parsing/parser.mly" +# 3547 "parsing/parser.mly" ( Public, Concrete ) -# 28299 "parsing/parser.ml" +# 28413 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28318,9 +28432,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3521 "parsing/parser.mly" +# 3548 "parsing/parser.mly" ( Private, Concrete ) -# 28324 "parsing/parser.ml" +# 28438 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28343,9 +28457,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3522 "parsing/parser.mly" +# 3549 "parsing/parser.mly" ( Public, Virtual ) -# 28349 "parsing/parser.ml" +# 28463 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28375,9 +28489,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3523 "parsing/parser.mly" +# 3550 "parsing/parser.mly" ( Private, Virtual ) -# 28381 "parsing/parser.ml" +# 28495 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28407,9 +28521,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = -# 3524 "parsing/parser.mly" +# 3551 "parsing/parser.mly" ( Private, Virtual ) -# 28413 "parsing/parser.ml" +# 28527 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28425,9 +28539,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.rec_flag) = -# 3477 "parsing/parser.mly" +# 3504 "parsing/parser.mly" ( Nonrecursive ) -# 28431 "parsing/parser.ml" +# 28545 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28450,9 +28564,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.rec_flag) = -# 3478 "parsing/parser.mly" +# 3505 "parsing/parser.mly" ( Recursive ) -# 28456 "parsing/parser.ml" +# 28570 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28478,12 +28592,12 @@ module Tables = struct (Longident.t Asttypes.loc * Parsetree.expression) list) = let eo = # 124 "menhir/standard.mly" ( None ) -# 28482 "parsing/parser.ml" +# 28596 "parsing/parser.ml" in -# 2478 "parsing/parser.mly" +# 2501 "parsing/parser.mly" ( eo, fields ) -# 28487 "parsing/parser.ml" +# 28601 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28524,18 +28638,18 @@ module Tables = struct let x = # 191 "menhir/standard.mly" ( x ) -# 28528 "parsing/parser.ml" +# 28642 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 28533 "parsing/parser.ml" +# 28647 "parsing/parser.ml" in -# 2478 "parsing/parser.mly" +# 2501 "parsing/parser.mly" ( eo, fields ) -# 28539 "parsing/parser.ml" +# 28653 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28560,17 +28674,17 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.constructor_declaration list) = let x = -# 2907 "parsing/parser.mly" +# 2930 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Type.constructor cid ~args ?res ~attrs ~loc ~info ) -# 28569 "parsing/parser.ml" +# 28683 "parsing/parser.ml" in -# 982 "parsing/parser.mly" +# 1004 "parsing/parser.mly" ( [x] ) -# 28574 "parsing/parser.ml" +# 28688 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28595,17 +28709,17 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.constructor_declaration list) = let x = -# 2907 "parsing/parser.mly" +# 2930 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Type.constructor cid ~args ?res ~attrs ~loc ~info ) -# 28604 "parsing/parser.ml" +# 28718 "parsing/parser.ml" in -# 985 "parsing/parser.mly" +# 1007 "parsing/parser.mly" ( [x] ) -# 28609 "parsing/parser.ml" +# 28723 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28637,17 +28751,17 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_d_ in let _v : (Parsetree.constructor_declaration list) = let x = -# 2907 "parsing/parser.mly" +# 2930 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Type.constructor cid ~args ?res ~attrs ~loc ~info ) -# 28646 "parsing/parser.ml" +# 28760 "parsing/parser.ml" in -# 989 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( x :: xs ) -# 28651 "parsing/parser.ml" +# 28765 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28673,23 +28787,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28682 "parsing/parser.ml" +# 28796 "parsing/parser.ml" in -# 3013 "parsing/parser.mly" +# 3036 "parsing/parser.mly" ( _1 ) -# 28687 "parsing/parser.ml" +# 28801 "parsing/parser.ml" in -# 982 "parsing/parser.mly" +# 1004 "parsing/parser.mly" ( [x] ) -# 28693 "parsing/parser.ml" +# 28807 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28712,14 +28826,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3015 "parsing/parser.mly" +# 3038 "parsing/parser.mly" ( _1 ) -# 28718 "parsing/parser.ml" +# 28832 "parsing/parser.ml" in -# 982 "parsing/parser.mly" +# 1004 "parsing/parser.mly" ( [x] ) -# 28723 "parsing/parser.ml" +# 28837 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28745,23 +28859,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28754 "parsing/parser.ml" +# 28868 "parsing/parser.ml" in -# 3013 "parsing/parser.mly" +# 3036 "parsing/parser.mly" ( _1 ) -# 28759 "parsing/parser.ml" +# 28873 "parsing/parser.ml" in -# 985 "parsing/parser.mly" +# 1007 "parsing/parser.mly" ( [x] ) -# 28765 "parsing/parser.ml" +# 28879 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28784,14 +28898,14 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3015 "parsing/parser.mly" +# 3038 "parsing/parser.mly" ( _1 ) -# 28790 "parsing/parser.ml" +# 28904 "parsing/parser.ml" in -# 985 "parsing/parser.mly" +# 1007 "parsing/parser.mly" ( [x] ) -# 28795 "parsing/parser.ml" +# 28909 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28824,23 +28938,23 @@ module Tables = struct let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = let _1 = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28833 "parsing/parser.ml" +# 28947 "parsing/parser.ml" in -# 3013 "parsing/parser.mly" +# 3036 "parsing/parser.mly" ( _1 ) -# 28838 "parsing/parser.ml" +# 28952 "parsing/parser.ml" in -# 989 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( x :: xs ) -# 28844 "parsing/parser.ml" +# 28958 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28870,14 +28984,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos__1_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3015 "parsing/parser.mly" +# 3038 "parsing/parser.mly" ( _1 ) -# 28876 "parsing/parser.ml" +# 28990 "parsing/parser.ml" in -# 989 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( x :: xs ) -# 28881 "parsing/parser.ml" +# 28995 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28902,17 +29016,17 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28911 "parsing/parser.ml" +# 29025 "parsing/parser.ml" in -# 982 "parsing/parser.mly" +# 1004 "parsing/parser.mly" ( [x] ) -# 28916 "parsing/parser.ml" +# 29030 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28937,17 +29051,17 @@ module Tables = struct let _startpos = _startpos_d_ in let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28946 "parsing/parser.ml" +# 29060 "parsing/parser.ml" in -# 985 "parsing/parser.mly" +# 1007 "parsing/parser.mly" ( [x] ) -# 28951 "parsing/parser.ml" +# 29065 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -28979,17 +29093,17 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_d_ in let _v : (Parsetree.extension_constructor list) = let x = -# 3019 "parsing/parser.mly" +# 3042 "parsing/parser.mly" ( let cid, args, res, attrs, loc, info = d in Te.decl cid ~args ?res ~attrs ~loc ~info ) -# 28988 "parsing/parser.ml" +# 29102 "parsing/parser.ml" in -# 989 "parsing/parser.mly" +# 1011 "parsing/parser.mly" ( x :: xs ) -# 28993 "parsing/parser.ml" +# 29107 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29005,9 +29119,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = -# 848 "parsing/parser.mly" +# 870 "parsing/parser.mly" ( [] ) -# 29011 "parsing/parser.ml" +# 29125 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29064,21 +29178,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1914 "parsing/parser.mly" +# 1934 "parsing/parser.mly" ( _1, _3, make_loc _sloc ) -# 29070 "parsing/parser.ml" +# 29184 "parsing/parser.ml" in # 183 "menhir/standard.mly" ( x ) -# 29076 "parsing/parser.ml" +# 29190 "parsing/parser.ml" in -# 850 "parsing/parser.mly" +# 872 "parsing/parser.mly" ( x :: xs ) -# 29082 "parsing/parser.ml" +# 29196 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29096,14 +29210,14 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos_x_; MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in - let x : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic x in + let x : (Parsetree.functor_parameter) = Obj.magic x in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in - let _v : ((string Asttypes.loc * Parsetree.module_type option) list) = -# 862 "parsing/parser.mly" + let _v : (Parsetree.functor_parameter list) = +# 884 "parsing/parser.mly" ( [ x ] ) -# 29107 "parsing/parser.ml" +# 29221 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29127,15 +29241,15 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; }; } = _menhir_stack in - let x : (string Asttypes.loc * Parsetree.module_type option) = Obj.magic x in - let xs : ((string Asttypes.loc * Parsetree.module_type option) list) = Obj.magic xs in + let x : (Parsetree.functor_parameter) = Obj.magic x in + let xs : (Parsetree.functor_parameter list) = Obj.magic xs in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in - let _v : ((string Asttypes.loc * Parsetree.module_type option) list) = -# 864 "parsing/parser.mly" + let _v : (Parsetree.functor_parameter list) = +# 886 "parsing/parser.mly" ( x :: xs ) -# 29139 "parsing/parser.ml" +# 29253 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29158,9 +29272,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : ((Asttypes.arg_label * Parsetree.expression) list) = -# 862 "parsing/parser.mly" +# 884 "parsing/parser.mly" ( [ x ] ) -# 29164 "parsing/parser.ml" +# 29278 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29190,9 +29304,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : ((Asttypes.arg_label * Parsetree.expression) list) = -# 864 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( x :: xs ) -# 29196 "parsing/parser.ml" +# 29310 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29215,9 +29329,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Asttypes.label list) = -# 862 "parsing/parser.mly" +# 884 "parsing/parser.mly" ( [ x ] ) -# 29221 "parsing/parser.ml" +# 29335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29247,9 +29361,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Asttypes.label list) = -# 864 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( x :: xs ) -# 29253 "parsing/parser.ml" +# 29367 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29285,21 +29399,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29291 "parsing/parser.ml" +# 29405 "parsing/parser.ml" in -# 3073 "parsing/parser.mly" +# 3096 "parsing/parser.mly" ( _2 ) -# 29297 "parsing/parser.ml" +# 29411 "parsing/parser.ml" in -# 862 "parsing/parser.mly" +# 884 "parsing/parser.mly" ( [ x ] ) -# 29303 "parsing/parser.ml" +# 29417 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29342,21 +29456,21 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 29348 "parsing/parser.ml" +# 29462 "parsing/parser.ml" in -# 3073 "parsing/parser.mly" +# 3096 "parsing/parser.mly" ( _2 ) -# 29354 "parsing/parser.ml" +# 29468 "parsing/parser.ml" in -# 864 "parsing/parser.mly" +# 886 "parsing/parser.mly" ( x :: xs ) -# 29360 "parsing/parser.ml" +# 29474 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29381,12 +29495,12 @@ module Tables = struct let _v : (Parsetree.case list) = let _1 = # 124 "menhir/standard.mly" ( None ) -# 29385 "parsing/parser.ml" +# 29499 "parsing/parser.ml" in -# 953 "parsing/parser.mly" +# 975 "parsing/parser.mly" ( [x] ) -# 29390 "parsing/parser.ml" +# 29504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29420,13 +29534,13 @@ module Tables = struct # 126 "menhir/standard.mly" ( Some x ) -# 29424 "parsing/parser.ml" +# 29538 "parsing/parser.ml" in -# 953 "parsing/parser.mly" +# 975 "parsing/parser.mly" ( [x] ) -# 29430 "parsing/parser.ml" +# 29544 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29463,9 +29577,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.case list) = -# 957 "parsing/parser.mly" +# 979 "parsing/parser.mly" ( x :: xs ) -# 29469 "parsing/parser.ml" +# 29583 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29489,20 +29603,20 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type list) = let xs = let x = -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 29495 "parsing/parser.ml" +# 29609 "parsing/parser.ml" in -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29500 "parsing/parser.ml" +# 29614 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29506 "parsing/parser.ml" +# 29620 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29540,20 +29654,20 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type list) = let xs = let x = -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 29546 "parsing/parser.ml" +# 29660 "parsing/parser.ml" in -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29551 "parsing/parser.ml" +# 29665 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29557 "parsing/parser.ml" +# 29671 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29576,14 +29690,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.with_constraint list) = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29582 "parsing/parser.ml" +# 29696 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29587 "parsing/parser.ml" +# 29701 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29620,14 +29734,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.with_constraint list) = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29626 "parsing/parser.ml" +# 29740 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29631 "parsing/parser.ml" +# 29745 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29650,14 +29764,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.row_field list) = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29656 "parsing/parser.ml" +# 29770 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29661 "parsing/parser.ml" +# 29775 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29694,14 +29808,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.row_field list) = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29700 "parsing/parser.ml" +# 29814 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29705 "parsing/parser.ml" +# 29819 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29724,14 +29838,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29730 "parsing/parser.ml" +# 29844 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29735 "parsing/parser.ml" +# 29849 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29768,14 +29882,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29774 "parsing/parser.ml" +# 29888 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29779 "parsing/parser.ml" +# 29893 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29798,14 +29912,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : ((Parsetree.core_type * Asttypes.variance) list) = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29804 "parsing/parser.ml" +# 29918 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29809 "parsing/parser.ml" +# 29923 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29842,14 +29956,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : ((Parsetree.core_type * Asttypes.variance) list) = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29848 "parsing/parser.ml" +# 29962 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29853 "parsing/parser.ml" +# 29967 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29872,14 +29986,14 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 888 "parsing/parser.mly" +# 910 "parsing/parser.mly" ( [ x ] ) -# 29878 "parsing/parser.ml" +# 29992 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29883 "parsing/parser.ml" +# 29997 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29916,14 +30030,14 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = let xs = -# 892 "parsing/parser.mly" +# 914 "parsing/parser.mly" ( x :: xs ) -# 29922 "parsing/parser.ml" +# 30036 "parsing/parser.ml" in -# 896 "parsing/parser.mly" +# 918 "parsing/parser.mly" ( xs ) -# 29927 "parsing/parser.ml" +# 30041 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29960,9 +30074,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = -# 919 "parsing/parser.mly" +# 941 "parsing/parser.mly" ( x :: xs ) -# 29966 "parsing/parser.ml" +# 30080 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -29999,9 +30113,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.core_type list) = -# 923 "parsing/parser.mly" +# 945 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30005 "parsing/parser.ml" +# 30119 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30038,9 +30152,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.expression list) = -# 919 "parsing/parser.mly" +# 941 "parsing/parser.mly" ( x :: xs ) -# 30044 "parsing/parser.ml" +# 30158 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30077,9 +30191,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.expression list) = -# 923 "parsing/parser.mly" +# 945 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30083 "parsing/parser.ml" +# 30197 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30116,9 +30230,9 @@ module Tables = struct let _startpos = _startpos_xs_ in let _endpos = _endpos_x_ in let _v : (Parsetree.core_type list) = -# 919 "parsing/parser.mly" +# 941 "parsing/parser.mly" ( x :: xs ) -# 30122 "parsing/parser.ml" +# 30236 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30155,9 +30269,9 @@ module Tables = struct let _startpos = _startpos_x1_ in let _endpos = _endpos_x2_ in let _v : (Parsetree.core_type list) = -# 923 "parsing/parser.mly" +# 945 "parsing/parser.mly" ( [ x2; x1 ] ) -# 30161 "parsing/parser.ml" +# 30275 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30180,9 +30294,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.row_field) = -# 3256 "parsing/parser.mly" +# 3279 "parsing/parser.mly" ( _1 ) -# 30186 "parsing/parser.ml" +# 30300 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30208,9 +30322,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3258 "parsing/parser.mly" +# 3281 "parsing/parser.mly" ( Rf.inherit_ ~loc:(make_loc _sloc) _1 ) -# 30214 "parsing/parser.ml" +# 30328 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30235,12 +30349,12 @@ module Tables = struct let _v : (Parsetree.expression list) = let _2 = # 124 "menhir/standard.mly" ( None ) -# 30239 "parsing/parser.ml" +# 30353 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30244 "parsing/parser.ml" +# 30358 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30274,13 +30388,13 @@ module Tables = struct # 126 "menhir/standard.mly" ( Some x ) -# 30278 "parsing/parser.ml" +# 30392 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30284 "parsing/parser.ml" +# 30398 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30317,9 +30431,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.expression list) = -# 944 "parsing/parser.mly" +# 966 "parsing/parser.mly" ( x :: xs ) -# 30323 "parsing/parser.ml" +# 30437 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30345,9 +30459,9 @@ module Tables = struct } = _menhir_stack in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 30351 "parsing/parser.ml" +# 30465 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -30355,22 +30469,22 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "menhir/standard.mly" ( None ) -# 30359 "parsing/parser.ml" +# 30473 "parsing/parser.ml" in let x = let label = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 30366 "parsing/parser.ml" +# 30480 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30374 "parsing/parser.ml" +# 30488 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30378,7 +30492,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2501 "parsing/parser.mly" +# 2524 "parsing/parser.mly" ( let e = match oe with | None -> @@ -30388,13 +30502,13 @@ module Tables = struct e in label, e ) -# 30392 "parsing/parser.ml" +# 30506 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30398 "parsing/parser.ml" +# 30512 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30427,9 +30541,9 @@ module Tables = struct let x : unit = Obj.magic x in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 30433 "parsing/parser.ml" +# 30547 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -30437,22 +30551,22 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "menhir/standard.mly" ( Some x ) -# 30441 "parsing/parser.ml" +# 30555 "parsing/parser.ml" in let x = let label = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 30448 "parsing/parser.ml" +# 30562 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30456 "parsing/parser.ml" +# 30570 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30460,7 +30574,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2501 "parsing/parser.mly" +# 2524 "parsing/parser.mly" ( let e = match oe with | None -> @@ -30470,13 +30584,13 @@ module Tables = struct e in label, e ) -# 30474 "parsing/parser.ml" +# 30588 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30480 "parsing/parser.ml" +# 30594 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30516,9 +30630,9 @@ module Tables = struct let _2 : unit = Obj.magic _2 in let oe : (Parsetree.expression option) = Obj.magic oe in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 30522 "parsing/parser.ml" +# 30636 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -30526,17 +30640,17 @@ module Tables = struct let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x = let label = let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 30532 "parsing/parser.ml" +# 30646 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30540 "parsing/parser.ml" +# 30654 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30544,7 +30658,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2501 "parsing/parser.mly" +# 2524 "parsing/parser.mly" ( let e = match oe with | None -> @@ -30554,13 +30668,13 @@ module Tables = struct e in label, e ) -# 30558 "parsing/parser.ml" +# 30672 "parsing/parser.ml" in -# 944 "parsing/parser.mly" +# 966 "parsing/parser.mly" ( x :: xs ) -# 30564 "parsing/parser.ml" +# 30678 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30585,12 +30699,12 @@ module Tables = struct let _v : (Parsetree.pattern list) = let _2 = # 124 "menhir/standard.mly" ( None ) -# 30589 "parsing/parser.ml" +# 30703 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30594 "parsing/parser.ml" +# 30708 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30624,13 +30738,13 @@ module Tables = struct # 126 "menhir/standard.mly" ( Some x ) -# 30628 "parsing/parser.ml" +# 30742 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30634 "parsing/parser.ml" +# 30748 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30667,9 +30781,9 @@ module Tables = struct let _startpos = _startpos_x_ in let _endpos = _endpos_xs_ in let _v : (Parsetree.pattern list) = -# 944 "parsing/parser.mly" +# 966 "parsing/parser.mly" ( x :: xs ) -# 30673 "parsing/parser.ml" +# 30787 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30708,7 +30822,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 124 "menhir/standard.mly" ( None ) -# 30712 "parsing/parser.ml" +# 30826 "parsing/parser.ml" in let x = let label = @@ -30716,9 +30830,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30722 "parsing/parser.ml" +# 30836 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30726,7 +30840,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2484 "parsing/parser.mly" +# 2507 "parsing/parser.mly" ( let e = match eo with | None -> @@ -30736,13 +30850,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 30740 "parsing/parser.ml" +# 30854 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30746 "parsing/parser.ml" +# 30860 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30788,7 +30902,7 @@ module Tables = struct let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = # 126 "menhir/standard.mly" ( Some x ) -# 30792 "parsing/parser.ml" +# 30906 "parsing/parser.ml" in let x = let label = @@ -30796,9 +30910,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30802 "parsing/parser.ml" +# 30916 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30806,7 +30920,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2484 "parsing/parser.mly" +# 2507 "parsing/parser.mly" ( let e = match eo with | None -> @@ -30816,13 +30930,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 30820 "parsing/parser.ml" +# 30934 "parsing/parser.ml" in -# 940 "parsing/parser.mly" +# 962 "parsing/parser.mly" ( [x] ) -# 30826 "parsing/parser.ml" +# 30940 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30878,9 +30992,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 30884 "parsing/parser.ml" +# 30998 "parsing/parser.ml" in let _startpos_label_ = _startpos__1_ in @@ -30888,7 +31002,7 @@ module Tables = struct let _symbolstartpos = _startpos_label_ in let _sloc = (_symbolstartpos, _endpos) in -# 2484 "parsing/parser.mly" +# 2507 "parsing/parser.mly" ( let e = match eo with | None -> @@ -30898,13 +31012,13 @@ module Tables = struct e in label, mkexp_opt_constraint ~loc:_sloc e c ) -# 30902 "parsing/parser.ml" +# 31016 "parsing/parser.ml" in -# 944 "parsing/parser.mly" +# 966 "parsing/parser.mly" ( x :: xs ) -# 30908 "parsing/parser.ml" +# 31022 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30927,9 +31041,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = -# 2003 "parsing/parser.mly" +# 2023 "parsing/parser.mly" ( _1 ) -# 30933 "parsing/parser.ml" +# 31047 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30959,9 +31073,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2004 "parsing/parser.mly" +# 2024 "parsing/parser.mly" ( _1 ) -# 30965 "parsing/parser.ml" +# 31079 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -30999,24 +31113,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2006 "parsing/parser.mly" +# 2026 "parsing/parser.mly" ( Pexp_sequence(_1, _3) ) -# 31005 "parsing/parser.ml" +# 31119 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 31014 "parsing/parser.ml" +# 31128 "parsing/parser.ml" in -# 2007 "parsing/parser.mly" +# 2027 "parsing/parser.mly" ( _1 ) -# 31020 "parsing/parser.ml" +# 31134 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31070,11 +31184,11 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2009 "parsing/parser.mly" +# 2029 "parsing/parser.mly" ( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in let payload = PStr [mkstrexp seq []] in mkexp ~loc:_sloc (Pexp_extension (_4, payload)) ) -# 31078 "parsing/parser.ml" +# 31192 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31141,18 +31255,18 @@ module Tables = struct let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 31147 "parsing/parser.ml" +# 31261 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined4_ in let attrs2 = let _1 = _1_inlined3 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 31156 "parsing/parser.ml" +# 31270 "parsing/parser.ml" in let id = @@ -31161,31 +31275,31 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31167 "parsing/parser.ml" +# 31281 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 31175 "parsing/parser.ml" +# 31289 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2937 "parsing/parser.mly" +# 2960 "parsing/parser.mly" ( let args, res = args_res in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Te.mk_exception ~attrs (Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs) , ext ) -# 31189 "parsing/parser.ml" +# 31303 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31211,21 +31325,21 @@ module Tables = struct let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 31215 "parsing/parser.ml" +# 31329 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 763 "parsing/parser.mly" +# 785 "parsing/parser.mly" ( extra_sig _startpos _endpos _1 ) -# 31223 "parsing/parser.ml" +# 31337 "parsing/parser.ml" in -# 1471 "parsing/parser.mly" +# 1492 "parsing/parser.mly" ( _1 ) -# 31229 "parsing/parser.ml" +# 31343 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31257,9 +31371,9 @@ module Tables = struct let _v : (Parsetree.signature_item) = let _2 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 31263 "parsing/parser.ml" +# 31377 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -31267,10 +31381,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1486 "parsing/parser.mly" +# 1507 "parsing/parser.mly" ( let docs = symbol_docs _sloc in mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) ) -# 31274 "parsing/parser.ml" +# 31388 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31294,23 +31408,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1490 "parsing/parser.mly" +# 1511 "parsing/parser.mly" ( Psig_attribute _1 ) -# 31300 "parsing/parser.ml" +# 31414 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 811 "parsing/parser.mly" +# 833 "parsing/parser.mly" ( mksig ~loc:_sloc _1 ) -# 31308 "parsing/parser.ml" +# 31422 "parsing/parser.ml" in -# 1492 "parsing/parser.mly" +# 1513 "parsing/parser.mly" ( _1 ) -# 31314 "parsing/parser.ml" +# 31428 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31334,23 +31448,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1495 "parsing/parser.mly" +# 1516 "parsing/parser.mly" ( psig_value _1 ) -# 31340 "parsing/parser.ml" +# 31454 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31348 "parsing/parser.ml" +# 31462 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31354 "parsing/parser.ml" +# 31468 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31374,23 +31488,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1497 "parsing/parser.mly" +# 1518 "parsing/parser.mly" ( psig_value _1 ) -# 31380 "parsing/parser.ml" +# 31494 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31388 "parsing/parser.ml" +# 31502 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31394 "parsing/parser.ml" +# 31508 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31425,26 +31539,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 31431 "parsing/parser.ml" +# 31545 "parsing/parser.ml" in -# 2769 "parsing/parser.mly" +# 2792 "parsing/parser.mly" ( _1 ) -# 31436 "parsing/parser.ml" +# 31550 "parsing/parser.ml" in -# 2752 "parsing/parser.mly" +# 2775 "parsing/parser.mly" ( _1 ) -# 31442 "parsing/parser.ml" +# 31556 "parsing/parser.ml" in -# 1499 "parsing/parser.mly" +# 1520 "parsing/parser.mly" ( psig_type _1 ) -# 31448 "parsing/parser.ml" +# 31562 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -31452,15 +31566,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31458 "parsing/parser.ml" +# 31572 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31464 "parsing/parser.ml" +# 31578 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31495,26 +31609,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 31501 "parsing/parser.ml" +# 31615 "parsing/parser.ml" in -# 2769 "parsing/parser.mly" +# 2792 "parsing/parser.mly" ( _1 ) -# 31506 "parsing/parser.ml" +# 31620 "parsing/parser.ml" in -# 2757 "parsing/parser.mly" +# 2780 "parsing/parser.mly" ( _1 ) -# 31512 "parsing/parser.ml" +# 31626 "parsing/parser.ml" in -# 1501 "parsing/parser.mly" +# 1522 "parsing/parser.mly" ( psig_typesubst _1 ) -# 31518 "parsing/parser.ml" +# 31632 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -31522,15 +31636,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31528 "parsing/parser.ml" +# 31642 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31534 "parsing/parser.ml" +# 31648 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31615,16 +31729,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 31621 "parsing/parser.ml" +# 31735 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = -# 993 "parsing/parser.mly" +# 1015 "parsing/parser.mly" ( List.rev xs ) -# 31628 "parsing/parser.ml" +# 31742 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -31632,46 +31746,46 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31638 "parsing/parser.ml" +# 31752 "parsing/parser.ml" in let _4 = -# 3485 "parsing/parser.mly" +# 3512 "parsing/parser.mly" ( Recursive ) -# 31644 "parsing/parser.ml" +# 31758 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 31651 "parsing/parser.ml" +# 31765 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3006 "parsing/parser.mly" +# 3029 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 31663 "parsing/parser.ml" +# 31777 "parsing/parser.ml" in -# 2993 "parsing/parser.mly" +# 3016 "parsing/parser.mly" ( _1 ) -# 31669 "parsing/parser.ml" +# 31783 "parsing/parser.ml" in -# 1503 "parsing/parser.mly" +# 1524 "parsing/parser.mly" ( psig_typext _1 ) -# 31675 "parsing/parser.ml" +# 31789 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -31679,15 +31793,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31685 "parsing/parser.ml" +# 31799 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31691 "parsing/parser.ml" +# 31805 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31779,16 +31893,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 31785 "parsing/parser.ml" +# 31899 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = -# 993 "parsing/parser.mly" +# 1015 "parsing/parser.mly" ( List.rev xs ) -# 31792 "parsing/parser.ml" +# 31906 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -31796,9 +31910,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31802 "parsing/parser.ml" +# 31916 "parsing/parser.ml" in let _4 = @@ -31807,41 +31921,41 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3486 "parsing/parser.mly" +# 3513 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 31813 "parsing/parser.ml" +# 31927 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 31821 "parsing/parser.ml" +# 31935 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3006 "parsing/parser.mly" +# 3029 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 31833 "parsing/parser.ml" +# 31947 "parsing/parser.ml" in -# 2993 "parsing/parser.mly" +# 3016 "parsing/parser.mly" ( _1 ) -# 31839 "parsing/parser.ml" +# 31953 "parsing/parser.ml" in -# 1503 "parsing/parser.mly" +# 1524 "parsing/parser.mly" ( psig_typext _1 ) -# 31845 "parsing/parser.ml" +# 31959 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -31849,15 +31963,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31855 "parsing/parser.ml" +# 31969 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31861 "parsing/parser.ml" +# 31975 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31881,23 +31995,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1505 "parsing/parser.mly" +# 1526 "parsing/parser.mly" ( psig_exception _1 ) -# 31887 "parsing/parser.ml" +# 32001 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 31895 "parsing/parser.ml" +# 32009 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 31901 "parsing/parser.ml" +# 32015 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -31947,11 +32061,7 @@ module Tables = struct } = _menhir_stack in let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.module_type) = Obj.magic body in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 31954 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in let _1 : unit = Obj.magic _1 in @@ -31964,49 +32074,49 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 31970 "parsing/parser.ml" +# 32080 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 31982 "parsing/parser.ml" +# 32092 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 31990 "parsing/parser.ml" +# 32100 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1534 "parsing/parser.mly" +# 1555 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in - Md.mk uid body ~attrs ~loc ~docs, ext + Md.mk name body ~attrs ~loc ~docs, ext ) -# 32004 "parsing/parser.ml" +# 32114 "parsing/parser.ml" in -# 1507 "parsing/parser.mly" +# 1528 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 32010 "parsing/parser.ml" +# 32120 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -32014,15 +32124,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32020 "parsing/parser.ml" +# 32130 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32026 "parsing/parser.ml" +# 32136 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32079,11 +32189,7 @@ module Tables = struct let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 32086 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in let _1 : unit = Obj.magic _1 in @@ -32096,9 +32202,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 32102 "parsing/parser.ml" +# 32208 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in @@ -32109,9 +32215,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32115 "parsing/parser.ml" +# 32221 "parsing/parser.ml" in let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in @@ -32119,48 +32225,48 @@ module Tables = struct let _symbolstartpos = _startpos_id_ in let _sloc = (_symbolstartpos, _endpos) in -# 1571 "parsing/parser.mly" +# 1591 "parsing/parser.mly" ( Mty.alias ~loc:(make_loc _sloc) id ) -# 32125 "parsing/parser.ml" +# 32231 "parsing/parser.ml" in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32136 "parsing/parser.ml" +# 32242 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 32144 "parsing/parser.ml" +# 32250 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1562 "parsing/parser.mly" +# 1582 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in - Md.mk uid body ~attrs ~loc ~docs, ext + Md.mk name body ~attrs ~loc ~docs, ext ) -# 32158 "parsing/parser.ml" +# 32264 "parsing/parser.ml" in -# 1509 "parsing/parser.mly" +# 1530 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_module body, ext) ) -# 32164 "parsing/parser.ml" +# 32270 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -32168,15 +32274,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32174 "parsing/parser.ml" +# 32280 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32180 "parsing/parser.ml" +# 32286 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32200,23 +32306,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1511 "parsing/parser.mly" +# 1532 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modsubst body, ext) ) -# 32206 "parsing/parser.ml" +# 32312 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32214 "parsing/parser.ml" +# 32320 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32220 "parsing/parser.ml" +# 32326 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32286,11 +32392,7 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let mty : (Parsetree.module_type) = Obj.magic mty in let _6 : unit = Obj.magic _6 in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 32293 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _4 : unit = Obj.magic _4 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in @@ -32306,61 +32408,61 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 32312 "parsing/parser.ml" +# 32414 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32324 "parsing/parser.ml" +# 32426 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 32332 "parsing/parser.ml" +# 32434 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1605 "parsing/parser.mly" +# 1625 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in - ext, Md.mk uid mty ~attrs ~loc ~docs + ext, Md.mk name mty ~attrs ~loc ~docs ) -# 32346 "parsing/parser.ml" +# 32448 "parsing/parser.ml" in -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 32352 "parsing/parser.ml" +# 32454 "parsing/parser.ml" in -# 1594 "parsing/parser.mly" +# 1614 "parsing/parser.mly" ( _1 ) -# 32358 "parsing/parser.ml" +# 32460 "parsing/parser.ml" in -# 1513 "parsing/parser.mly" +# 1534 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_recmodule l, ext) ) -# 32364 "parsing/parser.ml" +# 32466 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -32368,15 +32470,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32374 "parsing/parser.ml" +# 32476 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32380 "parsing/parser.ml" +# 32482 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32400,23 +32502,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1515 "parsing/parser.mly" +# 1536 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_modtype body, ext) ) -# 32406 "parsing/parser.ml" +# 32508 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32414 "parsing/parser.ml" +# 32516 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32420 "parsing/parser.ml" +# 32522 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32440,23 +32542,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1517 "parsing/parser.mly" +# 1538 "parsing/parser.mly" ( let (body, ext) = _1 in (Psig_open body, ext) ) -# 32446 "parsing/parser.ml" +# 32548 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32454 "parsing/parser.ml" +# 32556 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32460 "parsing/parser.ml" +# 32562 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32512,38 +32614,38 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 32518 "parsing/parser.ml" +# 32620 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 32527 "parsing/parser.ml" +# 32629 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1363 "parsing/parser.mly" +# 1384 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Incl.mk thing ~attrs ~loc ~docs, ext ) -# 32541 "parsing/parser.ml" +# 32643 "parsing/parser.ml" in -# 1519 "parsing/parser.mly" +# 1540 "parsing/parser.mly" ( psig_include _1 ) -# 32547 "parsing/parser.ml" +# 32649 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -32551,15 +32653,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32557 "parsing/parser.ml" +# 32659 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32563 "parsing/parser.ml" +# 32665 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32636,9 +32738,9 @@ module Tables = struct let cty : (Parsetree.class_type) = Obj.magic cty in let _7 : unit = Obj.magic _7 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 32642 "parsing/parser.ml" +# 32744 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -32656,9 +32758,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 32662 "parsing/parser.ml" +# 32764 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -32668,24 +32770,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 32674 "parsing/parser.ml" +# 32776 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 32682 "parsing/parser.ml" +# 32784 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1935 "parsing/parser.mly" +# 1955 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -32693,25 +32795,25 @@ module Tables = struct ext, Ci.mk id cty ~virt ~params ~attrs ~loc ~docs ) -# 32697 "parsing/parser.ml" +# 32799 "parsing/parser.ml" in -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 32703 "parsing/parser.ml" +# 32805 "parsing/parser.ml" in -# 1923 "parsing/parser.mly" +# 1943 "parsing/parser.mly" ( _1 ) -# 32709 "parsing/parser.ml" +# 32811 "parsing/parser.ml" in -# 1521 "parsing/parser.mly" +# 1542 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class l, ext) ) -# 32715 "parsing/parser.ml" +# 32817 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -32719,15 +32821,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32725 "parsing/parser.ml" +# 32827 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32731 "parsing/parser.ml" +# 32833 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32751,23 +32853,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.signature_item) = let _1 = let _1 = -# 1523 "parsing/parser.mly" +# 1544 "parsing/parser.mly" ( let (ext, l) = _1 in (Psig_class_type l, ext) ) -# 32757 "parsing/parser.ml" +# 32859 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 828 "parsing/parser.mly" +# 850 "parsing/parser.mly" ( wrap_mksig_ext ~loc:_sloc _1 ) -# 32765 "parsing/parser.ml" +# 32867 "parsing/parser.ml" in -# 1525 "parsing/parser.mly" +# 1546 "parsing/parser.mly" ( _1 ) -# 32771 "parsing/parser.ml" +# 32873 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32790,9 +32892,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.constant) = -# 3332 "parsing/parser.mly" +# 3355 "parsing/parser.mly" ( _1 ) -# 32796 "parsing/parser.ml" +# 32898 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32817,18 +32919,18 @@ module Tables = struct }; } = _menhir_stack in let _2 : ( -# 606 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string * char option) -# 32823 "parsing/parser.ml" +# 32925 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constant) = -# 3333 "parsing/parser.mly" +# 3356 "parsing/parser.mly" ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) ) -# 32832 "parsing/parser.ml" +# 32934 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32853,18 +32955,18 @@ module Tables = struct }; } = _menhir_stack in let _2 : ( -# 585 "parsing/parser.mly" +# 607 "parsing/parser.mly" (string * char option) -# 32859 "parsing/parser.ml" +# 32961 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constant) = -# 3334 "parsing/parser.mly" +# 3357 "parsing/parser.mly" ( let (f, m) = _2 in Pconst_float("-" ^ f, m) ) -# 32868 "parsing/parser.ml" +# 32970 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32889,18 +32991,18 @@ module Tables = struct }; } = _menhir_stack in let _2 : ( -# 606 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string * char option) -# 32895 "parsing/parser.ml" +# 32997 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constant) = -# 3335 "parsing/parser.mly" +# 3358 "parsing/parser.mly" ( let (n, m) = _2 in Pconst_integer (n, m) ) -# 32904 "parsing/parser.ml" +# 33006 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32925,18 +33027,18 @@ module Tables = struct }; } = _menhir_stack in let _2 : ( -# 585 "parsing/parser.mly" +# 607 "parsing/parser.mly" (string * char option) -# 32931 "parsing/parser.ml" +# 33033 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : unit = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.constant) = -# 3336 "parsing/parser.mly" +# 3359 "parsing/parser.mly" ( let (f, m) = _2 in Pconst_float(f, m) ) -# 32940 "parsing/parser.ml" +# 33042 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -32977,18 +33079,18 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 2684 "parsing/parser.mly" +# 2707 "parsing/parser.mly" ( let fields, closed = _1 in let closed = match closed with Some () -> Open | None -> Closed in fields, closed ) -# 32985 "parsing/parser.ml" +# 33087 "parsing/parser.ml" in -# 2655 "parsing/parser.mly" +# 2678 "parsing/parser.mly" ( let (fields, closed) = _2 in Ppat_record(fields, closed) ) -# 32992 "parsing/parser.ml" +# 33094 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -32996,15 +33098,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33002 "parsing/parser.ml" +# 33104 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33008 "parsing/parser.ml" +# 33110 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33045,19 +33147,19 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 2684 "parsing/parser.mly" +# 2707 "parsing/parser.mly" ( let fields, closed = _1 in let closed = match closed with Some () -> Open | None -> Closed in fields, closed ) -# 33053 "parsing/parser.ml" +# 33155 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2658 "parsing/parser.mly" +# 2681 "parsing/parser.mly" ( unclosed "{" _loc__1_ "}" _loc__3_ ) -# 33061 "parsing/parser.ml" +# 33163 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33065,15 +33167,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33071 "parsing/parser.ml" +# 33173 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33077 "parsing/parser.ml" +# 33179 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33112,15 +33214,15 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2678 "parsing/parser.mly" +# 2701 "parsing/parser.mly" ( ps ) -# 33118 "parsing/parser.ml" +# 33220 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2660 "parsing/parser.mly" +# 2683 "parsing/parser.mly" ( fst (mktailpat _loc__3_ _2) ) -# 33124 "parsing/parser.ml" +# 33226 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33128,15 +33230,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33134 "parsing/parser.ml" +# 33236 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33140 "parsing/parser.ml" +# 33242 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33175,16 +33277,16 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2678 "parsing/parser.mly" +# 2701 "parsing/parser.mly" ( ps ) -# 33181 "parsing/parser.ml" +# 33283 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2662 "parsing/parser.mly" +# 2685 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 33188 "parsing/parser.ml" +# 33290 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33192,15 +33294,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33198 "parsing/parser.ml" +# 33300 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33204 "parsing/parser.ml" +# 33306 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33239,14 +33341,14 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2678 "parsing/parser.mly" +# 2701 "parsing/parser.mly" ( ps ) -# 33245 "parsing/parser.ml" +# 33347 "parsing/parser.ml" in -# 2664 "parsing/parser.mly" +# 2687 "parsing/parser.mly" ( Ppat_array _2 ) -# 33250 "parsing/parser.ml" +# 33352 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33254,15 +33356,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33260 "parsing/parser.ml" +# 33362 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33266 "parsing/parser.ml" +# 33368 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33293,24 +33395,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2666 "parsing/parser.mly" +# 2689 "parsing/parser.mly" ( Ppat_array [] ) -# 33299 "parsing/parser.ml" +# 33401 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33308 "parsing/parser.ml" +# 33410 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33314 "parsing/parser.ml" +# 33416 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33349,16 +33451,16 @@ module Tables = struct let _v : (Parsetree.pattern) = let _1 = let _1 = let _2 = -# 2678 "parsing/parser.mly" +# 2701 "parsing/parser.mly" ( ps ) -# 33355 "parsing/parser.ml" +# 33457 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2668 "parsing/parser.mly" +# 2691 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 33362 "parsing/parser.ml" +# 33464 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -33366,15 +33468,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 33372 "parsing/parser.ml" +# 33474 "parsing/parser.ml" in -# 2669 "parsing/parser.mly" +# 2692 "parsing/parser.mly" ( _1 ) -# 33378 "parsing/parser.ml" +# 33480 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33414,9 +33516,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2167 "parsing/parser.mly" +# 2190 "parsing/parser.mly" ( reloc_exp ~loc:_sloc _2 ) -# 33420 "parsing/parser.ml" +# 33522 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33455,9 +33557,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2169 "parsing/parser.mly" +# 2192 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 33461 "parsing/parser.ml" +# 33563 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33504,9 +33606,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2171 "parsing/parser.mly" +# 2194 "parsing/parser.mly" ( mkexp_constraint ~loc:_sloc _2 _3 ) -# 33510 "parsing/parser.ml" +# 33612 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33560,9 +33662,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2173 "parsing/parser.mly" +# 2196 "parsing/parser.mly" ( array_get ~loc:_sloc _1 _4 ) -# 33566 "parsing/parser.ml" +# 33668 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33615,9 +33717,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2175 "parsing/parser.mly" +# 2198 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 33621 "parsing/parser.ml" +# 33723 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33671,9 +33773,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2177 "parsing/parser.mly" +# 2200 "parsing/parser.mly" ( string_get ~loc:_sloc _1 _4 ) -# 33677 "parsing/parser.ml" +# 33779 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33726,9 +33828,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2179 "parsing/parser.mly" +# 2202 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 33732 "parsing/parser.ml" +# 33834 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33746,9 +33848,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -33771,24 +33873,29 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 33780 "parsing/parser.ml" +# 33882 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 33891 "parsing/parser.ml" + in + let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2181 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "[]")) _1 _4 ) -# 33792 "parsing/parser.ml" +# 2204 "parsing/parser.mly" + ( dotop_get ~loc:_sloc lident bracket _2 _1 _4 ) +# 33899 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33806,9 +33913,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -33831,23 +33938,28 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 33840 "parsing/parser.ml" +# 33947 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 33956 "parsing/parser.ml" + in + let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2183 "parsing/parser.mly" +# 2206 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 33851 "parsing/parser.ml" +# 33963 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33865,9 +33977,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -33890,24 +34002,29 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 33899 "parsing/parser.ml" +# 34011 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 34020 "parsing/parser.ml" + in + let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2185 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "()")) _1 _4 ) -# 33911 "parsing/parser.ml" +# 2208 "parsing/parser.mly" + ( dotop_get ~loc:_sloc lident paren _2 _1 _4 ) +# 34028 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33925,9 +34042,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -33950,23 +34067,28 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 33959 "parsing/parser.ml" +# 34076 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 34085 "parsing/parser.ml" + in + let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2187 "parsing/parser.mly" +# 2210 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 33970 "parsing/parser.ml" +# 34092 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -33984,9 +34106,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__5_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _4; - MenhirLib.EngineTypes.startp = _startpos__4_; - MenhirLib.EngineTypes.endp = _endpos__4_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _3; @@ -34009,24 +34131,29 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _4 : (Parsetree.expression) = Obj.magic _4 in + let es : (Parsetree.expression list) = Obj.magic es in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34018 "parsing/parser.ml" +# 34140 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in + let _v : (Parsetree.expression) = let _4 = +# 2536 "parsing/parser.mly" + ( es ) +# 34149 "parsing/parser.ml" + in + let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2189 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Lident ("." ^ _2 ^ "{}")) _1 _4 ) -# 34030 "parsing/parser.ml" +# 2212 "parsing/parser.mly" + ( dotop_get ~loc:_sloc lident brace _2 _1 _4 ) +# 34157 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34072,9 +34199,9 @@ module Tables = struct let _4 : (Parsetree.expression) = Obj.magic _4 in let _3 : unit = Obj.magic _3 in let _2 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34078 "parsing/parser.ml" +# 34205 "parsing/parser.ml" ) = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -34083,9 +34210,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2191 "parsing/parser.mly" +# 2214 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 34089 "parsing/parser.ml" +# 34216 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34103,9 +34230,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34140,12 +34267,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34149 "parsing/parser.ml" +# 34276 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34153,13 +34280,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34287 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2193 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "[]")) _1 _6 ) -# 34163 "parsing/parser.ml" +# 2216 "parsing/parser.mly" + ( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6 ) +# 34295 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34177,9 +34309,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34214,12 +34346,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34223 "parsing/parser.ml" +# 34355 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34227,12 +34359,17 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34366 "parsing/parser.ml" + in + let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__5_ = (_startpos__5_, _endpos__5_) in -# 2196 "parsing/parser.mly" +# 2219 "parsing/parser.mly" ( unclosed "[" _loc__5_ "]" _loc__7_ ) -# 34236 "parsing/parser.ml" +# 34373 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34250,9 +34387,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34287,12 +34424,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34296 "parsing/parser.ml" +# 34433 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34300,13 +34437,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34444 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2198 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "()")) _1 _6 ) -# 34310 "parsing/parser.ml" +# 2221 "parsing/parser.mly" + ( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 ) +# 34452 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34324,9 +34466,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34361,12 +34503,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34370 "parsing/parser.ml" +# 34512 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34374,12 +34516,17 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34523 "parsing/parser.ml" + in + let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__5_ = (_startpos__5_, _endpos__5_) in -# 2201 "parsing/parser.mly" +# 2224 "parsing/parser.mly" ( unclosed "(" _loc__5_ ")" _loc__7_ ) -# 34383 "parsing/parser.ml" +# 34530 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34397,9 +34544,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34434,12 +34581,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34443 "parsing/parser.ml" +# 34590 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34447,13 +34594,18 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34601 "parsing/parser.ml" + in + let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2203 "parsing/parser.mly" - ( dotop_get ~loc:_sloc (Ldot(_3, "." ^ _4 ^ "{}")) _1 _6 ) -# 34457 "parsing/parser.ml" +# 2226 "parsing/parser.mly" + ( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6 ) +# 34609 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34471,9 +34623,9 @@ module Tables = struct MenhirLib.EngineTypes.endp = _endpos__7_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; - MenhirLib.EngineTypes.semv = _6; - MenhirLib.EngineTypes.startp = _startpos__6_; - MenhirLib.EngineTypes.endp = _endpos__6_; + MenhirLib.EngineTypes.semv = es; + MenhirLib.EngineTypes.startp = _startpos_es_; + MenhirLib.EngineTypes.endp = _endpos_es_; MenhirLib.EngineTypes.next = { MenhirLib.EngineTypes.state = _; MenhirLib.EngineTypes.semv = _5; @@ -34508,12 +34660,12 @@ module Tables = struct }; } = _menhir_stack in let _7 : unit = Obj.magic _7 in - let _6 : (Parsetree.expression) = Obj.magic _6 in + let es : (Parsetree.expression list) = Obj.magic es in let _5 : unit = Obj.magic _5 in let _4 : ( -# 601 "parsing/parser.mly" +# 623 "parsing/parser.mly" (string) -# 34517 "parsing/parser.ml" +# 34669 "parsing/parser.ml" ) = Obj.magic _4 in let _3 : (Longident.t) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in @@ -34521,12 +34673,17 @@ module Tables = struct let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__7_ in - let _v : (Parsetree.expression) = let _loc__7_ = (_startpos__7_, _endpos__7_) in + let _v : (Parsetree.expression) = let _6 = +# 2536 "parsing/parser.mly" + ( es ) +# 34680 "parsing/parser.ml" + in + let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__5_ = (_startpos__5_, _endpos__5_) in -# 2206 "parsing/parser.mly" +# 2229 "parsing/parser.mly" ( unclosed "{" _loc__5_ "}" _loc__7_ ) -# 34530 "parsing/parser.ml" +# 34687 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34580,9 +34737,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2208 "parsing/parser.mly" +# 2231 "parsing/parser.mly" ( bigarray_get ~loc:_sloc _1 _4 ) -# 34586 "parsing/parser.ml" +# 34743 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34635,9 +34792,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2210 "parsing/parser.mly" +# 2233 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 34641 "parsing/parser.ml" +# 34798 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34691,15 +34848,15 @@ module Tables = struct let attrs = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 34697 "parsing/parser.ml" +# 34854 "parsing/parser.ml" in -# 2219 "parsing/parser.mly" +# 2242 "parsing/parser.mly" ( e.pexp_desc, (ext, attrs @ e.pexp_attributes) ) -# 34703 "parsing/parser.ml" +# 34860 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -34707,10 +34864,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 34714 "parsing/parser.ml" +# 34871 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34759,24 +34916,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 34765 "parsing/parser.ml" +# 34922 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 34771 "parsing/parser.ml" +# 34928 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2221 "parsing/parser.mly" +# 2244 "parsing/parser.mly" ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 ) -# 34780 "parsing/parser.ml" +# 34937 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -34784,10 +34941,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 34791 "parsing/parser.ml" +# 34948 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34843,23 +35000,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 34849 "parsing/parser.ml" +# 35006 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 34855 "parsing/parser.ml" +# 35012 "parsing/parser.ml" in let _loc__4_ = (_startpos__4_, _endpos__4_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2223 "parsing/parser.mly" +# 2246 "parsing/parser.mly" ( unclosed "begin" _loc__1_ "end" _loc__4_ ) -# 34863 "parsing/parser.ml" +# 35020 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -34867,10 +35024,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 34874 "parsing/parser.ml" +# 35031 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -34920,9 +35077,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 34926 "parsing/parser.ml" +# 35083 "parsing/parser.ml" in let _2 = @@ -34930,21 +35087,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 34936 "parsing/parser.ml" +# 35093 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 34942 "parsing/parser.ml" +# 35099 "parsing/parser.ml" in -# 2225 "parsing/parser.mly" +# 2248 "parsing/parser.mly" ( Pexp_new(_3), _2 ) -# 34948 "parsing/parser.ml" +# 35105 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -34952,10 +35109,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 34959 "parsing/parser.ml" +# 35116 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35018,21 +35175,21 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 35024 "parsing/parser.ml" +# 35181 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 35030 "parsing/parser.ml" +# 35187 "parsing/parser.ml" in -# 2227 "parsing/parser.mly" +# 2250 "parsing/parser.mly" ( Pexp_pack _4, _3 ) -# 35036 "parsing/parser.ml" +# 35193 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -35040,10 +35197,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35047 "parsing/parser.ml" +# 35204 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35119,23 +35276,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 35125 "parsing/parser.ml" +# 35282 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 35133 "parsing/parser.ml" +# 35290 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 35139 "parsing/parser.ml" +# 35296 "parsing/parser.ml" in let _3 = @@ -35143,24 +35300,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 35149 "parsing/parser.ml" +# 35306 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 35155 "parsing/parser.ml" +# 35312 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2229 "parsing/parser.mly" +# 2252 "parsing/parser.mly" ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 ) -# 35164 "parsing/parser.ml" +# 35321 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -35168,10 +35325,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35175 "parsing/parser.ml" +# 35332 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35241,23 +35398,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 35247 "parsing/parser.ml" +# 35404 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 35253 "parsing/parser.ml" +# 35410 "parsing/parser.ml" in let _loc__6_ = (_startpos__6_, _endpos__6_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2231 "parsing/parser.mly" +# 2254 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__6_ ) -# 35261 "parsing/parser.ml" +# 35418 "parsing/parser.ml" in let _endpos__1_ = _endpos__6_ in @@ -35265,10 +35422,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2212 "parsing/parser.mly" +# 2235 "parsing/parser.mly" ( let desc, attrs = _1 in mkexp_attrs ~loc:_sloc desc attrs ) -# 35272 "parsing/parser.ml" +# 35429 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35297,30 +35454,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35303 "parsing/parser.ml" +# 35460 "parsing/parser.ml" in -# 2235 "parsing/parser.mly" +# 2258 "parsing/parser.mly" ( Pexp_ident (_1) ) -# 35309 "parsing/parser.ml" +# 35466 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35318 "parsing/parser.ml" +# 35475 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35324 "parsing/parser.ml" +# 35481 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35344,23 +35501,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2237 "parsing/parser.mly" +# 2260 "parsing/parser.mly" ( Pexp_constant _1 ) -# 35350 "parsing/parser.ml" +# 35507 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35358 "parsing/parser.ml" +# 35515 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35364 "parsing/parser.ml" +# 35521 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35389,30 +35546,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35395 "parsing/parser.ml" +# 35552 "parsing/parser.ml" in -# 2239 "parsing/parser.mly" +# 2262 "parsing/parser.mly" ( Pexp_construct(_1, None) ) -# 35401 "parsing/parser.ml" +# 35558 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35410 "parsing/parser.ml" +# 35567 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35416 "parsing/parser.ml" +# 35573 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35436,23 +35593,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2241 "parsing/parser.mly" +# 2264 "parsing/parser.mly" ( Pexp_variant(_1, None) ) -# 35442 "parsing/parser.ml" +# 35599 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35450 "parsing/parser.ml" +# 35607 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35456 "parsing/parser.ml" +# 35613 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35478,9 +35635,9 @@ module Tables = struct } = _menhir_stack in let _2 : (Parsetree.expression) = Obj.magic _2 in let _1 : ( -# 644 "parsing/parser.mly" +# 666 "parsing/parser.mly" (string) -# 35484 "parsing/parser.ml" +# 35641 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in @@ -35492,15 +35649,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 35498 "parsing/parser.ml" +# 35655 "parsing/parser.ml" in -# 2243 "parsing/parser.mly" +# 2266 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 35504 "parsing/parser.ml" +# 35661 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -35508,15 +35665,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35514 "parsing/parser.ml" +# 35671 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35520 "parsing/parser.ml" +# 35677 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35549,23 +35706,23 @@ module Tables = struct let _1 = let _1 = let _1 = -# 2244 "parsing/parser.mly" +# 2267 "parsing/parser.mly" ("!") -# 35555 "parsing/parser.ml" +# 35712 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 35563 "parsing/parser.ml" +# 35720 "parsing/parser.ml" in -# 2245 "parsing/parser.mly" +# 2268 "parsing/parser.mly" ( Pexp_apply(_1, [Nolabel,_2]) ) -# 35569 "parsing/parser.ml" +# 35726 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in @@ -35573,15 +35730,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35579 "parsing/parser.ml" +# 35736 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35585 "parsing/parser.ml" +# 35742 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35620,14 +35777,14 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2496 "parsing/parser.mly" +# 2519 "parsing/parser.mly" ( xs ) -# 35626 "parsing/parser.ml" +# 35783 "parsing/parser.ml" in -# 2247 "parsing/parser.mly" +# 2270 "parsing/parser.mly" ( Pexp_override _2 ) -# 35631 "parsing/parser.ml" +# 35788 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -35635,15 +35792,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35641 "parsing/parser.ml" +# 35798 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35647 "parsing/parser.ml" +# 35804 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35682,16 +35839,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2496 "parsing/parser.mly" +# 2519 "parsing/parser.mly" ( xs ) -# 35688 "parsing/parser.ml" +# 35845 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2249 "parsing/parser.mly" +# 2272 "parsing/parser.mly" ( unclosed "{<" _loc__1_ ">}" _loc__3_ ) -# 35695 "parsing/parser.ml" +# 35852 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -35699,15 +35856,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35705 "parsing/parser.ml" +# 35862 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35711 "parsing/parser.ml" +# 35868 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35738,24 +35895,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2251 "parsing/parser.mly" +# 2274 "parsing/parser.mly" ( Pexp_override [] ) -# 35744 "parsing/parser.ml" +# 35901 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35753 "parsing/parser.ml" +# 35910 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35759 "parsing/parser.ml" +# 35916 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35799,15 +35956,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35805 "parsing/parser.ml" +# 35962 "parsing/parser.ml" in -# 2253 "parsing/parser.mly" +# 2276 "parsing/parser.mly" ( Pexp_field(_1, _3) ) -# 35811 "parsing/parser.ml" +# 35968 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -35815,15 +35972,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35821 "parsing/parser.ml" +# 35978 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35827 "parsing/parser.ml" +# 35984 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35881,24 +36038,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35887 "parsing/parser.ml" +# 36044 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 35896 "parsing/parser.ml" +# 36053 "parsing/parser.ml" in -# 2255 "parsing/parser.mly" +# 2278 "parsing/parser.mly" ( Pexp_open(od, _4) ) -# 35902 "parsing/parser.ml" +# 36059 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -35906,15 +36063,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 35912 "parsing/parser.ml" +# 36069 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 35918 "parsing/parser.ml" +# 36075 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -35967,9 +36124,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2496 "parsing/parser.mly" +# 2519 "parsing/parser.mly" ( xs ) -# 35973 "parsing/parser.ml" +# 36130 "parsing/parser.ml" in let od = let _1 = @@ -35977,18 +36134,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 35983 "parsing/parser.ml" +# 36140 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 35992 "parsing/parser.ml" +# 36149 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -35996,10 +36153,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2257 "parsing/parser.mly" +# 2280 "parsing/parser.mly" ( (* TODO: review the location of Pexp_override *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) ) -# 36003 "parsing/parser.ml" +# 36160 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36007,15 +36164,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36013 "parsing/parser.ml" +# 36170 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36019 "parsing/parser.ml" +# 36176 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36068,16 +36225,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2496 "parsing/parser.mly" +# 2519 "parsing/parser.mly" ( xs ) -# 36074 "parsing/parser.ml" +# 36231 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2260 "parsing/parser.mly" +# 2283 "parsing/parser.mly" ( unclosed "{<" _loc__3_ ">}" _loc__5_ ) -# 36081 "parsing/parser.ml" +# 36238 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36085,15 +36242,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36091 "parsing/parser.ml" +# 36248 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36097 "parsing/parser.ml" +# 36254 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36124,9 +36281,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 36130 "parsing/parser.ml" +# 36287 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in let _1 : (Parsetree.expression) = Obj.magic _1 in @@ -36138,23 +36295,23 @@ module Tables = struct let _3 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 36144 "parsing/parser.ml" +# 36301 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36152 "parsing/parser.ml" +# 36309 "parsing/parser.ml" in -# 2262 "parsing/parser.mly" +# 2285 "parsing/parser.mly" ( Pexp_send(_1, _3) ) -# 36158 "parsing/parser.ml" +# 36315 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -36162,15 +36319,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36168 "parsing/parser.ml" +# 36325 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36174 "parsing/parser.ml" +# 36331 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36202,9 +36359,9 @@ module Tables = struct } = _menhir_stack in let _3 : (Parsetree.expression) = Obj.magic _3 in let _1_inlined1 : ( -# 655 "parsing/parser.mly" +# 677 "parsing/parser.mly" (string) -# 36208 "parsing/parser.ml" +# 36365 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _1 : (Parsetree.expression) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in @@ -36218,15 +36375,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 797 "parsing/parser.mly" +# 819 "parsing/parser.mly" ( mkoperator ~loc:_sloc _1 ) -# 36224 "parsing/parser.ml" +# 36381 "parsing/parser.ml" in -# 2264 "parsing/parser.mly" +# 2287 "parsing/parser.mly" ( mkinfix _1 _2 _3 ) -# 36230 "parsing/parser.ml" +# 36387 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36234,15 +36391,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36240 "parsing/parser.ml" +# 36397 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36246 "parsing/parser.ml" +# 36403 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36266,23 +36423,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2266 "parsing/parser.mly" +# 2289 "parsing/parser.mly" ( Pexp_extension _1 ) -# 36272 "parsing/parser.ml" +# 36429 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36280 "parsing/parser.ml" +# 36437 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36286 "parsing/parser.ml" +# 36443 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36330,18 +36487,18 @@ module Tables = struct let _3 = let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in let _1 = -# 2267 "parsing/parser.mly" +# 2290 "parsing/parser.mly" (Lident "()") -# 36336 "parsing/parser.ml" +# 36493 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36345 "parsing/parser.ml" +# 36502 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -36351,18 +36508,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36357 "parsing/parser.ml" +# 36514 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 36366 "parsing/parser.ml" +# 36523 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -36370,10 +36527,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2268 "parsing/parser.mly" +# 2291 "parsing/parser.mly" ( (* TODO: review the location of Pexp_construct *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) ) -# 36377 "parsing/parser.ml" +# 36534 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -36381,15 +36538,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36387 "parsing/parser.ml" +# 36544 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36393 "parsing/parser.ml" +# 36550 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36444,9 +36601,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2271 "parsing/parser.mly" +# 2294 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 36450 "parsing/parser.ml" +# 36607 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36454,15 +36611,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36460 "parsing/parser.ml" +# 36617 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36466 "parsing/parser.ml" +# 36623 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36501,25 +36658,25 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2273 "parsing/parser.mly" +# 2296 "parsing/parser.mly" ( let (exten, fields) = _2 in Pexp_record(fields, exten) ) -# 36508 "parsing/parser.ml" +# 36665 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36517 "parsing/parser.ml" +# 36674 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36523 "parsing/parser.ml" +# 36680 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36561,9 +36718,9 @@ module Tables = struct let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2276 "parsing/parser.mly" +# 2299 "parsing/parser.mly" ( unclosed "{" _loc__1_ "}" _loc__3_ ) -# 36567 "parsing/parser.ml" +# 36724 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36571,15 +36728,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36577 "parsing/parser.ml" +# 36734 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36583 "parsing/parser.ml" +# 36740 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36638,18 +36795,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36644 "parsing/parser.ml" +# 36801 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 36653 "parsing/parser.ml" +# 36810 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -36657,11 +36814,11 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2278 "parsing/parser.mly" +# 2301 "parsing/parser.mly" ( let (exten, fields) = _4 in (* TODO: review the location of Pexp_construct *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_record(fields, exten))) ) -# 36665 "parsing/parser.ml" +# 36822 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36669,15 +36826,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36675 "parsing/parser.ml" +# 36832 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36681 "parsing/parser.ml" +# 36838 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36733,9 +36890,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2282 "parsing/parser.mly" +# 2305 "parsing/parser.mly" ( unclosed "{" _loc__3_ "}" _loc__5_ ) -# 36739 "parsing/parser.ml" +# 36896 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -36743,15 +36900,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36749 "parsing/parser.ml" +# 36906 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36755 "parsing/parser.ml" +# 36912 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36790,14 +36947,14 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 36796 "parsing/parser.ml" +# 36953 "parsing/parser.ml" in -# 2284 "parsing/parser.mly" +# 2307 "parsing/parser.mly" ( Pexp_array(_2) ) -# 36801 "parsing/parser.ml" +# 36958 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36805,15 +36962,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36811 "parsing/parser.ml" +# 36968 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36817 "parsing/parser.ml" +# 36974 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36852,16 +37009,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 36858 "parsing/parser.ml" +# 37015 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2286 "parsing/parser.mly" +# 2309 "parsing/parser.mly" ( unclosed "[|" _loc__1_ "|]" _loc__3_ ) -# 36865 "parsing/parser.ml" +# 37022 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -36869,15 +37026,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36875 "parsing/parser.ml" +# 37032 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36881 "parsing/parser.ml" +# 37038 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36908,24 +37065,24 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = let _1 = let _1 = -# 2288 "parsing/parser.mly" +# 2311 "parsing/parser.mly" ( Pexp_array [] ) -# 36914 "parsing/parser.ml" +# 37071 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 36923 "parsing/parser.ml" +# 37080 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 36929 "parsing/parser.ml" +# 37086 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -36978,9 +37135,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 36984 "parsing/parser.ml" +# 37141 "parsing/parser.ml" in let od = let _1 = @@ -36988,18 +37145,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 36994 "parsing/parser.ml" +# 37151 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37003 "parsing/parser.ml" +# 37160 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37007,10 +37164,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2290 "parsing/parser.mly" +# 2313 "parsing/parser.mly" ( (* TODO: review the location of Pexp_array *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_array(_4))) ) -# 37014 "parsing/parser.ml" +# 37171 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37018,15 +37175,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37024 "parsing/parser.ml" +# 37181 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37030 "parsing/parser.ml" +# 37187 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37077,18 +37234,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37083 "parsing/parser.ml" +# 37240 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37092 "parsing/parser.ml" +# 37249 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37096,10 +37253,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2293 "parsing/parser.mly" +# 2316 "parsing/parser.mly" ( (* TODO: review the location of Pexp_array *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_array [])) ) -# 37103 "parsing/parser.ml" +# 37260 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -37107,15 +37264,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37113 "parsing/parser.ml" +# 37270 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37119 "parsing/parser.ml" +# 37276 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37168,16 +37325,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 37174 "parsing/parser.ml" +# 37331 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2297 "parsing/parser.mly" +# 2320 "parsing/parser.mly" ( unclosed "[|" _loc__3_ "|]" _loc__5_ ) -# 37181 "parsing/parser.ml" +# 37338 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37185,15 +37342,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37191 "parsing/parser.ml" +# 37348 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37197 "parsing/parser.ml" +# 37354 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37232,15 +37389,15 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 37238 "parsing/parser.ml" +# 37395 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2299 "parsing/parser.mly" +# 2322 "parsing/parser.mly" ( fst (mktailexp _loc__3_ _2) ) -# 37244 "parsing/parser.ml" +# 37401 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37248,15 +37405,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37254 "parsing/parser.ml" +# 37411 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37260 "parsing/parser.ml" +# 37417 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37295,16 +37452,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _2 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 37301 "parsing/parser.ml" +# 37458 "parsing/parser.ml" in let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2301 "parsing/parser.mly" +# 2324 "parsing/parser.mly" ( unclosed "[" _loc__1_ "]" _loc__3_ ) -# 37308 "parsing/parser.ml" +# 37465 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -37312,15 +37469,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37318 "parsing/parser.ml" +# 37475 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37324 "parsing/parser.ml" +# 37481 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37373,9 +37530,9 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 37379 "parsing/parser.ml" +# 37536 "parsing/parser.ml" in let od = let _1 = @@ -37383,18 +37540,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37389 "parsing/parser.ml" +# 37546 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37398 "parsing/parser.ml" +# 37555 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37403,13 +37560,13 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _sloc = (_symbolstartpos, _endpos) in -# 2303 "parsing/parser.mly" +# 2326 "parsing/parser.mly" ( let list_exp = (* TODO: review the location of list_exp *) let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in mkexp ~loc:_sloc tail_exp in Pexp_open(od, list_exp) ) -# 37413 "parsing/parser.ml" +# 37570 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37417,15 +37574,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37423 "parsing/parser.ml" +# 37580 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37429 "parsing/parser.ml" +# 37586 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37473,18 +37630,18 @@ module Tables = struct let _3 = let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in let _1 = -# 2308 "parsing/parser.mly" +# 2331 "parsing/parser.mly" (Lident "[]") -# 37479 "parsing/parser.ml" +# 37636 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37488 "parsing/parser.ml" +# 37645 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -37494,18 +37651,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37500 "parsing/parser.ml" +# 37657 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37509 "parsing/parser.ml" +# 37666 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37513,10 +37670,10 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2309 "parsing/parser.mly" +# 2332 "parsing/parser.mly" ( (* TODO: review the location of Pexp_construct *) Pexp_open(od, mkexp ~loc:_sloc (Pexp_construct(_3, None))) ) -# 37520 "parsing/parser.ml" +# 37677 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -37524,15 +37681,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37530 "parsing/parser.ml" +# 37687 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37536 "parsing/parser.ml" +# 37693 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37585,16 +37742,16 @@ module Tables = struct let _v : (Parsetree.expression) = let _1 = let _1 = let _4 = -# 2513 "parsing/parser.mly" +# 2536 "parsing/parser.mly" ( es ) -# 37591 "parsing/parser.ml" +# 37748 "parsing/parser.ml" in let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2313 "parsing/parser.mly" +# 2336 "parsing/parser.mly" ( unclosed "[" _loc__3_ "]" _loc__5_ ) -# 37598 "parsing/parser.ml" +# 37755 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -37602,15 +37759,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37608 "parsing/parser.ml" +# 37765 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37614 "parsing/parser.ml" +# 37771 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37701,23 +37858,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 37707 "parsing/parser.ml" +# 37864 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 37715 "parsing/parser.ml" +# 37872 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 37721 "parsing/parser.ml" +# 37878 "parsing/parser.ml" in let _5 = @@ -37725,15 +37882,15 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 37731 "parsing/parser.ml" +# 37888 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 37737 "parsing/parser.ml" +# 37894 "parsing/parser.ml" in let od = @@ -37742,18 +37899,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37748 "parsing/parser.ml" +# 37905 "parsing/parser.ml" in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 1422 "parsing/parser.mly" +# 1443 "parsing/parser.mly" ( let loc = make_loc _loc__1_ in let me = Mod.ident ~loc _1 in Opn.mk ~loc me ) -# 37757 "parsing/parser.ml" +# 37914 "parsing/parser.ml" in let _startpos_od_ = _startpos__1_ in @@ -37761,13 +37918,13 @@ module Tables = struct let _symbolstartpos = _startpos_od_ in let _sloc = (_symbolstartpos, _endpos) in -# 2316 "parsing/parser.mly" +# 2339 "parsing/parser.mly" ( (* TODO: review the location of Pexp_constraint *) let modexp = mkexp_attrs ~loc:_sloc (Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in Pexp_open(od, modexp) ) -# 37771 "parsing/parser.ml" +# 37928 "parsing/parser.ml" in let _endpos__1_ = _endpos__9_ in @@ -37775,15 +37932,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37781 "parsing/parser.ml" +# 37938 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37787 "parsing/parser.ml" +# 37944 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37868,23 +38025,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 37874 "parsing/parser.ml" +# 38031 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 37880 "parsing/parser.ml" +# 38037 "parsing/parser.ml" in let _loc__8_ = (_startpos__8_, _endpos__8_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2323 "parsing/parser.mly" +# 2346 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__8_ ) -# 37888 "parsing/parser.ml" +# 38045 "parsing/parser.ml" in let _endpos__1_ = _endpos__8_ in @@ -37892,15 +38049,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 803 "parsing/parser.mly" +# 825 "parsing/parser.mly" ( mkexp ~loc:_sloc _1 ) -# 37898 "parsing/parser.ml" +# 38055 "parsing/parser.ml" in -# 2215 "parsing/parser.mly" +# 2238 "parsing/parser.mly" ( _1 ) -# 37904 "parsing/parser.ml" +# 38061 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37929,30 +38086,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 37935 "parsing/parser.ml" +# 38092 "parsing/parser.ml" in -# 2593 "parsing/parser.mly" +# 2616 "parsing/parser.mly" ( Ppat_var (_1) ) -# 37941 "parsing/parser.ml" +# 38098 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 37950 "parsing/parser.ml" +# 38107 "parsing/parser.ml" in -# 2594 "parsing/parser.mly" +# 2617 "parsing/parser.mly" ( _1 ) -# 37956 "parsing/parser.ml" +# 38113 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -37975,9 +38132,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2595 "parsing/parser.mly" +# 2618 "parsing/parser.mly" ( _1 ) -# 37981 "parsing/parser.ml" +# 38138 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38017,9 +38174,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2600 "parsing/parser.mly" +# 2623 "parsing/parser.mly" ( reloc_pat ~loc:_sloc _2 ) -# 38023 "parsing/parser.ml" +# 38180 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38042,9 +38199,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = -# 2602 "parsing/parser.mly" +# 2625 "parsing/parser.mly" ( _1 ) -# 38048 "parsing/parser.ml" +# 38205 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38093,11 +38250,7 @@ module Tables = struct }; } = _menhir_stack in let _5 : unit = Obj.magic _5 in - let _1_inlined3 : ( -# 666 "parsing/parser.mly" - (string) -# 38100 "parsing/parser.ml" - ) = Obj.magic _1_inlined3 in + let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in @@ -38111,9 +38264,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38117 "parsing/parser.ml" +# 38270 "parsing/parser.ml" in let _3 = @@ -38121,24 +38274,24 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 38127 "parsing/parser.ml" +# 38280 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 38133 "parsing/parser.ml" +# 38286 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2604 "parsing/parser.mly" +# 2627 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 ) -# 38142 "parsing/parser.ml" +# 38295 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38201,11 +38354,7 @@ module Tables = struct let _7 : unit = Obj.magic _7 in let _1_inlined4 : (Parsetree.module_type) = Obj.magic _1_inlined4 in let _5 : unit = Obj.magic _5 in - let _1_inlined3 : ( -# 666 "parsing/parser.mly" - (string) -# 38208 "parsing/parser.ml" - ) = Obj.magic _1_inlined3 in + let _1_inlined3 : (string option) = Obj.magic _1_inlined3 in let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in @@ -38217,23 +38366,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 38223 "parsing/parser.ml" +# 38372 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 38231 "parsing/parser.ml" +# 38380 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 38237 "parsing/parser.ml" +# 38386 "parsing/parser.ml" in let _4 = @@ -38242,9 +38391,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38248 "parsing/parser.ml" +# 38397 "parsing/parser.ml" in let _3 = @@ -38252,26 +38401,26 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 38258 "parsing/parser.ml" +# 38407 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 38264 "parsing/parser.ml" +# 38413 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2606 "parsing/parser.mly" +# 2629 "parsing/parser.mly" ( mkpat_attrs ~loc:_sloc (Ppat_constraint(mkpat ~loc:_sloc (Ppat_unpack _4), _6)) _3 ) -# 38275 "parsing/parser.ml" +# 38424 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38295,23 +38444,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2614 "parsing/parser.mly" +# 2637 "parsing/parser.mly" ( Ppat_any ) -# 38301 "parsing/parser.ml" +# 38450 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38309 "parsing/parser.ml" +# 38458 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38315 "parsing/parser.ml" +# 38464 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38335,23 +38484,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2616 "parsing/parser.mly" +# 2639 "parsing/parser.mly" ( Ppat_constant _1 ) -# 38341 "parsing/parser.ml" +# 38490 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38349 "parsing/parser.ml" +# 38498 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38355 "parsing/parser.ml" +# 38504 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38389,24 +38538,24 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2618 "parsing/parser.mly" +# 2641 "parsing/parser.mly" ( Ppat_interval (_1, _3) ) -# 38395 "parsing/parser.ml" +# 38544 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38404 "parsing/parser.ml" +# 38553 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38410 "parsing/parser.ml" +# 38559 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38435,30 +38584,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38441 "parsing/parser.ml" +# 38590 "parsing/parser.ml" in -# 2620 "parsing/parser.mly" +# 2643 "parsing/parser.mly" ( Ppat_construct(_1, None) ) -# 38447 "parsing/parser.ml" +# 38596 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38456 "parsing/parser.ml" +# 38605 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38462 "parsing/parser.ml" +# 38611 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38482,23 +38631,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2622 "parsing/parser.mly" +# 2645 "parsing/parser.mly" ( Ppat_variant(_1, None) ) -# 38488 "parsing/parser.ml" +# 38637 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38496 "parsing/parser.ml" +# 38645 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38502 "parsing/parser.ml" +# 38651 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38535,15 +38684,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38541 "parsing/parser.ml" +# 38690 "parsing/parser.ml" in -# 2624 "parsing/parser.mly" +# 2647 "parsing/parser.mly" ( Ppat_type (_2) ) -# 38547 "parsing/parser.ml" +# 38696 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -38551,15 +38700,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38557 "parsing/parser.ml" +# 38706 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38563 "parsing/parser.ml" +# 38712 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38602,15 +38751,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38608 "parsing/parser.ml" +# 38757 "parsing/parser.ml" in -# 2626 "parsing/parser.mly" +# 2649 "parsing/parser.mly" ( Ppat_open(_1, _3) ) -# 38614 "parsing/parser.ml" +# 38763 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -38618,15 +38767,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38624 "parsing/parser.ml" +# 38773 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38630 "parsing/parser.ml" +# 38779 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38674,18 +38823,18 @@ module Tables = struct let _3 = let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in let _1 = -# 2627 "parsing/parser.mly" +# 2650 "parsing/parser.mly" (Lident "[]") -# 38680 "parsing/parser.ml" +# 38829 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38689 "parsing/parser.ml" +# 38838 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -38694,18 +38843,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38700 "parsing/parser.ml" +# 38849 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2628 "parsing/parser.mly" +# 2651 "parsing/parser.mly" ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) -# 38709 "parsing/parser.ml" +# 38858 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -38713,15 +38862,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38719 "parsing/parser.ml" +# 38868 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38725 "parsing/parser.ml" +# 38874 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38769,18 +38918,18 @@ module Tables = struct let _3 = let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in let _1 = -# 2629 "parsing/parser.mly" +# 2652 "parsing/parser.mly" (Lident "()") -# 38775 "parsing/parser.ml" +# 38924 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38784 "parsing/parser.ml" +# 38933 "parsing/parser.ml" in let _endpos__3_ = _endpos__2_inlined1_ in @@ -38789,18 +38938,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38795 "parsing/parser.ml" +# 38944 "parsing/parser.ml" in let _endpos = _endpos__3_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2630 "parsing/parser.mly" +# 2653 "parsing/parser.mly" ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) ) -# 38804 "parsing/parser.ml" +# 38953 "parsing/parser.ml" in let _endpos__1_ = _endpos__2_inlined1_ in @@ -38808,15 +38957,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38814 "parsing/parser.ml" +# 38963 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38820 "parsing/parser.ml" +# 38969 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38873,15 +39022,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 38879 "parsing/parser.ml" +# 39028 "parsing/parser.ml" in -# 2632 "parsing/parser.mly" +# 2655 "parsing/parser.mly" ( Ppat_open (_1, _4) ) -# 38885 "parsing/parser.ml" +# 39034 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -38889,15 +39038,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38895 "parsing/parser.ml" +# 39044 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38901 "parsing/parser.ml" +# 39050 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -38952,9 +39101,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 2634 "parsing/parser.mly" +# 2657 "parsing/parser.mly" ( unclosed "(" _loc__3_ ")" _loc__5_ ) -# 38958 "parsing/parser.ml" +# 39107 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -38962,15 +39111,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 38968 "parsing/parser.ml" +# 39117 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 38974 "parsing/parser.ml" +# 39123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39017,9 +39166,9 @@ module Tables = struct let _1 = let _loc__4_ = (_startpos__4_, _endpos__4_) in -# 2636 "parsing/parser.mly" +# 2659 "parsing/parser.mly" ( expecting _loc__4_ "pattern" ) -# 39023 "parsing/parser.ml" +# 39172 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -39027,15 +39176,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39033 "parsing/parser.ml" +# 39182 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39039 "parsing/parser.ml" +# 39188 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39076,9 +39225,9 @@ module Tables = struct let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2638 "parsing/parser.mly" +# 2661 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 39082 "parsing/parser.ml" +# 39231 "parsing/parser.ml" in let _endpos__1_ = _endpos__3_ in @@ -39086,15 +39235,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39092 "parsing/parser.ml" +# 39241 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39098 "parsing/parser.ml" +# 39247 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39146,24 +39295,24 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2640 "parsing/parser.mly" +# 2663 "parsing/parser.mly" ( Ppat_constraint(_2, _4) ) -# 39152 "parsing/parser.ml" +# 39301 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39161 "parsing/parser.ml" +# 39310 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39167 "parsing/parser.ml" +# 39316 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39218,9 +39367,9 @@ module Tables = struct let _loc__5_ = (_startpos__5_, _endpos__5_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2642 "parsing/parser.mly" +# 2665 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__5_ ) -# 39224 "parsing/parser.ml" +# 39373 "parsing/parser.ml" in let _endpos__1_ = _endpos__5_ in @@ -39228,15 +39377,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39234 "parsing/parser.ml" +# 39383 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39240 "parsing/parser.ml" +# 39389 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39283,9 +39432,9 @@ module Tables = struct let _1 = let _loc__4_ = (_startpos__4_, _endpos__4_) in -# 2644 "parsing/parser.mly" +# 2667 "parsing/parser.mly" ( expecting _loc__4_ "type" ) -# 39289 "parsing/parser.ml" +# 39438 "parsing/parser.ml" in let _endpos__1_ = _endpos__4_ in @@ -39293,15 +39442,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39299 "parsing/parser.ml" +# 39448 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39305 "parsing/parser.ml" +# 39454 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39364,11 +39513,7 @@ module Tables = struct let _7 : unit = Obj.magic _7 in let _1_inlined3 : (Parsetree.module_type) = Obj.magic _1_inlined3 in let _5 : unit = Obj.magic _5 in - let _4 : ( -# 666 "parsing/parser.mly" - (string) -# 39371 "parsing/parser.ml" - ) = Obj.magic _4 in + let _4 : (string option) = Obj.magic _4 in let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in let _2 : unit = Obj.magic _2 in @@ -39382,23 +39527,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in let _1 = let _1 = -# 3247 "parsing/parser.mly" +# 3270 "parsing/parser.mly" ( Ptyp_package (package_type_of_module_type _1) ) -# 39388 "parsing/parser.ml" +# 39533 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 39396 "parsing/parser.ml" +# 39541 "parsing/parser.ml" in -# 3248 "parsing/parser.mly" +# 3271 "parsing/parser.mly" ( _1 ) -# 39402 "parsing/parser.ml" +# 39547 "parsing/parser.ml" in let _3 = @@ -39406,23 +39551,23 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 39412 "parsing/parser.ml" +# 39557 "parsing/parser.ml" in -# 3653 "parsing/parser.mly" +# 3680 "parsing/parser.mly" ( _1, _2 ) -# 39418 "parsing/parser.ml" +# 39563 "parsing/parser.ml" in let _loc__7_ = (_startpos__7_, _endpos__7_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 2647 "parsing/parser.mly" +# 2670 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__7_ ) -# 39426 "parsing/parser.ml" +# 39571 "parsing/parser.ml" in let _endpos__1_ = _endpos__7_ in @@ -39430,15 +39575,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39436 "parsing/parser.ml" +# 39581 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39442 "parsing/parser.ml" +# 39587 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39462,23 +39607,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.pattern) = let _1 = let _1 = -# 2649 "parsing/parser.mly" +# 2672 "parsing/parser.mly" ( Ppat_extension _1 ) -# 39468 "parsing/parser.ml" +# 39613 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 805 "parsing/parser.mly" +# 827 "parsing/parser.mly" ( mkpat ~loc:_sloc _1 ) -# 39476 "parsing/parser.ml" +# 39621 "parsing/parser.ml" in -# 2610 "parsing/parser.mly" +# 2633 "parsing/parser.mly" ( _1 ) -# 39482 "parsing/parser.ml" +# 39627 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39497,17 +39642,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 39503 "parsing/parser.ml" +# 39648 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3563 "parsing/parser.mly" +# 3590 "parsing/parser.mly" ( _1 ) -# 39511 "parsing/parser.ml" +# 39656 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39526,17 +39671,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 666 "parsing/parser.mly" +# 688 "parsing/parser.mly" (string) -# 39532 "parsing/parser.ml" +# 39677 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3564 "parsing/parser.mly" +# 3591 "parsing/parser.mly" ( _1 ) -# 39540 "parsing/parser.ml" +# 39685 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39559,9 +39704,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3565 "parsing/parser.mly" +# 3592 "parsing/parser.mly" ( "and" ) -# 39565 "parsing/parser.ml" +# 39710 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39584,9 +39729,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3566 "parsing/parser.mly" +# 3593 "parsing/parser.mly" ( "as" ) -# 39590 "parsing/parser.ml" +# 39735 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39609,9 +39754,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3567 "parsing/parser.mly" +# 3594 "parsing/parser.mly" ( "assert" ) -# 39615 "parsing/parser.ml" +# 39760 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39634,9 +39779,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3568 "parsing/parser.mly" +# 3595 "parsing/parser.mly" ( "begin" ) -# 39640 "parsing/parser.ml" +# 39785 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39659,9 +39804,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3569 "parsing/parser.mly" +# 3596 "parsing/parser.mly" ( "class" ) -# 39665 "parsing/parser.ml" +# 39810 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39684,9 +39829,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3570 "parsing/parser.mly" +# 3597 "parsing/parser.mly" ( "constraint" ) -# 39690 "parsing/parser.ml" +# 39835 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39709,9 +39854,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3571 "parsing/parser.mly" +# 3598 "parsing/parser.mly" ( "do" ) -# 39715 "parsing/parser.ml" +# 39860 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39734,9 +39879,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3572 "parsing/parser.mly" +# 3599 "parsing/parser.mly" ( "done" ) -# 39740 "parsing/parser.ml" +# 39885 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39759,9 +39904,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3573 "parsing/parser.mly" +# 3600 "parsing/parser.mly" ( "downto" ) -# 39765 "parsing/parser.ml" +# 39910 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39784,9 +39929,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3574 "parsing/parser.mly" +# 3601 "parsing/parser.mly" ( "else" ) -# 39790 "parsing/parser.ml" +# 39935 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39809,9 +39954,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3575 "parsing/parser.mly" +# 3602 "parsing/parser.mly" ( "end" ) -# 39815 "parsing/parser.ml" +# 39960 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39834,9 +39979,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3576 "parsing/parser.mly" +# 3603 "parsing/parser.mly" ( "exception" ) -# 39840 "parsing/parser.ml" +# 39985 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39859,9 +40004,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3577 "parsing/parser.mly" +# 3604 "parsing/parser.mly" ( "external" ) -# 39865 "parsing/parser.ml" +# 40010 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39884,9 +40029,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3578 "parsing/parser.mly" +# 3605 "parsing/parser.mly" ( "false" ) -# 39890 "parsing/parser.ml" +# 40035 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39909,9 +40054,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3579 "parsing/parser.mly" +# 3606 "parsing/parser.mly" ( "for" ) -# 39915 "parsing/parser.ml" +# 40060 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39934,9 +40079,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3580 "parsing/parser.mly" +# 3607 "parsing/parser.mly" ( "fun" ) -# 39940 "parsing/parser.ml" +# 40085 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39959,9 +40104,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3581 "parsing/parser.mly" +# 3608 "parsing/parser.mly" ( "function" ) -# 39965 "parsing/parser.ml" +# 40110 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -39984,9 +40129,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3582 "parsing/parser.mly" +# 3609 "parsing/parser.mly" ( "functor" ) -# 39990 "parsing/parser.ml" +# 40135 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40009,9 +40154,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3583 "parsing/parser.mly" +# 3610 "parsing/parser.mly" ( "if" ) -# 40015 "parsing/parser.ml" +# 40160 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40034,9 +40179,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3584 "parsing/parser.mly" +# 3611 "parsing/parser.mly" ( "in" ) -# 40040 "parsing/parser.ml" +# 40185 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40059,9 +40204,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3585 "parsing/parser.mly" +# 3612 "parsing/parser.mly" ( "include" ) -# 40065 "parsing/parser.ml" +# 40210 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40084,9 +40229,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3586 "parsing/parser.mly" +# 3613 "parsing/parser.mly" ( "inherit" ) -# 40090 "parsing/parser.ml" +# 40235 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40109,9 +40254,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3587 "parsing/parser.mly" +# 3614 "parsing/parser.mly" ( "initializer" ) -# 40115 "parsing/parser.ml" +# 40260 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40134,9 +40279,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3588 "parsing/parser.mly" +# 3615 "parsing/parser.mly" ( "lazy" ) -# 40140 "parsing/parser.ml" +# 40285 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40159,9 +40304,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3589 "parsing/parser.mly" +# 3616 "parsing/parser.mly" ( "let" ) -# 40165 "parsing/parser.ml" +# 40310 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40184,9 +40329,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3590 "parsing/parser.mly" +# 3617 "parsing/parser.mly" ( "match" ) -# 40190 "parsing/parser.ml" +# 40335 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40209,9 +40354,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3591 "parsing/parser.mly" +# 3618 "parsing/parser.mly" ( "method" ) -# 40215 "parsing/parser.ml" +# 40360 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40234,9 +40379,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3592 "parsing/parser.mly" +# 3619 "parsing/parser.mly" ( "module" ) -# 40240 "parsing/parser.ml" +# 40385 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40259,9 +40404,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3593 "parsing/parser.mly" +# 3620 "parsing/parser.mly" ( "mutable" ) -# 40265 "parsing/parser.ml" +# 40410 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40284,9 +40429,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3594 "parsing/parser.mly" +# 3621 "parsing/parser.mly" ( "new" ) -# 40290 "parsing/parser.ml" +# 40435 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40309,9 +40454,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3595 "parsing/parser.mly" +# 3622 "parsing/parser.mly" ( "nonrec" ) -# 40315 "parsing/parser.ml" +# 40460 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40334,9 +40479,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3596 "parsing/parser.mly" +# 3623 "parsing/parser.mly" ( "object" ) -# 40340 "parsing/parser.ml" +# 40485 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40359,9 +40504,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3597 "parsing/parser.mly" +# 3624 "parsing/parser.mly" ( "of" ) -# 40365 "parsing/parser.ml" +# 40510 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40384,9 +40529,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3598 "parsing/parser.mly" +# 3625 "parsing/parser.mly" ( "open" ) -# 40390 "parsing/parser.ml" +# 40535 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40409,9 +40554,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3599 "parsing/parser.mly" +# 3626 "parsing/parser.mly" ( "or" ) -# 40415 "parsing/parser.ml" +# 40560 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40434,9 +40579,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3600 "parsing/parser.mly" +# 3627 "parsing/parser.mly" ( "private" ) -# 40440 "parsing/parser.ml" +# 40585 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40459,9 +40604,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3601 "parsing/parser.mly" +# 3628 "parsing/parser.mly" ( "rec" ) -# 40465 "parsing/parser.ml" +# 40610 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40484,9 +40629,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3602 "parsing/parser.mly" +# 3629 "parsing/parser.mly" ( "sig" ) -# 40490 "parsing/parser.ml" +# 40635 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40509,9 +40654,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3603 "parsing/parser.mly" +# 3630 "parsing/parser.mly" ( "struct" ) -# 40515 "parsing/parser.ml" +# 40660 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40534,9 +40679,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3604 "parsing/parser.mly" +# 3631 "parsing/parser.mly" ( "then" ) -# 40540 "parsing/parser.ml" +# 40685 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40559,9 +40704,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3605 "parsing/parser.mly" +# 3632 "parsing/parser.mly" ( "to" ) -# 40565 "parsing/parser.ml" +# 40710 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40584,9 +40729,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3606 "parsing/parser.mly" +# 3633 "parsing/parser.mly" ( "true" ) -# 40590 "parsing/parser.ml" +# 40735 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40609,9 +40754,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3607 "parsing/parser.mly" +# 3634 "parsing/parser.mly" ( "try" ) -# 40615 "parsing/parser.ml" +# 40760 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40634,9 +40779,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3608 "parsing/parser.mly" +# 3635 "parsing/parser.mly" ( "type" ) -# 40640 "parsing/parser.ml" +# 40785 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40659,9 +40804,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3609 "parsing/parser.mly" +# 3636 "parsing/parser.mly" ( "val" ) -# 40665 "parsing/parser.ml" +# 40810 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40684,9 +40829,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3610 "parsing/parser.mly" +# 3637 "parsing/parser.mly" ( "virtual" ) -# 40690 "parsing/parser.ml" +# 40835 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40709,9 +40854,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3611 "parsing/parser.mly" +# 3638 "parsing/parser.mly" ( "when" ) -# 40715 "parsing/parser.ml" +# 40860 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40734,9 +40879,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3612 "parsing/parser.mly" +# 3639 "parsing/parser.mly" ( "while" ) -# 40740 "parsing/parser.ml" +# 40885 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40759,9 +40904,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3613 "parsing/parser.mly" +# 3640 "parsing/parser.mly" ( "with" ) -# 40765 "parsing/parser.ml" +# 40910 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40784,9 +40929,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Parsetree.type_exception * string Asttypes.loc option) = -# 2914 "parsing/parser.mly" +# 2937 "parsing/parser.mly" ( _1 ) -# 40790 "parsing/parser.ml" +# 40935 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40860,18 +41005,18 @@ module Tables = struct let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs = let _1 = _1_inlined5 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 40866 "parsing/parser.ml" +# 41011 "parsing/parser.ml" in let _endpos_attrs_ = _endpos__1_inlined5_ in let attrs2 = let _1 = _1_inlined4 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 40875 "parsing/parser.ml" +# 41020 "parsing/parser.ml" in let lid = @@ -40880,9 +41025,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 40886 "parsing/parser.ml" +# 41031 "parsing/parser.ml" in let id = @@ -40891,30 +41036,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 40897 "parsing/parser.ml" +# 41042 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 40905 "parsing/parser.ml" +# 41050 "parsing/parser.ml" in let _endpos = _endpos_attrs_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2923 "parsing/parser.mly" +# 2946 "parsing/parser.mly" ( let loc = make_loc _sloc in let docs = symbol_docs _sloc in Te.mk_exception ~attrs (Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs) , ext ) -# 40918 "parsing/parser.ml" +# 41063 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40944,9 +41089,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.expression) = -# 2438 "parsing/parser.mly" +# 2461 "parsing/parser.mly" ( _2 ) -# 40950 "parsing/parser.ml" +# 41095 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -40979,9 +41124,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2440 "parsing/parser.mly" +# 2463 "parsing/parser.mly" ( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) ) -# 40985 "parsing/parser.ml" +# 41130 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41032,17 +41177,17 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__5_ in let _v : (Parsetree.expression) = let _3 = -# 2341 "parsing/parser.mly" +# 2364 "parsing/parser.mly" ( xs ) -# 41038 "parsing/parser.ml" +# 41183 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2442 "parsing/parser.mly" +# 2465 "parsing/parser.mly" ( mk_newtypes ~loc:_sloc _3 _5 ) -# 41046 "parsing/parser.ml" +# 41191 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41069,39 +41214,39 @@ module Tables = struct let ys = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 41073 "parsing/parser.ml" +# 41218 "parsing/parser.ml" in let xs = let items = -# 840 "parsing/parser.mly" +# 862 "parsing/parser.mly" ( [] ) -# 41079 "parsing/parser.ml" +# 41224 "parsing/parser.ml" in -# 1225 "parsing/parser.mly" +# 1247 "parsing/parser.mly" ( items ) -# 41084 "parsing/parser.ml" +# 41229 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 41090 "parsing/parser.ml" +# 41235 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 762 "parsing/parser.mly" +# 784 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 41099 "parsing/parser.ml" +# 41244 "parsing/parser.ml" in -# 1218 "parsing/parser.mly" +# 1240 "parsing/parser.mly" ( _1 ) -# 41105 "parsing/parser.ml" +# 41250 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41142,7 +41287,7 @@ module Tables = struct let ys = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 41146 "parsing/parser.ml" +# 41291 "parsing/parser.ml" in let xs = let items = @@ -41150,65 +41295,65 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 41156 "parsing/parser.ml" +# 41301 "parsing/parser.ml" in -# 1232 "parsing/parser.mly" +# 1254 "parsing/parser.mly" ( mkstrexp e attrs ) -# 41161 "parsing/parser.ml" +# 41306 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 774 "parsing/parser.mly" +# 796 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 41169 "parsing/parser.ml" +# 41314 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 793 "parsing/parser.mly" +# 815 "parsing/parser.mly" ( mark_rhs_docs _startpos _endpos; _1 ) -# 41179 "parsing/parser.ml" +# 41324 "parsing/parser.ml" in -# 842 "parsing/parser.mly" +# 864 "parsing/parser.mly" ( x ) -# 41185 "parsing/parser.ml" +# 41330 "parsing/parser.ml" in -# 1225 "parsing/parser.mly" +# 1247 "parsing/parser.mly" ( items ) -# 41191 "parsing/parser.ml" +# 41336 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 41197 "parsing/parser.ml" +# 41342 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 762 "parsing/parser.mly" +# 784 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 41206 "parsing/parser.ml" +# 41351 "parsing/parser.ml" in -# 1218 "parsing/parser.mly" +# 1240 "parsing/parser.mly" ( _1 ) -# 41212 "parsing/parser.ml" +# 41357 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41234,9 +41379,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1247 "parsing/parser.mly" +# 1269 "parsing/parser.mly" ( val_of_let_bindings ~loc:_sloc _1 ) -# 41240 "parsing/parser.ml" +# 41385 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41270,9 +41415,9 @@ module Tables = struct let _2 = let _1 = _1_inlined1 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 41276 "parsing/parser.ml" +# 41421 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -41280,10 +41425,10 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1250 "parsing/parser.mly" +# 1272 "parsing/parser.mly" ( let docs = symbol_docs _sloc in Pstr_extension (_1, add_docs_attrs docs _2) ) -# 41287 "parsing/parser.ml" +# 41432 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined1_ in @@ -41291,15 +41436,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 809 "parsing/parser.mly" +# 831 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 41297 "parsing/parser.ml" +# 41442 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41303 "parsing/parser.ml" +# 41448 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41323,23 +41468,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1253 "parsing/parser.mly" +# 1275 "parsing/parser.mly" ( Pstr_attribute _1 ) -# 41329 "parsing/parser.ml" +# 41474 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 809 "parsing/parser.mly" +# 831 "parsing/parser.mly" ( mkstr ~loc:_sloc _1 ) -# 41337 "parsing/parser.ml" +# 41482 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41343 "parsing/parser.ml" +# 41488 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41363,23 +41508,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1257 "parsing/parser.mly" +# 1279 "parsing/parser.mly" ( pstr_primitive _1 ) -# 41369 "parsing/parser.ml" +# 41514 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41377 "parsing/parser.ml" +# 41522 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41383 "parsing/parser.ml" +# 41528 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41403,23 +41548,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1259 "parsing/parser.mly" +# 1281 "parsing/parser.mly" ( pstr_primitive _1 ) -# 41409 "parsing/parser.ml" +# 41554 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41417 "parsing/parser.ml" +# 41562 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41423 "parsing/parser.ml" +# 41568 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41454,26 +41599,26 @@ module Tables = struct let _1 = let _1 = let _1 = -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 41460 "parsing/parser.ml" +# 41605 "parsing/parser.ml" in -# 2769 "parsing/parser.mly" +# 2792 "parsing/parser.mly" ( _1 ) -# 41465 "parsing/parser.ml" +# 41610 "parsing/parser.ml" in -# 2752 "parsing/parser.mly" +# 2775 "parsing/parser.mly" ( _1 ) -# 41471 "parsing/parser.ml" +# 41616 "parsing/parser.ml" in -# 1261 "parsing/parser.mly" +# 1283 "parsing/parser.mly" ( pstr_type _1 ) -# 41477 "parsing/parser.ml" +# 41622 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in @@ -41481,15 +41626,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41487 "parsing/parser.ml" +# 41632 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41493 "parsing/parser.ml" +# 41638 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41574,16 +41719,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 41580 "parsing/parser.ml" +# 41725 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in let cs = -# 993 "parsing/parser.mly" +# 1015 "parsing/parser.mly" ( List.rev xs ) -# 41587 "parsing/parser.ml" +# 41732 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in @@ -41591,46 +41736,46 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41597 "parsing/parser.ml" +# 41742 "parsing/parser.ml" in let _4 = -# 3485 "parsing/parser.mly" +# 3512 "parsing/parser.mly" ( Recursive ) -# 41603 "parsing/parser.ml" +# 41748 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 41610 "parsing/parser.ml" +# 41755 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3006 "parsing/parser.mly" +# 3029 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 41622 "parsing/parser.ml" +# 41767 "parsing/parser.ml" in -# 2989 "parsing/parser.mly" +# 3012 "parsing/parser.mly" ( _1 ) -# 41628 "parsing/parser.ml" +# 41773 "parsing/parser.ml" in -# 1263 "parsing/parser.mly" +# 1285 "parsing/parser.mly" ( pstr_typext _1 ) -# 41634 "parsing/parser.ml" +# 41779 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -41638,15 +41783,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41644 "parsing/parser.ml" +# 41789 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41650 "parsing/parser.ml" +# 41795 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41738,16 +41883,16 @@ module Tables = struct let attrs2 = let _1 = _1_inlined4 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 41744 "parsing/parser.ml" +# 41889 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined4_ in let cs = -# 993 "parsing/parser.mly" +# 1015 "parsing/parser.mly" ( List.rev xs ) -# 41751 "parsing/parser.ml" +# 41896 "parsing/parser.ml" in let tid = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in @@ -41755,9 +41900,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41761 "parsing/parser.ml" +# 41906 "parsing/parser.ml" in let _4 = @@ -41766,41 +41911,41 @@ module Tables = struct let _startpos = _startpos__1_ in let _loc = (_startpos, _endpos) in -# 3486 "parsing/parser.mly" +# 3513 "parsing/parser.mly" ( not_expecting _loc "nonrec flag" ) -# 41772 "parsing/parser.ml" +# 41917 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 41780 "parsing/parser.ml" +# 41925 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3006 "parsing/parser.mly" +# 3029 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let attrs = attrs1 @ attrs2 in Te.mk tid cs ~params ~priv ~attrs ~docs, ext ) -# 41792 "parsing/parser.ml" +# 41937 "parsing/parser.ml" in -# 2989 "parsing/parser.mly" +# 3012 "parsing/parser.mly" ( _1 ) -# 41798 "parsing/parser.ml" +# 41943 "parsing/parser.ml" in -# 1263 "parsing/parser.mly" +# 1285 "parsing/parser.mly" ( pstr_typext _1 ) -# 41804 "parsing/parser.ml" +# 41949 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined4_ in @@ -41808,15 +41953,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41814 "parsing/parser.ml" +# 41959 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41820 "parsing/parser.ml" +# 41965 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41840,23 +41985,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1265 "parsing/parser.mly" +# 1287 "parsing/parser.mly" ( pstr_exception _1 ) -# 41846 "parsing/parser.ml" +# 41991 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41854 "parsing/parser.ml" +# 41999 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41860 "parsing/parser.ml" +# 42005 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -41906,11 +42051,7 @@ module Tables = struct } = _menhir_stack in let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.module_expr) = Obj.magic body in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 41913 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in let _1 : unit = Obj.magic _1 in @@ -41923,48 +42064,48 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 41929 "parsing/parser.ml" +# 42070 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 41941 "parsing/parser.ml" +# 42082 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 41949 "parsing/parser.ml" +# 42090 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1291 "parsing/parser.mly" +# 1313 "parsing/parser.mly" ( let docs = symbol_docs _sloc in let loc = make_loc _sloc in let attrs = attrs1 @ attrs2 in - let body = Mb.mk uid body ~attrs ~loc ~docs in + let body = Mb.mk name body ~attrs ~loc ~docs in Pstr_module body, ext ) -# 41962 "parsing/parser.ml" +# 42103 "parsing/parser.ml" in -# 1267 "parsing/parser.mly" +# 1289 "parsing/parser.mly" ( _1 ) -# 41968 "parsing/parser.ml" +# 42109 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined3_ in @@ -41972,15 +42113,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 41978 "parsing/parser.ml" +# 42119 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 41984 "parsing/parser.ml" +# 42125 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42043,11 +42184,7 @@ module Tables = struct let bs : (Parsetree.module_binding list) = Obj.magic bs in let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.module_expr) = Obj.magic body in - let _1_inlined2 : ( -# 666 "parsing/parser.mly" - (string) -# 42050 "parsing/parser.ml" - ) = Obj.magic _1_inlined2 in + let _1_inlined2 : (string option) = Obj.magic _1_inlined2 in let _4 : unit = Obj.magic _4 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in let ext : (string Asttypes.loc option) = Obj.magic ext in @@ -42063,62 +42200,62 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 42069 "parsing/parser.ml" +# 42206 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in - let uid = + let name = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42081 "parsing/parser.ml" +# 42218 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 42089 "parsing/parser.ml" +# 42226 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1326 "parsing/parser.mly" +# 1347 "parsing/parser.mly" ( let loc = make_loc _sloc in let attrs = attrs1 @ attrs2 in let docs = symbol_docs _sloc in ext, - Mb.mk uid body ~attrs ~loc ~docs + Mb.mk name body ~attrs ~loc ~docs ) -# 42104 "parsing/parser.ml" +# 42241 "parsing/parser.ml" in -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42110 "parsing/parser.ml" +# 42247 "parsing/parser.ml" in -# 1314 "parsing/parser.mly" +# 1335 "parsing/parser.mly" ( _1 ) -# 42116 "parsing/parser.ml" +# 42253 "parsing/parser.ml" in -# 1269 "parsing/parser.mly" +# 1291 "parsing/parser.mly" ( pstr_recmodule _1 ) -# 42122 "parsing/parser.ml" +# 42259 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -42126,15 +42263,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42132 "parsing/parser.ml" +# 42269 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42138 "parsing/parser.ml" +# 42275 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42158,23 +42295,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1271 "parsing/parser.mly" +# 1293 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_modtype body, ext) ) -# 42164 "parsing/parser.ml" +# 42301 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42172 "parsing/parser.ml" +# 42309 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42178 "parsing/parser.ml" +# 42315 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42198,23 +42335,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1273 "parsing/parser.mly" +# 1295 "parsing/parser.mly" ( let (body, ext) = _1 in (Pstr_open body, ext) ) -# 42204 "parsing/parser.ml" +# 42341 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42212 "parsing/parser.ml" +# 42349 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42218 "parsing/parser.ml" +# 42355 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42284,9 +42421,9 @@ module Tables = struct let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in let body : (Parsetree.class_expr) = Obj.magic body in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 42290 "parsing/parser.ml" +# 42427 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let params : ((Parsetree.core_type * Asttypes.variance) list) = Obj.magic params in let virt : (Asttypes.virtual_flag) = Obj.magic virt in @@ -42304,9 +42441,9 @@ module Tables = struct let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 42310 "parsing/parser.ml" +# 42447 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -42316,24 +42453,24 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42322 "parsing/parser.ml" +# 42459 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 42330 "parsing/parser.ml" +# 42467 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1645 "parsing/parser.mly" +# 1665 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in @@ -42341,25 +42478,25 @@ module Tables = struct ext, Ci.mk id body ~virt ~params ~attrs ~loc ~docs ) -# 42345 "parsing/parser.ml" +# 42482 "parsing/parser.ml" in -# 1001 "parsing/parser.mly" +# 1023 "parsing/parser.mly" ( let (x, b) = a in x, b :: bs ) -# 42351 "parsing/parser.ml" +# 42488 "parsing/parser.ml" in -# 1634 "parsing/parser.mly" +# 1654 "parsing/parser.mly" ( _1 ) -# 42357 "parsing/parser.ml" +# 42494 "parsing/parser.ml" in -# 1275 "parsing/parser.mly" +# 1297 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class l, ext) ) -# 42363 "parsing/parser.ml" +# 42500 "parsing/parser.ml" in let _endpos__1_ = _endpos_bs_ in @@ -42367,15 +42504,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42373 "parsing/parser.ml" +# 42510 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42379 "parsing/parser.ml" +# 42516 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42399,23 +42536,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.structure_item) = let _1 = let _1 = -# 1277 "parsing/parser.mly" +# 1299 "parsing/parser.mly" ( let (ext, l) = _1 in (Pstr_class_type l, ext) ) -# 42405 "parsing/parser.ml" +# 42542 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42413 "parsing/parser.ml" +# 42550 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42419 "parsing/parser.ml" +# 42556 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42471,38 +42608,38 @@ module Tables = struct let attrs2 = let _1 = _1_inlined2 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 42477 "parsing/parser.ml" +# 42614 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined2_ in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 42486 "parsing/parser.ml" +# 42623 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 1363 "parsing/parser.mly" +# 1384 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Incl.mk thing ~attrs ~loc ~docs, ext ) -# 42500 "parsing/parser.ml" +# 42637 "parsing/parser.ml" in -# 1279 "parsing/parser.mly" +# 1301 "parsing/parser.mly" ( pstr_include _1 ) -# 42506 "parsing/parser.ml" +# 42643 "parsing/parser.ml" in let _endpos__1_ = _endpos__1_inlined2_ in @@ -42510,15 +42647,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 826 "parsing/parser.mly" +# 848 "parsing/parser.mly" ( wrap_mkstr_ext ~loc:_sloc _1 ) -# 42516 "parsing/parser.ml" +# 42653 "parsing/parser.ml" in -# 1281 "parsing/parser.mly" +# 1303 "parsing/parser.mly" ( _1 ) -# 42522 "parsing/parser.ml" +# 42659 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42541,9 +42678,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3548 "parsing/parser.mly" +# 3575 "parsing/parser.mly" ( "-" ) -# 42547 "parsing/parser.ml" +# 42684 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42566,9 +42703,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3549 "parsing/parser.mly" +# 3576 "parsing/parser.mly" ( "-." ) -# 42572 "parsing/parser.ml" +# 42709 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42621,9 +42758,9 @@ module Tables = struct let _v : (Parsetree.row_field) = let _5 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 42627 "parsing/parser.ml" +# 42764 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined1_ in @@ -42632,18 +42769,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 42636 "parsing/parser.ml" +# 42773 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 42641 "parsing/parser.ml" +# 42778 "parsing/parser.ml" in -# 3276 "parsing/parser.mly" +# 3299 "parsing/parser.mly" ( _1 ) -# 42647 "parsing/parser.ml" +# 42784 "parsing/parser.ml" in let _1 = @@ -42651,20 +42788,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42657 "parsing/parser.ml" +# 42794 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3262 "parsing/parser.mly" +# 3285 "parsing/parser.mly" ( let info = symbol_info _endpos in let attrs = add_info_attrs info _5 in Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 ) -# 42668 "parsing/parser.ml" +# 42805 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42696,9 +42833,9 @@ module Tables = struct let _v : (Parsetree.row_field) = let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 42702 "parsing/parser.ml" +# 42839 "parsing/parser.ml" in let _endpos__2_ = _endpos__1_inlined1_ in @@ -42707,20 +42844,20 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42713 "parsing/parser.ml" +# 42850 "parsing/parser.ml" in let _endpos = _endpos__2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3266 "parsing/parser.mly" +# 3289 "parsing/parser.mly" ( let info = symbol_info _endpos in let attrs = add_info_attrs info _2 in Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] ) -# 42724 "parsing/parser.ml" +# 42861 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42752,7 +42889,7 @@ module Tables = struct let _v : (Parsetree.toplevel_phrase) = let arg = # 124 "menhir/standard.mly" ( None ) -# 42756 "parsing/parser.ml" +# 42893 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined1_ in let dir = @@ -42761,18 +42898,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42767 "parsing/parser.ml" +# 42904 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 42776 "parsing/parser.ml" +# 42913 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42803,9 +42940,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined2 : ( -# 658 "parsing/parser.mly" +# 680 "parsing/parser.mly" (string * string option) -# 42809 "parsing/parser.ml" +# 42946 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in @@ -42816,23 +42953,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3452 "parsing/parser.mly" +# 3479 "parsing/parser.mly" ( let (s, _) = _1 in Pdir_string s ) -# 42822 "parsing/parser.ml" +# 42959 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 42830 "parsing/parser.ml" +# 42967 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 42836 "parsing/parser.ml" +# 42973 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -42842,18 +42979,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42848 "parsing/parser.ml" +# 42985 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 42857 "parsing/parser.ml" +# 42994 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42884,9 +43021,9 @@ module Tables = struct }; } = _menhir_stack in let _1_inlined2 : ( -# 606 "parsing/parser.mly" +# 628 "parsing/parser.mly" (string * char option) -# 42890 "parsing/parser.ml" +# 43027 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in let _1 : unit = Obj.magic _1 in @@ -42897,23 +43034,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3453 "parsing/parser.mly" +# 3480 "parsing/parser.mly" ( let (n, m) = _1 in Pdir_int (n ,m) ) -# 42903 "parsing/parser.ml" +# 43040 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 42911 "parsing/parser.ml" +# 43048 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 42917 "parsing/parser.ml" +# 43054 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -42923,18 +43060,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 42929 "parsing/parser.ml" +# 43066 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 42938 "parsing/parser.ml" +# 43075 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -42974,23 +43111,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3454 "parsing/parser.mly" +# 3481 "parsing/parser.mly" ( Pdir_ident _1 ) -# 42980 "parsing/parser.ml" +# 43117 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 42988 "parsing/parser.ml" +# 43125 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 42994 "parsing/parser.ml" +# 43131 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43000,18 +43137,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43006 "parsing/parser.ml" +# 43143 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43015 "parsing/parser.ml" +# 43152 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43051,23 +43188,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3455 "parsing/parser.mly" +# 3482 "parsing/parser.mly" ( Pdir_ident _1 ) -# 43057 "parsing/parser.ml" +# 43194 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43065 "parsing/parser.ml" +# 43202 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 43071 "parsing/parser.ml" +# 43208 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43077,18 +43214,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43083 "parsing/parser.ml" +# 43220 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43092 "parsing/parser.ml" +# 43229 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43128,23 +43265,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3456 "parsing/parser.mly" +# 3483 "parsing/parser.mly" ( Pdir_bool false ) -# 43134 "parsing/parser.ml" +# 43271 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43142 "parsing/parser.ml" +# 43279 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 43148 "parsing/parser.ml" +# 43285 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43154,18 +43291,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43160 "parsing/parser.ml" +# 43297 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43169 "parsing/parser.ml" +# 43306 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43205,23 +43342,23 @@ module Tables = struct let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let x = let _1 = -# 3457 "parsing/parser.mly" +# 3484 "parsing/parser.mly" ( Pdir_bool true ) -# 43211 "parsing/parser.ml" +# 43348 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 831 "parsing/parser.mly" +# 853 "parsing/parser.mly" ( mk_directive_arg ~loc:_sloc _1 ) -# 43219 "parsing/parser.ml" +# 43356 "parsing/parser.ml" in # 126 "menhir/standard.mly" ( Some x ) -# 43225 "parsing/parser.ml" +# 43362 "parsing/parser.ml" in let _endpos_arg_ = _endpos__1_inlined2_ in @@ -43231,18 +43368,18 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 43237 "parsing/parser.ml" +# 43374 "parsing/parser.ml" in let _endpos = _endpos_arg_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3448 "parsing/parser.mly" +# 3475 "parsing/parser.mly" ( mk_directive ~loc:_sloc dir arg ) -# 43246 "parsing/parser.ml" +# 43383 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43279,44 +43416,44 @@ module Tables = struct let _startpos = _startpos_e_ in let _endpos = _endpos__2_ in let _v : ( -# 750 "parsing/parser.mly" +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 43285 "parsing/parser.ml" +# 43422 "parsing/parser.ml" ) = let _1 = let _1 = let _1 = let attrs = -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 43292 "parsing/parser.ml" +# 43429 "parsing/parser.ml" in -# 1232 "parsing/parser.mly" +# 1254 "parsing/parser.mly" ( mkstrexp e attrs ) -# 43297 "parsing/parser.ml" +# 43434 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 774 "parsing/parser.mly" +# 796 "parsing/parser.mly" ( text_str _startpos @ [_1] ) -# 43305 "parsing/parser.ml" +# 43442 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 762 "parsing/parser.mly" +# 784 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 43314 "parsing/parser.ml" +# 43451 "parsing/parser.ml" in -# 1039 "parsing/parser.mly" +# 1061 "parsing/parser.mly" ( Ptop_def _1 ) -# 43320 "parsing/parser.ml" +# 43457 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43346,28 +43483,28 @@ module Tables = struct let _startpos = _startpos_xss_ in let _endpos = _endpos__2_ in let _v : ( -# 750 "parsing/parser.mly" +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 43352 "parsing/parser.ml" +# 43489 "parsing/parser.ml" ) = let _1 = let _1 = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 43357 "parsing/parser.ml" +# 43494 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 762 "parsing/parser.mly" +# 784 "parsing/parser.mly" ( extra_str _startpos _endpos _1 ) -# 43365 "parsing/parser.ml" +# 43502 "parsing/parser.ml" in -# 1043 "parsing/parser.mly" +# 1065 "parsing/parser.mly" ( Ptop_def _1 ) -# 43371 "parsing/parser.ml" +# 43508 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43397,13 +43534,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : ( -# 750 "parsing/parser.mly" +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 43403 "parsing/parser.ml" +# 43540 "parsing/parser.ml" ) = -# 1047 "parsing/parser.mly" +# 1069 "parsing/parser.mly" ( _1 ) -# 43407 "parsing/parser.ml" +# 43544 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43426,13 +43563,13 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : ( -# 750 "parsing/parser.mly" +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 43432 "parsing/parser.ml" +# 43569 "parsing/parser.ml" ) = -# 1050 "parsing/parser.mly" +# 1072 "parsing/parser.mly" ( raise End_of_file ) -# 43436 "parsing/parser.ml" +# 43573 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43455,9 +43592,9 @@ module Tables = struct let _startpos = _startpos_ty_ in let _endpos = _endpos_ty_ in let _v : (Parsetree.core_type) = -# 3168 "parsing/parser.mly" +# 3191 "parsing/parser.mly" ( ty ) -# 43461 "parsing/parser.ml" +# 43598 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43485,18 +43622,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 43489 "parsing/parser.ml" +# 43626 "parsing/parser.ml" in -# 932 "parsing/parser.mly" +# 954 "parsing/parser.mly" ( xs ) -# 43494 "parsing/parser.ml" +# 43631 "parsing/parser.ml" in -# 3171 "parsing/parser.mly" +# 3194 "parsing/parser.mly" ( Ptyp_tuple tys ) -# 43500 "parsing/parser.ml" +# 43637 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in @@ -43504,15 +43641,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 43510 "parsing/parser.ml" +# 43647 "parsing/parser.ml" in -# 3173 "parsing/parser.mly" +# 3196 "parsing/parser.mly" ( _1 ) -# 43516 "parsing/parser.ml" +# 43653 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43542,9 +43679,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2516 "parsing/parser.mly" +# 2539 "parsing/parser.mly" ( (Some _2, None) ) -# 43548 "parsing/parser.ml" +# 43685 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43588,9 +43725,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__4_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2517 "parsing/parser.mly" +# 2540 "parsing/parser.mly" ( (Some _2, Some _4) ) -# 43594 "parsing/parser.ml" +# 43731 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43620,9 +43757,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2518 "parsing/parser.mly" +# 2541 "parsing/parser.mly" ( (None, Some _2) ) -# 43626 "parsing/parser.ml" +# 43763 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43652,9 +43789,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2519 "parsing/parser.mly" +# 2542 "parsing/parser.mly" ( syntax_error() ) -# 43658 "parsing/parser.ml" +# 43795 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43684,9 +43821,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type option * Parsetree.core_type option) = -# 2520 "parsing/parser.mly" +# 2543 "parsing/parser.mly" ( syntax_error() ) -# 43690 "parsing/parser.ml" +# 43827 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43702,9 +43839,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = -# 2843 "parsing/parser.mly" +# 2866 "parsing/parser.mly" ( (Ptype_abstract, Public, None) ) -# 43708 "parsing/parser.ml" +# 43845 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43734,9 +43871,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = -# 2845 "parsing/parser.mly" +# 2868 "parsing/parser.mly" ( _2 ) -# 43740 "parsing/parser.ml" +# 43877 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43755,17 +43892,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 43761 "parsing/parser.ml" +# 43898 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3415 "parsing/parser.mly" +# 3442 "parsing/parser.mly" ( Lident _1 ) -# 43769 "parsing/parser.ml" +# 43906 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43796,9 +43933,9 @@ module Tables = struct }; } = _menhir_stack in let _3 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 43802 "parsing/parser.ml" +# 43939 "parsing/parser.ml" ) = Obj.magic _3 in let _2 : unit = Obj.magic _2 in let _1 : (Longident.t) = Obj.magic _1 in @@ -43806,9 +43943,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3416 "parsing/parser.mly" +# 3443 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 43812 "parsing/parser.ml" +# 43949 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43838,9 +43975,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Parsetree.core_type * Asttypes.variance) = -# 2860 "parsing/parser.mly" +# 2883 "parsing/parser.mly" ( _2, _1 ) -# 43844 "parsing/parser.ml" +# 43981 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43856,9 +43993,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : ((Parsetree.core_type * Asttypes.variance) list) = -# 2853 "parsing/parser.mly" +# 2876 "parsing/parser.mly" ( [] ) -# 43862 "parsing/parser.ml" +# 43999 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43881,9 +44018,9 @@ module Tables = struct let _startpos = _startpos_p_ in let _endpos = _endpos_p_ in let _v : ((Parsetree.core_type * Asttypes.variance) list) = -# 2855 "parsing/parser.mly" +# 2878 "parsing/parser.mly" ( [p] ) -# 43887 "parsing/parser.ml" +# 44024 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43923,18 +44060,18 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 43927 "parsing/parser.ml" +# 44064 "parsing/parser.ml" in -# 904 "parsing/parser.mly" +# 926 "parsing/parser.mly" ( xs ) -# 43932 "parsing/parser.ml" +# 44069 "parsing/parser.ml" in -# 2857 "parsing/parser.mly" +# 2880 "parsing/parser.mly" ( ps ) -# 43938 "parsing/parser.ml" +# 44075 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -43965,24 +44102,24 @@ module Tables = struct let _endpos = _endpos_tyvar_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 2865 "parsing/parser.mly" +# 2888 "parsing/parser.mly" ( Ptyp_var tyvar ) -# 43971 "parsing/parser.ml" +# 44108 "parsing/parser.ml" in let _endpos__1_ = _endpos_tyvar_ in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 43980 "parsing/parser.ml" +# 44117 "parsing/parser.ml" in -# 2868 "parsing/parser.mly" +# 2891 "parsing/parser.mly" ( _1 ) -# 43986 "parsing/parser.ml" +# 44123 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44006,23 +44143,23 @@ module Tables = struct let _endpos = _endpos__1_ in let _v : (Parsetree.core_type) = let _1 = let _1 = -# 2867 "parsing/parser.mly" +# 2890 "parsing/parser.mly" ( Ptyp_any ) -# 44012 "parsing/parser.ml" +# 44149 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 807 "parsing/parser.mly" +# 829 "parsing/parser.mly" ( mktyp ~loc:_sloc _1 ) -# 44020 "parsing/parser.ml" +# 44157 "parsing/parser.ml" in -# 2868 "parsing/parser.mly" +# 2891 "parsing/parser.mly" ( _1 ) -# 44026 "parsing/parser.ml" +# 44163 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44038,9 +44175,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.variance) = -# 2872 "parsing/parser.mly" +# 2895 "parsing/parser.mly" ( Invariant ) -# 44044 "parsing/parser.ml" +# 44181 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44063,9 +44200,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.variance) = -# 2873 "parsing/parser.mly" +# 2896 "parsing/parser.mly" ( Covariant ) -# 44069 "parsing/parser.ml" +# 44206 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44088,9 +44225,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.variance) = -# 2874 "parsing/parser.mly" +# 2897 "parsing/parser.mly" ( Contravariant ) -# 44094 "parsing/parser.ml" +# 44231 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44120,47 +44257,47 @@ module Tables = struct let _startpos = _startpos_xss_ in let _endpos = _endpos__2_ in let _v : ( -# 752 "parsing/parser.mly" +# 774 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 44126 "parsing/parser.ml" +# 44263 "parsing/parser.ml" ) = let _1 = let _1 = let ys = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 44132 "parsing/parser.ml" +# 44269 "parsing/parser.ml" in let xs = let _1 = -# 840 "parsing/parser.mly" +# 862 "parsing/parser.mly" ( [] ) -# 44138 "parsing/parser.ml" +# 44275 "parsing/parser.ml" in -# 1070 "parsing/parser.mly" +# 1092 "parsing/parser.mly" ( _1 ) -# 44143 "parsing/parser.ml" +# 44280 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 44149 "parsing/parser.ml" +# 44286 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 766 "parsing/parser.mly" +# 788 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 44158 "parsing/parser.ml" +# 44295 "parsing/parser.ml" in -# 1063 "parsing/parser.mly" +# 1085 "parsing/parser.mly" ( _1 ) -# 44164 "parsing/parser.ml" +# 44301 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44204,15 +44341,15 @@ module Tables = struct let _startpos = _startpos_e_ in let _endpos = _endpos__2_ in let _v : ( -# 752 "parsing/parser.mly" +# 774 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 44210 "parsing/parser.ml" +# 44347 "parsing/parser.ml" ) = let _1 = let _1 = let ys = # 260 "menhir/standard.mly" ( List.flatten xss ) -# 44216 "parsing/parser.ml" +# 44353 "parsing/parser.ml" in let xs = let _1 = @@ -44220,61 +44357,61 @@ module Tables = struct let _1 = let _1 = let attrs = -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 44226 "parsing/parser.ml" +# 44363 "parsing/parser.ml" in -# 1232 "parsing/parser.mly" +# 1254 "parsing/parser.mly" ( mkstrexp e attrs ) -# 44231 "parsing/parser.ml" +# 44368 "parsing/parser.ml" in -# 784 "parsing/parser.mly" +# 806 "parsing/parser.mly" ( Ptop_def [_1] ) -# 44237 "parsing/parser.ml" +# 44374 "parsing/parser.ml" in let _startpos__1_ = _startpos_e_ in let _startpos = _startpos__1_ in -# 782 "parsing/parser.mly" +# 804 "parsing/parser.mly" ( text_def _startpos @ [_1] ) -# 44245 "parsing/parser.ml" +# 44382 "parsing/parser.ml" in -# 842 "parsing/parser.mly" +# 864 "parsing/parser.mly" ( x ) -# 44251 "parsing/parser.ml" +# 44388 "parsing/parser.ml" in -# 1070 "parsing/parser.mly" +# 1092 "parsing/parser.mly" ( _1 ) -# 44257 "parsing/parser.ml" +# 44394 "parsing/parser.ml" in # 267 "menhir/standard.mly" ( xs @ ys ) -# 44263 "parsing/parser.ml" +# 44400 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in let _endpos = _endpos__1_ in let _startpos = _startpos__1_ in -# 766 "parsing/parser.mly" +# 788 "parsing/parser.mly" ( extra_def _startpos _endpos _1 ) -# 44272 "parsing/parser.ml" +# 44409 "parsing/parser.ml" in -# 1063 "parsing/parser.mly" +# 1085 "parsing/parser.mly" ( _1 ) -# 44278 "parsing/parser.ml" +# 44415 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44293,17 +44430,17 @@ module Tables = struct MenhirLib.EngineTypes.next = _menhir_stack; } = _menhir_stack in let _1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44299 "parsing/parser.ml" +# 44436 "parsing/parser.ml" ) = Obj.magic _1 in let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (string) = -# 3346 "parsing/parser.mly" +# 3369 "parsing/parser.mly" ( _1 ) -# 44307 "parsing/parser.ml" +# 44444 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44340,9 +44477,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (string) = -# 3347 "parsing/parser.mly" +# 3370 "parsing/parser.mly" ( _2 ) -# 44346 "parsing/parser.ml" +# 44483 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44381,9 +44518,9 @@ module Tables = struct let _v : (string) = let _loc__3_ = (_startpos__3_, _endpos__3_) in let _loc__1_ = (_startpos__1_, _endpos__1_) in -# 3348 "parsing/parser.mly" +# 3371 "parsing/parser.mly" ( unclosed "(" _loc__1_ ")" _loc__3_ ) -# 44387 "parsing/parser.ml" +# 44524 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44414,9 +44551,9 @@ module Tables = struct let _endpos = _endpos__2_ in let _v : (string) = let _loc__2_ = (_startpos__2_, _endpos__2_) in -# 3349 "parsing/parser.mly" +# 3372 "parsing/parser.mly" ( expecting _loc__2_ "operator" ) -# 44420 "parsing/parser.ml" +# 44557 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44454,9 +44591,9 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (string) = let _loc__3_ = (_startpos__3_, _endpos__3_) in -# 3350 "parsing/parser.mly" +# 3373 "parsing/parser.mly" ( expecting _loc__3_ "module-expr" ) -# 44460 "parsing/parser.ml" +# 44597 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44479,9 +44616,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Longident.t) = -# 3398 "parsing/parser.mly" +# 3425 "parsing/parser.mly" ( Lident _1 ) -# 44485 "parsing/parser.ml" +# 44622 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44518,9 +44655,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__3_ in let _v : (Longident.t) = -# 3399 "parsing/parser.mly" +# 3426 "parsing/parser.mly" ( Ldot(_1, _3) ) -# 44524 "parsing/parser.ml" +# 44661 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44565,9 +44702,9 @@ module Tables = struct let ty : (Parsetree.core_type) = Obj.magic ty in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44571 "parsing/parser.ml" +# 44708 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -44579,33 +44716,33 @@ module Tables = struct Parsetree.attributes) = let label = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 44585 "parsing/parser.ml" +# 44722 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44593 "parsing/parser.ml" +# 44730 "parsing/parser.ml" in let attrs = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 44599 "parsing/parser.ml" +# 44736 "parsing/parser.ml" in let _1 = -# 3541 "parsing/parser.mly" +# 3568 "parsing/parser.mly" ( Fresh ) -# 44604 "parsing/parser.ml" +# 44741 "parsing/parser.ml" in -# 1785 "parsing/parser.mly" +# 1805 "parsing/parser.mly" ( (label, mutable_, Cfk_virtual ty), attrs ) -# 44609 "parsing/parser.ml" +# 44746 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44650,9 +44787,9 @@ module Tables = struct let _6 : (Parsetree.expression) = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44656 "parsing/parser.ml" +# 44793 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -44664,33 +44801,33 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 44670 "parsing/parser.ml" +# 44807 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44678 "parsing/parser.ml" +# 44815 "parsing/parser.ml" in let _2 = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 44684 "parsing/parser.ml" +# 44821 "parsing/parser.ml" in let _1 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 44689 "parsing/parser.ml" +# 44826 "parsing/parser.ml" in -# 1787 "parsing/parser.mly" +# 1807 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 44694 "parsing/parser.ml" +# 44831 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44741,9 +44878,9 @@ module Tables = struct let _6 : (Parsetree.expression) = Obj.magic _6 in let _5 : unit = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44747 "parsing/parser.ml" +# 44884 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -44756,36 +44893,36 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 44762 "parsing/parser.ml" +# 44899 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44770 "parsing/parser.ml" +# 44907 "parsing/parser.ml" in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 44778 "parsing/parser.ml" +# 44915 "parsing/parser.ml" in let _1 = -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 44784 "parsing/parser.ml" +# 44921 "parsing/parser.ml" in -# 1787 "parsing/parser.mly" +# 1807 "parsing/parser.mly" ( (_4, _3, Cfk_concrete (_1, _6)), _2 ) -# 44789 "parsing/parser.ml" +# 44926 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44837,9 +44974,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in let _1_inlined1 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44843 "parsing/parser.ml" +# 44980 "parsing/parser.ml" ) = Obj.magic _1_inlined1 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1 : (Parsetree.attributes) = Obj.magic _1 in @@ -44851,30 +44988,30 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 44857 "parsing/parser.ml" +# 44994 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44865 "parsing/parser.ml" +# 45002 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined1_ in let _2 = -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 44872 "parsing/parser.ml" +# 45009 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in let _1 = -# 3544 "parsing/parser.mly" +# 3571 "parsing/parser.mly" ( Fresh ) -# 44878 "parsing/parser.ml" +# 45015 "parsing/parser.ml" in let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in let _endpos = _endpos__7_ in @@ -44890,11 +45027,11 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1790 "parsing/parser.mly" +# 1810 "parsing/parser.mly" ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 44898 "parsing/parser.ml" +# 45035 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -44952,9 +45089,9 @@ module Tables = struct let _6 : unit = Obj.magic _6 in let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in let _1_inlined2 : ( -# 620 "parsing/parser.mly" +# 642 "parsing/parser.mly" (string) -# 44958 "parsing/parser.ml" +# 45095 "parsing/parser.ml" ) = Obj.magic _1_inlined2 in let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in @@ -44967,33 +45104,33 @@ module Tables = struct Parsetree.attributes) = let _4 = let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in let _1 = -# 3320 "parsing/parser.mly" +# 3343 "parsing/parser.mly" ( _1 ) -# 44973 "parsing/parser.ml" +# 45110 "parsing/parser.ml" in let _endpos = _endpos__1_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 44981 "parsing/parser.ml" +# 45118 "parsing/parser.ml" in let _startpos__4_ = _startpos__1_inlined2_ in let _2 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 44990 "parsing/parser.ml" +# 45127 "parsing/parser.ml" in let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in let _1 = -# 3545 "parsing/parser.mly" +# 3572 "parsing/parser.mly" ( Override ) -# 44997 "parsing/parser.ml" +# 45134 "parsing/parser.ml" in let _endpos = _endpos__7_ in let _symbolstartpos = if _startpos__1_ != _endpos__1_ then @@ -45008,11 +45145,11 @@ module Tables = struct _startpos__4_ in let _sloc = (_symbolstartpos, _endpos) in -# 1790 "parsing/parser.mly" +# 1810 "parsing/parser.mly" ( let e = mkexp_constraint ~loc:_sloc _7 _5 in (_4, _3, Cfk_concrete (_1, e)), _2 ) -# 45016 "parsing/parser.ml" +# 45153 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45079,9 +45216,9 @@ module Tables = struct let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 = let _1 = _1_inlined3 in -# 3638 "parsing/parser.mly" +# 3665 "parsing/parser.mly" ( _1 ) -# 45085 "parsing/parser.ml" +# 45222 "parsing/parser.ml" in let _endpos_attrs2_ = _endpos__1_inlined3_ in @@ -45091,30 +45228,30 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45097 "parsing/parser.ml" +# 45234 "parsing/parser.ml" in let attrs1 = let _1 = _1_inlined1 in -# 3642 "parsing/parser.mly" +# 3669 "parsing/parser.mly" ( _1 ) -# 45105 "parsing/parser.ml" +# 45242 "parsing/parser.ml" in let _endpos = _endpos_attrs2_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 2714 "parsing/parser.mly" +# 2737 "parsing/parser.mly" ( let attrs = attrs1 @ attrs2 in let loc = make_loc _sloc in let docs = symbol_docs _sloc in Val.mk id ty ~attrs ~loc ~docs, ext ) -# 45118 "parsing/parser.ml" +# 45255 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45130,9 +45267,9 @@ module Tables = struct let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in let _endpos = _startpos in let _v : (Asttypes.virtual_flag) = -# 3505 "parsing/parser.mly" +# 3532 "parsing/parser.mly" ( Concrete ) -# 45136 "parsing/parser.ml" +# 45273 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45155,9 +45292,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.virtual_flag) = -# 3506 "parsing/parser.mly" +# 3533 "parsing/parser.mly" ( Virtual ) -# 45161 "parsing/parser.ml" +# 45298 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45180,9 +45317,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.mutable_flag) = -# 3529 "parsing/parser.mly" +# 3556 "parsing/parser.mly" ( Immutable ) -# 45186 "parsing/parser.ml" +# 45323 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45212,9 +45349,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag) = -# 3530 "parsing/parser.mly" +# 3557 "parsing/parser.mly" ( Mutable ) -# 45218 "parsing/parser.ml" +# 45355 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45244,9 +45381,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.mutable_flag) = -# 3531 "parsing/parser.mly" +# 3558 "parsing/parser.mly" ( Mutable ) -# 45250 "parsing/parser.ml" +# 45387 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45269,9 +45406,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = -# 3536 "parsing/parser.mly" +# 3563 "parsing/parser.mly" ( Public ) -# 45275 "parsing/parser.ml" +# 45412 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45301,9 +45438,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3537 "parsing/parser.mly" +# 3564 "parsing/parser.mly" ( Private ) -# 45307 "parsing/parser.ml" +# 45444 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45333,9 +45470,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3538 "parsing/parser.mly" +# 3565 "parsing/parser.mly" ( Private ) -# 45339 "parsing/parser.ml" +# 45476 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45397,27 +45534,27 @@ module Tables = struct let xs = # 253 "menhir/standard.mly" ( List.rev xs ) -# 45401 "parsing/parser.ml" +# 45538 "parsing/parser.ml" in -# 854 "parsing/parser.mly" +# 876 "parsing/parser.mly" ( xs ) -# 45406 "parsing/parser.ml" +# 45543 "parsing/parser.ml" in -# 2814 "parsing/parser.mly" +# 2837 "parsing/parser.mly" ( _1 ) -# 45412 "parsing/parser.ml" +# 45549 "parsing/parser.ml" in let _endpos__6_ = _endpos_xs_ in let _5 = let _1 = _1_inlined2 in -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 45421 "parsing/parser.ml" +# 45558 "parsing/parser.ml" in let _3 = @@ -45426,16 +45563,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45432 "parsing/parser.ml" +# 45569 "parsing/parser.ml" in let _endpos = _endpos__6_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3039 "parsing/parser.mly" +# 3062 "parsing/parser.mly" ( let lident = loc_last _3 in Pwith_type (_3, @@ -45445,7 +45582,7 @@ module Tables = struct ~manifest:_5 ~priv:_4 ~loc:(make_loc _sloc))) ) -# 45449 "parsing/parser.ml" +# 45586 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45498,9 +45635,9 @@ module Tables = struct let _v : (Parsetree.with_constraint) = let _5 = let _1 = _1_inlined2 in -# 3116 "parsing/parser.mly" +# 3139 "parsing/parser.mly" ( _1 ) -# 45504 "parsing/parser.ml" +# 45641 "parsing/parser.ml" in let _endpos__5_ = _endpos__1_inlined2_ in @@ -45510,16 +45647,16 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45516 "parsing/parser.ml" +# 45653 "parsing/parser.ml" in let _endpos = _endpos__5_ in let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 3052 "parsing/parser.mly" +# 3075 "parsing/parser.mly" ( let lident = loc_last _3 in Pwith_typesubst (_3, @@ -45527,7 +45664,7 @@ module Tables = struct ~params:_2 ~manifest:_5 ~loc:(make_loc _sloc))) ) -# 45531 "parsing/parser.ml" +# 45668 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45576,9 +45713,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45582 "parsing/parser.ml" +# 45719 "parsing/parser.ml" in let _2 = @@ -45587,15 +45724,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45593 "parsing/parser.ml" +# 45730 "parsing/parser.ml" in -# 3060 "parsing/parser.mly" +# 3083 "parsing/parser.mly" ( Pwith_module (_2, _4) ) -# 45599 "parsing/parser.ml" +# 45736 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45644,9 +45781,9 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45650 "parsing/parser.ml" +# 45787 "parsing/parser.ml" in let _2 = @@ -45655,15 +45792,15 @@ module Tables = struct let _symbolstartpos = _startpos__1_ in let _sloc = (_symbolstartpos, _endpos) in -# 770 "parsing/parser.mly" +# 792 "parsing/parser.mly" ( mkrhs _1 _sloc ) -# 45661 "parsing/parser.ml" +# 45798 "parsing/parser.ml" in -# 3062 "parsing/parser.mly" +# 3085 "parsing/parser.mly" ( Pwith_modsubst (_2, _4) ) -# 45667 "parsing/parser.ml" +# 45804 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45686,9 +45823,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__1_ in let _v : (Asttypes.private_flag) = -# 3065 "parsing/parser.mly" +# 3088 "parsing/parser.mly" ( Public ) -# 45692 "parsing/parser.ml" +# 45829 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45718,9 +45855,9 @@ module Tables = struct let _startpos = _startpos__1_ in let _endpos = _endpos__2_ in let _v : (Asttypes.private_flag) = -# 3066 "parsing/parser.mly" +# 3089 "parsing/parser.mly" ( Private ) -# 45724 "parsing/parser.ml" +# 45861 "parsing/parser.ml" in { MenhirLib.EngineTypes.state = _menhir_s; @@ -45748,126 +45885,126 @@ end let use_file = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1758 lexer lexbuf) : ( -# 752 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1765 lexer lexbuf) : ( +# 774 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 45755 "parsing/parser.ml" +# 45892 "parsing/parser.ml" )) and toplevel_phrase = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1737 lexer lexbuf) : ( -# 750 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1744 lexer lexbuf) : ( +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 45763 "parsing/parser.ml" +# 45900 "parsing/parser.ml" )) and parse_pattern = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1733 lexer lexbuf) : ( -# 758 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1740 lexer lexbuf) : ( +# 780 "parsing/parser.mly" (Parsetree.pattern) -# 45771 "parsing/parser.ml" +# 45908 "parsing/parser.ml" )) and parse_expression = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1729 lexer lexbuf) : ( -# 756 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1736 lexer lexbuf) : ( +# 778 "parsing/parser.mly" (Parsetree.expression) -# 45779 "parsing/parser.ml" +# 45916 "parsing/parser.ml" )) and parse_core_type = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1725 lexer lexbuf) : ( -# 754 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1732 lexer lexbuf) : ( +# 776 "parsing/parser.mly" (Parsetree.core_type) -# 45787 "parsing/parser.ml" +# 45924 "parsing/parser.ml" )) and interface = fun lexer lexbuf -> - (Obj.magic (MenhirInterpreter.entry 1721 lexer lexbuf) : ( -# 748 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.entry 1728 lexer lexbuf) : ( +# 770 "parsing/parser.mly" (Parsetree.signature) -# 45795 "parsing/parser.ml" +# 45932 "parsing/parser.ml" )) and implementation = fun lexer lexbuf -> (Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : ( -# 746 "parsing/parser.mly" +# 768 "parsing/parser.mly" (Parsetree.structure) -# 45803 "parsing/parser.ml" +# 45940 "parsing/parser.ml" )) module Incremental = struct let use_file = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1758 initial_position) : ( -# 752 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1765 initial_position) : ( +# 774 "parsing/parser.mly" (Parsetree.toplevel_phrase list) -# 45813 "parsing/parser.ml" +# 45950 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and toplevel_phrase = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1737 initial_position) : ( -# 750 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1744 initial_position) : ( +# 772 "parsing/parser.mly" (Parsetree.toplevel_phrase) -# 45821 "parsing/parser.ml" +# 45958 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_pattern = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1733 initial_position) : ( -# 758 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1740 initial_position) : ( +# 780 "parsing/parser.mly" (Parsetree.pattern) -# 45829 "parsing/parser.ml" +# 45966 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_expression = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1729 initial_position) : ( -# 756 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1736 initial_position) : ( +# 778 "parsing/parser.mly" (Parsetree.expression) -# 45837 "parsing/parser.ml" +# 45974 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and parse_core_type = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1725 initial_position) : ( -# 754 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1732 initial_position) : ( +# 776 "parsing/parser.mly" (Parsetree.core_type) -# 45845 "parsing/parser.ml" +# 45982 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and interface = fun initial_position -> - (Obj.magic (MenhirInterpreter.start 1721 initial_position) : ( -# 748 "parsing/parser.mly" + (Obj.magic (MenhirInterpreter.start 1728 initial_position) : ( +# 770 "parsing/parser.mly" (Parsetree.signature) -# 45853 "parsing/parser.ml" +# 45990 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) and implementation = fun initial_position -> (Obj.magic (MenhirInterpreter.start 0 initial_position) : ( -# 746 "parsing/parser.mly" +# 768 "parsing/parser.mly" (Parsetree.structure) -# 45861 "parsing/parser.ml" +# 45998 "parsing/parser.ml" ) MenhirInterpreter.checkpoint) end -# 3668 "parsing/parser.mly" +# 3695 "parsing/parser.mly" -# 45869 "parsing/parser.ml" +# 46006 "parsing/parser.ml" # 269 "menhir/standard.mly" -# 45874 "parsing/parser.ml" +# 46011 "parsing/parser.ml" diff --git a/boot/ocamlc b/boot/ocamlc index 0b856190..71fcc11f 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamllex b/boot/ocamllex index 4fc970db..fb586c1f 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 3f50520c..0065ebd3 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -330,7 +330,16 @@ let link_bytecode ?final_name tolink exec_name standalone = (* The path to the bytecode interpreter (in use_runtime mode) *) if String.length !Clflags.use_runtime > 0 && !Clflags.with_runtime then begin - output_string outchan (make_absolute !Clflags.use_runtime); + let runtime = make_absolute !Clflags.use_runtime in + let runtime = + (* shebang mustn't exceed 128 including the #! and \0 *) + if String.length runtime > 125 then + "/bin/sh\n\ + exec \"" ^ runtime ^ "\" \"$0\" \"$@\"" + else + runtime + in + output_string outchan runtime; output_char outchan '\n'; Bytesections.record outchan "RNTM" end; @@ -445,7 +454,7 @@ let output_cds_file outfile = (* Output a bytecode executable as a C file *) -let link_bytecode_as_c tolink outfile = +let link_bytecode_as_c tolink outfile with_main = let outchan = open_out outfile in Misc.try_finally ~always:(fun () -> close_out outchan) @@ -488,7 +497,23 @@ let link_bytecode_as_c tolink outfile = (* The table of primitives *) Symtable.output_primitive_table outchan; (* The entry point *) - output_string outchan "\ + if with_main then begin + output_string outchan "\ +\n#ifdef _WIN32\ +\nint wmain(int argc, wchar_t **argv)\ +\n#else\ +\nint main(int argc, char **argv)\ +\n#endif\ +\n{\ +\n caml_startup_code(caml_code, sizeof(caml_code),\ +\n caml_data, sizeof(caml_data),\ +\n caml_sections, sizeof(caml_sections),\ +\n /* pooling */ 0,\ +\n argv);\ +\n return 0; /* not reached */\ +\n}\n" + end else begin + output_string outchan "\ \nvoid caml_startup(char_os ** argv)\ \n{\ \n caml_startup_code(caml_code, sizeof(caml_code),\ @@ -523,7 +548,9 @@ let link_bytecode_as_c tolink outfile = \n caml_sections, sizeof(caml_sections),\ \n /* pooling */ 1,\ \n argv);\ -\n}\ +\n}\n" + end; + output_string outchan "\ \n#ifdef __cplusplus\ \n}\ \n#endif\n"; @@ -627,7 +654,7 @@ let link objfiles output_name = append_bytecode bytecode_name exec_name ) end else begin - let basename = Filename.chop_extension output_name in + let basename = Filename.remove_extension output_name in let c_file, stable_name = if !Clflags.output_complete_object && not (Filename.check_suffix output_name ".c") @@ -647,8 +674,12 @@ let link objfiles output_name = Misc.try_finally ~always:(fun () -> List.iter remove_file !temps) (fun () -> - link_bytecode_as_c tolink c_file; - if not (Filename.check_suffix output_name ".c") then begin + link_bytecode_as_c tolink c_file !Clflags.output_complete_executable; + if !Clflags.output_complete_executable then begin + temps := c_file :: !temps; + if not (build_custom_runtime c_file output_name) then + raise(Error Custom_runtime) + end else if not (Filename.check_suffix output_name ".c") then begin temps := c_file :: !temps; if Ccomp.compile_file ~output:obj_file ?stable_name c_file <> 0 then raise(Error Custom_runtime); diff --git a/configure b/configure index d9cc166e..b8f74728 100755 --- a/configure +++ b/configure @@ -1,6 +1,62 @@ #! /bin/sh + +if test -e '.git' ; then : + if test -z "$ac_read_git_config" ; then : + extra_args=$(git config ocaml.configure 2>/dev/null) + extended_cache=$(git config ocaml.configure-cache 2>/dev/null) + cache_file= + + # If ocaml.configure-cache is set, parse the command-line for the --host + # option, in order to determine the name of the cache file. + if test -n "$extended_cache" ; then : + echo "Detected Git configuration option ocaml.configure-cache set to \ +\"$extended_cache\"" + dashdash= + prev= + host=default + # The logic here is pretty borrowed from autoconf's + for option in $extra_args "$@" + do + if test -n "$prev" ; then : + host=$option + continue + fi + + case $dashdash$option in + --) + dashdash=yes ;; + -host | --host | --hos | --ho) + prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + case $option in + *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;; + *=) host= ;; + esac ;; + esac + done + cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache" + fi + + # If either option has a value, re-invoke configure + if test -n "$extra_args$cache_file" ; then : + echo "Detected Git configuration option ocaml.configure set to \ +\"$extra_args\"" + # Too much effort to get the echo to show appropriate quoting - the + # invocation itself intentionally quotes $0 and passes $@ exactly as given + # but allows a single expansion of ocaml.configure + if test -n "$cache_file" ; then : + echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@" + ac_read_git_config=true exec "$0" $extra_args \ + --cache-file "$cache_file" "$@" + else + echo "Re-running $0 $extra_args $@" + ac_read_git_config=true exec "$0" $extra_args "$@" + fi + fi + fi +fi # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for OCaml 4.09.1+dev1-2020-03-13. +# Generated by GNU Autoconf 2.69 for OCaml 4.10.0. # # Report bugs to . # @@ -590,8 +646,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='OCaml' PACKAGE_TARNAME='ocaml' -PACKAGE_VERSION='4.09.1+dev1-2020-03-13' -PACKAGE_STRING='OCaml 4.09.1+dev1-2020-03-13' +PACKAGE_VERSION='4.10.0' +PACKAGE_STRING='OCaml 4.10.0' PACKAGE_BUGREPORT='caml-list@inria.fr' PACKAGE_URL='http://www.ocaml.org' @@ -691,12 +747,14 @@ build_os build_vendor build_cpu build +stdlib_manpages PACKLD flexlink_flags flexdll_chain default_safe_string force_safe_string afl +function_sections flat_float_array windows_unicode max_testsuite_dir_retries @@ -742,7 +800,8 @@ mklib RANLIBCMD RANLIB AR -hashbangscripts +shebangscripts +long_shebang iflexdir ocamlopt_cppflags ocamlopt_cflags @@ -780,6 +839,7 @@ ac_tool_prefix DIRECT_CPP CC VERSION +native_compiler CONFIGURE_ARGS target_alias host_alias @@ -846,8 +906,10 @@ enable_flambda enable_flambda_invariants with_target_bindir enable_reserved_header_bits +enable_stdlib_manpages enable_force_safe_string enable_flat_float_array +enable_function_sections with_afl enable_shared enable_static @@ -1418,7 +1480,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OCaml 4.09.1+dev1-2020-03-13 to adapt to many kinds of systems. +\`configure' configures OCaml 4.10.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1484,7 +1546,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OCaml 4.09.1+dev1-2020-03-13:";; + short | recursive ) echo "Configuration of OCaml 4.10.0:";; esac cat <<\_ACEOF @@ -1520,10 +1582,14 @@ Optional Features: --enable-reserved-header-bits=BITS reserve BITS (between 0 and 31) bits in block headers for profiling info - --enable-force-safe-string - force strings to be safe + --disable-stdlib-manpages + do not build or install the library man pages + --disable-force-safe-string + do not force strings to be safe --disable-flat-float-array do not use flat float arrays + --disable-function-sections + do not emit each function in a separate section --enable-shared[=PKGS] build shared libraries [default=yes] --enable-static[=PKGS] build static libraries [default=yes] --enable-fast-install[=PKGS] @@ -1642,7 +1708,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OCaml configure 4.09.1+dev1-2020-03-13 +OCaml configure 4.10.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -2305,7 +2371,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OCaml $as_me 4.09.1+dev1-2020-03-13, which was +It was created by OCaml $as_me 4.10.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -2654,8 +2720,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.09.1+dev1-2020-03-13" >&5 -$as_echo "$as_me: Configuring OCaml version 4.09.1+dev1-2020-03-13" >&6;} +{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.10.0" >&5 +$as_echo "$as_me: Configuring OCaml version 4.10.0" >&6;} # Configuration variables @@ -2730,7 +2796,8 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. ## Output variables -VERSION=4.09.1+dev1-2020-03-13 + +VERSION=4.10.0 # Note: This is present for the flexdll bootstrap where it exposed as the old @@ -2783,6 +2850,7 @@ VERSION=4.09.1+dev1-2020-03-13 + # TODO: rename this variable @@ -2821,6 +2889,8 @@ VERSION=4.09.1+dev1-2020-03-13 + + @@ -2955,7 +3025,6 @@ case $host in #( S=asm SO=dll outputexe=-Fe - mkexedebugflag='' syslib='$(1).lib' ;; #( *) : ccomptype=cc @@ -3149,6 +3218,12 @@ esac fi +# Check whether --enable-stdlib-manpages was given. +if test "${enable_stdlib_manpages+set}" = set; then : + enableval=$enable_stdlib_manpages; +fi + + # There are two configure-time string safety options, @@ -3170,9 +3245,11 @@ fi # explicitly passed. # # The configure-time behavior of OCaml 4.05 and older was equivalent -# to --disable-force-safe-string DEFAULT_STRING=unsafe. OCaml 4.06 -# and later use --disable-force-safe-string DEFAULT_STRING=safe. We -# expect --enable-force-safe-string to become the default in the future. +# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06 +# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe. +# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe. +# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options +# to be removed in the future. # Check whether --enable-force-safe-string was given. if test "${enable_force_safe_string+set}" = set; then : @@ -3188,6 +3265,14 @@ if test "${enable_flat_float_array+set}" = set; then : fi +# Check whether --enable-function-sections was given. +if test "${enable_function_sections+set}" = set; then : + enableval=$enable_function_sections; +else + enable_function_sections=auto +fi + + # Check whether --with-afl was given. if test "${with_afl+set}" = set; then : @@ -12206,6 +12291,48 @@ fi ;; esac +## Find vendor of the C compiler + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking C compiler vendor" >&5 +$as_echo_n "checking C compiler vendor... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if defined(_MSC_VER) +msvc _MSC_VER +#elif defined(__INTEL_COMPILER) +icc __INTEL_COMPILER +#elif defined(__clang_major__) && defined(__clang_minor__) +clang __clang_major__ __clang_minor__ +#elif defined(__GNUC__) && defined(__GNUC_MINOR__) +gcc __GNUC__ __GNUC_MINOR__ +#elif defined(__xlc__) && defined(__xlC__) +xlc __xlC__ __xlC_ver__ +#else +unknown +#endif + +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + if ${ocaml_cv_cc_vendor+:} false; then : + $as_echo_n "(cached) " >&6 +else + ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'` +fi + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "unexpected preprocessor failure +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.err conftest.i conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_cc_vendor" >&5 +$as_echo "$ocaml_cv_cc_vendor" >&6; } + + # Determine how to call the C preprocessor directly. # Most of the time, calling the C preprocessor through the C compiler is # desirable and even important. @@ -12217,8 +12344,11 @@ esac # We thus figure out how to invoke the C preprocessor directly but # let the CPP variable untouched, except for the MSVC port where we set it # manually to make sure the backward compatibility is preserved -case $host in #( - *-pc-windows) : +case $ocaml_cv_cc_vendor in #( + xlc-*) : + CPP="$CC -E -qnoppline" ;; #( + # suppress incompatible XLC line directives + msvc-*) : CPP="$CC -nologo -EP" ;; #( *) : ;; @@ -12280,16 +12410,29 @@ $as_echo "$ac_cv_sys_interpreter" >&6; } interpval=$ac_cv_sys_interpreter +long_shebang=false if test "x$interpval" = "xyes"; then : case $host in #( *-cygwin|*-*-mingw32|*-pc-windows) : - hashbangscripts=false ;; #( + shebangscripts=false ;; #( *) : - hashbangscripts=true + shebangscripts=true + prev_exec_prefix="$exec_prefix" + if test "x$exec_prefix" = "xNONE"; then : + exec_prefix="$prefix" +fi + eval "expanded_bindir=\"$bindir\"" + exec_prefix="$prev_exec_prefix" + # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional + # 1 char suffix and the \0 leaving 115 characters + if test "${#expanded_bindir}" -gt 115; then : + long_shebang=true +fi + ;; esac else - hashbangscripts=false + shebangscripts=false fi @@ -12309,48 +12452,6 @@ fi ## Check for C99 support: done by libtool ## AC_PROG_CC_C99 -## Find vendor of the C compiler - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking C compiler vendor" >&5 -$as_echo_n "checking C compiler vendor... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#if defined(_MSC_VER) -msvc _MSC_VER -#elif defined(__INTEL_COMPILER) -icc __INTEL_COMPILER -#elif defined(__clang_major__) && defined(__clang_minor__) -clang __clang_major__ __clang_minor__ -#elif defined(__GNUC__) && defined(__GNUC_MINOR__) -gcc __GNUC__ __GNUC_MINOR__ -#elif defined(__xlc__) && defined(__xlC__) -xlc __xlC__ __xlC_ver__ -#else -unknown -#endif - -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - if ${ocaml_cv_cc_vendor+:} false; then : - $as_echo_n "(cached) " >&6 -else - ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'` -fi - -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "unexpected preprocessor failure -See \`config.log' for more details" "$LINENO" 5; } -fi -rm -f conftest.err conftest.i conftest.$ac_ext - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_cc_vendor" >&5 -$as_echo "$ocaml_cv_cc_vendor" >&6; } - - ## Determine which flags to use for the C compiler case $ocaml_cv_cc_vendor in #( @@ -12358,9 +12459,9 @@ case $ocaml_cv_cc_vendor in #( outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i" ;; #( # all warnings enabled msvc-*) : - outputobj=-Fo; CPP="cl -nologo -EP"; gcc_warnings="" ;; #( + outputobj=-Fo; gcc_warnings="" ;; #( *) : - outputobj='-o $(EMPTY)'; case 4.09.1+dev1-2020-03-13 in #( + outputobj='-o $(EMPTY)'; case 4.10.0 in #( *+dev*) : gcc_warnings="-Wall -Werror" ;; #( *) : @@ -12550,7 +12651,7 @@ esac flexdir='$(ROOTDIR)/flexdll' fi iflexdir="-I\"$flexdir\"" - mkexedebugflag="-link -g" + mkexedebugflag='' fi ;; #( *,x86_64-*-linux*) : $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h @@ -13444,6 +13545,24 @@ fi ;; #( ;; esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((aligned(n)))" >&5 +$as_echo_n "checking whether the C compiler supports __attribute__((aligned(n)))... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +typedef struct {__attribute__((aligned(8))) int t;} t; +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define SUPPORTS_ALIGNED_ATTRIBUTE 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + # Configure the native-code compiler arch=none @@ -13903,7 +14022,7 @@ fi fi -CPP_FLAGS="$saved_CPPFLAGS" +CPPFLAGS="$saved_CPPFLAGS" ## issetugid @@ -15130,6 +15249,21 @@ if test "x$ac_cv_func_execvpe" = xyes; then : fi +## ffs or _BitScanForward + +ac_fn_c_check_func "$LINENO" "ffs" "ac_cv_func_ffs" +if test "x$ac_cv_func_ffs" = xyes; then : + $as_echo "#define HAS_FFS 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "_BitScanForward" "ac_cv_func__BitScanForward" +if test "x$ac_cv_func__BitScanForward" = xyes; then : + $as_echo "#define HAS_BITSCANFORWARD 1" >>confdefs.h + +fi + + ## Determine whether the debugger should/can be built case $enable_debugger in #( @@ -15948,7 +16082,7 @@ if ${ac_cv_lib_bfd_bfd_openr+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lbfd -ldl $LIBS" +LIBS="-lbfd $DLLIBS $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -15979,7 +16113,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : - bfd_ldlibs="-lbfd -ldl" + bfd_ldlibs="-lbfd $DLLIBS" fi fi @@ -15991,7 +16125,7 @@ if ${ac_cv_lib_bfd_bfd_openr+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lbfd -ldl -liberty $LIBS" +LIBS="-lbfd $DLLIBS -liberty $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -16022,7 +16156,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : - bfd_ldlibs="-lbfd -ldl -liberty" + bfd_ldlibs="-lbfd $DLLIBS -liberty" fi fi @@ -16034,7 +16168,7 @@ if ${ac_cv_lib_bfd_bfd_openr+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lbfd -ldl -liberty -lz $LIBS" +LIBS="-lbfd $DLLIBS -liberty -lz $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -16065,7 +16199,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : - bfd_ldlibs="-lbfd -ldl -liberty -lz" + bfd_ldlibs="-lbfd $DLLIBS -liberty -lz" fi fi @@ -16077,7 +16211,7 @@ if ${ac_cv_lib_bfd_bfd_openr+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lbfd -ldl -liberty -lz -lintl $LIBS" +LIBS="-lbfd $DLLIBS -liberty -lz -lintl $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -16108,7 +16242,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bfd_bfd_openr" >&5 $as_echo "$ac_cv_lib_bfd_bfd_openr" >&6; } if test "x$ac_cv_lib_bfd_bfd_openr" = xyes; then : - bfd_ldlibs="-lbfd -ldl -liberty -lz -lintl" + bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl" fi fi @@ -16579,18 +16713,73 @@ else flat_float_array=true fi +if test x"$enable_function_sections" = "xno"; then : + function_sections=false +else + case $arch in #( + amd64|i386|arm64) : + # not supported on arm32, see issue #9124. + case $target in #( + *-cygwin*|*-mingw*|*-windows|*-apple-darwin*) : + function_sections=false; + { $as_echo "$as_me:${as_lineno-$LINENO}: No support for function sections on $target." >&5 +$as_echo "$as_me: No support for function sections on $target." >&6;} ;; #( + *) : + case $ocaml_cv_cc_vendor in #( + gcc-0123-*|gcc-4-01234567) : + function_sections=false; + { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not + supported in GCC prior to version 4.8." >&5 +$as_echo "$as_me: Function sections are not + supported in GCC prior to version 4.8." >&6;} ;; #( + clang-012-*|clang-3-01234) : + function_sections=false; + { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported + in Clang prior to version 3.5." >&5 +$as_echo "$as_me: Function sections are not supported + in Clang prior to version 3.5." >&6;} ;; #( + gcc-*|clang-*) : + function_sections=true; + internal_cflags="$internal_cflags -ffunction-sections"; + $as_echo "#define FUNCTION_SECTIONS 1" >>confdefs.h + ;; #( + *) : + function_sections=false; + { $as_echo "$as_me:${as_lineno-$LINENO}: Function sections are not supported by + $ocaml_cv_cc_vendor." >&5 +$as_echo "$as_me: Function sections are not supported by + $ocaml_cv_cc_vendor." >&6;} ;; #( + *) : + ;; +esac ;; #( + *) : + ;; +esac ;; #( + *) : + function_sections=false ;; +esac; + if test x"$function_sections" = "xfalse"; then : + if test x"$enable_function_sections" = "xyes"; then : + as_fn_error $? "Function sections are not supported." "$LINENO" 5 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: Disabling function sections." >&5 +$as_echo "$as_me: Disabling function sections." >&6;} +fi +fi +fi + if test x"$with_afl" = "xyes"; then : afl=true else afl=false fi -if test x"$enable_force_safe_string" = "xyes"; then : +if test x"$enable_force_safe_string" = "xno"; then : + force_safe_string=false +else $as_echo "#define CAML_SAFE_STRING 1" >>confdefs.h - force_safe_string=true -else - force_safe_string=false + force_safe_string=true fi if test x"$DEFAULT_STRING" = "xunsafe"; then : @@ -16675,6 +16864,16 @@ if test x"$prefix" = "xNONE"; then : *) : ;; esac +else + if test x"$unix_or_win32" = "xwin32" \ + && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ; then : + case $build in #( + *-pc-cygwin) : + prefix=`cygpath -m "$prefix"` ;; #( + *) : + ;; +esac +fi fi # Define a few macros that were defined in config/m-nt.h @@ -16694,6 +16893,12 @@ case $host in #( ;; esac +if test x"$enable_stdlib_manpages" != "xno"; then : + stdlib_manpages=true +else + stdlib_manpages=false +fi + cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -17200,7 +17405,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OCaml $as_me 4.09.1+dev1-2020-03-13, which was +This file was extended by OCaml $as_me 4.10.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -17267,7 +17472,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -OCaml config.status 4.09.1+dev1-2020-03-13 +OCaml config.status 4.10.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index 866b59a3..e3e28fb6 100644 --- a/configure.ac +++ b/configure.ac @@ -15,6 +15,8 @@ # Process this file with autoconf to produce a configure script. +# Require Autoconf 2.69 for repeatability in CI +AC_PREREQ([2.69]) AC_INIT([OCaml], m4_esyscmd([head -n1 VERSION | tr -d '\r\n']), [caml-list@inria.fr], @@ -68,6 +70,7 @@ AC_CONFIG_AUX_DIR([build-aux]) ## Output variables AC_SUBST([CONFIGURE_ARGS]) +AC_SUBST([native_compiler]) AC_SUBST([VERSION], [AC_PACKAGE_VERSION]) AC_SUBST([CC]) # Note: This is present for the flexdll bootstrap where it exposed as the old @@ -108,7 +111,8 @@ AC_SUBST([ocamlc_cppflags]) AC_SUBST([ocamlopt_cflags]) AC_SUBST([ocamlopt_cppflags]) AC_SUBST([iflexdir]) -AC_SUBST([hashbangscripts]) +AC_SUBST([long_shebang]) +AC_SUBST([shebangscripts]) AC_SUBST([AR]) AC_SUBST([RANLIB]) AC_SUBST([RANLIBCMD]) @@ -154,12 +158,14 @@ AC_SUBST([flambda_invariants]) AC_SUBST([max_testsuite_dir_retries]) AC_SUBST([windows_unicode]) AC_SUBST([flat_float_array]) +AC_SUBST([function_sections]) AC_SUBST([afl]) AC_SUBST([force_safe_string]) AC_SUBST([default_safe_string]) AC_SUBST([flexdll_chain]) AC_SUBST([flexlink_flags]) AC_SUBST([PACKLD]) +AC_SUBST([stdlib_manpages]) ## Generated files @@ -181,7 +187,6 @@ AS_CASE([$host], S=asm SO=dll outputexe=-Fe - mkexedebugflag='' syslib='$(1).lib'], [ccomptype=cc S=s @@ -326,6 +331,10 @@ AC_ARG_ENABLE([reserved-header-bits], profinfo_width="$enable_reserved_header_bits"], [AC_MSG_ERROR([invalid argument to --enable-reserved-header-bits])])]) +AC_ARG_ENABLE([stdlib-manpages], + [AS_HELP_STRING([--disable-stdlib-manpages], + [do not build or install the library man pages])]) + AC_ARG_VAR([WINDOWS_UNICODE_MODE], [how to handle Unicode under Windows: ansi, compatible]) @@ -348,13 +357,15 @@ AC_ARG_VAR([WINDOWS_UNICODE_MODE], # explicitly passed. # # The configure-time behavior of OCaml 4.05 and older was equivalent -# to --disable-force-safe-string DEFAULT_STRING=unsafe. OCaml 4.06 -# and later use --disable-force-safe-string DEFAULT_STRING=safe. We -# expect --enable-force-safe-string to become the default in the future. +# to --disable-force-safe-string DEFAULT_STRING=unsafe. With OCaml 4.06 +# and older was equivalent to --disable-force-safe-string DEFAULT_STRING=safe. +# With OCaml 4.10 and later use --enable-force-safe-string DEFAULT_STRING=safe. +# We expect the --disable-force-safe-string and DEFAULT_STRING=unsafe options +# to be removed in the future. AC_ARG_ENABLE([force-safe-string], - [AS_HELP_STRING([--enable-force-safe-string], - [force strings to be safe])]) + [AS_HELP_STRING([--disable-force-safe-string], + [do not force strings to be safe])]) AC_ARG_VAR([DEFAULT_STRING], [whether strings should be safe (default) or unsafe]) @@ -363,6 +374,12 @@ AC_ARG_ENABLE([flat-float-array], [AS_HELP_STRING([--disable-flat-float-array], [do not use flat float arrays])]) +AC_ARG_ENABLE([function-sections], + [AS_HELP_STRING([--disable-function-sections], + [do not emit each function in a separate section])], + [], + [enable_function_sections=auto]) + AC_ARG_WITH([afl], [AS_HELP_STRING([--with-afl], [use the AFL fuzzer])]) @@ -419,6 +436,9 @@ AS_CASE([$host], mklib="rm -f \$(1) && ${AR} rc \$(1) \$(2) && ${RANLIB} \$(1)" ]) +## Find vendor of the C compiler +OCAML_CC_VENDOR + # Determine how to call the C preprocessor directly. # Most of the time, calling the C preprocessor through the C compiler is # desirable and even important. @@ -430,8 +450,10 @@ AS_CASE([$host], # We thus figure out how to invoke the C preprocessor directly but # let the CPP variable untouched, except for the MSVC port where we set it # manually to make sure the backward compatibility is preserved -AS_CASE([$host], - [*-pc-windows], +AS_CASE([$ocaml_cv_cc_vendor], + [xlc-*], + [CPP="$CC -E -qnoppline"], # suppress incompatible XLC line directives + [msvc-*], [CPP="$CC -nologo -EP"]) # Libraries to build depending on the host @@ -462,14 +484,23 @@ AS_IF([test x"$enable_str_lib" != "xno"], ## TODO: have two values, one for host and one for target AC_SYS_INTERPRETER +long_shebang=false AS_IF( [test "x$interpval" = "xyes"], [AS_CASE([$host], [*-cygwin|*-*-mingw32|*-pc-windows], - [hashbangscripts=false], - [hashbangscripts=true] + [shebangscripts=false], + [shebangscripts=true + prev_exec_prefix="$exec_prefix" + AS_IF([test "x$exec_prefix" = "xNONE"],[exec_prefix="$prefix"]) + eval "expanded_bindir=\"$bindir\"" + exec_prefix="$prev_exec_prefix" + # Assume maximum shebang is 128 chars; less #!, /ocamlrun, an optional + # 1 char suffix and the \0 leaving 115 characters + AS_IF([test "${#expanded_bindir}" -gt 115],[long_shebang=true]) + ] )], - [hashbangscripts=false] + [shebangscripts=false] ) # Are we building a cross-compiler @@ -487,16 +518,13 @@ AS_IF( ## Check for C99 support: done by libtool ## AC_PROG_CC_C99 -## Find vendor of the C compiler -OCAML_CC_VENDOR - ## Determine which flags to use for the C compiler AS_CASE([$ocaml_cv_cc_vendor], [xlc-*], [outputobj='-o $(EMPTY)'; gcc_warnings="-qflag=i:i"], # all warnings enabled [msvc-*], - [outputobj=-Fo; CPP="cl -nologo -EP"; gcc_warnings=""], + [outputobj=-Fo; gcc_warnings=""], [outputobj='-o $(EMPTY)'; AS_CASE([AC_PACKAGE_VERSION], [*+dev*], [gcc_warnings="-Wall -Werror"], @@ -643,7 +671,7 @@ AS_CASE([$CC,$host], flexdir=`$flexlink -where | tr -d '\015'` AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll']) iflexdir="-I\"$flexdir\"" - mkexedebugflag="-link -g"])], + mkexedebugflag=''])], [*,x86_64-*-linux*], AC_DEFINE([HAS_ARCH_CODE32], [1]), [xlc*,powerpc-ibm-aix*], @@ -817,6 +845,8 @@ AS_CASE(["$CC,$host"], AS_IF([$cc_has_fno_tree_vrp], [internal_cflags="$internal_cflags -fno-tree-vrp"])]) +OCAML_CC_SUPPORTS_ALIGNED + # Configure the native-code compiler arch=none @@ -1044,7 +1074,7 @@ AC_CHECK_FUNC([secure_getenv], [AC_DEFINE([HAS_SECURE_GETENV])], [AC_CHECK_FUNC([__secure_getenv], [AC_DEFINE([HAS___SECURE_GETENV])])]) -CPP_FLAGS="$saved_CPPFLAGS" +CPPFLAGS="$saved_CPPFLAGS" ## issetugid @@ -1388,6 +1418,11 @@ AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL])]) AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])]) +## ffs or _BitScanForward + +AC_CHECK_FUNC([ffs], [AC_DEFINE([HAS_FFS])]) +AC_CHECK_FUNC([_BitScanForward], [AC_DEFINE([HAS_BITSCANFORWARD])]) + ## Determine whether the debugger should/can be built AS_CASE([$enable_debugger], @@ -1481,20 +1516,20 @@ AS_IF([test x"$with_bfd" != "xno"], AS_IF([test -z "$bfd_ldlibs"], [unset ac_cv_lib_bfd_bfd_openr AC_CHECK_LIB([bfd], [bfd_openr], - [bfd_ldlibs="-lbfd -ldl"], [], [-ldl])]) + [bfd_ldlibs="-lbfd $DLLIBS"], [], [$DLLIBS])]) AS_IF([test -z "$bfd_ldlibs"], [unset ac_cv_lib_bfd_bfd_openr AC_CHECK_LIB([bfd], [bfd_openr], - [bfd_ldlibs="-lbfd -ldl -liberty"], [], [-ldl -liberty])]) + [bfd_ldlibs="-lbfd $DLLIBS -liberty"], [], [$DLLIBS -liberty])]) AS_IF([test -z "$bfd_ldlibs"], [unset ac_cv_lib_bfd_bfd_openr AC_CHECK_LIB([bfd], [bfd_openr], - [bfd_ldlibs="-lbfd -ldl -liberty -lz"], [], [-ldl -liberty -lz])]) + [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz"], [], [$DLLIBS -liberty -lz])]) AS_IF([test -z "$bfd_ldlibs"], [unset ac_cv_lib_bfd_bfd_openr AC_CHECK_LIB([bfd], [bfd_openr], - [bfd_ldlibs="-lbfd -ldl -liberty -lz -lintl"], [], - [-ldl -liberty -lz -lintl])]) + [bfd_ldlibs="-lbfd $DLLIBS -liberty -lz -lintl"], [], + [$DLLIBS -liberty -lz -lintl])]) AS_IF([test -n "$bfd_ldlibs"], [bfd_available=true AC_DEFINE([HAS_LIBBFD])])]) @@ -1657,14 +1692,47 @@ AS_IF([test x"$enable_flat_float_array" = "xno"], [AC_DEFINE([FLAT_FLOAT_ARRAY]) flat_float_array=true]) +AS_IF([test x"$enable_function_sections" = "xno"], + [function_sections=false], + [AS_CASE([$arch], + [amd64|i386|arm64], # not supported on arm32, see issue #9124. + [AS_CASE([$target], + [*-cygwin*|*-mingw*|*-windows|*-apple-darwin*], + [function_sections=false; + AC_MSG_NOTICE([No support for function sections on $target.])], + [*], + [AS_CASE([$ocaml_cv_cc_vendor], + [gcc-[0123]-*|gcc-4-[01234567]], + [function_sections=false; + AC_MSG_NOTICE([Function sections are not + supported in GCC prior to version 4.8.])], + [clang-[012]-*|clang-3-[01234]], + [function_sections=false; + AC_MSG_NOTICE([Function sections are not supported + in Clang prior to version 3.5.])], + [gcc-*|clang-*], + [function_sections=true; + internal_cflags="$internal_cflags -ffunction-sections"; + AC_DEFINE([FUNCTION_SECTIONS])], + [*], + [function_sections=false; + AC_MSG_NOTICE([Function sections are not supported by + $ocaml_cv_cc_vendor.])])])], + [function_sections=false]); + AS_IF([test x"$function_sections" = "xfalse"], + [AS_IF([test x"$enable_function_sections" = "xyes"], + [AC_MSG_ERROR([Function sections are not supported.])], + [AC_MSG_NOTICE([Disabling function sections.])])], + [])]) + AS_IF([test x"$with_afl" = "xyes"], [afl=true], [afl=false]) -AS_IF([test x"$enable_force_safe_string" = "xyes"], +AS_IF([test x"$enable_force_safe_string" = "xno"], + [force_safe_string=false], [AC_DEFINE([CAML_SAFE_STRING]) - force_safe_string=true], - [force_safe_string=false]) + force_safe_string=true]) AS_IF([test x"$DEFAULT_STRING" = "xunsafe"], [default_safe_string=false], @@ -1727,7 +1795,11 @@ AS_IF([test x"$prefix" = "xNONE"], [i686-w64-mingw32], [prefix='C:/ocamlmgw'], [x86_64-w64-mingw32], [prefix='C:/ocamlmgw64'], [i686-pc-windows], [prefix='C:/ocamlms'], - [x86_64-pc-windows], [prefix='C:/ocamlms64'])]) + [x86_64-pc-windows], [prefix='C:/ocamlms64'])], + [AS_IF([test x"$unix_or_win32" = "xwin32" \ + && test "$host_vendor-$host_os" != "$build_vendor-$build_os" ], + [AS_CASE([$build], + [*-pc-cygwin], [prefix=`cygpath -m "$prefix"`])])]) # Define a few macros that were defined in config/m-nt.h # but whose value is not guessed properly by configure @@ -1739,4 +1811,7 @@ AS_CASE([$host], AC_DEFINE([HAS_IPV6]) AC_DEFINE([HAS_NICE])]) +AS_IF([test x"$enable_stdlib_manpages" != "xno"], + [stdlib_manpages=true],[stdlib_manpages=false]) + AC_OUTPUT diff --git a/debugger/.depend b/debugger/.depend index 114bd380..5fdc17ea 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -2,8 +2,11 @@ breakpoints.cmo : \ symbols.cmi \ pos.cmi \ parameters.cmi \ + ../utils/misc.cmi \ ../bytecomp/instruct.cmi \ exec.cmi \ + events.cmi \ + debugger_config.cmi \ debugcom.cmi \ checkpoints.cmi \ breakpoints.cmi @@ -11,13 +14,17 @@ breakpoints.cmx : \ symbols.cmx \ pos.cmx \ parameters.cmx \ + ../utils/misc.cmx \ ../bytecomp/instruct.cmx \ exec.cmx \ + events.cmx \ + debugger_config.cmx \ debugcom.cmx \ checkpoints.cmx \ breakpoints.cmi breakpoints.cmi : \ - ../bytecomp/instruct.cmi + events.cmi \ + debugcom.cmi checkpoints.cmo : \ primitives.cmi \ int64ops.cmi \ @@ -112,16 +119,19 @@ debugcom.cmo : \ primitives.cmi \ ../utils/misc.cmi \ int64ops.cmi \ + ../bytecomp/instruct.cmi \ input_handling.cmi \ debugcom.cmi debugcom.cmx : \ primitives.cmx \ ../utils/misc.cmx \ int64ops.cmx \ + ../bytecomp/instruct.cmx \ input_handling.cmx \ debugcom.cmi debugcom.cmi : \ - primitives.cmi + primitives.cmi \ + ../bytecomp/instruct.cmi debugger_config.cmo : \ int64ops.cmi \ debugger_config.cmi @@ -143,6 +153,7 @@ eval.cmo : \ ../bytecomp/instruct.cmi \ ../typing/ident.cmi \ frames.cmi \ + events.cmi \ ../typing/env.cmi \ debugcom.cmi \ ../typing/ctype.cmi \ @@ -162,6 +173,7 @@ eval.cmx : \ ../bytecomp/instruct.cmx \ ../typing/ident.cmx \ frames.cmx \ + events.cmx \ ../typing/env.cmx \ debugcom.cmx \ ../typing/ctype.cmx \ @@ -172,8 +184,8 @@ eval.cmi : \ ../typing/path.cmi \ parser_aux.cmi \ ../parsing/longident.cmi \ - ../bytecomp/instruct.cmi \ ../typing/ident.cmi \ + events.cmi \ ../typing/env.cmi \ debugcom.cmi events.cmo : \ @@ -206,7 +218,7 @@ frames.cmx : \ debugcom.cmx \ frames.cmi frames.cmi : \ - ../bytecomp/instruct.cmi + events.cmi history.cmo : \ primitives.cmi \ int64ops.cmi \ @@ -340,18 +352,21 @@ parser.cmo : \ ../parsing/longident.cmi \ int64ops.cmi \ input_handling.cmi \ + debugcom.cmi \ parser.cmi parser.cmx : \ parser_aux.cmi \ ../parsing/longident.cmx \ int64ops.cmx \ input_handling.cmx \ + debugcom.cmx \ parser.cmi parser.cmi : \ parser_aux.cmi \ ../parsing/longident.cmi parser_aux.cmi : \ - ../parsing/longident.cmi + ../parsing/longident.cmi \ + debugcom.cmi pattern_matching.cmo : \ ../typing/typedtree.cmi \ parser_aux.cmi \ @@ -375,13 +390,15 @@ pattern_matching.cmi : \ pos.cmo : \ ../parsing/location.cmi \ ../bytecomp/instruct.cmi \ + events.cmi \ pos.cmi pos.cmx : \ ../parsing/location.cmx \ ../bytecomp/instruct.cmx \ + events.cmx \ pos.cmi pos.cmi : \ - ../bytecomp/instruct.cmi + events.cmi primitives.cmo : \ $(UNIXDIR)/unix.cmi \ primitives.cmi @@ -511,7 +528,7 @@ show_information.cmx : \ breakpoints.cmx \ show_information.cmi show_information.cmi : \ - ../bytecomp/instruct.cmi + events.cmi show_source.cmo : \ source.cmi \ primitives.cmi \ @@ -568,7 +585,9 @@ symbols.cmx : \ ../bytecomp/bytesections.cmx \ symbols.cmi symbols.cmi : \ - ../bytecomp/instruct.cmi + ../bytecomp/instruct.cmi \ + events.cmi \ + debugcom.cmi time_travel.cmo : \ trap_barrier.cmi \ symbols.cmi \ diff --git a/debugger/Makefile b/debugger/Makefile index 1ff7fc25..0d5037c0 100644 --- a/debugger/Makefile +++ b/debugger/Makefile @@ -17,19 +17,20 @@ ROOTDIR = .. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries DYNLINKDIR=$(ROOTDIR)/otherlibs/dynlink UNIXDIR=$(ROOTDIR)/otherlibs/$(UNIXLIB) CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE) -CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -g -nostdlib -I $(ROOTDIR)/stdlib +CAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \ -safe-string -strict-sequence -strict-formats LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR) YACCFLAGS= -CAMLLEX=$(CAMLRUN) $(ROOTDIR)/boot/ocamllex -CAMLDEP=$(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend +CAMLLEX=$(BEST_OCAMLLEX) +CAMLDEP=$(BEST_OCAMLDEP) DEPFLAGS=-slash DEPINCLUDES=$(INCLUDES) @@ -47,8 +48,8 @@ parsing_modules := $(addprefix parsing/,\ attr_helper builtin_attributes pprintast) typing_modules := $(addprefix typing/,\ - ident path types btype primitive typedtree subst predef datarepr \ - persistent_env env oprint ctype printtyp mtype envaux) + ident path type_immediacy types btype primitive typedtree subst predef \ + datarepr persistent_env env oprint ctype printtyp mtype envaux) file_formats_modules := $(addprefix file_formats/,\ cmi_format) @@ -103,7 +104,7 @@ depend: beforedepend | sed -e 's,$(UNIXDIR)/,$$(UNIXDIR)/,' > .depend lexer.ml: lexer.mll - $(CAMLLEX) lexer.mll + $(CAMLLEX) $(OCAMLLEX_FLAGS) $< clean:: rm -f lexer.ml beforedepend:: lexer.ml diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml index 4751bde6..f3755282 100644 --- a/debugger/breakpoints.ml +++ b/debugger/breakpoints.ml @@ -19,6 +19,7 @@ open Checkpoints open Debugcom open Instruct +open Events open Printf (*** Debugging. ***) @@ -30,10 +31,11 @@ let debug_breakpoints = ref false let breakpoint_number = ref 0 (* Breakpoint number -> event. *) -let breakpoints = ref ([] : (int * debug_event) list) +type breakpoint_id = int +let breakpoints = ref ([] : (breakpoint_id * code_event) list) (* Program counter -> breakpoint count. *) -let positions = ref ([] : (int * int ref) list) +let positions = ref ([] : (pc * int ref) list) (* Versions of the breakpoint list. *) let current_version = ref 0 @@ -58,17 +60,17 @@ let breakpoints_count () = (* List of breakpoints at `pc'. *) let rec breakpoints_at_pc pc = - begin try - let ev = Symbols.event_at_pc pc in - match ev.ev_repr with - Event_child {contents = pc'} -> breakpoints_at_pc pc' - | _ -> [] - with Not_found -> - [] + begin match Symbols.event_at_pc pc with + | {ev_frag = frag; ev_ev = {ev_repr = Event_child {contents = pos}}} -> + breakpoints_at_pc {frag; pos} + | _ -> [] + | exception Not_found -> [] end @ - List.map fst (List.filter (function (_, {ev_pos = pos}) -> pos = pc) - !breakpoints) + List.map fst (List.filter + (function (_, {ev_frag = frag; ev_ev = {ev_pos = pos}}) -> + {frag; pos} = pc) + !breakpoints) (* Is there a breakpoint at `pc' ? *) let breakpoint_at_pc pc = @@ -76,32 +78,28 @@ let breakpoint_at_pc pc = (*** Set and remove breakpoints ***) +let print_pc out {frag;pos} = fprintf out "%d:%d" frag pos + (* Remove all breakpoints. *) -let remove_breakpoints pos = +let remove_breakpoints pcs = if !debug_breakpoints then - (print_string "Removing breakpoints..."; print_newline ()); + printf "Removing breakpoints...\n%!"; List.iter - (function (pos, _) -> - if !debug_breakpoints then begin - print_int pos; - print_newline() - end; - reset_instr pos; - Symbols.set_event_at_pc pos) - pos + (function (pc, _) -> + if !debug_breakpoints then printf "%a\n%!" print_pc pc; + reset_instr pc; + Symbols.set_event_at_pc pc) + pcs (* Set all breakpoints. *) -let set_breakpoints pos = +let set_breakpoints pcs = if !debug_breakpoints then - (print_string "Setting breakpoints..."; print_newline ()); + printf "Setting breakpoints...\n%!"; List.iter - (function (pos, _) -> - if !debug_breakpoints then begin - print_int pos; - print_newline() - end; - set_breakpoint pos) - pos + (function (pc, _) -> + if !debug_breakpoints then printf "%a\n%!" print_pc pc; + set_breakpoint pc) + pcs (* Ensure the current version is installed in current checkpoint. *) let update_breakpoints () = @@ -119,25 +117,15 @@ let update_breakpoints () = set_breakpoints !positions; copy_breakpoints ()) -let change_version version pos = - Exec.protect - (function () -> - current_version := version; - positions := pos) - (* Execute given function with no breakpoint in current checkpoint. *) (* --- `goto' runs faster this way (does not stop on each breakpoint). *) let execute_without_breakpoints f = - let version = !current_version - and pos = !positions - in - change_version 0 []; - try - f (); - change_version version pos - with - _ -> - change_version version pos + Misc.protect_refs [Misc.R (Debugger_config.break_on_load, false); + Misc.R (current_version, 0); + Misc.R (positions, []); + Misc.R (breakpoints, []); + Misc.R (breakpoint_number, 0)] + f (* Add a position in the position list. *) (* Change version if necessary. *) @@ -160,37 +148,33 @@ let remove_position pos = end (* Insert a new breakpoint in lists. *) -let rec new_breakpoint = - function - {ev_repr = Event_child pc} -> - new_breakpoint (Symbols.any_event_at_pc !pc) - | event -> - Exec.protect - (function () -> - incr breakpoint_number; - insert_position event.ev_pos; - breakpoints := (!breakpoint_number, event) :: !breakpoints); - if !Parameters.breakpoint then begin - printf "Breakpoint %d at %d: %s" !breakpoint_number event.ev_pos - (Pos.get_desc event); - print_newline () - end +let rec new_breakpoint event = + match event with + {ev_frag=frag; ev_ev={ev_repr=Event_child pos}} -> + new_breakpoint (Symbols.any_event_at_pc {frag; pos=(!pos)}) + | {ev_frag=frag; ev_ev={ev_pos=pos}} -> + let pc = {frag; pos} in + Exec.protect + (function () -> + incr breakpoint_number; + insert_position pc; + breakpoints := (!breakpoint_number, event) :: !breakpoints); + if !Parameters.breakpoint then + printf "Breakpoint %d at %a: %s\n%!" !breakpoint_number print_pc pc + (Pos.get_desc event) (* Remove a breakpoint from lists. *) let remove_breakpoint number = try let ev = List.assoc number !breakpoints in - let pos = ev.ev_pos in - Exec.protect - (function () -> - breakpoints := List.remove_assoc number !breakpoints; - remove_position pos; - if !Parameters.breakpoint then begin - printf "Removed breakpoint %d at %d: %s" number ev.ev_pos - (Pos.get_desc ev); - print_newline () - end - ) + let pc = {frag = ev.ev_frag; pos=ev.ev_ev.ev_pos} in + Exec.protect + (function () -> + breakpoints := List.remove_assoc number !breakpoints; + remove_position pc; + if !Parameters.breakpoint then + printf "Removed breakpoint %d at %a: %s\n%!" number print_pc pc + (Pos.get_desc ev)) with Not_found -> prerr_endline ("No breakpoint number " ^ (Int.to_string number) ^ "."); @@ -202,7 +186,7 @@ let remove_all_breakpoints () = (*** Temporary breakpoints. ***) (* Temporary breakpoint position. *) -let temporary_breakpoint_position = ref (None : int option) +let temporary_breakpoint_position = ref (None : pc option) (* Execute `funct' with a breakpoint added at `pc'. *) (* --- Used by `finish'. *) diff --git a/debugger/breakpoints.mli b/debugger/breakpoints.mli index be1baf12..d26d9b24 100644 --- a/debugger/breakpoints.mli +++ b/debugger/breakpoints.mli @@ -16,8 +16,6 @@ (******************************* Breakpoints ***************************) -open Instruct - (*** Debugging. ***) val debug_breakpoints : bool ref @@ -25,14 +23,15 @@ val debug_breakpoints : bool ref val breakpoints_count : unit -> int -(* Breakpoint number -> debug_event_kind. *) -val breakpoints : (int * debug_event) list ref +(* Breakpoint number -> code_event. *) +type breakpoint_id = int +val breakpoints : (breakpoint_id * Events.code_event) list ref (* Is there a breakpoint at `pc' ? *) -val breakpoint_at_pc : int -> bool +val breakpoint_at_pc : Debugcom.pc -> bool (* List of breakpoints at `pc'. *) -val breakpoints_at_pc : int -> int list +val breakpoints_at_pc : Debugcom.pc -> breakpoint_id list (*** Set and remove breakpoints ***) @@ -44,18 +43,18 @@ val update_breakpoints : unit -> unit val execute_without_breakpoints : (unit -> unit) -> unit (* Insert a new breakpoint in lists. *) -val new_breakpoint : debug_event -> unit +val new_breakpoint : Events.code_event -> unit (* Remove a breakpoint from lists. *) -val remove_breakpoint : int -> unit +val remove_breakpoint : breakpoint_id -> unit val remove_all_breakpoints : unit -> unit (*** Temporary breakpoints. ***) (* Temporary breakpoint position. *) -val temporary_breakpoint_position : int option ref +val temporary_breakpoint_position : Debugcom.pc option ref (* Execute `funct' with a breakpoint added at `pc'. *) (* --- Used by `finish'. *) -val exec_with_temporary_breakpoint : int -> (unit -> unit) -> unit +val exec_with_temporary_breakpoint : Debugcom.pc -> (unit -> unit) -> unit diff --git a/debugger/checkpoints.ml b/debugger/checkpoints.ml index 7ab8de72..b7896140 100644 --- a/debugger/checkpoints.ml +++ b/debugger/checkpoints.ml @@ -43,8 +43,9 @@ type checkpoint = { mutable c_state : checkpoint_state; mutable c_parent : checkpoint; mutable c_breakpoint_version : int; - mutable c_breakpoints : (int * int ref) list; - mutable c_trap_barrier : int + mutable c_breakpoints : (pc * int ref) list; + mutable c_trap_barrier : int; + mutable c_code_fragments : int list } (*** Pseudo-checkpoint `root'. ***) @@ -59,7 +60,8 @@ let rec root = { c_parent = root; c_breakpoint_version = 0; c_breakpoints = []; - c_trap_barrier = 0 + c_trap_barrier = 0; + c_code_fragments = [0] } (*** Current state ***) @@ -75,12 +77,14 @@ let current_time () = let current_report () = !current_checkpoint.c_report -let current_pc () = - match current_report () with - None | Some {rep_type = Exited | Uncaught_exc} -> None - | Some {rep_program_pointer = pc } -> Some pc - let current_pc_sp () = + (* This pattern matching mimics the test used in debugger.c for + deciding whether or not PC/SP should be sent with the report. + See debugger.c, the [if] statement above the [command_loop] + label. *) match current_report () with - None | Some {rep_type = Exited | Uncaught_exc} -> None - | Some {rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp) + | Some {rep_type = Event | Breakpoint; + rep_program_pointer = pc; rep_stack_pointer = sp } -> Some (pc, sp) + | _ -> None + +let current_pc () = Option.map fst (current_pc_sp ()) diff --git a/debugger/checkpoints.mli b/debugger/checkpoints.mli index f3ca1380..d02240ee 100644 --- a/debugger/checkpoints.mli +++ b/debugger/checkpoints.mli @@ -42,8 +42,9 @@ type checkpoint = mutable c_state : checkpoint_state; mutable c_parent : checkpoint; mutable c_breakpoint_version : int; - mutable c_breakpoints : (int * int ref) list; - mutable c_trap_barrier : int} + mutable c_breakpoints : (pc * int ref) list; + mutable c_trap_barrier : int; + mutable c_code_fragments : int list} (*** Pseudo-checkpoint `root'. ***) (* --- Parents of all checkpoints which have no parent. *) @@ -55,5 +56,5 @@ val current_checkpoint : checkpoint ref val current_time : unit -> int64 val current_report : unit -> report option -val current_pc : unit -> int option -val current_pc_sp : unit -> (int * int) option +val current_pc : unit -> pc option +val current_pc_sp : unit -> (pc * int) option diff --git a/debugger/command_line.ml b/debugger/command_line.ml index 0cd25ccb..b9bc9d2f 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -126,14 +126,15 @@ let add_breakpoint_at_pc pc = new_breakpoint (any_event_at_pc pc) with | Not_found -> - eprintf "Can\'t add breakpoint at pc %i: no event there.@." pc; + eprintf "Can\'t add breakpoint at pc %i:%i: no event there.@." + pc.frag pc.pos; raise Toplevel let add_breakpoint_after_pc pc = let rec try_add n = if n < 3 then begin try - new_breakpoint (any_event_at_pc (pc + n * 4)) + new_breakpoint (any_event_at_pc {pc with pos = pc.pos + n * 4}) with | Not_found -> try_add (n+1) @@ -156,11 +157,8 @@ let convert_module mdle = then Filename.chop_suffix m ".ml" else m) | None -> - try - (get_current_event ()).ev_module - with - | Not_found -> - error "Not in a module." + try (get_current_event ()).ev_ev.ev_module + with Not_found -> error "Not in a module." (** Toplevel. **) let current_line = ref "" @@ -303,7 +301,7 @@ let instr_run ppf lexbuf = ensure_loaded (); reset_named_values (); run (); - show_current_event ppf;; + show_current_event ppf let instr_reverse ppf lexbuf = eol lexbuf; @@ -502,7 +500,7 @@ let env_of_event = function None -> Env.empty | Some ev -> - Envaux.env_from_summary ev.Instruct.ev_typenv ev.Instruct.ev_typsubst + Envaux.env_from_summary ev.ev_ev.ev_typenv ev.ev_ev.ev_typsubst let print_command depth ppf lexbuf = let exprs = expression_list_eol Lexer.lexeme lexbuf in @@ -613,8 +611,8 @@ let instr_break ppf lexbuf = new_breakpoint ev | None -> error "Can\'t add breakpoint at this point.") - | BA_pc pc -> (* break PC *) - add_breakpoint_at_pc pc + | BA_pc {frag; pos} -> (* break PC *) + add_breakpoint_at_pc {frag; pos} | BA_function expr -> (* break FUNCTION *) let env = try @@ -644,7 +642,7 @@ let instr_break ppf lexbuf = let ev = event_at_pos module_name 0 in let ev_pos = {Lexing.dummy_pos with - pos_fname = (Events.get_pos ev).pos_fname} in + pos_fname = (Events.get_pos ev.ev_ev).pos_fname} in let buffer = try get_buffer ev_pos module_name with | Not_found -> @@ -703,7 +701,7 @@ let instr_backtrace ppf lexbuf = | Some x -> x in ensure_loaded (); match current_report() with - | None | Some {rep_type = Exited | Uncaught_exc} -> () + | None | Some {rep_type = Exited | Uncaught_exc | Code_loaded _} -> () | Some _ -> let frame_counter = ref 0 in let print_frame first_frame last_frame = function @@ -936,8 +934,8 @@ let info_checkpoints ppf lexbuf = !checkpoints)) let info_one_breakpoint ppf (num, ev) = - fprintf ppf "%3d %10d %s@." num ev.ev_pos (Pos.get_desc ev); -;; + fprintf ppf "%3d %d:%10d %s@." num ev.ev_frag ev.ev_ev.ev_pos + (Pos.get_desc ev) let info_breakpoints ppf lexbuf = eol lexbuf; @@ -946,7 +944,7 @@ let info_breakpoints ppf lexbuf = fprintf ppf "Num Address Where@."; List.iter (info_one_breakpoint ppf) (List.rev !breakpoints); end -;; + let info_events _ppf lexbuf = ensure_loaded (); @@ -955,6 +953,7 @@ let info_events _ppf lexbuf = in print_endline ("Module: " ^ mdle); print_endline " Address Characters Kind Repr."; + let frag, events = events_in_module mdle in List.iter (function ev -> let start_char, end_char = @@ -966,7 +965,8 @@ let info_events _ppf lexbuf = ev.ev_loc.Location.loc_start.Lexing.pos_cnum, ev.ev_loc.Location.loc_end.Lexing.pos_cnum in Printf.printf - "%10d %6d-%-6d %10s %10s\n" + "%d:%10d %6d-%-6d %10s %10s\n" + frag ev.ev_pos start_char end_char @@ -983,7 +983,7 @@ let info_events _ppf lexbuf = Event_none -> "" | Event_parent _ -> "(repr)" | Event_child repr -> Int.to_string !repr)) - (events_in_module mdle) + events (** User-defined printers **) @@ -1093,10 +1093,14 @@ Argument N means do this N times (or till program stops for another reason)." }; (* Breakpoints *) { instr_name = "break"; instr_prio = false; instr_action = instr_break; instr_repeat = false; instr_help = -"Set breakpoint at specified line or function.\ -\nSyntax: break function-name\ +"Set breakpoint.\ +\nSyntax: break\ +\n break function-name\ \n break @ [module] linenum\ -\n break @ [module] # characternum" }; +\n break @ [module] linenum columnnum\ +\n break @ [module] # characternum\ +\n break frag:pc\ +\n break pc" }; { instr_name = "delete"; instr_prio = false; instr_action = instr_delete; instr_repeat = false; instr_help = "delete some breakpoints.\n\ @@ -1214,7 +1218,11 @@ It can be either:\n\ "process to follow after forking.\n\ It can be either :\n\ child: the newly created process.\n\ - parent: the process that called fork.\n" }]; + parent: the process that called fork.\n" }; + { var_name = "break_on_load"; + var_action = boolean_variable false break_on_load; + var_help = +"whether to stop after loading new code (e.g. with Dynlink)." }]; info_list := (* info name, function, help *) diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml index e828ec4e..f9f8164f 100644 --- a/debugger/debugcom.ml +++ b/debugger/debugcom.ml @@ -45,16 +45,23 @@ let set_current_connection io_chan = (* Modify the program code *) -let set_event pos = +type pc = + { frag : int; + pos : int; } + +let set_event {frag; pos} = output_char !conn.io_out 'e'; + output_binary_int !conn.io_out frag; output_binary_int !conn.io_out pos -let set_breakpoint pos = +let set_breakpoint {frag; pos} = output_char !conn.io_out 'B'; + output_binary_int !conn.io_out frag; output_binary_int !conn.io_out pos -let reset_instr pos = +let reset_instr {frag; pos} = output_char !conn.io_out 'i'; + output_binary_int !conn.io_out frag; output_binary_int !conn.io_out pos (* Basic commands for flow control *) @@ -65,12 +72,15 @@ type execution_summary = | Exited | Trap_barrier | Uncaught_exc + | Debug_info of Instruct.debug_event list array + | Code_loaded of int + | Code_unloaded of int type report = { rep_type : execution_summary; - rep_event_count : int; + rep_event_count : int64; rep_stack_pointer : int; - rep_program_pointer : int + rep_program_pointer : pc } type checkpoint_report = @@ -95,24 +105,33 @@ let do_go_smallint n = | 'x' -> Exited | 's' -> Trap_barrier | 'u' -> Uncaught_exc - | _ -> Misc.fatal_error "Debugcom.do_go" in + | 'D' -> Debug_info (input_value !conn.io_in : + Instruct.debug_event list array) + | 'L' -> Code_loaded (input_binary_int !conn.io_in) + | 'U' -> Code_unloaded (input_binary_int !conn.io_in) + | c -> Misc.fatal_error (Printf.sprintf "Debugcom.do_go %c" c) + in let event_counter = input_binary_int !conn.io_in in let stack_pos = input_binary_int !conn.io_in in - let pc = input_binary_int !conn.io_in in + let frag = input_binary_int !conn.io_in in + let pos = input_binary_int !conn.io_in in { rep_type = summary; - rep_event_count = event_counter; + rep_event_count = Int64.of_int event_counter; rep_stack_pointer = stack_pos; - rep_program_pointer = pc }) + rep_program_pointer = {frag; pos} }) let rec do_go n = assert (n >= _0); - if n > max_small_int then( - ignore (do_go_smallint max_int); - do_go (n -- max_small_int) - )else( + if n > max_small_int then + begin match do_go_smallint max_int with + | { rep_type = Event } -> + do_go (n -- max_small_int) + | report -> + { report with + rep_event_count = report.rep_event_count ++ (n -- max_small_int) } + end + else do_go_smallint (Int64.to_int n) - ) -;; (* Perform a checkpoint *) @@ -148,8 +167,9 @@ let initial_frame () = output_char !conn.io_out '0'; flush !conn.io_out; let stack_pos = input_binary_int !conn.io_in in - let pc = input_binary_int !conn.io_in in - (stack_pos, pc) + let frag = input_binary_int !conn.io_in in + let pos = input_binary_int !conn.io_in in + (stack_pos, {frag; pos}) let set_initial_frame () = ignore(initial_frame ()) @@ -163,8 +183,14 @@ let up_frame stacksize = output_binary_int !conn.io_out stacksize; flush !conn.io_out; let stack_pos = input_binary_int !conn.io_in in - let pc = if stack_pos = -1 then 0 else input_binary_int !conn.io_in in - (stack_pos, pc) + let frag, pos = + if stack_pos = -1 + then 0, 0 + else let frag = input_binary_int !conn.io_in in + let pos = input_binary_int !conn.io_in in + frag, pos + in + (stack_pos, { frag; pos }) (* Get and set the current frame position *) @@ -172,8 +198,9 @@ let get_frame () = output_char !conn.io_out 'f'; flush !conn.io_out; let stack_pos = input_binary_int !conn.io_in in - let pc = input_binary_int !conn.io_in in - (stack_pos, pc) + let frag = input_binary_int !conn.io_in in + let pos = input_binary_int !conn.io_in in + (stack_pos, {frag; pos}) let set_frame stack_pos = output_char !conn.io_out 'S'; @@ -308,7 +335,9 @@ module Remote_value = output_char !conn.io_out 'C'; output_remote_value !conn.io_out v; flush !conn.io_out; - input_binary_int !conn.io_in + let frag = input_binary_int !conn.io_in in + let pos = input_binary_int !conn.io_in in + {frag;pos} let same rv1 rv2 = match (rv1, rv2) with diff --git a/debugger/debugcom.mli b/debugger/debugcom.mli index 40913626..0b6eb30f 100644 --- a/debugger/debugcom.mli +++ b/debugger/debugcom.mli @@ -16,18 +16,25 @@ (* Low-level communication with the debuggee *) +type pc = + { frag : int; + pos : int; } + type execution_summary = Event | Breakpoint | Exited | Trap_barrier | Uncaught_exc + | Debug_info of Instruct.debug_event list array + | Code_loaded of int + | Code_unloaded of int type report = { rep_type : execution_summary; - rep_event_count : int; + rep_event_count : int64; rep_stack_pointer : int; - rep_program_pointer : int } + rep_program_pointer : pc } type checkpoint_report = Checkpoint_done of int @@ -41,13 +48,13 @@ type follow_fork_mode = val set_current_connection : Primitives.io_channel -> unit (* Put an event at given pc *) -val set_event : int -> unit +val set_event : pc -> unit (* Put a breakpoint at given pc *) -val set_breakpoint : int -> unit +val set_breakpoint : pc -> unit (* Remove breakpoint or event at given pc *) -val reset_instr : int -> unit +val reset_instr : pc -> unit (* Create a new checkpoint (the current process forks). *) val do_checkpoint : unit -> checkpoint_report @@ -63,12 +70,12 @@ val wait_child : Primitives.io_channel -> unit (* Move to initial frame (that of current function). *) (* Return stack position and current pc *) -val initial_frame : unit -> int * int +val initial_frame : unit -> int * pc val set_initial_frame : unit -> unit (* Get the current frame position *) (* Return stack position and current pc *) -val get_frame : unit -> int * int +val get_frame : unit -> int * pc (* Set the current frame *) val set_frame : int -> unit @@ -76,7 +83,7 @@ val set_frame : int -> unit (* Move up one frame *) (* Return stack position and current pc. If there's no frame above, return (-1, 0). *) -val up_frame : int -> int * int +val up_frame : int -> int * pc (* Set the trap barrier to given stack position. *) val set_trap_barrier : int -> unit @@ -109,7 +116,7 @@ module Remote_value : val from_environment : int -> t val global : int -> t val accu : unit -> t - val closure_code : t -> int + val closure_code : t -> pc (* Returns a hexadecimal representation of the remote address, or [""] if the value is local. *) diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml index 3996d221..9677bb0c 100644 --- a/debugger/debugger_config.ml +++ b/debugger/debugger_config.ml @@ -82,6 +82,9 @@ let make_checkpoints = ref "Win32" -> false | _ -> true) +(* Whether to break when new code is loaded. *) +let break_on_load = ref true + (*** Environment variables for debuggee. ***) let environment = ref [] diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli index 42fa7744..9db86e93 100644 --- a/debugger/debugger_config.mli +++ b/debugger/debugger_config.mli @@ -34,6 +34,7 @@ val checkpoint_big_step : int64 ref val checkpoint_small_step : int64 ref val checkpoint_max_count : int ref val make_checkpoints : bool ref +val break_on_load : bool ref (*** Environment variables for debuggee. ***) diff --git a/debugger/eval.ml b/debugger/eval.ml index e3bacfa6..240ea882 100644 --- a/debugger/eval.ml +++ b/debugger/eval.ml @@ -19,6 +19,7 @@ open Path open Instruct open Types open Parser_aux +open Events type error = Unbound_identifier of Ident.t @@ -47,7 +48,7 @@ let rec address path event = function with Symtable.Error _ -> raise(Error(Unbound_identifier id)) else begin match event with - Some ev -> + Some {ev_ev = ev} -> begin try let pos = Ident.find_same id ev.ev_compenv.ce_stack in Debugcom.Remote_value.local (ev.ev_stacksize - pos) @@ -74,27 +75,30 @@ let value_path event env path = fatal_error ("Cannot find address for: " ^ (Path.name path)) let rec expression event env = function - E_ident lid -> - begin try - let (p, valdesc) = Env.lookup_value lid env in - (begin match valdesc.val_kind with - Val_ivar (_, cl_num) -> - let (p0, _) = - Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env - in - let v = value_path event env p0 in - let i = value_path event env p in - Debugcom.Remote_value.field v (Debugcom.Remote_value.obj i) - | _ -> - value_path event env p - end, - Ctype.correct_levels valdesc.val_type) - with Not_found -> - raise(Error(Unbound_long_identifier lid)) - end + | E_ident lid -> begin + match Env.find_value_by_name lid env with + | (p, valdesc) -> + let v = + match valdesc.val_kind with + | Val_ivar (_, cl_num) -> + let (p0, _) = + Env.find_value_by_name + (Longident.Lident ("self-" ^ cl_num)) env + in + let v = value_path event env p0 in + let i = value_path event env p in + Debugcom.Remote_value.field v (Debugcom.Remote_value.obj i) + | _ -> + value_path event env p + in + let typ = Ctype.correct_levels valdesc.val_type in + v, typ + | exception Not_found -> + raise(Error(Unbound_long_identifier lid)) + end | E_result -> begin match event with - Some {ev_kind = Event_after ty; ev_typsubst = subst} + Some {ev_ev = {ev_kind = Event_after ty; ev_typsubst = subst}} when !Frames.current_frame = 0 -> (Debugcom.Remote_value.accu(), Subst.type_expr subst ty) | _ -> @@ -183,7 +187,6 @@ let report_error ppf = function | Unknown_name n -> fprintf ppf "@[Unknown value name $%i@]@." n | Tuple_index(ty, len, pos) -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[Cannot extract field number %i from a %i-tuple of type@ %a@]@." pos len Printtyp.type_expr ty diff --git a/debugger/eval.mli b/debugger/eval.mli index 51d27136..6aa8cb1f 100644 --- a/debugger/eval.mli +++ b/debugger/eval.mli @@ -19,7 +19,7 @@ open Parser_aux open Format val expression : - Instruct.debug_event option -> Env.t -> expression -> + Events.code_event option -> Env.t -> expression -> Debugcom.Remote_value.t * type_expr type error = diff --git a/debugger/events.ml b/debugger/events.ml index a50eae0d..3bad8b2f 100644 --- a/debugger/events.ml +++ b/debugger/events.ml @@ -18,6 +18,10 @@ open Instruct +type code_event = + { ev_frag : int; + ev_ev : Instruct.debug_event } + let get_pos ev = match ev.ev_kind with | Event_before -> ev.ev_loc.Location.loc_start @@ -30,7 +34,7 @@ let get_pos ev = (* Event at current position *) let current_event = - ref (None : debug_event option) + ref (None : code_event option) (* Current position in source. *) (* Raise `Not_found' if not on an event (beginning or end of program). *) @@ -43,7 +47,7 @@ let current_event_is_before () = match !current_event with None -> raise Not_found - | Some {ev_kind = Event_before} -> + | Some {ev_ev = {ev_kind = Event_before}} -> true | _ -> false diff --git a/debugger/events.mli b/debugger/events.mli index f50f156e..b095e50a 100644 --- a/debugger/events.mli +++ b/debugger/events.mli @@ -16,15 +16,20 @@ open Instruct +(* A debug event associated with a code fragment. *) +type code_event = + { ev_frag : int; + ev_ev : Instruct.debug_event } + val get_pos : debug_event -> Lexing.position;; (** Current events. **) (* The event at current position. *) -val current_event : debug_event option ref +val current_event : code_event option ref (* Current position in source. *) (* Raise `Not_found' if not on an event (beginning or end of program). *) -val get_current_event : unit -> debug_event +val get_current_event : unit -> code_event val current_event_is_before : unit -> bool diff --git a/debugger/frames.ml b/debugger/frames.ml index 96b7ce15..e1edf231 100644 --- a/debugger/frames.ml +++ b/debugger/frames.ml @@ -25,7 +25,7 @@ open Symbols let current_frame = ref 0 (* Event at selected position *) -let selected_event = ref (None : debug_event option) +let selected_event = ref (None : code_event option) (* Selected position in source. *) (* Raise `Not_found' if not on an event. *) @@ -33,7 +33,7 @@ let selected_point () = match !selected_event with None -> raise Not_found - | Some ev -> + | Some {ev_ev=ev} -> (ev.ev_module, (Events.get_pos ev).Lexing.pos_lnum, (Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol) @@ -42,7 +42,7 @@ let selected_event_is_before () = match !selected_event with None -> raise Not_found - | Some {ev_kind = Event_before} -> + | Some {ev_ev={ev_kind = Event_before}} -> true | _ -> false @@ -52,7 +52,7 @@ let selected_event_is_before () = let rec move_up frame_count event = if frame_count <= 0 then event else begin - let (sp, pc) = up_frame event.ev_stacksize in + let (sp, pc) = up_frame event.ev_ev.ev_stacksize in if sp < 0 then raise Not_found; move_up (frame_count - 1) (any_event_at_pc pc) end @@ -106,13 +106,13 @@ let reset_frame () = let do_backtrace action = match !current_event with None -> Misc.fatal_error "Frames.do_backtrace" - | Some curr_ev -> + | Some ev -> let (initial_sp, _) = get_frame() in set_initial_frame(); - let event = ref curr_ev in + let event = ref ev in begin try while action (Some !event) do - let (sp, pc) = up_frame !event.ev_stacksize in + let (sp, pc) = up_frame !event.ev_ev.ev_stacksize in if sp < 0 then raise Exit; event := any_event_at_pc pc done diff --git a/debugger/frames.mli b/debugger/frames.mli index 514aa2e3..08fd326c 100644 --- a/debugger/frames.mli +++ b/debugger/frames.mli @@ -16,13 +16,13 @@ (****************************** Frames *********************************) -open Instruct +open Events (* Current frame number *) val current_frame : int ref -(* Event at selected position. *) -val selected_event : debug_event option ref +(* Fragment and event at selected position. *) +val selected_event : code_event option ref (* Selected position in source (module, line, column). *) (* Raise `Not_found' if not on an event. *) @@ -48,7 +48,7 @@ val reset_frame : unit -> unit or None if we've encountered a stack frame with no debugging info attached. Stop when the function returns false, or frame with no debugging info reached, or top of stack reached. *) -val do_backtrace : (debug_event option -> bool) -> unit +val do_backtrace : (code_event option -> bool) -> unit (* Return the number of frames in the stack, or (-1) if it can't be determined because some frames have no debugging info. *) diff --git a/debugger/lexer.mll b/debugger/lexer.mll index 8570b152..f6744f79 100644 --- a/debugger/lexer.mll +++ b/debugger/lexer.mll @@ -83,6 +83,8 @@ and lexeme = (* Read a lexeme *) { AT } | "$" { DOLLAR } + | ":" + { COLON } | "!" { BANG } | "(" diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml index f664a278..3cb66a09 100644 --- a/debugger/loadprinter.ml +++ b/debugger/loadprinter.ml @@ -99,10 +99,14 @@ let init () = let match_printer_type desc typename = let printer_type = - try - Env.lookup_type (Ldot(Lident "Topdirs", typename)) Env.empty - with Not_found -> - raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename)))) in + match + Env.find_type_by_name + (Ldot(Lident "Topdirs", typename)) Env.empty + with + | path, _ -> path + | exception Not_found -> + raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename)))) + in Ctype.begin_def(); let ty_arg = Ctype.newvar() in Ctype.unify Env.empty @@ -113,17 +117,18 @@ let match_printer_type desc typename = ty_arg let find_printer_type lid = - try - let (path, desc) = Env.lookup_value lid Env.empty in - let (ty_arg, is_old_style) = - try - (match_printer_type desc "printer_type_new", false) - with Ctype.Unify _ -> - (match_printer_type desc "printer_type_old", true) in - (ty_arg, path, is_old_style) - with - | Not_found -> raise(Error(Unbound_identifier lid)) - | Ctype.Unify _ -> raise(Error(Wrong_type lid)) + match Env.find_value_by_name lid Env.empty with + | (path, desc) -> begin + match match_printer_type desc "printer_type_new" with + | ty_arg -> (ty_arg, path, false) + | exception Ctype.Unify _ -> begin + match match_printer_type desc "printer_type_old" with + | ty_arg -> (ty_arg, path, true) + | exception Ctype.Unify _ -> raise(Error(Wrong_type lid)) + end + end + | exception Not_found -> + raise(Error(Unbound_identifier lid)) let install_printer ppf lid = let (ty_arg, path, is_old_style) = find_printer_type lid in diff --git a/debugger/parser.mly b/debugger/parser.mly index 36864b04..b8789d94 100644 --- a/debugger/parser.mly +++ b/debugger/parser.mly @@ -20,6 +20,7 @@ open Int64ops open Input_handling open Longident open Parser_aux +open Debugcom %} @@ -31,6 +32,7 @@ open Parser_aux %token STAR /* * */ %token MINUS /* - */ %token DOT /* . */ +%token COLON /* : */ %token HASH /* # */ %token AT /* @ */ %token DOLLAR /* $ */ @@ -235,7 +237,9 @@ expression_list_eol : break_argument_eol : end_of_line { BA_none } - | integer_eol { BA_pc $1 } + | integer_eol { BA_pc {frag = 0; pos = $1} } + | INTEGER COLON integer_eol { BA_pc {frag = to_int $1; + pos = $3} } | expression end_of_line { BA_function $1 } | AT opt_longident INTEGER opt_integer_eol { BA_pos1 ($2, (to_int $3), $4)} | AT opt_longident HASH integer_eol { BA_pos2 ($2, $4) } diff --git a/debugger/parser_aux.mli b/debugger/parser_aux.mli index 67c84462..36c383e0 100644 --- a/debugger/parser_aux.mli +++ b/debugger/parser_aux.mli @@ -23,7 +23,7 @@ type expression = type break_arg = BA_none (* break *) - | BA_pc of int (* break PC *) + | BA_pc of Debugcom.pc (* break FRAG PC *) | BA_function of expression (* break FUNCTION *) | BA_pos1 of Longident.t option * int * int option (* break @ [MODULE] LINE [POS] *) diff --git a/debugger/pos.ml b/debugger/pos.ml index cc164e68..2b5b0e2e 100644 --- a/debugger/pos.ml +++ b/debugger/pos.ml @@ -13,14 +13,14 @@ (* *) (**************************************************************************) -open Instruct;; -open Lexing;; -open Location;; +open Instruct +open Lexing +open Location +open Events let get_desc ev = - let loc = ev.ev_loc in + let loc = ev.ev_ev.ev_loc in Printf.sprintf "file %s, line %d, characters %d-%d" loc.loc_start.pos_fname loc.loc_start.pos_lnum (loc.loc_start.pos_cnum - loc.loc_start.pos_bol + 1) (loc.loc_end.pos_cnum - loc.loc_start.pos_bol + 1) -;; diff --git a/debugger/pos.mli b/debugger/pos.mli index f5c37650..31bc341f 100644 --- a/debugger/pos.mli +++ b/debugger/pos.mli @@ -13,4 +13,4 @@ (* *) (**************************************************************************) -val get_desc : Instruct.debug_event -> string;; +val get_desc : Events.code_event -> string;; diff --git a/debugger/printval.ml b/debugger/printval.ml index a6d83ce7..6e634ad1 100644 --- a/debugger/printval.ml +++ b/debugger/printval.ml @@ -99,7 +99,6 @@ let print_named_value max_depth exp env obj ppf ty = | _ -> let n = name_value obj ty in fprintf ppf "$%i" n in - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[<2>%a:@ %a@ =@ %a@]@." print_value_name exp Printtyp.type_expr ty diff --git a/debugger/program_management.ml b/debugger/program_management.ml index a232be2b..318e3f2c 100644 --- a/debugger/program_management.ml +++ b/debugger/program_management.ml @@ -126,7 +126,8 @@ let initialize_loading () = prerr_endline "Program not found."; raise Toplevel; end; - Symbols.read_symbols !program_name; + Symbols.clear_symbols (); + Symbols.read_symbols 0 !program_name; Load_path.init (Load_path.get_paths () @ !Symbols.program_source_dirs); Envaux.reset_cache (); if !debug_loading then @@ -134,7 +135,7 @@ let initialize_loading () = open_connection !socket_name (function () -> go_to _0; - Symbols.set_all_events(); + Symbols.set_all_events 0; exit_main_loop ()) (* Ensure the program is already loaded. *) diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 29fe1fb6..27cdf5f6 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -32,7 +32,7 @@ let show_current_event ppf = fprintf ppf "Time: %Li" (current_time ()); (match current_pc () with | Some pc -> - fprintf ppf " - pc: %i" pc + fprintf ppf " - pc: %i:%i" pc.frag pc.pos | _ -> ()); end; update_current_event (); @@ -43,7 +43,7 @@ let show_current_event ppf = fprintf ppf "Beginning of program.@."; show_no_point () | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} -> - let ev = get_current_event () in + let ev = (get_current_event ()).ev_ev in if !Parameters.time then fprintf ppf " - module %s@." ev.ev_module; (match breakpoints_at_pc pc with | [] -> @@ -68,28 +68,34 @@ let show_current_event ppf = @[Uncaught exception:@ %a@]@." Printval.print_exception (Debugcom.Remote_value.accu ()); show_no_point () - | Some {rep_type = Trap_barrier} -> - (* Trap_barrier not visible outside *) - (* of module `time_travel'. *) + | Some {rep_type = Code_loaded frag} -> + let mds = String.concat ", " (Symbols.modules_in_code_fragment frag) in + fprintf ppf "@.Module(s) %s loaded.@." mds; + show_no_point () + | Some {rep_type = Trap_barrier} + | Some {rep_type = Debug_info _} + | Some {rep_type = Code_unloaded _} -> + (* Not visible outside *) + (* of module `time_travel'. *) if !Parameters.time then fprintf ppf "@."; Misc.fatal_error "Show_information.show_current_event" (* Display short information about one frame. *) -let show_one_frame framenum ppf event = - let pos = Events.get_pos event in +let show_one_frame framenum ppf ev = + let pos = Events.get_pos ev.ev_ev in let cnum = try - let buffer = get_buffer pos event.ev_module in + let buffer = get_buffer pos ev.ev_ev.ev_module in snd (start_and_cnum buffer pos) with _ -> pos.Lexing.pos_cnum in if !machine_readable then - fprintf ppf "#%i Pc: %i %s char %i@." - framenum event.ev_pos event.ev_module + fprintf ppf "#%i Pc: %i:%i %s char %i@." + framenum ev.ev_frag ev.ev_ev.ev_pos ev.ev_ev.ev_module cnum else fprintf ppf "#%i %s %s:%i:%i@." - framenum event.ev_module + framenum ev.ev_ev.ev_module pos.Lexing.pos_fname pos.Lexing.pos_lnum (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1) @@ -101,7 +107,8 @@ let show_current_frame ppf selected = fprintf ppf "@.No frame selected.@." | Some sel_ev -> show_one_frame !current_frame ppf sel_ev; - begin match breakpoints_at_pc sel_ev.ev_pos with + begin match breakpoints_at_pc + {frag=sel_ev.ev_frag; pos = sel_ev.ev_ev.ev_pos} with | [] -> () | [breakpoint] -> fprintf ppf "Breakpoint: %i@." breakpoint @@ -111,4 +118,4 @@ let show_current_frame ppf selected = List.iter (function x -> fprintf ppf "%i " x) l) (List.sort compare breakpoints); end; - show_point sel_ev selected + show_point sel_ev.ev_ev selected diff --git a/debugger/show_information.mli b/debugger/show_information.mli index 2d6b6b01..bc5df9d9 100644 --- a/debugger/show_information.mli +++ b/debugger/show_information.mli @@ -14,14 +14,14 @@ (* *) (**************************************************************************) -open Format;; +open Format (* Display information about the current event. *) -val show_current_event : formatter -> unit;; +val show_current_event : formatter -> unit (* Display information about the current frame. *) (* --- `select frame' must have succeeded before calling this function. *) -val show_current_frame : formatter -> bool -> unit;; +val show_current_frame : formatter -> bool -> unit (* Display short information about one frame. *) -val show_one_frame : int -> formatter -> Instruct.debug_event -> unit +val show_one_frame : int -> formatter -> Events.code_event -> unit diff --git a/debugger/symbols.ml b/debugger/symbols.ml index d22f1a17..8ed9b9db 100644 --- a/debugger/symbols.ml +++ b/debugger/symbols.ml @@ -19,6 +19,8 @@ open Instruct open Debugger_config (* Toplevel *) open Program_loading +open Debugcom +open Events module String = Misc.Stdlib.String let modules = @@ -27,14 +29,12 @@ let modules = let program_source_dirs = ref ([] : string list) -let events = - ref ([] : debug_event list) let events_by_pc = - (Hashtbl.create 257 : (int, debug_event) Hashtbl.t) + (Hashtbl.create 257 : (pc, debug_event) Hashtbl.t) let events_by_module = - (Hashtbl.create 17 : (string, debug_event array) Hashtbl.t) + (Hashtbl.create 17 : (string, int * debug_event array) Hashtbl.t) let all_events_by_module = - (Hashtbl.create 17 : (string, debug_event list) Hashtbl.t) + (Hashtbl.create 17 : (string, int * debug_event list) Hashtbl.t) let partition_modules evl = let rec partition_modules' ev evl = @@ -93,20 +93,18 @@ let read_symbols' bytecode_file = close_in_noerr ic; !eventlists, !dirs -let read_symbols bytecode_file = - let all_events, all_dirs = read_symbols' bytecode_file in - - modules := []; events := []; - program_source_dirs := String.Set.elements all_dirs; +let clear_symbols () = + modules := []; + program_source_dirs := []; Hashtbl.clear events_by_pc; Hashtbl.clear events_by_module; - Hashtbl.clear all_events_by_module; + Hashtbl.clear all_events_by_module +let add_symbols frag all_events = List.iter (fun evl -> List.iter (fun ev -> - events := ev :: !events; - Hashtbl.add events_by_pc ev.ev_pos ev) + Hashtbl.add events_by_pc {frag; pos = ev.ev_pos} ev) evl) all_events; @@ -120,7 +118,7 @@ let read_symbols bytecode_file = in let sorted_evl = List.sort cmp evl in modules := md :: !modules; - Hashtbl.add all_events_by_module md sorted_evl; + Hashtbl.add all_events_by_module md (frag, sorted_evl); let real_evl = List.filter (function @@ -128,20 +126,52 @@ let read_symbols bytecode_file = | _ -> true) sorted_evl in - Hashtbl.add events_by_module md (Array.of_list real_evl)) + Hashtbl.add events_by_module md (frag, Array.of_list real_evl)) all_events +let read_symbols frag bytecode_file = + let all_events, all_dirs = read_symbols' bytecode_file in + program_source_dirs := !program_source_dirs @ (String.Set.elements all_dirs); + add_symbols frag all_events + +let erase_symbols frag = + let pcs = Hashtbl.fold (fun pc _ pcs -> + if pc.frag = frag then pc :: pcs else pcs) + events_by_pc [] + in + List.iter (Hashtbl.remove events_by_pc) pcs; + + let mds = Hashtbl.fold (fun md (frag', _) mds -> + if frag' = frag then md :: mds else mds) + events_by_module [] + in + List.iter (Hashtbl.remove events_by_module) mds; + List.iter (Hashtbl.remove all_events_by_module) mds; + modules := List.filter (fun md -> not (List.mem md mds)) !modules + +let code_fragments () = + let frags = + Hashtbl.fold + (fun _ (frag, _) l -> frag :: l) + all_events_by_module [] + in + List.sort_uniq compare frags + +let modules_in_code_fragment frag' = + Hashtbl.fold (fun md (frag, _) l -> + if frag' = frag then md :: l else l) + all_events_by_module [] + let any_event_at_pc pc = - Hashtbl.find events_by_pc pc + { ev_frag = pc.frag; ev_ev = Hashtbl.find events_by_pc pc } let event_at_pc pc = - let ev = any_event_at_pc pc in - match ev.ev_kind with - Event_pseudo -> raise Not_found - | _ -> ev + match any_event_at_pc pc with + { ev_ev = { ev_kind = Event_pseudo } } -> raise Not_found + | ev -> ev let set_event_at_pc pc = - try ignore(event_at_pc pc); Debugcom.set_event pc + try ignore(event_at_pc pc); set_event pc with Not_found -> () (* List all events in module *) @@ -149,7 +179,7 @@ let events_in_module mdle = try Hashtbl.find all_events_by_module mdle with Not_found -> - [] + 0, [] (* Binary search of event at or just after char *) let find_event ev char = @@ -174,40 +204,40 @@ let find_event ev char = (* Return first event after the given position. *) (* Raise [Not_found] if module is unknown or no event is found. *) let event_at_pos md char = - let ev = Hashtbl.find events_by_module md in - ev.(find_event ev char) + let ev_frag, ev = Hashtbl.find events_by_module md in + { ev_frag; ev_ev = ev.(find_event ev char) } (* Return event closest to given position *) (* Raise [Not_found] if module is unknown or no event is found. *) let event_near_pos md char = - let ev = Hashtbl.find events_by_module md in + let ev_frag, ev = Hashtbl.find events_by_module md in try let pos = find_event ev char in (* Desired event is either ev.(pos) or ev.(pos - 1), whichever is closest *) if pos > 0 && char - (Events.get_pos ev.(pos - 1)).Lexing.pos_cnum <= (Events.get_pos ev.(pos)).Lexing.pos_cnum - char - then ev.(pos - 1) - else ev.(pos) + then { ev_frag; ev_ev = ev.(pos - 1) } + else { ev_frag; ev_ev = ev.(pos) } with Not_found -> let pos = Array.length ev - 1 in if pos < 0 then raise Not_found; - ev.(pos) + { ev_frag; ev_ev = ev.(pos) } (* Flip "event" bit on all instructions *) -let set_all_events () = +let set_all_events frag = Hashtbl.iter - (fun _pc ev -> + (fun pc ev -> match ev.ev_kind with Event_pseudo -> () - | _ -> Debugcom.set_event ev.ev_pos) + | _ when pc.frag = frag -> set_event pc + | _ -> ()) events_by_pc - (* Previous `pc'. *) (* Save time if `update_current_event' is called *) (* several times at the same point. *) -let old_pc = ref (None : int option) +let old_pc = ref (None : pc option) (* Recompute the current event *) let update_current_event () = diff --git a/debugger/symbols.mli b/debugger/symbols.mli index b1fc9d6f..30728f55 100644 --- a/debugger/symbols.mli +++ b/debugger/symbols.mli @@ -14,6 +14,8 @@ (* *) (**************************************************************************) +open Events + (* Modules used by the program. *) val modules : string list ref @@ -21,31 +23,49 @@ val modules : string list ref * compiled *) val program_source_dirs : string list ref -(* Read debugging info from executable file *) -val read_symbols : string -> unit +(* Clear loaded symbols *) +val clear_symbols : unit -> unit + +(* Read debugging info from executable or dynlinkable file + and associate with given code fragment *) +val read_symbols : int -> string -> unit + +(* Add debugging info from memory and associate with given + code fragment *) +val add_symbols : int -> Instruct.debug_event list list -> unit + +(* Erase debugging info associated with given code fragment *) +val erase_symbols : int -> unit -(* Flip "event" bit on all instructions *) -val set_all_events : unit -> unit +(* Return the list of all code fragments that have debug info associated *) +val code_fragments : unit -> int list + +(* Flip "event" bit on all instructions in given fragment *) +val set_all_events : int -> unit (* Return event at given PC, or raise Not_found *) (* Can also return pseudo-event at beginning of functions *) -val any_event_at_pc : int -> Instruct.debug_event +val any_event_at_pc : Debugcom.pc -> code_event (* Return event at given PC, or raise Not_found *) -val event_at_pc : int -> Instruct.debug_event +val event_at_pc : Debugcom.pc -> code_event + (* Set event at given PC *) -val set_event_at_pc : int -> unit +val set_event_at_pc : Debugcom.pc -> unit (* List the events in `module'. *) -val events_in_module : string -> Instruct.debug_event list +val events_in_module : string -> int * Instruct.debug_event list + +(* List the modules in given code fragment. *) +val modules_in_code_fragment : int -> string list (* First event after the given position. *) (* --- Raise `Not_found' if no such event. *) -val event_at_pos : string -> int -> Instruct.debug_event +val event_at_pos : string -> int -> code_event (* Closest event from given position. *) (* --- Raise `Not_found' if no such event. *) -val event_near_pos : string -> int -> Instruct.debug_event +val event_near_pos : string -> int -> code_event (* Recompute the current event *) val update_current_event : unit -> unit diff --git a/debugger/time_travel.ml b/debugger/time_travel.ml index c239a20c..4d3252fb 100644 --- a/debugger/time_travel.ml +++ b/debugger/time_travel.ml @@ -99,6 +99,11 @@ let set_current_checkpoint checkpoint = if not checkpoint.c_valid then wait_for_connection checkpoint; current_checkpoint := checkpoint; + let dead_frags = List.filter (fun frag -> + not (List.mem frag checkpoint.c_code_fragments)) + (Symbols.code_fragments ()) + in + List.iter Symbols.erase_symbols dead_frags; set_current_connection checkpoint.c_fd (* Kill `checkpoint'. *) @@ -231,7 +236,8 @@ let duplicate_current_checkpoint () = c_parent = checkpoint; c_breakpoint_version = checkpoint.c_breakpoint_version; c_breakpoints = checkpoint.c_breakpoints; - c_trap_barrier = checkpoint.c_trap_barrier} + c_trap_barrier = checkpoint.c_trap_barrier; + c_code_fragments = checkpoint.c_code_fragments} in checkpoints := list_replace checkpoint new_checkpoint !checkpoints; set_current_checkpoint checkpoint; @@ -260,6 +266,29 @@ let interrupted = ref false (* Information about last breakpoint encountered *) let last_breakpoint = ref None +(* Last debug info loaded *) +let last_debug_info = ref None + +let rec do_go_dynlink steps = + match do_go steps with + | { rep_type = Code_loaded frag; rep_event_count = steps } as report -> + begin match !last_debug_info with + | Some di -> + Symbols.add_symbols frag di; + Symbols.set_all_events frag; + last_debug_info := None + | None -> assert false + end; + if !break_on_load then report + else do_go_dynlink steps + | { rep_type = Code_unloaded frag; rep_event_count = steps } -> + Symbols.erase_symbols frag; + do_go_dynlink steps + | { rep_type = Debug_info di; rep_event_count = steps } -> + last_debug_info := Some (Array.to_list di); + do_go_dynlink steps + | report -> report + (* Ensure we stop on an event. *) let rec stop_on_event report = match report with @@ -282,7 +311,7 @@ and find_event () = print_string "Searching next event..."; print_newline () end; - let report = do_go _1 in + let report = do_go_dynlink _1 in !current_checkpoint.c_report <- Some report; stop_on_event report @@ -302,9 +331,10 @@ let internal_step duration = update_breakpoints (); update_trap_barrier (); !current_checkpoint.c_state <- C_running duration; - let report = do_go duration in + let report = do_go_dynlink duration in !current_checkpoint.c_report <- Some report; !current_checkpoint.c_state <- C_stopped; + !current_checkpoint.c_code_fragments <- Symbols.code_fragments (); if report.rep_type = Event then begin !current_checkpoint.c_time <- !current_checkpoint.c_time ++ duration; @@ -314,7 +344,7 @@ let internal_step duration = else begin !current_checkpoint.c_time <- !current_checkpoint.c_time ++ duration - -- (Int64.of_int report.rep_event_count) ++ _1; + -- report.rep_event_count ++ _1; interrupted := true; last_breakpoint := None; stop_on_event report @@ -350,7 +380,8 @@ let new_checkpoint pid fd = c_parent = root; c_breakpoint_version = 0; c_breakpoints = []; - c_trap_barrier = 0} + c_trap_barrier = 0; + c_code_fragments = [0]} in insert_checkpoint new_checkpoint @@ -469,7 +500,6 @@ let find_last_breakpoint max_time = (Some (pc, _)) as state when breakpoint_at_pc pc -> state | _ -> None) - (* Run from `time_max' back to `time'. *) (* --- Assume 0 <= time < time_max *) let rec back_to time time_max = @@ -522,9 +552,9 @@ let finish () = None -> prerr_endline "`finish' not meaningful in outermost frame."; raise Toplevel - | Some curr_event -> + | Some {ev_ev={ev_stacksize}} -> set_initial_frame(); - let (frame, pc) = up_frame curr_event.ev_stacksize in + let (frame, pc) = up_frame ev_stacksize in if frame < 0 then begin prerr_endline "`finish' not meaningful in outermost frame."; raise Toplevel @@ -558,18 +588,18 @@ let next_1 () = match !current_event with None -> (* Beginning of the program. *) step _1 - | Some event1 -> + | Some {ev_ev={ev_stacksize=ev_stacksize1}} -> let (frame1, _pc1) = initial_frame() in step _1; if not !interrupted then begin Symbols.update_current_event (); match !current_event with None -> () - | Some event2 -> + | Some {ev_ev={ev_stacksize=ev_stacksize2}} -> let (frame2, _pc2) = initial_frame() in (* Call `finish' if we've entered a function. *) if frame1 >= 0 && frame2 >= 0 && - frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize + frame2 - ev_stacksize2 > frame1 - ev_stacksize1 then finish() end @@ -589,9 +619,9 @@ let start () = None -> prerr_endline "`start not meaningful in outermost frame."; raise Toplevel - | Some curr_event -> + | Some {ev_ev={ev_stacksize}} -> let (frame, _) = initial_frame() in - let (frame', pc) = up_frame curr_event.ev_stacksize in + let (frame', pc) = up_frame ev_stacksize in if frame' < 0 then begin prerr_endline "`start not meaningful in outermost frame."; raise Toplevel @@ -602,11 +632,11 @@ let start () = prerr_endline "Calling function has no debugging information."; raise Toplevel with - {ev_info = Event_return nargs} -> nargs + {ev_ev = {ev_info = Event_return nargs}} -> nargs | _ -> Misc.fatal_error "Time_travel.start" in let offset = if nargs < 4 then 1 else 2 in - let pc = pc - 4 * offset in + let pc = { pc with pos = pc.pos - 4 * offset } in while exec_with_temporary_breakpoint pc back_run; match !last_breakpoint with @@ -614,7 +644,7 @@ let start () = step _minus1; (not !interrupted) && - (frame' - nargs > frame - curr_event.ev_stacksize) + (frame' - nargs > frame - ev_stacksize) | _ -> false do @@ -626,18 +656,18 @@ let previous_1 () = match !current_event with None -> (* End of the program. *) step _minus1 - | Some event1 -> + | Some {ev_ev={ev_stacksize=ev_stacksize1}} -> let (frame1, _pc1) = initial_frame() in step _minus1; if not !interrupted then begin Symbols.update_current_event (); match !current_event with None -> () - | Some event2 -> + | Some {ev_ev={ev_stacksize=ev_stacksize2}} -> let (frame2, _pc2) = initial_frame() in (* Call `start' if we've entered a function. *) if frame1 >= 0 && frame2 >= 0 && - frame2 - event2.ev_stacksize > frame1 - event1.ev_stacksize + frame2 - ev_stacksize2 > frame1 - ev_stacksize1 then start() end diff --git a/driver/compenv.ml b/driver/compenv.ml index d5dde211..90f42d8c 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -239,6 +239,8 @@ let read_one_param ppf position name v = | "clambda-checks" -> set "clambda-checks" [ clambda_checks ] v + | "function-sections" -> + set "function-sections" [ Clflags.function_sections ] v (* assembly sources *) | "s" -> set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v @@ -659,7 +661,7 @@ let process_deferred_actions env = if List.length (List.filter (function | ProcessImplementation _ - | ProcessInterface _ + | ProcessInterface _ -> true | _ -> false) !deferred_actions) > 1 then fatal "Options -c -o are incompatible with compiling multiple files" end; diff --git a/driver/main.ml b/driver/main.ml index a649d24a..adf66644 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -21,132 +21,7 @@ let usage = "Usage: ocamlc \nOptions are:" (* Error messages to standard error formatter *) let ppf = Format.err_formatter -let vmthread_removed_message = "\ -The -vmthread argument of ocamlc is no longer supported\n\ -since OCaml 4.09.0. Please switch to system threads, which have the\n\ -same API. Lightweight threads with VM-level scheduling are provided by\n\ -third-party libraries such as Lwt, but with a different API." - -module Options = Main_args.Make_bytecomp_options (struct - let set r () = r := true - let unset r () = r := false - let _a = set make_archive - let _absname = set Clflags.absname - let _alert = Warnings.parse_alert_option - let _annot = set annotations - let _binannot = set binary_annotations - let _c = set compile_only - let _cc s = c_compiler := Some s - let _cclib s = Compenv.defer (ProcessObjects (Misc.rev_split_words s)) - let _ccopt s = first_ccopts := s :: !first_ccopts - let _compat_32 = set bytecode_compatible_32 - let _config = Misc.show_config_and_exit - let _config_var = Misc.show_config_variable_and_exit - let _custom = set custom_runtime - let _no_check_prims = set no_check_prims - let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s)) - let _dllpath s = dllpaths := !dllpaths @ [s] - let _for_pack s = for_package := Some s - let _g = set debug - let _i () = - print_types := true; - compile_only := true; - stop_after := Some Compiler_pass.Typing; - () - let _stop_after pass = - let module P = Compiler_pass in - begin match P.of_string pass with - | None -> () (* this should not occur as we use Arg.Symbol *) - | Some pass -> - stop_after := Some pass; - begin match pass with - | P.Parsing | P.Typing -> - compile_only := true - end; - end - let _I s = include_dirs := s :: !include_dirs - let _impl = impl - let _intf = intf - let _intf_suffix s = Config.interface_suffix := s - let _keep_docs = set keep_docs - let _no_keep_docs = unset keep_docs - let _keep_locs = set keep_locs - let _no_keep_locs = unset keep_locs - let _labels = unset classic - let _linkall = set link_everything - let _make_runtime () = - custom_runtime := true; make_runtime := true; link_everything := true - let _alias_deps = unset transparent_modules - let _no_alias_deps = set transparent_modules - let _app_funct = set applicative_functors - let _no_app_funct = unset applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noautolink = set no_auto_link - let _nostdlib = set no_std_include - let _o s = output_name := Some s - let _opaque = set opaque - let _open s = open_modules := s :: !open_modules - let _output_obj () = output_c_object := true; custom_runtime := true - let _output_complete_obj () = - output_c_object := true; - output_complete_object := true; - custom_runtime := true - let _pack = set make_package - let _pp s = preprocessor := Some s - let _ppx s = first_ppx := s :: !first_ppx - let _plugin _p = plugin := true - let _principal = set principal - let _no_principal = unset principal - let _rectypes = set recursive_types - let _no_rectypes = unset recursive_types - let _runtime_variant s = runtime_variant := s - let _with_runtime = set with_runtime - let _without_runtime = unset with_runtime - let _safe_string = unset unsafe_string - let _short_paths = unset real_paths - let _strict_sequence = set strict_sequence - let _no_strict_sequence = unset strict_sequence - let _strict_formats = set strict_formats - let _no_strict_formats = unset strict_formats - let _thread = set use_threads - let _vmthread = fun () -> fatal vmthread_removed_message - let _unboxed_types = set unboxed_types - let _no_unboxed_types = unset unboxed_types - let _unsafe = set unsafe - let _unsafe_string = set unsafe_string - let _use_prims s = use_prims := s - let _use_runtime s = use_runtime := s - let _v () = print_version_and_library "compiler" - let _version = print_version_string - let _vnum = print_version_string - let _w = (Warnings.parse_options false) - let _warn_error = (Warnings.parse_options true) - let _warn_help = Warnings.help_warnings - let _color = Misc.set_or_ignore color_reader.parse color - let _error_style = Misc.set_or_ignore error_style_reader.parse error_style - let _where = print_standard_library - let _verbose = set verbose - let _nopervasives = set nopervasives - let _match_context_rows n = match_context_rows := n - let _dump_into_file = set dump_into_file - let _dno_unique_ids = unset unique_ids - let _dunique_ids = set unique_ids - let _dsource = set dump_source - let _dparsetree = set dump_parsetree - let _dtypedtree = set dump_typedtree - let _drawlambda = set dump_rawlambda - let _dlambda = set dump_lambda - let _dinstr = set dump_instr - let _dcamlprimc = set keep_camlprimc_file - let _dtimings () = profile_columns := [ `Time ] - let _dprofile () = profile_columns := Profile.all_columns - - let _args = Arg.read_arg - let _args0 = Arg.read_arg0 - - let anonymous = anonymous -end) +module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main) let main () = Clflags.add_arguments __LOC__ Options.list; @@ -209,7 +84,7 @@ let main () = end else if not !compile_only && !objfiles <> [] then begin let target = - if !output_c_object then + if !output_c_object && not !output_complete_executable then let s = extract_output !output_name in if (Filename.check_suffix s Config.ext_obj || Filename.check_suffix s Config.ext_dll diff --git a/driver/main_args.ml b/driver/main_args.ml index b7e3c082..8a6c1b83 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -94,6 +94,18 @@ let mk_dllpath f = " Add to the run-time search path for shared libraries" ;; +let mk_function_sections f = + if Config.function_sections then + "-function-sections", Arg.Unit f, + " Generate each function in a separate section if target supports it" + else + let err () = + raise (Arg.Bad "OCaml has been configured without support for \ + -function-sections") + in + "-function-sections", Arg.Unit err, " (option not available)" +;; + let mk_stop_after f = "-stop-after", Arg.Symbol (Clflags.Compiler_pass.pass_names, f), " Stop after the given compilation pass." @@ -400,6 +412,11 @@ let mk_output_complete_obj f = " Output an object file, including runtime, instead of an executable" ;; +let mk_output_complete_exe f = + "-output-complete-exe", Arg.Unit f, + " Output a self-contained executable, including runtime and C stubs" +;; + let mk_p f = "-p", Arg.Unit f, " (no longer supported)" ;; @@ -872,7 +889,6 @@ module type Common_options = sig val _noassert : unit -> unit val _nolabels : unit -> unit val _nostdlib : unit -> unit - val _nopervasives : unit -> unit val _open : string -> unit val _ppx : string -> unit val _principal : unit -> unit @@ -887,11 +903,19 @@ module type Common_options = sig val _no_strict_formats : unit -> unit val _unboxed_types : unit -> unit val _no_unboxed_types : unit -> unit - val _unsafe : unit -> unit val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit + + val anonymous : string -> unit +end + +module type Core_options = sig + include Common_options + + val _nopervasives : unit -> unit + val _unsafe : unit -> unit val _warn_error : string -> unit val _warn_help : unit -> unit @@ -903,7 +927,6 @@ module type Common_options = sig val _drawlambda : unit -> unit val _dlambda : unit -> unit - val anonymous : string -> unit end module type Compiler_options = sig @@ -962,7 +985,7 @@ end ;; module type Toplevel_options = sig - include Common_options + include Core_options val _init : string -> unit val _noinit : unit -> unit val _no_version : unit -> unit @@ -977,7 +1000,7 @@ end ;; module type Bytecomp_options = sig - include Common_options + include Core_options include Compiler_options val _compat_32 : unit -> unit val _custom : unit -> unit @@ -987,6 +1010,7 @@ module type Bytecomp_options = sig val _make_runtime : unit -> unit val _vmthread : unit -> unit val _use_runtime : string -> unit + val _output_complete_exe : unit -> unit val _dinstr : unit -> unit val _dcamlprimc : unit -> unit @@ -1026,6 +1050,8 @@ module type Optcommon_options = sig val _o3 : unit -> unit val _insn_sched : unit -> unit val _no_insn_sched : unit -> unit + val _linscan : unit -> unit + val _no_float_const_prop : unit -> unit val _clambda_checks : unit -> unit val _dflambda : unit -> unit @@ -1051,15 +1077,14 @@ module type Optcommon_options = sig val _dreload : unit -> unit val _dscheduling : unit -> unit val _dlinear : unit -> unit + val _dinterval : unit -> unit val _dstartup : unit -> unit end;; module type Optcomp_options = sig - include Common_options + include Core_options include Compiler_options include Optcommon_options - val _linscan : unit -> unit - val _no_float_const_prop : unit -> unit val _nodynlink : unit -> unit val _p : unit -> unit val _pp : string -> unit @@ -1067,7 +1092,7 @@ module type Optcomp_options = sig val _shared : unit -> unit val _afl_instrument : unit -> unit val _afl_inst_ratio : int -> unit - val _dinterval : unit -> unit + val _function_sections : unit -> unit end;; module type Opttop_options = sig @@ -1147,6 +1172,7 @@ struct mk_open F._open; mk_output_obj F._output_obj; mk_output_complete_obj F._output_complete_obj; + mk_output_complete_exe F._output_complete_exe; mk_pack_byt F._pack; mk_pp F._pp; mk_ppx F._ppx; @@ -1289,6 +1315,7 @@ struct mk_dtypes F._annot; mk_for_pack_opt F._for_pack; mk_g_opt F._g; + mk_function_sections F._function_sections; mk_stop_after F._stop_after; mk_i F._i; mk_I F._I; @@ -1441,8 +1468,10 @@ module Make_opttop_options (F : Opttop_options) = struct mk_labels F._labels; mk_alias_deps F._alias_deps; mk_no_alias_deps F._no_alias_deps; + mk_linscan F._linscan; mk_app_funct F._app_funct; mk_no_app_funct F._no_app_funct; + mk_no_float_const_prop F._no_float_const_prop; mk_noassert F._noassert; mk_noinit F._noinit; mk_nolabels F._nolabels; @@ -1510,6 +1539,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_dreload F._dreload; mk_dscheduling F._dscheduling; mk_dlinear F._dlinear; + mk_dinterval F._dinterval; mk_dstartup F._dstartup; mk_dump_pass F._dump_pass; ] @@ -1604,3 +1634,335 @@ let options_with_command_line_syntax options r = options_with_command_line_syntax_inner r rest ~name_opt:(Some name) spec, doc) ) options + +module Default = struct + open Clflags + open Compenv + let set r () = r := true + let clear r () = r := false + + module Common = struct + let _absname = set Clflags.absname + let _alert = Warnings.parse_alert_option + let _alias_deps = clear transparent_modules + let _app_funct = set applicative_functors + let _labels = clear classic + let _no_alias_deps = set transparent_modules + let _no_app_funct = clear applicative_functors + let _no_principal = clear principal + let _no_rectypes = clear recursive_types + let _no_strict_formats = clear strict_formats + let _no_strict_sequence = clear strict_sequence + let _no_unboxed_types = clear unboxed_types + let _noassert = set noassert + let _nolabels = set classic + let _nostdlib = set no_std_include + let _open s = open_modules := (s :: (!open_modules)) + let _principal = set principal + let _rectypes = set recursive_types + let _safe_string = clear unsafe_string + let _short_paths = clear real_paths + let _strict_formats = set strict_formats + let _strict_sequence = set strict_sequence + let _unboxed_types = set unboxed_types + let _unsafe_string = set unsafe_string + let _w s = Warnings.parse_options false s + + let anonymous = anonymous + + end + + module Core = struct + include Common + let _I dir = include_dirs := (dir :: (!include_dirs)) + let _color = Misc.set_or_ignore color_reader.parse color + let _dlambda = set dump_lambda + let _dno_unique_ids = clear unique_ids + let _dparsetree = set dump_parsetree + let _drawlambda = set dump_rawlambda + let _dsource = set dump_source + let _dtypedtree = set dump_typedtree + let _dunique_ids = set unique_ids + let _error_style = + Misc.set_or_ignore error_style_reader.parse error_style + let _nopervasives = set nopervasives + let _ppx s = first_ppx := (s :: (!first_ppx)) + let _unsafe = set unsafe + let _warn_error s = Warnings.parse_options true s + let _warn_help = Warnings.help_warnings + end + + module Native = struct + let _S = set keep_asm_file + let _clambda_checks () = clambda_checks := true + let _classic_inlining () = classic_inlining := true + let _compact = clear optimize_for_speed + let _dalloc = set dump_regalloc + let _davail () = dump_avail := true + let _dclambda = set dump_clambda + let _dcmm = set dump_cmm + let _dcombine = set dump_combine + let _dcse = set dump_cse + let _dflambda = set dump_flambda + let _dflambda_invariants = set flambda_invariant_checks + let _dflambda_let stamp = dump_flambda_let := (Some stamp) + let _dflambda_no_invariants = clear flambda_invariant_checks + let _dflambda_verbose () = + set dump_flambda (); set dump_flambda_verbose () + let _dinterval = set dump_interval + let _dinterf = set dump_interf + let _dlinear = set dump_linear + let _dlive () = dump_live := true + let _dprefer = set dump_prefer + let _drawclambda = set dump_rawclambda + let _drawflambda = set dump_rawflambda + let _dreload = set dump_reload + let _drunavail () = debug_runavail := true + let _dscheduling = set dump_scheduling + let _dsel = set dump_selection + let _dspill = set dump_spill + let _dsplit = set dump_split + let _dstartup = set keep_startup_file + let _dump_pass pass = set_dumped_pass pass true + let _inline spec = + Float_arg_helper.parse spec "Syntax: -inline | =[,...]" + inline_threshold + let _inline_alloc_cost spec = + Int_arg_helper.parse spec + "Syntax: -inline-alloc-cost | =[,...]" + inline_alloc_cost + let _inline_branch_cost spec = + Int_arg_helper.parse spec + "Syntax: -inline-branch-cost | =[,...]" + inline_branch_cost + let _inline_branch_factor spec = + Float_arg_helper.parse spec + "Syntax: -inline-branch-factor | =[,...]" + inline_branch_factor + let _inline_call_cost spec = + Int_arg_helper.parse spec + "Syntax: -inline-call-cost | =[,...]" inline_call_cost + let _inline_indirect_cost spec = + Int_arg_helper.parse spec + "Syntax: -inline-indirect-cost | =[,...]" + inline_indirect_cost + let _inline_lifting_benefit spec = + Int_arg_helper.parse spec + "Syntax: -inline-lifting-benefit | =[,...]" + inline_lifting_benefit + let _inline_max_depth spec = + Int_arg_helper.parse spec + "Syntax: -inline-max-depth | =[,...]" inline_max_depth + let _inline_max_unroll spec = + Int_arg_helper.parse spec + "Syntax: -inline-max-unroll | =[,...]" + inline_max_unroll + let _inline_prim_cost spec = + Int_arg_helper.parse spec + "Syntax: -inline-prim-cost | =[,...]" inline_prim_cost + let _inline_toplevel spec = + Int_arg_helper.parse spec + "Syntax: -inline-toplevel | =[,...]" + inline_toplevel_threshold + let _inlining_report () = inlining_report := true + let _insn_sched = set insn_sched + let _no_insn_sched = clear insn_sched + let _linscan = set use_linscan + let _no_float_const_prop = clear float_const_prop + let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures + let _no_unbox_specialised_args = clear unbox_specialised_args + (* CR-someday 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. + mshinwell: We're going to defer this for the moment and add a note in + the manual that the behaviour is unspecified in cases such as this. + We should refactor the code so that the user's requirements are + collected, then checked all at once for illegal combinations, and then + transformed into the settings of the individual parameters. + *) + let _o2 () = + default_simplify_rounds := 2; + use_inlining_arguments_set o2_arguments; + use_inlining_arguments_set ~round:0 o1_arguments + let _o3 () = + default_simplify_rounds := 3; + use_inlining_arguments_set o3_arguments; + use_inlining_arguments_set ~round:1 o2_arguments; + use_inlining_arguments_set ~round:0 o1_arguments + let _remove_unused_arguments = set remove_unused_arguments + let _rounds n = simplify_rounds := (Some n) + let _unbox_closures = set unbox_closures + let _unbox_closures_factor f = unbox_closures_factor := f + let _verbose = set verbose + end + + module Compiler = struct + let _a = set make_archive + let _annot = set annotations + let _args = Arg.read_arg + let _args0 = Arg.read_arg0 + let _binannot = set binary_annotations + let _c = set compile_only + let _cc s = c_compiler := (Some s) + let _cclib s = defer (ProcessObjects (Misc.rev_split_words s)) + let _ccopt s = first_ccopts := (s :: (!first_ccopts)) + let _config = Misc.show_config_and_exit + let _config_var = Misc.show_config_variable_and_exit + let _dprofile () = profile_columns := Profile.all_columns + let _dtimings () = profile_columns := [`Time] + let _dump_into_file = set dump_into_file + let _for_pack s = for_package := (Some s) + let _g = set debug + let _i () = + print_types := true; + compile_only := true; + stop_after := (Some Compiler_pass.Typing); + () + let _impl = impl + let _intf = intf + let _intf_suffix s = Config.interface_suffix := s + let _keep_docs = set keep_docs + let _keep_locs = set keep_locs + let _linkall = set link_everything + let _match_context_rows n = match_context_rows := n + let _no_keep_docs = clear keep_docs + let _no_keep_locs = clear keep_locs + let _noautolink = set no_auto_link + let _o s = output_name := (Some s) + let _opaque = set opaque + let _pack = set make_package + let _plugin _p = plugin := true + let _pp s = preprocessor := (Some s) + let _runtime_variant s = runtime_variant := s + let _stop_after pass = + let module P = Compiler_pass in + match P.of_string pass with + | None -> () (* this should not occur as we use Arg.Symbol *) + | Some pass -> + stop_after := (Some pass); + match pass with + | P.Parsing | P.Typing -> compile_only := true + let _thread = set use_threads + let _verbose = set verbose + let _version () = print_version_string () + let _vnum () = print_version_string () + let _where () = print_standard_library () + let _with_runtime = set with_runtime + let _without_runtime = clear with_runtime + end + + module Toplevel = struct + + let print_version () = + Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version; + exit 0; + ;; + + let print_version_num () = + Printf.printf "%s\n" Sys.ocaml_version; + exit 0; + ;; + + let _args (_:string) = (* placeholder: wrap_expand Arg.read_arg *) [||] + let _args0 (_:string) = (* placeholder: wrap_expand Arg.read_arg0 *) [||] + let _init s = init_file := (Some s) + let _no_version = set noversion + let _noinit = set noinit + let _noprompt = set noprompt + let _nopromptcont = set nopromptcont + let _stdin () = (* placeholder: file_argument ""*) () + let _version () = print_version () + let _vnum () = print_version_num () + end + + module Topmain = struct + include Toplevel + include Core + let _dinstr = set dump_instr + end + + module Opttopmain = struct + include Toplevel + include Native + include Core + end + + module Optmain = struct + include Native + include Core + include Compiler + let _afl_inst_ratio n = afl_inst_ratio := n + let _afl_instrument = set afl_instrument + let _function_sections () = + assert Config.function_sections; + first_ccopts := ("-ffunction-sections" :: (!first_ccopts)); + function_sections := true + let _nodynlink = clear dlcode + let _output_complete_obj () = + set output_c_object (); set output_complete_object () + let _output_obj = set output_c_object + let _p () = + fatal + "Profiling with \"gprof\" (option `-p') is only supported up to \ + OCaml 4.08.0" + let _shared () = shared := true; dlcode := true + let _v () = print_version_and_library "native-code compiler" + end + + module Odoc_args = struct + include Common + let _I(_:string) = + (* placeholder: + Odoc_global.include_dirs := (s :: (!Odoc_global.include_dirs)) + *) () + let _impl (_:string) = + (* placeholder: + Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s]) + *) () + let _intf (_:string) = (* placeholder: + Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Intf_file s]) + *) () + let _intf_suffix s = Config.interface_suffix := s + let _pp s = Clflags.preprocessor := (Some s) + let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx)) + let _thread = set Clflags.use_threads + let _v () = Compenv.print_version_and_library "documentation generator" + let _verbose = set Clflags.verbose + let _version = Compenv.print_version_string + let _vmthread = ignore + let _vnum = Compenv.print_version_string + end + + module Main = struct + + let vmthread_removed_message = "\ +The -vmthread argument of ocamlc is no longer supported\n\ +since OCaml 4.09.0. Please switch to system threads, which have the\n\ +same API. Lightweight threads with VM-level scheduling are provided by\n\ +third-party libraries such as Lwt, but with a different API." + + include Core + include Compiler + let _compat_32 = set bytecode_compatible_32 + let _custom = set custom_runtime + let _dcamlprimc = set keep_camlprimc_file + let _dinstr = set dump_instr + let _dllib s = defer (ProcessDLLs (Misc.rev_split_words s)) + let _dllpath s = dllpaths := ((!dllpaths) @ [s]) + let _make_runtime () = + custom_runtime := true; make_runtime := true; link_everything := true + let _no_check_prims = set no_check_prims + let _output_complete_obj () = + output_c_object := true; + output_complete_object := true; + custom_runtime := true + let _output_complete_exe () = + _output_complete_obj (); output_complete_executable := true + let _output_obj () = output_c_object := true; custom_runtime := true + let _use_prims s = use_prims := s + let _use_runtime s = use_runtime := s + let _v () = print_version_and_library "compiler" + let _vmthread () = fatal vmthread_removed_message + end + +end diff --git a/driver/main_args.mli b/driver/main_args.mli index 64067b2c..56e03ba8 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -28,7 +28,6 @@ module type Common_options = sig val _noassert : unit -> unit val _nolabels : unit -> unit val _nostdlib : unit -> unit - val _nopervasives : unit -> unit val _open : string -> unit val _ppx : string -> unit val _principal : unit -> unit @@ -43,11 +42,19 @@ module type Common_options = sig val _no_strict_formats : unit -> unit val _unboxed_types : unit -> unit val _no_unboxed_types : unit -> unit - val _unsafe : unit -> unit val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit + + val anonymous : string -> unit +end + +module type Core_options = sig + include Common_options + + val _nopervasives : unit -> unit + val _unsafe : unit -> unit val _warn_error : string -> unit val _warn_help : unit -> unit @@ -59,8 +66,7 @@ module type Common_options = sig val _drawlambda : unit -> unit val _dlambda : unit -> unit - val anonymous : string -> unit -end;; +end module type Compiler_options = sig val _a : unit -> unit @@ -118,23 +124,22 @@ end ;; module type Toplevel_options = sig - include Common_options + include Core_options val _init : string -> unit val _noinit : unit -> unit val _no_version : unit -> unit val _noprompt : unit -> unit val _nopromptcont : unit -> unit val _stdin : unit -> unit - val _args: string -> string array - val _args0: string -> string array + val _args : string -> string array + val _args0 : string -> string array val _color : string -> unit val _error_style : string -> unit - end ;; module type Bytecomp_options = sig - include Common_options + include Core_options include Compiler_options val _compat_32 : unit -> unit val _custom : unit -> unit @@ -144,6 +149,7 @@ module type Bytecomp_options = sig val _make_runtime : unit -> unit val _vmthread : unit -> unit val _use_runtime : string -> unit + val _output_complete_exe : unit -> unit val _dinstr : unit -> unit val _dcamlprimc : unit -> unit @@ -154,6 +160,7 @@ end;; module type Bytetop_options = sig include Toplevel_options val _dinstr : unit -> unit + end;; module type Optcommon_options = sig @@ -182,6 +189,8 @@ module type Optcommon_options = sig val _o3 : unit -> unit val _insn_sched : unit -> unit val _no_insn_sched : unit -> unit + val _linscan : unit -> unit + val _no_float_const_prop : unit -> unit val _clambda_checks : unit -> unit val _dflambda : unit -> unit @@ -207,15 +216,14 @@ module type Optcommon_options = sig val _dreload : unit -> unit val _dscheduling : unit -> unit val _dlinear : unit -> unit + val _dinterval : unit -> unit val _dstartup : unit -> unit end;; module type Optcomp_options = sig - include Common_options + include Core_options include Compiler_options include Optcommon_options - val _linscan : unit -> unit - val _no_float_const_prop : unit -> unit val _nodynlink : unit -> unit val _p : unit -> unit val _pp : string -> unit @@ -223,7 +231,7 @@ module type Optcomp_options = sig val _shared : unit -> unit val _afl_instrument : unit -> unit val _afl_inst_ratio : int -> unit - val _dinterval : unit -> unit + val _function_sections : unit -> unit end;; module type Opttop_options = sig @@ -243,17 +251,17 @@ module type Ocamldoc_options = sig val _v : unit -> unit val _verbose : unit -> unit val _vmthread : unit -> unit -end;; +end module type Arg_list = sig val list : (string * Arg.spec * string) list end;; -module Make_bytecomp_options (F : Bytecomp_options) : Arg_list;; -module Make_bytetop_options (F : Bytetop_options) : Arg_list;; -module Make_optcomp_options (F : Optcomp_options) : Arg_list;; -module Make_opttop_options (F : Opttop_options) : Arg_list;; -module Make_ocamldoc_options (F : Ocamldoc_options) : Arg_list;; +module Make_bytecomp_options : Bytecomp_options -> Arg_list;; +module Make_bytetop_options : Bytetop_options -> Arg_list;; +module Make_optcomp_options : Optcomp_options -> Arg_list;; +module Make_opttop_options : Opttop_options -> Arg_list;; +module Make_ocamldoc_options : Ocamldoc_options -> Arg_list;; (** [options_with_command_line_syntax options r] returns [options2] that behaves like [options], but additionally pushes command line argument on [r] (quoted @@ -264,3 +272,11 @@ val options_with_command_line_syntax : (string * Arg.spec * string) list -> string list ref -> (string * Arg.spec * string) list + +module Default: sig + module Topmain: Bytetop_options + module Opttopmain: Opttop_options + module Main: Bytecomp_options + module Optmain: Optcomp_options + module Odoc_args: Ocamldoc_options +end diff --git a/driver/makedepend.ml b/driver/makedepend.ml index d9494056..4942eab0 100644 --- a/driver/makedepend.ml +++ b/driver/makedepend.ml @@ -578,7 +578,7 @@ let main () = "-all", Arg.Set all_dependencies, " Generate dependencies on all files"; "-allow-approx", Arg.Set allow_approximation, - " Fallback to a lexer-based approximation on unparseable files"; + " Fallback to a lexer-based approximation on unparsable files"; "-as-map", Arg.Set Clflags.transparent_modules, " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)"; (* "compiler uses -no-alias-deps, and no module is coerced"; *) diff --git a/driver/ocamlcomp.sh.in b/driver/ocamlcomp.sh.in deleted file mode 100644 index fb011c8b..00000000 --- a/driver/ocamlcomp.sh.in +++ /dev/null @@ -1,20 +0,0 @@ -#!/bin/sh - -#************************************************************************** -#* * -#* OCaml * -#* * -#* Jacques Garrigue, Kyoto University RIMS * -#* * -#* Copyright 2002 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -topdir=`dirname $0` - -exec @compiler@ -nostdlib -I $topdir/stdlib "$@" diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 0af391cc..9ca93c33 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -48,17 +48,22 @@ let flambda i backend typed = |>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda |>> Simplif.simplify_lambda |>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda - |> (fun ((module_ident, size), lam) -> - Flambda_middle_end.middle_end - ~ppf_dump:i.ppf_dump - ~prefixname:i.output_prefix - ~size - ~filename:i.source_file - ~module_ident + |> (fun ((module_ident, main_module_block_size), code) -> + let program : Lambda.program = + { Lambda. + module_ident; + main_module_block_size; + required_globals; + code; + } + in + Asmgen.compile_implementation ~backend - ~module_initializer:lam) - |> Asmgen.compile_implementation_flambda - i.output_prefix ~required_globals ~backend ~ppf_dump:i.ppf_dump; + ~filename:i.source_file + ~prefixname:i.output_prefix + ~middle_end:Flambda_middle_end.lambda_to_clambda + ~ppf_dump:i.ppf_dump + program); Compilenv.save_unit_info (cmx i)) let clambda i backend typed = @@ -72,8 +77,12 @@ let clambda i backend typed = let code = Simplif.simplify_lambda program.Lambda.code in { program with Lambda.code } |> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program - |> Asmgen.compile_implementation_clambda - i.output_prefix ~backend ~ppf_dump:i.ppf_dump; + |> Asmgen.compile_implementation + ~backend + ~filename:i.source_file + ~prefixname:i.output_prefix + ~middle_end:Closure_middle_end.lambda_to_clambda + ~ppf_dump:i.ppf_dump; Compilenv.save_unit_info (cmx i)) let implementation ~backend ~source_file ~output_prefix = diff --git a/driver/optmain.ml b/driver/optmain.ml index 59e531e4..f26631d7 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -36,225 +36,7 @@ let backend = (module Backend : Backend_intf.S) let usage = "Usage: ocamlopt \nOptions are:" -module Options = Main_args.Make_optcomp_options (struct - let set r () = r := true - let clear r () = r := false - - let _a = set make_archive - let _absname = set Clflags.absname - let _afl_instrument = set afl_instrument - let _afl_inst_ratio n = afl_inst_ratio := n - let _alert = Warnings.parse_alert_option - let _annot = set annotations - let _binannot = set binary_annotations - let _c = set compile_only - let _cc s = c_compiler := Some s - let _cclib s = defer (ProcessObjects (Misc.rev_split_words s)) - let _ccopt s = first_ccopts := s :: !first_ccopts - let _clambda_checks () = clambda_checks := true - let _compact = clear optimize_for_speed - let _config = Misc.show_config_and_exit - let _config_var = Misc.show_config_variable_and_exit - let _for_pack s = for_package := Some s - let _g = set debug - let _i () = - print_types := true; - compile_only := true; - stop_after := Some Compiler_pass.Typing; - () - let _stop_after pass = - let module P = Compiler_pass in - begin match P.of_string pass with - | None -> () (* this should not occur as we use Arg.Symbol *) - | Some pass -> - stop_after := Some pass; - begin match pass with - | P.Parsing | P.Typing -> - compile_only := true - end; - end - let _I dir = include_dirs := dir :: !include_dirs - let _impl = impl - let _inline spec = - Float_arg_helper.parse spec - "Syntax: -inline | =[,...]" inline_threshold - let _inline_toplevel spec = - Int_arg_helper.parse spec - "Syntax: -inline-toplevel | =[,...]" - inline_toplevel_threshold - let _inlining_report () = inlining_report := true - let _dump_pass pass = set_dumped_pass pass true - let _rounds n = simplify_rounds := Some n - let _inline_max_unroll spec = - Int_arg_helper.parse spec - "Syntax: -inline-max-unroll | =[,...]" - inline_max_unroll - let _classic_inlining () = classic_inlining := true - let _inline_call_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-call-cost | =[,...]" - inline_call_cost - let _inline_alloc_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-alloc-cost | =[,...]" - inline_alloc_cost - let _inline_prim_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-prim-cost | =[,...]" - inline_prim_cost - let _inline_branch_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-branch-cost | =[,...]" - inline_branch_cost - let _inline_indirect_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-indirect-cost | =[,...]" - inline_indirect_cost - let _inline_lifting_benefit spec = - Int_arg_helper.parse spec - "Syntax: -inline-lifting-benefit | =[,...]" - inline_lifting_benefit - let _inline_branch_factor spec = - Float_arg_helper.parse spec - "Syntax: -inline-branch-factor | =[,...]" - inline_branch_factor - let _intf_suffix s = Config.interface_suffix := s - let _insn_sched = set insn_sched - let _intf = intf - let _keep_docs = set keep_docs - let _no_keep_docs = clear keep_docs - let _keep_locs = set keep_locs - let _no_keep_locs = clear keep_locs - let _labels = clear classic - let _linkall = set link_everything - let _inline_max_depth spec = - Int_arg_helper.parse spec - "Syntax: -inline-max-depth | =[,...]" - inline_max_depth - let _alias_deps = clear transparent_modules - let _no_alias_deps = set transparent_modules - let _linscan = set use_linscan - let _app_funct = set applicative_functors - 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_insn_sched = clear insn_sched - let _nolabels = set classic - let _nostdlib = set no_std_include - let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures - let _no_unbox_specialised_args = clear unbox_specialised_args - let _o s = output_name := Some s - (* CR-someday 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. - mshinwell: We're going to defer this for the moment and add a note in - the manual that the behaviour is unspecified in cases such as this. - We should refactor the code so that the user's requirements are - collected, then checked all at once for illegal combinations, and then - transformed into the settings of the individual parameters. - *) - let _o2 () = - default_simplify_rounds := 2; - use_inlining_arguments_set o2_arguments; - use_inlining_arguments_set ~round:0 o1_arguments - let _o3 () = - default_simplify_rounds := 3; - use_inlining_arguments_set o3_arguments; - use_inlining_arguments_set ~round:1 o2_arguments; - use_inlining_arguments_set ~round:0 o1_arguments - let _open s = open_modules := s :: !open_modules - let _output_obj = set output_c_object - let _output_complete_obj () = - set output_c_object (); set output_complete_object () - let _p () = - fatal "Profiling with \"gprof\" (option `-p') is only supported up \ - to OCaml 4.08.0" - let _pack = set make_package - let _plugin _p = plugin := true - let _pp s = preprocessor := Some s - let _ppx s = first_ppx := s :: !first_ppx - let _principal = set principal - let _no_principal = clear principal - let _rectypes = set recursive_types - let _no_rectypes = clear recursive_types - let _remove_unused_arguments = set remove_unused_arguments - let _runtime_variant s = runtime_variant := s - let _with_runtime = set with_runtime - let _without_runtime = clear with_runtime - let _safe_string = clear unsafe_string - let _short_paths = clear real_paths - let _strict_sequence = set strict_sequence - let _no_strict_sequence = clear strict_sequence - let _strict_formats = set strict_formats - let _no_strict_formats = clear strict_formats - let _shared () = shared := true; dlcode := true - let _S = set keep_asm_file - let _thread = set use_threads - let _unbox_closures = set unbox_closures - let _unbox_closures_factor f = unbox_closures_factor := f - let _unboxed_types = set unboxed_types - let _no_unboxed_types = clear unboxed_types - let _unsafe = set unsafe - let _unsafe_string = set unsafe_string - let _v () = print_version_and_library "native-code compiler" - let _version () = print_version_string () - let _vnum () = print_version_string () - let _verbose = set verbose - let _w s = Warnings.parse_options false s - let _warn_error s = Warnings.parse_options true s - let _warn_help = Warnings.help_warnings - let _color = Misc.set_or_ignore color_reader.parse color - let _error_style = Misc.set_or_ignore error_style_reader.parse error_style - let _where () = print_standard_library () - let _nopervasives = set nopervasives - let _match_context_rows n = match_context_rows := n - let _dump_into_file = set dump_into_file - let _dno_unique_ids = clear unique_ids - let _dunique_ids = set unique_ids - let _dsource = set dump_source - let _dparsetree = set dump_parsetree - 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 _drawflambda = set dump_rawflambda - 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 _dflambda_no_invariants = clear flambda_invariant_checks - let _dcmm = set dump_cmm - let _dsel = set dump_selection - let _dcombine = set dump_combine - let _dcse = set dump_cse - let _dlive () = dump_live := true; Printmach.print_live := true - let _davail () = dump_avail := true - let _drunavail () = debug_runavail := true - let _dspill = set dump_spill - let _dsplit = set dump_split - let _dinterf = set dump_interf - let _dprefer = set dump_prefer - let _dalloc = set dump_regalloc - let _dreload = set dump_reload - let _dscheduling = set dump_scheduling - let _dlinear = set dump_linear - let _dinterval = set dump_interval - let _dstartup = set keep_startup_file - let _dtimings () = profile_columns := [ `Time ] - let _dprofile () = profile_columns := Profile.all_columns - let _opaque = set opaque - - let _args = Arg.read_arg - let _args0 = Arg.read_arg0 - - let anonymous = anonymous -end);; - +module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain) let main () = native_code := true; let ppf = Format.err_formatter in diff --git a/dune b/dune index 27824047..653708c2 100644 --- a/dune +++ b/dune @@ -13,8 +13,8 @@ ;************************************************************************** (env - (dev (flags (:standard -w +a-4-9-41-42-44-45-48))) - (release (flags (:standard -w +a-4-9-41-42-44-45-48)))) + (dev (flags (:standard -w +a-4-9-40-41-42-44-45-48))) + (release (flags (:standard -w +a-4-9-40-41-42-44-45-48)))) ;; Too annoying to get to work. Use (copy_files# ...) instead ; (include_subdirs unqualified) @@ -56,7 +56,7 @@ ;; TYPING ident path primitive types btype oprint subst predef datarepr - cmi_format persistent_env env + cmi_format persistent_env env type_immediacy typedtree printtyped ctype printtyp includeclass mtype envaux includecore tast_iterator tast_mapper cmt_format untypeast includemod typetexp printpat parmatch stypes typedecl typeopt rec_check typecore @@ -112,7 +112,7 @@ symbol variable ;; middle_end/closure/ - closure + closure closure_middle_end ;; middle_end/flambda/base_types/ closure_element closure_id closure_origin export_id id_types mutable_variable @@ -147,11 +147,12 @@ (modules ;; asmcomp/ afl_instrument arch asmgen asmlibrarian asmlink asmpackager branch_relaxation - branch_relaxation_intf cmm cmmgen cmmgen_state coloring comballoc CSE CSEgen - deadcode emit emitaux interf interval linearize linscan liveness mach - printcmm printlinear printmach proc reg reload reloadgen schedgen scheduling - selectgen selection spacetime_profiling spill split strmatch x86_ast - x86_dsl x86_gas x86_masm x86_proc + branch_relaxation_intf cmm_helpers cmm cmmgen cmmgen_state coloring comballoc + CSE CSEgen + deadcode domainstate emit emitaux interf interval linear linearize linscan + liveness mach printcmm printlinear printmach proc reg reload reloadgen + schedgen scheduling selectgen selection spacetime_profiling spill split + strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc ;; asmcomp/debug/ reg_availability_set compute_ranges_intf available_regs reg_with_debug_info @@ -206,3 +207,16 @@ toplevel/ocaml.byte toplevel/expunge.exe )) + +(alias + (name libs) + (deps + ocamloptcomp.cma + ocamlmiddleend.cma + ocamlcommon.cma + runtime/runtime.cma + stdlib/stdlib.cma + ocamlbytecomp.cma + ocamltest/ocamltest_core_and_plugin.cma + toplevel/ocamltoplevel.cma + )) diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml index 09c787d9..cf33fa3f 100644 --- a/file_formats/cmt_format.ml +++ b/file_formats/cmt_format.ml @@ -172,7 +172,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env cmi = | None -> None | Some cmi -> Some (output_cmi temp_file_name oc cmi) in - let source_digest = Misc.may_map Digest.file sourcefile in + let source_digest = Option.map Digest.file sourcefile in let cmt = { cmt_modname = modname; cmt_annots = clear_env binary_annots; diff --git a/lambda/.ocamlformat b/lambda/.ocamlformat new file mode 100644 index 00000000..e7acdb9b --- /dev/null +++ b/lambda/.ocamlformat @@ -0,0 +1,5 @@ +profile=conventional +if-then-else=k-r +indicate-multiline-delimiters=closing-on-separate-line +break-cases=all +disable=true diff --git a/lambda/.ocamlformat-enable b/lambda/.ocamlformat-enable new file mode 100644 index 00000000..796b708c --- /dev/null +++ b/lambda/.ocamlformat-enable @@ -0,0 +1 @@ +matching.ml diff --git a/lambda/generate_runtimedef.sh b/lambda/generate_runtimedef.sh index 66ccf3ce..d1bef18f 100755 --- a/lambda/generate_runtimedef.sh +++ b/lambda/generate_runtimedef.sh @@ -16,8 +16,7 @@ #************************************************************************** echo 'let builtin_exceptions = [|' -cat "$1" | tr -d '\r' | \ - sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p' +tr -d '\r' < "$1" | sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p' echo '|]' echo 'let builtin_primitives = [|' diff --git a/lambda/lambda.ml b/lambda/lambda.ml index ebdd49a3..0f9045c1 100644 --- a/lambda/lambda.ml +++ b/lambda/lambda.ml @@ -656,7 +656,7 @@ let transl_prim mod_name name = let pers = Ident.create_persistent mod_name in let env = Env.add_persistent_structure pers Env.empty in let lid = Longident.Ldot (Longident.Lident mod_name, name) in - match Env.lookup_value lid env with + match Env.find_value_by_name lid env with | path, _ -> transl_value_path Location.none env path | exception Not_found -> fatal_error ("Primitive " ^ name ^ " not found.") @@ -678,7 +678,6 @@ let subst update_env s lam = let remove_list l s = List.fold_left (fun s (id, _kind) -> Ident.Map.remove id s) s l in - let module M = Ident.Map in match lam with | Lvar id as l -> begin try Ident.Map.find id s with Not_found -> l end @@ -783,14 +782,14 @@ let shallow_map f = function sw_consts = List.map (fun (n, e) -> (n, f e)) sw.sw_consts; sw_numblocks = sw.sw_numblocks; sw_blocks = List.map (fun (n, e) -> (n, f e)) sw.sw_blocks; - sw_failaction = Misc.may_map f sw.sw_failaction; + sw_failaction = Option.map f sw.sw_failaction; }, loc) | Lstringswitch (e, sw, default, loc) -> Lstringswitch ( f e, List.map (fun (s, e) -> (s, f e)) sw, - Misc.may_map f default, + Option.map f default, loc) | Lstaticraise (i, args) -> Lstaticraise (i, List.map f args) diff --git a/lambda/lambda.mli b/lambda/lambda.mli index f79ee0c7..9c703afe 100644 --- a/lambda/lambda.mli +++ b/lambda/lambda.mli @@ -268,6 +268,8 @@ type lambda = | Lstaticraise of int * lambda list | Lstaticcatch of lambda * (int * (Ident.t * value_kind) list) * lambda | Ltrywith of lambda * Ident.t * lambda +(* Lifthenelse (e, t, f) evaluates t if e evaluates to 0, and + evaluates f if e evaluates to any other value *) | Lifthenelse of lambda * lambda * lambda | Lsequence of lambda * lambda | Lwhile of lambda * lambda diff --git a/lambda/matching.ml b/lambda/matching.ml index 0b31ecbc..20968a63 100644 --- a/lambda/matching.ml +++ b/lambda/matching.ml @@ -13,7 +13,79 @@ (* *) (**************************************************************************) -(* Compilation of pattern matching *) +(* Compilation of pattern matching + + Based upon Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001. + + A previous version was based on Peyton-Jones, ``The Implementation of + functional programming languages'', chapter 5. + + + Overview of the implementation + ============================== + + 1. Precompilation + ----------------- + + (split_and_precompile) + We first split the initial pattern matching (or "pm") along its first column + -- simplifying pattern heads in the process --, so that we obtain an ordered + list of pms. + For every pm in this list, and any two patterns in its first column, either + the patterns have the same head, or their heads match disjoint sets of + values. (In particular, two extension constructors that may or may not be + equal due to hidden rebinding cannot occur in the same simple pm.) + + 2. Compilation + -------------- + + The compilation of one of these pms obtained after precompiling is done as + follows: + + (divide) + We split the match along the first column again, this time grouping rows + which start with the same head, and removing the first column. + As a result we get a "division", which is a list a "cells" of the form: + discriminating pattern head * specialized pm + + (compile_list + compile_match) + We then map over the division to compile each cell: we simply restart the + whole process on the second element of each cell. + Each cell is now of the form: + discriminating pattern head * lambda + + (combine_constant, combine_construct, combine_array, ...) + We recombine the cells using a switch or some ifs, and if the matching can + fail, introduce a jump to the next pm that could potentially match the + scrutiny. + + 3. Chaining of pms + ------------------ + + (comp_match_handlers) + Once the pms have been compiled, we stitch them back together in the order + produced by precompilation, resulting in the following structure: + {v + catch + catch + + with -> + + with -> + + v} + + Additionally, bodies whose corresponding exit-number is never used are + discarded. So for instance, if in the pseudo-example above we know that exit + [i] is never taken, we would actually generate: + {v + catch + + with -> + + v} + +*) open Misc open Asttypes @@ -24,16 +96,8 @@ open Parmatch open Printf open Printpat - let dbg = false -(* See Peyton-Jones, ``The Implementation of functional programming - languages'', chapter 5. *) -(* - Well, it was true at the beginning of the world. - Now, see Lefessant-Maranget ``Optimizing Pattern-Matching'' ICFP'2001 -*) - (* Compatibility predicate that considers potential rebindings of constructors of an extension type. @@ -42,9 +106,12 @@ let dbg = false returns true when they may have a common instance. *) -module MayCompat = - Parmatch.Compat (struct let equal = Types.may_equal_constr end) +module MayCompat = Parmatch.Compat (struct + let equal = Types.may_equal_constr +end) + let may_compat = MayCompat.compat + and may_compats = MayCompat.compats (* @@ -56,409 +123,586 @@ and may_compats = MayCompat.compats - Jump summaries: mapping from exit numbers to contexts *) - let string_of_lam lam = - Printlambda.lambda Format.str_formatter lam ; + Printlambda.lambda Format.str_formatter lam; Format.flush_str_formatter () -let all_record_args lbls = match lbls with -| (_,{lbl_all=lbl_all},_)::_ -> - let t = - Array.map - (fun lbl -> mknoloc (Longident.Lident "?temp?"), lbl,omega) - lbl_all in - List.iter - (fun ((_, lbl,_) as x) -> t.(lbl.lbl_pos) <- x) - lbls ; - Array.to_list t -| _ -> fatal_error "Parmatch.all_record_args" +let all_record_args lbls = + match lbls with + | (_, { lbl_all }, _) :: _ -> + let t = + Array.map + (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega)) + lbl_all + in + List.iter (fun ((_, lbl, _) as x) -> t.(lbl.lbl_pos) <- x) lbls; + Array.to_list t + | _ -> fatal_error "Matching.all_record_args" type matrix = pattern list list -let add_omega_column pss = List.map (fun ps -> omega::ps) pss +let add_omega_column pss = List.map (fun ps -> omega :: ps) pss -type ctx = {left:pattern list ; right:pattern list} +let rec rev_split_at n ps = + if n <= 0 then + ([], ps) + else + match ps with + | p :: rem -> + let left, right = rev_split_at (n - 1) rem in + (p :: left, right) + | _ -> assert false -let pretty_ctx ctx = - List.iter - (fun {left=left ; right=right} -> - Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right) - ctx - -let le_ctx c1 c2 = - le_pats c1.left c2.left && - le_pats c1.right c2.right - -let lshift {left=left ; right=right} = match right with -| x::xs -> {left=x::left ; right=xs} -| _ -> assert false - -let lforget {left=left ; right=right} = match right with -| _::xs -> {left=omega::left ; right=xs} -| _ -> assert false - -let rec small_enough n = function - | [] -> true - | _::rem -> - if n <= 0 then false - else small_enough (n-1) rem - -let ctx_lshift ctx = - if small_enough (!Clflags.match_context_rows - 1) ctx then - List.map lshift ctx - else (* Context pruning *) begin - get_mins le_ctx (List.map lforget ctx) - end +exception NoMatch -let rshift {left=left ; right=right} = match left with -| p::ps -> {left=ps ; right=p::right} -| _ -> assert false +let ncols = function + | [] -> 0 + | ps :: _ -> List.length ps -let ctx_rshift ctx = List.map rshift ctx +module Context : sig + type t -let rec nchars n ps = - if n <= 0 then [],ps - else match ps with - | p::rem -> - let chars, cdrs = nchars (n-1) rem in - p::chars,cdrs - | _ -> assert false + val empty : t + + val is_empty : t -> bool + + val start : int -> t + + val eprintf : t -> unit + + val specialize : pattern -> t -> t + + val lshift : t -> t + + val rshift : t -> t + + val rshift_num : int -> t -> t + + val lub : pattern -> t -> t + + val matches : t -> matrix -> bool + + val combine : t -> t + + val select_columns : matrix -> t -> t + + val union : t -> t -> t +end = struct + module Row = struct + type t = { left : pattern list; right : pattern list } + + let eprintf { left; right } = + Format.eprintf "LEFT:%a RIGHT:%a\n" pretty_line left pretty_line right + + let le c1 c2 = le_pats c1.left c2.left && le_pats c1.right c2.right -let rshift_num n {left=left ; right=right} = - let shifted,left = nchars n left in - {left=left ; right = shifted@right} + let lshift { left; right } = + match right with + | x :: xs -> { left = x :: left; right = xs } + | _ -> assert false + + let lforget { left; right } = + match right with + | _ :: xs -> { left = omega :: left; right = xs } + | _ -> assert false -let ctx_rshift_num n ctx = List.map (rshift_num n) ctx + let rshift { left; right } = + match left with + | p :: ps -> { left = ps; right = p :: right } + | _ -> assert false -(* Recombination of contexts (eg: (_,_)::p1::p2::rem -> (p1,p2)::rem) + let rshift_num n { left; right } = + let shifted, left = rev_split_at n left in + { left; right = shifted @ right } + + (** Recombination of contexts (eg: (_,_)::p1::p2::rem -> (p1,p2)::rem) All mutable fields are replaced by '_', since side-effects in guards can alter these fields *) + let combine { left; right } = + match left with + | p :: ps -> { left = ps; right = set_args_erase_mutable p right } + | _ -> assert false + end -let combine {left=left ; right=right} = match left with -| p::ps -> {left=ps ; right=set_args_erase_mutable p right} -| _ -> assert false + type t = Row.t list -let ctx_combine ctx = List.map combine ctx + let empty = [] -let ncols = function - | [] -> 0 - | ps::_ -> List.length ps + let start n : t = [ { left = []; right = omegas n } ] + let is_empty = function + | [] -> true + | _ -> false -exception NoMatch -exception OrPat + let eprintf ctx = List.iter Row.eprintf ctx -let filter_matrix matcher pss = - - let rec filter_rec = function - | (p::ps)::rem -> - begin match p.pat_desc with - | Tpat_alias (p,_,_) -> - filter_rec ((p::ps)::rem) - | Tpat_var _ -> - filter_rec ((omega::ps)::rem) - | _ -> - begin + let lshift ctx = + if List.length ctx < !Clflags.match_context_rows then + List.map Row.lshift ctx + else + (* Context pruning *) + get_mins Row.le (List.map Row.lforget ctx) + + let rshift ctx = List.map Row.rshift ctx + + let rshift_num n ctx = List.map (Row.rshift_num n) ctx + + let combine ctx = List.map Row.combine ctx + + let ctx_matcher p = + let p = normalize_pat p in + match p.pat_desc with + | Tpat_construct (_, cstr, omegas) -> ( + fun q rem -> + match q.pat_desc with + | Tpat_construct (_, cstr', args) + (* NB: may_constr_equal considers (potential) constructor rebinding *) + when Types.may_equal_constr cstr cstr' -> + (p, args @ rem) + | Tpat_any -> (p, omegas @ rem) + | _ -> raise NoMatch + ) + | Tpat_constant cst -> ( + fun q rem -> + match q.pat_desc with + | Tpat_constant cst' when const_compare cst cst' = 0 -> (p, rem) + | Tpat_any -> (p, rem) + | _ -> raise NoMatch + ) + | Tpat_variant (lab, Some omega, _) -> ( + fun q rem -> + match q.pat_desc with + | Tpat_variant (lab', Some arg, _) when lab = lab' -> (p, arg :: rem) + | Tpat_any -> (p, omega :: rem) + | _ -> raise NoMatch + ) + | Tpat_variant (lab, None, _) -> ( + fun q rem -> + match q.pat_desc with + | Tpat_variant (lab', None, _) when lab = lab' -> (p, rem) + | Tpat_any -> (p, rem) + | _ -> raise NoMatch + ) + | Tpat_array omegas -> ( + let len = List.length omegas in + fun q rem -> + match q.pat_desc with + | Tpat_array args when List.length args = len -> (p, args @ rem) + | Tpat_any -> (p, omegas @ rem) + | _ -> raise NoMatch + ) + | Tpat_tuple omegas -> ( + let len = List.length omegas in + fun q rem -> + match q.pat_desc with + | Tpat_tuple args when List.length args = len -> (p, args @ rem) + | Tpat_any -> (p, omegas @ rem) + | _ -> raise NoMatch + ) + | Tpat_record (((_, lbl, _) :: _ as l), _) -> ( + (* Records are normalized *) + let len = Array.length lbl.lbl_all in + fun q rem -> + match q.pat_desc with + | Tpat_record (((_, lbl', _) :: _ as l'), _) + when Array.length lbl'.lbl_all = len -> + let l' = all_record_args l' in + (p, List.fold_right (fun (_, _, p) r -> p :: r) l' rem) + | Tpat_any -> (p, List.fold_right (fun (_, _, p) r -> p :: r) l rem) + | _ -> raise NoMatch + ) + | Tpat_lazy omega -> ( + fun q rem -> + match q.pat_desc with + | Tpat_lazy arg -> (p, arg :: rem) + | Tpat_any -> (p, omega :: rem) + | _ -> raise NoMatch + ) + | _ -> fatal_error "Matching.Context.matcher" + + let specialize q ctx = + let matcher = ctx_matcher q in + let rec filter_rec : t -> t = function + | ({ right = p :: ps } as l) :: rem -> ( + match p.pat_desc with + | Tpat_or (p1, p2, _) -> + filter_rec + ({ l with right = p1 :: ps } + :: { l with + Row.right (* disam not principal, OK *) = p2 :: ps + } + :: rem + ) + | Tpat_alias (p, _, _) -> + filter_rec ({ l with right = p :: ps } :: rem) + | Tpat_var _ -> filter_rec ({ l with right = omega :: ps } :: rem) + | _ -> ( let rem = filter_rec rem in try - matcher p ps::rem - with - | NoMatch -> rem - | OrPat -> - match p.pat_desc with - | Tpat_or (p1,p2,_) -> filter_rec [(p1::ps) ;(p2::ps)]@rem - | _ -> assert false - end - end - | [] -> [] - | _ -> - pretty_matrix Format.err_formatter pss ; - fatal_error "Matching.filter_matrix" in - filter_rec pss + let to_left, right = matcher p ps in + { left = to_left :: l.left; right } :: rem + with NoMatch -> rem + ) + ) + | [] -> [] + | _ -> fatal_error "Matching.Context.specialize" + in + filter_rec ctx + + let select_columns pss ctx = + let n = ncols pss in + let lub_row ps { Row.left; right } = + let transfer, right = rev_split_at n right in + match lubs transfer ps with + | exception Empty -> None + | inter -> Some { Row.left = inter @ left; right } + in + let lub_with_ctx ps = List.filter_map (lub_row ps) ctx in + List.flatten (List.map lub_with_ctx pss) + + let lub p ctx = + List.filter_map + (fun { Row.left; right } -> + match right with + | q :: rem -> ( + try Some { Row.left; right = lub p q :: rem } with Empty -> None + ) + | _ -> fatal_error "Matching.Context.lub") + ctx + + let matches ctx pss = + List.exists + (fun { Row.right = qs } -> List.exists (fun ps -> may_compats qs ps) pss) + ctx -let make_default matcher env = - let rec make_rec = function - | [] -> [] - | ([[]],i)::_ -> [[[]],i] - | (pss,i)::rem -> - let rem = make_rec rem in - match filter_matrix matcher pss with - | [] -> rem - | ([]::_) -> ([[]],i)::rem - | pss -> (pss,i)::rem in - make_rec env - -let ctx_matcher p = - let p = normalize_pat p in - match p.pat_desc with - | Tpat_construct (_, cstr,omegas) -> - (fun q rem -> match q.pat_desc with - | Tpat_construct (_, cstr',args) -(* NB: may_constr_equal considers (potential) constructor rebinding *) - when Types.may_equal_constr cstr cstr' -> - p,args@rem - | Tpat_any -> p,omegas @ rem - | _ -> raise NoMatch) - | Tpat_constant cst -> - (fun q rem -> match q.pat_desc with - | Tpat_constant cst' when const_compare cst cst' = 0 -> - p,rem - | Tpat_any -> p,rem - | _ -> raise NoMatch) - | Tpat_variant (lab,Some omega,_) -> - (fun q rem -> match q.pat_desc with - | Tpat_variant (lab',Some arg,_) when lab=lab' -> - p,arg::rem - | Tpat_any -> p,omega::rem - | _ -> raise NoMatch) - | Tpat_variant (lab,None,_) -> - (fun q rem -> match q.pat_desc with - | Tpat_variant (lab',None,_) when lab=lab' -> - p,rem - | Tpat_any -> p,rem - | _ -> raise NoMatch) - | Tpat_array omegas -> - let len = List.length omegas in - (fun q rem -> match q.pat_desc with - | Tpat_array args when List.length args = len -> p,args @ rem - | Tpat_any -> p, omegas @ rem - | _ -> raise NoMatch) - | Tpat_tuple omegas -> - let len = List.length omegas in - (fun q rem -> match q.pat_desc with - | Tpat_tuple args when List.length args = len -> p,args @ rem - | Tpat_any -> p, omegas @ rem - | _ -> raise NoMatch) - | Tpat_record (((_, lbl, _) :: _) as l,_) -> (* Records are normalized *) - let len = Array.length lbl.lbl_all in - (fun q rem -> match q.pat_desc with - | Tpat_record (((_, lbl', _) :: _) as l',_) - when Array.length lbl'.lbl_all = len -> - let l' = all_record_args l' in - p, List.fold_right (fun (_, _,p) r -> p::r) l' rem - | Tpat_any -> p,List.fold_right (fun (_, _,p) r -> p::r) l rem - | _ -> raise NoMatch) - | Tpat_lazy omega -> - (fun q rem -> match q.pat_desc with - | Tpat_lazy arg -> p, (arg::rem) - | Tpat_any -> p, (omega::rem) - | _ -> raise NoMatch) - | _ -> fatal_error "Matching.ctx_matcher" - - - - -let filter_ctx q ctx = - - let matcher = ctx_matcher q in - - let rec filter_rec = function - | ({right=p::ps} as l)::rem -> - begin match p.pat_desc with - | Tpat_or (p1,p2,_) -> - filter_rec ({l with right=p1::ps}::{l with right=p2::ps}::rem) - | Tpat_alias (p,_,_) -> - filter_rec ({l with right=p::ps}::rem) - | Tpat_var _ -> - filter_rec ({l with right=omega::ps}::rem) - | _ -> - begin let rem = filter_rec rem in - try - let to_left, right = matcher p ps in - {left=to_left::l.left ; right=right}::rem - with - | NoMatch -> rem - end - end - | [] -> [] - | _ -> fatal_error "Matching.filter_ctx" in + let union pss qss = get_mins Row.le (pss @ qss) +end - filter_rec ctx +exception OrPat + +let rec flatten_pat_line size p k = + match p.pat_desc with + | Tpat_any -> omegas size :: k + | Tpat_tuple args -> args :: k + | Tpat_or (p1, p2, _) -> + flatten_pat_line size p1 (flatten_pat_line size p2 k) + | Tpat_alias (p, _, _) -> + (* Note: if this 'as' pat is here, then this is a + useless binding, solves PR#3780 *) + flatten_pat_line size p k + | _ -> fatal_error "Matching.flatten_pat_line" -let select_columns pss ctx = - let n = ncols pss in +let flatten_matrix size pss = List.fold_right (fun ps r -> - List.fold_right - (fun {left=left ; right=right} r -> - let transfert, right = nchars n right in - try - {left = lubs transfert ps @ left ; right=right}::r - with - | Empty -> r) - ctx r) + match ps with + | [ p ] -> flatten_pat_line size p r + | _ -> fatal_error "Matching.flatten_matrix") pss [] -let ctx_lub p ctx = - List.fold_right - (fun {left=left ; right=right} r -> - match right with - | q::rem -> - begin try - {left=left ; right = lub p q::rem}::r - with - | Empty -> r - end - | _ -> fatal_error "Matching.ctx_lub") - ctx [] - -let ctx_match ctx pss = - List.exists - (fun {right=qs} -> List.exists (fun ps -> may_compats qs ps) pss) - ctx - -type jumps = (int * ctx list) list - -let pretty_jumps (env : jumps) = match env with -| [] -> () -| _ -> +(** A default environment (referred to as "reachable trap handlers" in the + paper), is an ordered list of [matrix * raise_num] pairs, and is used to + decide where to jump next if none of the rows in a given matrix match the + input. + + In such situations, one thing you can do is to jump to the first (leftmost) + [raise_num] in that list (by doing a raise to the static-cach handler number + [raise_num]); and you can assume that if the associated pm doesn't match + either, it will do the same thing, etc. + This is what [mk_failaction_neg] (and its callers) does. + + A more sophisticated alternative is to use what you know about the input + (what you might already have matched) and the current pm (what you know you + can't match) to directly jump to a pm that might match it instead of the + next one; that is why we don't just keep [raise_num]s but also the + associated matrices. + [mk_failaction_pos] does (a slightly more sophisticated version of) this. +*) +module Default_environment : sig + type t + + val is_empty : t -> bool + + val pop : t -> ((matrix * int) * t) option + + val empty : t + + val cons : matrix -> int -> t -> t + + val specialize : (pattern -> pattern list -> pattern list) -> t -> t + + val pop_column : t -> t + + val pop_compat : pattern -> t -> t + + val flatten : int -> t -> t + + val pp : t -> unit +end = struct + type t = (matrix * int) list + (** All matrices in the list should have the same arity -- their rows should + have the same number of columns -- as it should match the arity of the + current scrutiny vector. *) + + let empty = [] + + let is_empty = function + | [] -> true + | _ -> false + + let cons matrix raise_num default = + match matrix with + | [] -> default + | _ -> (matrix, raise_num) :: default + + let specialize_matrix matcher pss = + let rec filter_rec = function + | (p :: ps) :: rem -> ( + match p.pat_desc with + | Tpat_alias (p, _, _) -> filter_rec ((p :: ps) :: rem) + | Tpat_var _ -> filter_rec ((omega :: ps) :: rem) + | _ -> ( + let rem = filter_rec rem in + try matcher p ps :: rem with + | NoMatch -> rem + | OrPat -> ( + match p.pat_desc with + | Tpat_or (p1, p2, _) -> + filter_rec [ p1 :: ps; p2 :: ps ] @ rem + | _ -> assert false + ) + ) + ) + | [] -> [] + | _ -> + pretty_matrix Format.err_formatter pss; + fatal_error "Matching.Default_environment.specialize_matrix" + in + filter_rec pss + + let specialize matcher env = + let rec make_rec = function + | [] -> [] + | ([ [] ], i) :: _ -> [ ([ [] ], i) ] + | (pss, i) :: rem -> ( + let rem = make_rec rem in + match specialize_matrix matcher pss with + | [] -> rem + | [] :: _ -> [ ([ [] ], i) ] + | pss -> (pss, i) :: rem + ) + in + make_rec env + + let pop_column def = specialize (fun _p rem -> rem) def + + let pop_compat p def = + let compat_matcher q rem = + if may_compat p q then + rem + else + raise NoMatch + in + specialize compat_matcher def + + let pop = function + | [] -> None + | def :: defs -> Some (def, defs) + + let pp def = + Format.eprintf "+++++ Defaults +++++\n"; List.iter - (fun (i,ctx) -> - Printf.fprintf stderr "jump for %d\n" i ; - pretty_ctx ctx) + (fun (pss, i) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss) + def; + Format.eprintf "+++++++++++++++++++++\n" + + let flatten size def = + List.map (fun (pss, i) -> (flatten_matrix size pss, i)) def +end + +module Jumps : sig + type t + + val is_empty : t -> bool + + val empty : t + + val singleton : int -> Context.t -> t + + val add : int -> Context.t -> t -> t + + val union : t -> t -> t + + val unions : t list -> t + + val map : (Context.t -> Context.t) -> t -> t + + val remove : int -> t -> t + + val extract : int -> t -> Context.t * t + + val eprintf : t -> unit +end = struct + type t = (int * Context.t) list + + let eprintf (env : t) = + List.iter + (fun (i, ctx) -> + Printf.eprintf "jump for %d\n" i; + Context.eprintf ctx) env + let rec extract i = function + | [] -> (Context.empty, []) + | ((j, pss) as x) :: rem as all -> + if i = j then + (pss, rem) + else if j < i then + (Context.empty, all) + else + let r, rem = extract i rem in + (r, x :: rem) + + let rec remove i = function + | [] -> [] + | (j, _) :: rem when i = j -> rem + | x :: rem -> x :: remove i rem -let rec jumps_extract i = function - | [] -> [],[] - | (j,pss) as x::rem as all -> - if i=j then pss,rem - else if j < i then [],all - else - let r,rem = jumps_extract i rem in - r,(x::rem) - -let rec jumps_remove i = function - | [] -> [] - | (j,_)::rem when i=j -> rem - | x::rem -> x::jumps_remove i rem - -let jumps_empty = [] -and jumps_is_empty = function - | [] -> true - | _ -> false - -let jumps_singleton i = function - | [] -> [] - | ctx -> [i,ctx] - -let jumps_add i pss jumps = match pss with -| [] -> jumps -| _ -> - let rec add = function - | [] -> [i,pss] - | (j,qss) as x::rem as all -> - if j > i then x::add rem - else if j < i then (i,pss)::all - else (i,(get_mins le_ctx (pss@qss)))::rem in - add jumps - - -let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with -| [],_ -> env2 -| _,[] -> env1 -| ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) -> - if i1=i2 then - (i1,get_mins le_ctx (pss1@pss2))::jumps_union rem1 rem2 - else if i1 > i2 then - x1::jumps_union rem1 env2 + let empty = [] + + and is_empty = function + | [] -> true + | _ -> false + + let singleton i ctx = + if Context.is_empty ctx then + [] else - x2::jumps_union env1 rem2 + [ (i, ctx) ] + let add i ctx jumps = + let rec add = function + | [] -> [ (i, ctx) ] + | ((j, qss) as x) :: rem as all -> + if j > i then + x :: add rem + else if j < i then + (i, ctx) :: all + else + (i, Context.union ctx qss) :: rem + in + if Context.is_empty ctx then + jumps + else + add jumps + + let rec union (env1 : t) env2 = + match (env1, env2) with + | [], _ -> env2 + | _, [] -> env1 + | ((i1, pss1) as x1) :: rem1, ((i2, pss2) as x2) :: rem2 -> + if i1 = i2 then + (i1, Context.union pss1 pss2) :: union rem1 rem2 + else if i1 > i2 then + x1 :: union rem1 env2 + else + x2 :: union env1 rem2 -let rec merge = function - | env1::env2::rem -> jumps_union env1 env2::merge rem - | envs -> envs + let rec merge = function + | env1 :: env2 :: rem -> union env1 env2 :: merge rem + | envs -> envs -let rec jumps_unions envs = match envs with - | [] -> [] - | [env] -> env - | _ -> jumps_unions (merge envs) + let rec unions envs = + match envs with + | [] -> [] + | [ env ] -> env + | _ -> unions (merge envs) -let jumps_map f env = - List.map - (fun (i,pss) -> i,f pss) - env + let map f env = List.map (fun (i, pss) -> (i, f pss)) env +end (* Pattern matching before any compilation *) -type pattern_matching = - { mutable cases : (pattern list * lambda) list; - args : (lambda * let_kind) list ; - default : (matrix * int) list} +type pattern_matching = { + mutable cases : (pattern list * lambda) list; + args : (lambda * let_kind) list; + (** args are not just Ident.t in at least the following cases: + - when matching the arguments of a constructor, + direct field projections are used (make_field_args) + - with lazy patterns args can be of the form [Lazy.force ...] + (inline_lazy_force). *) + default : Default_environment.t +} + +type handler = { + provenance : matrix; + exit : int; + vars : (Ident.t * Lambda.value_kind) list; + pm : pattern_matching +} + +type pm_or_compiled = { + body : pattern_matching; + handlers : handler list; + or_matrix : matrix +} (* Pattern matching after application of both the or-pat rule and the mixture rule *) -type pm_or_compiled = - {body : pattern_matching ; - handlers : - (matrix * int * (Ident.t * Lambda.value_kind) list * pattern_matching) - list; - or_matrix : matrix ; } - type pm_half_compiled = | PmOr of pm_or_compiled - | PmVar of pm_var_compiled + | PmVar of { inside : pm_half_compiled } | Pm of pattern_matching -and pm_var_compiled = - {inside : pm_half_compiled ; var_arg : lambda ; } - -type pm_half_compiled_info = - {me : pm_half_compiled ; - matrix : matrix ; - top_default : (matrix * int) list ; } +(* Only used inside the various split functions, we only keep [me] when we're + done splitting / precompiling. *) +type pm_half_compiled_info = { + me : pm_half_compiled; + matrix : matrix; + (* the matrix matched by [me]. Is used to extend the list of reachable trap + handlers (aka "default environments") when returning from recursive + calls. *) + top_default : Default_environment.t +} let pretty_cases cases = List.iter - (fun (ps,_l) -> - List.iter - (fun p -> Format.eprintf " %a%!" top_pretty p) - ps ; + (fun (ps, _l) -> + List.iter (fun p -> Format.eprintf " %a%!" top_pretty p) ps; Format.eprintf "\n") cases -let pretty_def def = - Format.eprintf "+++++ Defaults +++++\n" ; - List.iter - (fun (pss,i) -> Format.eprintf "Matrix for %d\n%a" i pretty_matrix pss) - def ; - Format.eprintf "+++++++++++++++++++++\n" - let pretty_pm pm = - pretty_cases pm.cases ; - if pm.default <> [] then - pretty_def pm.default - + pretty_cases pm.cases; + if not (Default_environment.is_empty pm.default) then + Default_environment.pp pm.default let rec pretty_precompiled = function | Pm pm -> - Format.eprintf "++++ PM ++++\n" ; + Format.eprintf "++++ PM ++++\n"; pretty_pm pm | PmVar x -> - Format.eprintf "++++ VAR ++++\n" ; + Format.eprintf "++++ VAR ++++\n"; pretty_precompiled x.inside | PmOr x -> - Format.eprintf "++++ OR ++++\n" ; - pretty_pm x.body ; - pretty_matrix Format.err_formatter x.or_matrix ; + Format.eprintf "++++ OR ++++\n"; + pretty_pm x.body; + pretty_matrix Format.err_formatter x.or_matrix; List.iter - (fun (_,i,_,pm) -> - eprintf "++ Handler %d ++\n" i ; + (fun { exit = i; pm; _ } -> + eprintf "++ Handler %d ++\n" i; pretty_pm pm) x.handlers let pretty_precompiled_res first nexts = - pretty_precompiled first ; + pretty_precompiled first; List.iter (fun (e, pmh) -> - eprintf "** DEFAULT %d **\n" e ; + eprintf "** DEFAULT %d **\n" e; pretty_precompiled pmh) nexts - - (* Identifying some semantically equivalent lambda-expressions, Our goal here is also to find alpha-equivalent (simple) terms *) @@ -470,203 +714,188 @@ let pretty_precompiled_res first nexts = in case action sharing is present. *) +module StoreExp = Switch.Store (struct + type t = lambda + + type key = lambda -module StoreExp = - Switch.Store - (struct - type t = lambda - type key = lambda - let compare_key = Stdlib.compare - let make_key = Lambda.make_key - end) + let compare_key = Stdlib.compare + let make_key = Lambda.make_key +end) -let make_exit i = Lstaticraise (i,[]) +let make_exit i = Lstaticraise (i, []) (* Introduce a catch, if worth it *) -let make_catch d k = match d with -| Lstaticraise (_,[]) -> k d -| _ -> - let e = next_raise_count () in - Lstaticcatch (k (make_exit e),(e,[]),d) +let make_catch d k = + match d with + | Lstaticraise (_, []) -> k d + | _ -> + let e = next_raise_count () in + Lstaticcatch (k (make_exit e), (e, []), d) (* Introduce a catch, if worth it, delayed version *) let rec as_simple_exit = function - | Lstaticraise (i,[]) -> Some i - | Llet (Alias,_k,_,_,e) -> as_simple_exit e + | Lstaticraise (i, []) -> Some i + | Llet (Alias, _k, _, _, e) -> as_simple_exit e | _ -> None - -let make_catch_delayed handler = match as_simple_exit handler with -| Some i -> i,(fun act -> act) -| None -> - let i = next_raise_count () in -(* +let make_catch_delayed handler = + match as_simple_exit handler with + | Some i -> (i, fun act -> act) + | None -> ( + let i = next_raise_count () in + (* Printf.eprintf "SHARE LAMBDA: %i\n%s\n" i (string_of_lam handler); *) - i, - (fun body -> match body with - | Lstaticraise (j,_) -> - if i=j then handler else body - | _ -> Lstaticcatch (body,(i,[]),handler)) - + ( i, + fun body -> + match body with + | Lstaticraise (j, _) -> + if i = j then + handler + else + body + | _ -> Lstaticcatch (body, (i, []), handler) ) + ) let raw_action l = - match make_key l with | Some l -> l | None -> l - - -let tr_raw act = match make_key act with -| Some act -> act -| None -> raise Exit + match make_key l with + | Some l -> l + | None -> l let same_actions = function | [] -> None - | [_,act] -> Some act - | (_,act0) :: rem -> - try - let raw_act0 = tr_raw act0 in - let rec s_rec = function - | [] -> Some act0 - | (_,act)::rem -> - if raw_act0 = tr_raw act then - s_rec rem - else - None in - s_rec rem - with - | Exit -> None - - -(* Test for swapping two clauses *) - -let up_ok_action act1 act2 = - try - let raw1 = tr_raw act1 - and raw2 = tr_raw act2 in - raw1 = raw2 - with - | Exit -> false - -let up_ok (ps,act_p) l = + | [ (_, act) ] -> Some act + | (_, act0) :: rem -> ( + match make_key act0 with + | None -> None + | key0_opt -> + let same_act (_, act) = make_key act = key0_opt in + if List.for_all same_act rem then + Some act0 + else + None + ) + +let safe_before (ps, act_p) l = + (* Test for swapping two clauses *) + let same_actions act1 act2 = + match (make_key act1, make_key act2) with + | Some key1, Some key2 -> key1 = key2 + | None, _ + | _, None -> + false + in List.for_all - (fun (qs,act_q) -> - up_ok_action act_p act_q || not (may_compats ps qs)) + (fun (qs, act_q) -> same_actions act_p act_q || not (may_compats ps qs)) l (* - The simplify function normalizes the first column of the match + The half-simplify functions transforms the first column of the match - records are expanded so that they possess all fields - aliases are removed and replaced by bindings in actions. - However or-patterns are simplified differently, - - aliases are not removed - - or-patterns (_|p) are changed into _ -*) -exception Var of pattern - -let simplify_or p = - let rec simpl_rec p = match p with - | {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p) - | {pat_desc = Tpat_alias (q,id,s)} -> - begin try - {p with pat_desc = Tpat_alias (simpl_rec q,id,s)} - with - | Var q -> raise (Var {p with pat_desc = Tpat_alias (q,id,s)}) - end - | {pat_desc = Tpat_or (p1,p2,o)} -> - let q1 = simpl_rec p1 in - begin try - let q2 = simpl_rec p2 in - {p with pat_desc = Tpat_or (q1, q2, o)} - with - | Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)}) - end - | {pat_desc = Tpat_record (lbls,closed)} -> + However or-patterns are only half-simplified, + - aliases under or-patterns are kept + - or-patterns whose right-hand-side is subsumed by their lhs + are simplified to their lhs. + For instance: [(_ :: _ | 1 :: _)] is changed into [_ :: _] + - or-patterns whose left-hand-side is not simplified + are preserved: (p|q) is changed into (simpl(p)|simpl(q)) + {v + # match lazy (print_int 3; 3) with _ | lazy 2 -> ();; + - : unit = () + # match lazy (print_int 3; 3) with lazy 2 | _ -> ();; + 3- : unit = () + v} + + In particular, or-patterns may still occur in the head of the output row, + so this is only a "half-simplification". +*) +let half_simplify_cases args cls = + let rec simpl_pat p = + match p.pat_desc with + | Tpat_any + | Tpat_var _ -> + p + | Tpat_alias (q, id, s) -> + { p with pat_desc = Tpat_alias (simpl_pat q, id, s) } + | Tpat_or (p1, p2, o) -> + let p1, p2 = (simpl_pat p1, simpl_pat p2) in + if le_pat p1 p2 then + p1 + else + { p with pat_desc = Tpat_or (p1, p2, o) } + | Tpat_record (lbls, closed) -> let all_lbls = all_record_args lbls in - {p with pat_desc=Tpat_record (all_lbls, closed)} - | _ -> p in - try - simpl_rec p - with - | Var p -> p - -let simplify_cases args cls = match args with -| [] -> assert false -| (arg,_)::_ -> - let rec simplify = function - | [] -> [] - | ((pat :: patl, action) as cl) :: rem -> - begin match pat.pat_desc with - | Tpat_var (id, _) -> - let k = Typeopt.value_kind pat.pat_env pat.pat_type in - (omega :: patl, bind_with_value_kind Alias (id, k) arg action) :: - simplify rem - | Tpat_any -> - cl :: simplify rem - | Tpat_alias(p, id,_) -> - let k = Typeopt.value_kind pat.pat_env pat.pat_type in - simplify ((p :: patl, - bind_with_value_kind Alias (id, k) arg action) :: rem) - | Tpat_record ([],_) -> - (omega :: patl, action):: - simplify rem - | Tpat_record (lbls, closed) -> - let all_lbls = all_record_args lbls in - let full_pat = - {pat with pat_desc=Tpat_record (all_lbls, closed)} in - (full_pat::patl,action):: - simplify rem - | Tpat_or _ -> - let pat_simple = simplify_or pat in - begin match pat_simple.pat_desc with - | Tpat_or _ -> - (pat_simple :: patl, action) :: - simplify rem - | _ -> - simplify ((pat_simple::patl,action) :: rem) - end - | _ -> cl :: simplify rem - end - | _ -> assert false in - - simplify cls - - - -(* Once matchings are simplified one can easily find - their nature *) - -let rec what_is_cases cases = match cases with -| ({pat_desc=Tpat_any} :: _, _) :: rem -> what_is_cases rem -| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_,_))}::_),_)::_ - -> assert false (* applies to simplified matchings only *) -| (p::_,_)::_ -> p -| [] -> omega -| _ -> assert false - - - -(* A few operations on default environments *) -let as_matrix cases = get_mins le_pats (List.map (fun (ps,_) -> ps) cases) - -let cons_default matrix raise_num default = - match matrix with - | [] -> default - | _ -> (matrix,raise_num)::default - -let default_compat p def = - List.fold_right - (fun (pss,i) r -> - let qss = - List.fold_right - (fun qs r -> match qs with - | q::rem when may_compat p q -> rem::r - | _ -> r) - pss [] in - match qss with - | [] -> r - | _ -> (qss,i)::r) - def [] + { p with pat_desc = Tpat_record (all_lbls, closed) } + | _ -> p + in + let rec simpl_clause cl = + match cl with + | [], _ -> assert false + | pat :: patl, action -> ( + match pat.pat_desc with + | Tpat_any -> cl + | Tpat_var (id, s) -> + let p = { pat with pat_desc = Tpat_alias (omega, id, s) } in + simpl_clause (p :: patl, action) + | Tpat_alias (p, id, _) -> + let arg = + match args with + | [] -> assert false + | (arg, _) :: _ -> arg + in + let k = Typeopt.value_kind pat.pat_env pat.pat_type in + simpl_clause + (p :: patl, bind_with_value_kind Alias (id, k) arg action) + | Tpat_record ([], _) -> (omega :: patl, action) + | Tpat_record (lbls, closed) -> + let all_lbls = all_record_args lbls in + let full_pat = + { pat with pat_desc = Tpat_record (all_lbls, closed) } + in + (full_pat :: patl, action) + | Tpat_or _ -> ( + let pat_simple = simpl_pat pat in + match pat_simple.pat_desc with + | Tpat_or _ -> (pat_simple :: patl, action) + | _ -> simpl_clause (pat_simple :: patl, action) + ) + | Tpat_constant _ + | Tpat_tuple _ + | Tpat_construct _ + | Tpat_variant _ + | Tpat_array _ + | Tpat_lazy _ + | Tpat_exception _ -> + cl + ) + in + List.map simpl_clause cls + +(* Once matchings are *fully* simplified, one can easily find + their nature. *) + +let rec what_is_cases ~skip_any cases = + match cases with + | [] -> omega + | ([], _) :: _ -> assert false + | (p :: _, _) :: rem -> ( + match p.pat_desc with + | Tpat_any when skip_any -> what_is_cases ~skip_any rem + | Tpat_var _ + | Tpat_or (_, _, _) + | Tpat_alias (_, _, _) -> + (* applies to simplified matchings only *) + assert false + | _ -> p + ) + +let what_is_first_case = what_is_cases ~skip_any:false + +let what_is_cases = what_is_cases ~skip_any:true (* Or-pattern expansion, variables are a complication w.r.t. the article *) @@ -674,201 +903,236 @@ exception Cannot_flatten let mk_alpha_env arg aliases ids = List.map - (fun id -> id, - if List.mem id aliases then - match arg with - | Some v -> v - | _ -> raise Cannot_flatten - else - Ident.create_local (Ident.name id)) + (fun id -> + ( id, + if List.mem id aliases then + match arg with + | Some v -> v + | _ -> raise Cannot_flatten + else + Ident.create_local (Ident.name id) )) ids -let rec explode_or_pat arg patl mk_action rem vars aliases = function - | {pat_desc = Tpat_or (p1,p2,_)} -> - explode_or_pat - arg patl mk_action - (explode_or_pat arg patl mk_action rem vars aliases p2) - vars aliases p1 - | {pat_desc = Tpat_alias (p,id, _)} -> - explode_or_pat arg patl mk_action rem vars (id::aliases) p - | {pat_desc = Tpat_var (x, _)} -> - let env = mk_alpha_env arg (x::aliases) vars in - (omega::patl,mk_action (List.map snd env))::rem - | p -> +let rec explode_or_pat p arg patl mk_action vars aliases rem = + match p.pat_desc with + | Tpat_or (p1, p2, _) -> + explode_or_pat p1 arg patl mk_action vars aliases + (explode_or_pat p2 arg patl mk_action vars aliases rem) + | Tpat_alias (p, id, _) -> + explode_or_pat p arg patl mk_action vars (id :: aliases) rem + | Tpat_var (x, _) -> + let env = mk_alpha_env arg (x :: aliases) vars in + (omega :: patl, mk_action (List.map snd env)) :: rem + | _ -> let env = mk_alpha_env arg aliases vars in - (alpha_pat env p::patl,mk_action (List.map snd env))::rem + (alpha_pat env p :: patl, mk_action (List.map snd env)) :: rem -let pm_free_variables {cases=cases} = +let pm_free_variables { cases } = List.fold_right - (fun (_,act) r -> Ident.Set.union (free_variables act) r) + (fun (_, act) r -> Ident.Set.union (free_variables act) r) cases Ident.Set.empty - (* Basic grouping predicates *) let pat_as_constr = function - | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr + | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr | _ -> fatal_error "Matching.pat_as_constr" let group_const_int = function - | {pat_desc= Tpat_constant Const_int _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_int _) } -> true + | _ -> false let group_const_char = function - | {pat_desc= Tpat_constant Const_char _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_char _) } -> true + | _ -> false let group_const_string = function - | {pat_desc= Tpat_constant Const_string _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_string _) } -> true + | _ -> false let group_const_float = function - | {pat_desc= Tpat_constant Const_float _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_float _) } -> true + | _ -> false let group_const_int32 = function - | {pat_desc= Tpat_constant Const_int32 _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_int32 _) } -> true + | _ -> false let group_const_int64 = function - | {pat_desc= Tpat_constant Const_int64 _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_int64 _) } -> true + | _ -> false let group_const_nativeint = function - | {pat_desc= Tpat_constant Const_nativeint _ } -> true - | _ -> false + | { pat_desc = Tpat_constant (Const_nativeint _) } -> true + | _ -> false and group_constructor = function - | {pat_desc = Tpat_construct (_,_,_)} -> true + | { pat_desc = Tpat_construct (_, _, _) } -> true + | _ -> false + +and group_same_constructor tag = function + | { pat_desc = Tpat_construct (_, cstr, _) } -> + Types.equal_tag tag cstr.cstr_tag | _ -> false and group_variant = function - | {pat_desc = Tpat_variant (_, _, _)} -> true + | { pat_desc = Tpat_variant (_, _, _) } -> true | _ -> false and group_var = function - | {pat_desc=Tpat_any} -> true + | { pat_desc = Tpat_any } -> true | _ -> false and group_tuple = function - | {pat_desc = (Tpat_tuple _|Tpat_any)} -> true + | { pat_desc = Tpat_tuple _ | Tpat_any } -> true | _ -> false and group_record = function - | {pat_desc = (Tpat_record _|Tpat_any)} -> true + | { pat_desc = Tpat_record _ | Tpat_any } -> true | _ -> false and group_array = function - | {pat_desc=Tpat_array _} -> true + | { pat_desc = Tpat_array _ } -> true | _ -> false and group_lazy = function - | {pat_desc = Tpat_lazy _} -> true + | { pat_desc = Tpat_lazy _ } -> true | _ -> false -let get_group p = match p.pat_desc with -| Tpat_any -> group_var -| Tpat_constant Const_int _ -> group_const_int -| Tpat_constant Const_char _ -> group_const_char -| Tpat_constant Const_string _ -> group_const_string -| Tpat_constant Const_float _ -> group_const_float -| Tpat_constant Const_int32 _ -> group_const_int32 -| Tpat_constant Const_int64 _ -> group_const_int64 -| Tpat_constant Const_nativeint _ -> group_const_nativeint -| Tpat_construct _ -> group_constructor -| Tpat_tuple _ -> group_tuple -| Tpat_record _ -> group_record -| Tpat_array _ -> group_array -| Tpat_variant (_,_,_) -> group_variant -| Tpat_lazy _ -> group_lazy -| _ -> fatal_error "Matching.get_group" - - - -let is_or p = match p.pat_desc with -| Tpat_or _ -> true -| _ -> false - -(* Conditions for appending to the Or matrix *) -let conda p q = not (may_compat p q) -and condb act ps qs = not (is_guarded act) && Parmatch.le_pats qs ps - -let or_ok p ps l = - List.for_all - (function - | ({pat_desc=Tpat_or _} as q::qs,act) -> - conda p q || condb act ps qs - | _ -> true) - l +let can_group p = + match p.pat_desc with + | Tpat_any -> group_var + | Tpat_constant (Const_int _) -> group_const_int + | Tpat_constant (Const_char _) -> group_const_char + | Tpat_constant (Const_string _) -> group_const_string + | Tpat_constant (Const_float _) -> group_const_float + | Tpat_constant (Const_int32 _) -> group_const_int32 + | Tpat_constant (Const_int64 _) -> group_const_int64 + | Tpat_constant (Const_nativeint _) -> group_const_nativeint + | Tpat_construct (_, { cstr_tag = Cstr_extension _ as t }, _) -> + (* Extension constructors with distinct names may be equal thanks to + constructor rebinding. So we need to produce a specialized + submatrix for each syntactically-distinct constructor (with a threading + of exits such that each submatrix falls back to the + potentially-compatible submatrices below it). *) + group_same_constructor t + | Tpat_construct _ -> group_constructor + | Tpat_tuple _ -> group_tuple + | Tpat_record _ -> group_record + | Tpat_array _ -> group_array + | Tpat_variant (_, _, _) -> group_variant + | Tpat_lazy _ -> group_lazy + | _ -> fatal_error "Matching.can_group" + +let is_or p = + match p.pat_desc with + | Tpat_or _ -> true + | _ -> false -(* Insert or append a pattern in the Or matrix *) +let rec omega_like p = + match p.pat_desc with + | Tpat_any + | Tpat_var _ -> + true + | Tpat_alias (p, _, _) -> omega_like p + | Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2 + | _ -> false let equiv_pat p q = le_pat p q && le_pat q p -let rec get_equiv p l = match l with - | (q::_,_) as cl::rem -> +let rec extract_equiv_head p l = + match l with + | ((q :: _, _) as cl) :: rem -> if equiv_pat p q then - let others,rem = get_equiv p rem in - cl::others,rem + let others, rem = extract_equiv_head p rem in + (cl :: others, rem) else - [],l - | _ -> [],l - - -let insert_or_append p ps act ors no = - let rec attempt seen = function - | (q::qs,act_q) as cl::rem -> - if is_or q then begin - if may_compat p q then - if - Typedtree.pat_bound_idents p = [] && - Typedtree.pat_bound_idents q = [] && - equiv_pat p q - then (* attempt insert, for equivalent orpats with no variables *) - let _, not_e = get_equiv q rem in - if - or_ok p ps not_e && (* check append condition for head of O *) - List.for_all (* check insert condition for tail of O *) - (fun cl -> match cl with - | (q::_,_) -> not (may_compat p q) - | _ -> assert false) - seen - then (* insert *) - List.rev_append seen ((p::ps,act)::cl::rem), no - else (* fail to insert or append *) - ors,(p::ps,act)::no - else if condb act_q ps qs then (* check condition (b) for append *) - attempt (cl::seen) rem + ([], l) + | _ -> ([], l) + +module Or_matrix = struct + (* Splitting a matrix uses an or-matrix that contains or-patterns (at + the head of some of its rows). + + The property that we want to maintain for the rows of the + or-matrix is that if the row p::ps is before q::qs and p is an + or-pattern, and v::vs matches p but not ps, then we don't need to + try q::qs. This is necessary because the compilation of the + or-pattern p will exit to a sub-matrix and never come back. + + For this to hold, (p::ps) and (q::qs) must satisfy one of: + - disjointness: p and q are not compatible + - ordering: if p and q are compatible, ps is more general than qs + (this only works if the row p::ps is not guarded; otherwise the + guard could fail and q::qs should still be tried) + *) + + (* Conditions for appending to the Or matrix *) + let disjoint p q = not (may_compat p q) + + let safe_below (ps, act) qs = + (not (is_guarded act)) && Parmatch.le_pats ps qs + + let safe_below_or_matrix l (q, qs) = + List.for_all + (function + | ({ pat_desc = Tpat_or _ } as p) :: ps, act_p -> + disjoint p q || safe_below (ps, act_p) qs + | _ -> true) + l + + (* Insert or append a clause in the Or matrix: + - insert: adding the clause in the middle of the or_matrix + - append: adding the clause at the bottom of the or_matrix + + If neither are possible we add to the bottom of the No matrix. + *) + let insert_or_append (p, ps, act) rev_ors rev_no = + let safe_to_insert rem (p, ps) seen = + let _, not_e = extract_equiv_head p rem in + (* check append condition for head of O *) + safe_below_or_matrix not_e (p, ps) + && (* check insert condition for tail of O *) + List.for_all + (fun cl -> + match cl with + | q :: _, _ -> disjoint p q + | _ -> assert false) + seen + in + let rec attempt seen = function + (* invariant: the new clause is safe to append at the end of + [seen] (but maybe not [rem] yet) *) + | [] -> ((p :: ps, act) :: rev_ors, rev_no) + | ([], _act) :: _ -> assert false + | ((q :: qs, act_q) as cl) :: rem -> + if (not (is_or q)) || disjoint p q then + attempt (cl :: seen) rem + else if + Typedtree.pat_bound_idents p = [] + && Typedtree.pat_bound_idents q = [] + && equiv_pat p q + then + (* attempt insertion, for equivalent orpats with no variables *) + if safe_to_insert rem (p, ps) seen then + (List.rev_append seen ((p :: ps, act) :: cl :: rem), rev_no) else - ors,(p::ps,act)::no - else (* p # q, go on with append/insert *) - attempt (cl::seen) rem - end else (* q is not an or-pat, go on with append/insert *) - attempt (cl::seen) rem - | _ -> (* [] in fact *) - (p::ps,act)::ors,no in (* success in appending *) - attempt [] ors + (* fail to insert or append *) + (rev_ors, (p :: ps, act) :: rev_no) + else if safe_below (qs, act_q) ps then + attempt (cl :: seen) rem + else + (rev_ors, (p :: ps, act) :: rev_no) + in + attempt [] rev_ors +end (* Reconstruct default information from half_compiled pm list *) -let rec rebuild_matrix pmh = match pmh with - | Pm pm -> as_matrix pm.cases - | PmOr {or_matrix=m} -> m - | PmVar x -> add_omega_column (rebuild_matrix x.inside) - -let rec rebuild_default nexts def = match nexts with -| [] -> def -| (e, pmh)::rem -> - (add_omega_column (rebuild_matrix pmh), e):: - rebuild_default rem def - -let rebuild_nexts arg nexts k = - List.fold_right - (fun (e, pm) k -> (e, PmVar {inside=pm ; var_arg=arg})::k) - nexts k - +let as_matrix cases = get_mins le_pats (List.map (fun (ps, _) -> ps) cases) (* - Split a matching. + Split a matching along the first column. + Splitting is first directed by or-patterns, then by tests (e.g. constructors)/variable transitions. @@ -879,407 +1143,409 @@ let rebuild_nexts arg nexts k = Some precompilation of or-patterns and variable pattern occurs. Mostly this means that bindings are performed now, being replaced by let-bindings - in actions (cf. simplify_cases). + in actions (cf. half_simplify_cases). Additionally, if the match argument is a variable, matchings whose first column is made of variables only are split further (cf. precompile_var). -*) + --- + + Note: we assume that the first column of each pattern is coherent -- all + patterns match values of the same type. This comes from the fact that + we make agressive splitting decisions, splitting pattern heads that + may be different into different submatrices; in particular, in a given + submatrix the first column is formed of first arguments to the same + constructor. + + GADTs are not an issue because we split columns left-to-right, and + GADT typing also introduces typing equations left-to-right. In + particular, a leftmost column in matching.ml will be well-typed under + a set of equations accepted by the type-checker, and those equations + are forced to remain consistent: they can equate known types to + abstract types, but they cannot equate two incompatible known types + together, and in particular incompatible pattern heads do not appear + in a leftmost column. + + Parmatch has to be more conservative because it splits less + agressively: submatrices will contain not just the arguments of + a given pattern head, but also other lines that may be compatible with + it, in particular those with a leftmost omega and those starting with + an extension constructor that may be equal to it. +*) let rec split_or argo cls args def = - - let cls = simplify_cases args cls in - - let rec do_split before ors no = function + let cls = half_simplify_cases args cls in + let rec do_split rev_before rev_ors rev_no = function | [] -> - cons_next - (List.rev before) (List.rev ors) (List.rev no) - | ((p::ps,act) as cl)::rem -> - if up_ok cl no then - if is_or p then - let ors, no = insert_or_append p ps act ors no in - do_split before ors no rem - else begin - if up_ok cl ors then - do_split (cl::before) ors no rem - else if or_ok p ps ors then - do_split before (cl::ors) no rem - else - do_split before ors (cl::no) rem - end + cons_next (List.rev rev_before) (List.rev rev_ors) (List.rev rev_no) + | ((p :: ps, act) as cl) :: rem -> + if not (safe_before cl rev_no) then + do_split rev_before rev_ors (cl :: rev_no) rem + else if (not (is_or p)) && safe_before cl rev_ors then + do_split (cl :: rev_before) rev_ors rev_no rem else - do_split before ors (cl::no) rem + let rev_ors, rev_no = + Or_matrix.insert_or_append (p, ps, act) rev_ors rev_no + in + do_split rev_before rev_ors rev_no rem | _ -> assert false - - and cons_next yes yesor = function - | [] -> - precompile_or argo yes yesor args def [] - | rem -> - let {me=next ; matrix=matrix ; top_default=def},nexts = - do_split [] [] [] rem in - let idef = next_raise_count () in - precompile_or - argo yes yesor args - (cons_default matrix idef def) - ((idef,next)::nexts) in - + and cons_next yes yesor no = + let def, nexts = + match no with + | [] -> (def, []) + | _ -> + let { me = next; matrix; top_default = def }, nexts = + do_split [] [] [] no + in + let idef = next_raise_count () in + (Default_environment.cons matrix idef def, (idef, next) :: nexts) + in + match yesor with + | [] -> split_no_or yes args def nexts + | _ -> precompile_or argo yes yesor args def nexts + in do_split [] [] [] cls -(* Ultra-naive splitting, close to semantics, used for extension, - as potential rebind prevents any kind of optimisation *) - -and split_naive cls args def k = - - let rec split_exc cstr0 yes = function +and split_no_or cls args def k = + (* We split the remaining clauses in as few pms as possible while maintaining + the property stated earlier (cf. {1. Precompilation}), i.e. for + any pm in the result, it is possible to decide for any two patterns + on the first column whether their heads are equal or not. + + This generally means that we'll have two kinds of pms: ones where the first + column is made of variables only, and ones where the head is actually a + discriminating pattern. + + There is some subtlety regarding the handling of extension constructors + (where it is not always possible to syntactically decide whether two + different heads match different values), but this is handled by the + [can_group] function. *) + let rec split cls = + let discr = what_is_first_case cls in + collect discr [] [] cls + and collect group_discr rev_yes rev_no = function + | ([], _) :: _ -> assert false + | [ ((ps, _) as cl) ] when rev_yes <> [] && List.for_all omega_like ps -> + (* This enables an extra division in some frequent cases: + last row is made of variables only + + Splitting a matrix there creates two default environments (instead of + one for the non-split matrix), the first of which often gets + specialized away by further refinement, and the second one jumping + directly to the catch-all case -- this produces better code. + + This optimisation is tested in the first part of + testsuite/tests/basic/patmatch_split_no_or.ml *) + collect group_discr rev_yes (cl :: rev_no) [] + | ((p :: _, _) as cl) :: rem -> + if can_group group_discr p && safe_before cl rev_no then + collect group_discr (cl :: rev_yes) rev_no rem + else if should_split group_discr then ( + assert (rev_no = []); + let yes = List.rev rev_yes in + insert_split group_discr yes (cl :: rem) def k + ) else + collect group_discr rev_yes (cl :: rev_no) rem | [] -> - let yes = List.rev yes in - { me = Pm {cases=yes; args=args; default=def;} ; - matrix = as_matrix yes ; - top_default=def}, - k - | (p::_,_ as cl)::rem -> - if group_constructor p then - let cstr = pat_as_constr p in - if cstr = cstr0 then split_exc cstr0 (cl::yes) rem - else - let yes = List.rev yes in - let {me=next ; matrix=matrix ; top_default=def}, nexts = - split_exc cstr [cl] rem in - let idef = next_raise_count () in - let def = cons_default matrix idef def in - { me = Pm {cases=yes; args=args; default=def} ; - matrix = as_matrix yes ; - top_default = def; }, - (idef,next)::nexts - else - let yes = List.rev yes in - let {me=next ; matrix=matrix ; top_default=def}, nexts = - split_noexc [cl] rem in - let idef = next_raise_count () in - let def = cons_default matrix idef def in - { me = Pm {cases=yes; args=args; default=def} ; - matrix = as_matrix yes ; - top_default = def; }, - (idef,next)::nexts - | _ -> assert false - - and split_noexc yes = function - | [] -> precompile_var args (List.rev yes) def k - | (p::_,_ as cl)::rem -> - if group_constructor p then - let yes= List.rev yes in - let {me=next; matrix=matrix; top_default=def;},nexts = - split_exc (pat_as_constr p) [cl] rem in - let idef = next_raise_count () in - precompile_var - args yes - (cons_default matrix idef def) - ((idef,next)::nexts) - else split_noexc (cl::yes) rem - | _ -> assert false in - - match cls with - | [] -> assert false - | (p::_,_ as cl)::rem -> - if group_constructor p then - split_exc (pat_as_constr p) [cl] rem + let yes = List.rev rev_yes and no = List.rev rev_no in + insert_split group_discr yes no def k + and insert_split group_discr yes no def k = + let precompile_group = + if group_var group_discr then + precompile_var else - split_noexc [cl] rem - | _ -> assert false - -and split_constr cls args def k = - let ex_pat = what_is_cases cls in - match ex_pat.pat_desc with - | Tpat_any -> precompile_var args cls def k - | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> - split_naive cls args def k - | _ -> - - let group = get_group ex_pat in - - let rec split_ex yes no = function - | [] -> - let yes = List.rev yes and no = List.rev no in - begin match no with - | [] -> - {me = Pm {cases=yes ; args=args ; default=def} ; - matrix = as_matrix yes ; - top_default = def}, - k - | cl::rem -> - begin match yes with - | [] -> - (* Could not success in raising up a constr matching up *) - split_noex [cl] [] rem - | _ -> - let {me=next ; matrix=matrix ; top_default=def}, nexts = - split_noex [cl] [] rem in - let idef = next_raise_count () in - let def = cons_default matrix idef def in - {me = Pm {cases=yes ; args=args ; default=def} ; - matrix = as_matrix yes ; - top_default = def }, - (idef, next)::nexts - end - end - | (p::_,_) as cl::rem -> - if group p && up_ok cl no then - split_ex (cl::yes) no rem - else - split_ex yes (cl::no) rem - | _ -> assert false + do_not_precompile + in + match no with + | [] -> precompile_group args yes def k + | _ -> + let { me = next; matrix; top_default = def }, nexts = split no in + let idef = next_raise_count () in + precompile_group args yes + (Default_environment.cons matrix idef def) + ((idef, next) :: nexts) + and should_split group_discr = + match group_discr.pat_desc with + | Tpat_construct (_, { cstr_tag = Cstr_extension _ }, _) -> + (* it is unlikely that we will raise anything, so we split now *) + true + | _ -> false + in + split cls - and split_noex yes no = function - | [] -> - let yes = List.rev yes and no = List.rev no in - begin match no with - | [] -> precompile_var args yes def k - | cl::rem -> - let {me=next ; matrix=matrix ; top_default=def}, nexts = - split_ex [cl] [] rem in - let idef = next_raise_count () in - precompile_var - args yes - (cons_default matrix idef def) - ((idef,next)::nexts) - end - | [ps,_ as cl] - when List.for_all group_var ps && yes <> [] -> - (* This enables an extra division in some frequent cases : - last row is made of variables only *) - split_noex yes (cl::no) [] - | (p::_,_) as cl::rem -> - if not (group p) && up_ok cl no then - split_noex (cl::yes) no rem - else - split_noex yes (cl::no) rem - | _ -> assert false in +and precompile_var args cls def k = + (* Strategy: pop the first column, + precompile the rest, add a PmVar to all precompiled submatrices. + If the rest doesn't generate any split, abort and do_not_precompile. *) + match args with + | [] -> assert false + | _ :: ((Lvar v, _) as arg) :: rargs -> ( + (* We will use the name of the head column of the submatrix + we compile, and this is the *second* column of our argument. *) match cls with - | ((p::_,_) as cl)::rem -> - if group p then split_ex [cl] [] rem - else split_noex [cl] [] rem - | _ -> assert false - -and precompile_var args cls def k = match args with -| [] -> assert false -| _::((Lvar v as av,_) as arg)::rargs -> - begin match cls with - | [_] -> (* as split as it can *) - dont_precompile_var args cls def k - | _ -> -(* Precompile *) - let var_cls = - List.map - (fun (ps,act) -> match ps with - | _::ps -> ps,act | _ -> assert false) - cls - and var_def = make_default (fun _ rem -> rem) def in - let {me=first ; matrix=matrix}, nexts = - split_or (Some v) var_cls (arg::rargs) var_def in - -(* Compute top information *) - match nexts with - | [] -> (* If you need *) - dont_precompile_var args cls def k - | _ -> - let rfirst = - {me = PmVar {inside=first ; var_arg = av} ; - matrix = add_omega_column matrix ; - top_default = rebuild_default nexts def ; } - and rnexts = rebuild_nexts av nexts k in - rfirst, rnexts - end -| _ -> - dont_precompile_var args cls def k - -and dont_precompile_var args cls def k = - {me = Pm {cases = cls ; args = args ; default = def } ; - matrix=as_matrix cls ; - top_default=def},k - -and precompile_or argo cls ors args def k = match ors with -| [] -> split_constr cls args def k -| _ -> - let rec do_cases = function - | ({pat_desc=Tpat_or _} as orp::patl, action)::rem -> - let others,rem = get_equiv orp rem in - let orpm = - {cases = - (patl, action):: - List.map - (function - | (_::ps,action) -> ps,action - | _ -> assert false) - others ; - args = (match args with _::r -> r | _ -> assert false) ; - default = default_compat orp def} in - let pm_fv = pm_free_variables orpm in - let vars = - Typedtree.pat_bound_idents_full orp - |> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv) - |> List.map (fun (id,_,ty) -> id,Typeopt.value_kind orp.pat_env ty) + | [ _ ] -> + (* as split as it can *) + do_not_precompile args cls def k + | _ -> ( + (* Precompile *) + let var_cls = + List.map + (fun (ps, act) -> + match ps with + | p :: ps -> + assert (group_var p); + (ps, act) + | _ -> assert false) + cls + and var_def = Default_environment.pop_column def in + let { me = first; matrix }, nexts = + split_or (Some v) var_cls (arg :: rargs) var_def in - let or_num = next_raise_count () in - let new_patl = Parmatch.omega_list patl in - - let mk_new_action vs = - Lstaticraise - (or_num, List.map (fun v -> Lvar v) vs) in - - let body,handlers = do_cases rem in - explode_or_pat - argo new_patl mk_new_action body (List.map fst vars) [] orp, - let mat = [[orp]] in - ((mat, or_num, vars , orpm):: handlers) - | cl::rem -> - let new_ord,new_to_catch = do_cases rem in - cl::new_ord,new_to_catch - | [] -> [],[] in - - let end_body, handlers = do_cases ors in - let matrix = as_matrix (cls@ors) - and body = {cases=cls@end_body ; args=args ; default=def} in - {me = PmOr {body=body ; handlers=handlers ; or_matrix=matrix} ; - matrix=matrix ; - top_default=def}, - k - -let split_precompile argo pm = - let {me=next}, nexts = split_or argo pm.cases pm.args pm.default in - if dbg && (nexts <> [] || (match next with PmOr _ -> true | _ -> false)) - then begin - Format.eprintf "** SPLIT **\n" ; - pretty_pm pm ; - pretty_precompiled_res next nexts - end ; - next, nexts - + (* Compute top information *) + match nexts with + | [] -> + (* If you need *) + do_not_precompile args cls def k + | _ -> + let rec rebuild_matrix pmh = + match pmh with + | Pm pm -> as_matrix pm.cases + | PmOr { or_matrix = m } -> m + | PmVar x -> add_omega_column (rebuild_matrix x.inside) + in + let rebuild_default nexts def = + (* We can't just do: + {[ + List.map + (fun (mat, e) -> add_omega_column mat, e) + top_default (* assuming it'd been bound. *) + ]} + As we would be loosing information: [def] is more precise + than [add_omega_column (pop_column def)]. *) + List.fold_right + (fun (e, pmh) -> + Default_environment.cons + (add_omega_column (rebuild_matrix pmh)) + e) + nexts def + in + let rebuild_nexts nexts k = + map_end (fun (e, pm) -> (e, PmVar { inside = pm })) nexts k + in + let rfirst = + { me = PmVar { inside = first }; + matrix = add_omega_column matrix; + top_default = rebuild_default nexts def + } + and rnexts = rebuild_nexts nexts k in + (rfirst, rnexts) + ) + ) + | _ -> do_not_precompile args cls def k + +and do_not_precompile args cls def k = + ( { me = Pm { cases = cls; args; default = def }; + matrix = as_matrix cls; + top_default = def + }, + k ) + +and precompile_or argo cls ors args def k = + let rec do_cases = function + | (({ pat_desc = Tpat_or _ } as orp) :: patl, action) :: rem -> + let others, rem = extract_equiv_head orp rem in + let orpm = + { cases = + (patl, action) + :: List.map + (function + | _ :: ps, action -> (ps, action) + | _ -> assert false) + others; + args = + ( match args with + | _ :: r -> r + | _ -> assert false + ); + default = Default_environment.pop_compat orp def + } + in + let pm_fv = pm_free_variables orpm in + let vars = + (* bound variables of the or-pattern and used in the orpm actions *) + Typedtree.pat_bound_idents_full orp + |> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv) + |> List.map (fun (id, _, ty) -> + (id, Typeopt.value_kind orp.pat_env ty)) + in + let or_num = next_raise_count () in + let new_patl = Parmatch.omega_list patl in + let mk_new_action vs = + Lstaticraise (or_num, List.map (fun v -> Lvar v) vs) + in + let rem_cases, rem_handlers = do_cases rem in + let cases = + explode_or_pat orp argo new_patl mk_new_action (List.map fst vars) [] + rem_cases + in + let handler = + { provenance = [ [ orp ] ]; exit = or_num; vars; pm = orpm } + in + (cases, handler :: rem_handlers) + | cl :: rem -> + let new_ord, new_to_catch = do_cases rem in + (cl :: new_ord, new_to_catch) + | [] -> ([], []) + in + let cases, handlers = do_cases ors in + let matrix = as_matrix (cls @ ors) + and body = { cases = cls @ cases; args; default = def } in + ( { me = PmOr { body; handlers; or_matrix = matrix }; + matrix; + top_default = def + }, + k ) + +let split_and_precompile argo pm = + let { me = next }, nexts = split_or argo pm.cases pm.args pm.default in + if + dbg + && (nexts <> [] + || + match next with + | PmOr _ -> true + | _ -> false + ) + then ( + Format.eprintf "** SPLIT **\n"; + pretty_pm pm; + pretty_precompiled_res next nexts + ); + (next, nexts) (* General divide functions *) -let add_line patl_action pm = pm.cases <- patl_action :: pm.cases; pm - -type cell = - {pm : pattern_matching ; - ctx : ctx list ; - pat : pattern} - -let add make_matching_fun division eq_key key patl_action args = - try - let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in - cell.pm.cases <- patl_action :: cell.pm.cases; - division - with Not_found -> - let cell = make_matching_fun args in - cell.pm.cases <- [patl_action] ; - (key, cell) :: division - - -let divide make eq_key get_key get_args ctx pm = - - let rec divide_rec = function - | (p::patl,action) :: rem -> - let this_match = divide_rec rem in - add - (make p pm.default ctx) - this_match eq_key (get_key p) (get_args p patl,action) pm.args - | _ -> [] in - - divide_rec pm.cases - - -let divide_line make_ctx make get_args pat ctx pm = - let rec divide_rec = function - | (p::patl,action) :: rem -> - let this_match = divide_rec rem in - add_line (get_args p patl, action) this_match - | _ -> make pm.default pm.args in - - {pm = divide_rec pm.cases ; - ctx=make_ctx ctx ; - pat=pat} +type cell = { pm : pattern_matching; ctx : Context.t; discr : pattern } +(** a submatrix after specializing by discriminant pattern; + [ctx] is the context shared by all rows. *) + +type 'a division = { + args : (lambda * let_kind) list; + cells : ('a * cell) list +} + +let add_in_div make_matching_fun eq_key key patl_action division = + let cells = + match List.find_opt (fun (k, _) -> eq_key key k) division.cells with + | None -> + let cell = make_matching_fun division.args in + cell.pm.cases <- [ patl_action ]; + (key, cell) :: division.cells + | Some (_, cell) -> + cell.pm.cases <- patl_action :: cell.pm.cases; + division.cells + in + { division with cells } + +let divide make eq_key get_key get_args ctx (pm : pattern_matching) = + let add clause division = + match clause with + | [], _ -> assert false + | p :: patl, action -> + add_in_div (make p pm.default ctx) eq_key (get_key p) + (get_args p patl, action) + division + in + List.fold_right add pm.cases { args = pm.args; cells = [] } +let add_line patl_action pm = + pm.cases <- patl_action :: pm.cases; + pm +let divide_line make_ctx make get_args discr ctx (pm : pattern_matching) = + let add clause submatrix = + match clause with + | [], _ -> assert false + | p :: patl, action -> add_line (get_args p patl, action) submatrix + in + let pm = List.fold_right add pm.cases (make pm.default pm.args) in + { pm; ctx = make_ctx ctx; discr } (* Then come various functions, There is one set of functions per matching style (constants, constructors etc.) - - matcher functions are arguments to make_default (for default handlers) + - matcher functions are arguments to Default_environment.specialize (for + default handlers) They may raise NoMatch or OrPat and perform the full matching (selection + arguments). - - get_args and get_key are for the compiled matrices, note that selection and getting arguments are separated. - - make_ _matching combines the previous functions for producing + - make_*_matching combines the previous functions for producing new ``pattern_matching'' records. *) - - -let rec matcher_const cst p rem = match p.pat_desc with -| Tpat_or (p1,p2,_) -> - begin try - matcher_const cst p1 rem with - | NoMatch -> matcher_const cst p2 rem - end -| Tpat_constant c1 when const_compare c1 cst = 0 -> rem -| Tpat_any -> rem -| _ -> raise NoMatch +let rec matcher_const cst p rem = + match p.pat_desc with + | Tpat_or (p1, p2, _) -> ( + try matcher_const cst p1 rem with NoMatch -> matcher_const cst p2 rem + ) + | Tpat_constant c1 when const_compare c1 cst = 0 -> rem + | Tpat_any -> rem + | _ -> raise NoMatch let get_key_constant caller = function - | {pat_desc= Tpat_constant cst} -> cst + | { pat_desc = Tpat_constant cst } -> cst | p -> - Format.eprintf "BAD: %s" caller ; - pretty_pat p ; + Format.eprintf "BAD: %s" caller; + pretty_pat p; assert false let get_args_constant _ rem = rem let make_constant_matching p def ctx = function - [] -> fatal_error "Matching.make_constant_matching" - | (_ :: argl) -> + | [] -> fatal_error "Matching.make_constant_matching" + | _ :: argl -> let def = - make_default - (matcher_const (get_key_constant "make" p)) def - and ctx = - filter_ctx p ctx in - {pm = {cases = []; args = argl ; default = def} ; - ctx = ctx ; - pat = normalize_pat p} - - - + Default_environment.specialize + (matcher_const (get_key_constant "make" p)) + def + and ctx = Context.specialize p ctx in + { pm = { cases = []; args = argl; default = def }; + ctx; + discr = normalize_pat p + } let divide_constant ctx m = - divide - make_constant_matching - (fun c d -> const_compare c d = 0) (get_key_constant "divide") - get_args_constant - ctx m + divide make_constant_matching + (fun c d -> const_compare c d = 0) + (get_key_constant "divide") + get_args_constant ctx m (* Matching against a constructor *) - let make_field_args loc binding_kind arg first_pos last_pos argl = let rec make_args pos = - if pos > last_pos - then argl - else (Lprim(Pfield pos, [arg], loc), binding_kind) :: make_args (pos + 1) - in make_args first_pos + if pos > last_pos then + argl + else + (Lprim (Pfield pos, [ arg ], loc), binding_kind) :: make_args (pos + 1) + in + make_args first_pos let get_key_constr = function - | {pat_desc=Tpat_construct (_, cstr,_)} -> cstr.cstr_tag + | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr.cstr_tag | _ -> assert false -let get_args_constr p rem = match p with -| {pat_desc=Tpat_construct (_, _, args)} -> args @ rem -| _ -> assert false +let get_args_constr p rem = + match p with + | { pat_desc = Tpat_construct (_, _, args) } -> args @ rem + | _ -> assert false (* NB: matcher_constr applies to default matrices. @@ -1288,136 +1554,163 @@ let get_args_constr p rem = match p with This comparison is performed by Types.may_equal_constr. *) -let matcher_constr cstr = match cstr.cstr_arity with -| 0 -> - let rec matcher_rec q rem = match q.pat_desc with - | Tpat_or (p1,p2,_) -> - begin - try matcher_rec p1 rem - with NoMatch -> matcher_rec p2 rem - end - | Tpat_construct (_, cstr',[]) - when Types.may_equal_constr cstr cstr' -> rem - | Tpat_any -> rem - | _ -> raise NoMatch in - matcher_rec -| 1 -> - let rec matcher_rec q rem = match q.pat_desc with - | Tpat_or (p1,p2,_) -> - let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None - and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in - begin match r1,r2 with - | None, None -> raise NoMatch - | Some r1, None -> r1 - | None, Some r2 -> r2 - | Some (a1::_), Some (a2::_) -> - {a1 with - pat_loc = Location.none ; - pat_desc = Tpat_or (a1, a2, None)}:: +let matcher_constr cstr = + match cstr.cstr_arity with + | 0 -> + let rec matcher_rec q rem = + match q.pat_desc with + | Tpat_or (p1, p2, _) -> ( + try matcher_rec p1 rem with NoMatch -> matcher_rec p2 rem + ) + | Tpat_construct (_, cstr', []) when Types.may_equal_constr cstr cstr' + -> rem - | _, _ -> assert false - end - | Tpat_construct (_, cstr', [arg]) - when Types.may_equal_constr cstr cstr' -> arg::rem - | Tpat_any -> omega::rem - | _ -> raise NoMatch in - matcher_rec -| _ -> - fun q rem -> match q.pat_desc with - | Tpat_or (_,_,_) -> raise OrPat - | Tpat_construct (_,cstr',args) - when Types.may_equal_constr cstr cstr' -> args @ rem - | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem - | _ -> raise NoMatch + | Tpat_any -> rem + | _ -> raise NoMatch + in + matcher_rec + | 1 -> + let rec matcher_rec q rem = + match q.pat_desc with + | Tpat_or (p1, p2, _) -> ( + (* if both sides of the or-pattern match the head constructor, + (K p1 | K p2) :: rem + return (p1 | p2) :: rem *) + let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None + and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in + match (r1, r2) with + | None, None -> raise NoMatch + | Some r1, None -> r1 + | None, Some r2 -> r2 + | Some (a1 :: _), Some (a2 :: _) -> + { a1 with + pat_loc = Location.none; + pat_desc = Tpat_or (a1, a2, None) + } + :: rem + | _, _ -> assert false + ) + | Tpat_construct (_, cstr', [ arg ]) + when Types.may_equal_constr cstr cstr' -> + arg :: rem + | Tpat_any -> omega :: rem + | _ -> raise NoMatch + in + matcher_rec + | _ -> ( + fun q rem -> + match q.pat_desc with + | Tpat_or (_, _, _) -> + (* we cannot preserve the or-pattern as in the arity-1 case, + because we cannot express + (K (p1, .., pn) | K (q1, .. qn)) + as (p1 .. pn | q1 .. qn) *) + raise OrPat + | Tpat_construct (_, cstr', args) + when Types.may_equal_constr cstr cstr' -> + args @ rem + | Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem + | _ -> raise NoMatch + ) let make_constr_matching p def ctx = function - [] -> fatal_error "Matching.make_constr_matching" - | ((arg, _mut) :: argl) -> + | [] -> fatal_error "Matching.make_constr_matching" + | (arg, _mut) :: argl -> let cstr = pat_as_constr p in let newargs = if cstr.cstr_inlined <> None then (arg, Alias) :: argl - else match cstr.cstr_tag with - Cstr_constant _ | Cstr_block _ -> - make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl - | Cstr_unboxed -> (arg, Alias) :: argl - | Cstr_extension _ -> - make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl in - {pm= - {cases = []; args = newargs; - default = make_default (matcher_constr cstr) def} ; - ctx = filter_ctx p ctx ; - pat=normalize_pat p} - + else + match cstr.cstr_tag with + | Cstr_constant _ + | Cstr_block _ -> + make_field_args p.pat_loc Alias arg 0 (cstr.cstr_arity - 1) argl + | Cstr_unboxed -> (arg, Alias) :: argl + | Cstr_extension _ -> + make_field_args p.pat_loc Alias arg 1 cstr.cstr_arity argl + in + { pm = + { cases = []; + args = newargs; + default = Default_environment.specialize (matcher_constr cstr) def + }; + ctx = Context.specialize p ctx; + discr = normalize_pat p + } let divide_constructor ctx pm = - divide - make_constr_matching - (=) get_key_constr get_args_constr - ctx pm + divide make_constr_matching ( = ) get_key_constr get_args_constr ctx pm (* Matching against a variant *) -let rec matcher_variant_const lab p rem = match p.pat_desc with -| Tpat_or (p1, p2, _) -> - begin - try - matcher_variant_const lab p1 rem - with - | NoMatch -> matcher_variant_const lab p2 rem - end -| Tpat_variant (lab1,_,_) when lab1=lab -> rem -| Tpat_any -> rem -| _ -> raise NoMatch - +let rec matcher_variant_const lab p rem = + match p.pat_desc with + | Tpat_or (p1, p2, _) -> ( + try matcher_variant_const lab p1 rem + with NoMatch -> matcher_variant_const lab p2 rem + ) + | Tpat_variant (lab1, _, _) when lab1 = lab -> rem + | Tpat_any -> rem + | _ -> raise NoMatch let make_variant_matching_constant p lab def ctx = function - [] -> fatal_error "Matching.make_variant_matching_constant" - | (_ :: argl) -> - let def = make_default (matcher_variant_const lab) def - and ctx = filter_ctx p ctx in - {pm={ cases = []; args = argl ; default=def} ; - ctx=ctx ; - pat = normalize_pat p} - -let matcher_variant_nonconst lab p rem = match p.pat_desc with -| Tpat_or (_,_,_) -> raise OrPat -| Tpat_variant (lab1,Some arg,_) when lab1=lab -> arg::rem -| Tpat_any -> omega::rem -| _ -> raise NoMatch - + | [] -> fatal_error "Matching.make_variant_matching_constant" + | _ :: argl -> + let def = Default_environment.specialize (matcher_variant_const lab) def + and ctx = Context.specialize p ctx in + { pm = { cases = []; args = argl; default = def }; + ctx; + discr = normalize_pat p + } + +let matcher_variant_nonconst lab p rem = + match p.pat_desc with + | Tpat_or (_, _, _) -> raise OrPat + | Tpat_variant (lab1, Some arg, _) when lab1 = lab -> arg :: rem + | Tpat_any -> omega :: rem + | _ -> raise NoMatch let make_variant_matching_nonconst p lab def ctx = function - [] -> fatal_error "Matching.make_variant_matching_nonconst" - | ((arg, _mut) :: argl) -> - let def = make_default (matcher_variant_nonconst lab) def - and ctx = filter_ctx p ctx in - {pm= - {cases = []; args = (Lprim(Pfield 1, [arg], p.pat_loc), Alias) :: argl; - default=def} ; - ctx=ctx ; - pat = normalize_pat p} - -let divide_variant row ctx {cases = cl; args = al; default=def} = + | [] -> fatal_error "Matching.make_variant_matching_nonconst" + | (arg, _mut) :: argl -> + let def = + Default_environment.specialize (matcher_variant_nonconst lab) def + and ctx = Context.specialize p ctx in + { pm = + { cases = []; + args = (Lprim (Pfield 1, [ arg ], p.pat_loc), Alias) :: argl; + default = def + }; + ctx; + discr = normalize_pat p + } + +let divide_variant row ctx { cases = cl; args; default = def } = let row = Btype.row_repr row in let rec divide = function - ({pat_desc = Tpat_variant(lab, pato, _)} as p:: patl, action) :: rem -> + | (({ pat_desc = Tpat_variant (lab, pato, _) } as p) :: patl, action) + :: rem -> ( let variants = divide rem in - if try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent - with Not_found -> true + if + try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent + with Not_found -> true then variants - else begin + else let tag = Btype.hash_variant lab in match pato with - None -> - add (make_variant_matching_constant p lab def ctx) variants - (=) (Cstr_constant tag) (patl, action) al + | None -> + add_in_div + (make_variant_matching_constant p lab def ctx) + ( = ) (Cstr_constant tag) (patl, action) variants | Some pat -> - add (make_variant_matching_nonconst p lab def ctx) variants - (=) (Cstr_block tag) (pat :: patl, action) al - end - | _ -> [] + add_in_div + (make_variant_matching_nonconst p lab def ctx) + ( = ) (Cstr_block tag) + (pat :: patl, action) + variants + ) + | _ -> { args; cells = [] } in divide cl @@ -1426,61 +1719,62 @@ let divide_variant row ctx {cases = cl; args = al; default=def} = *) (* Matching against a variable *) - -let get_args_var _ rem = rem - +let get_args_var _p rem = rem let make_var_matching def = function - | [] -> fatal_error "Matching.make_var_matching" - | _::argl -> - {cases=[] ; - args = argl ; - default= make_default get_args_var def} + | [] -> fatal_error "Matching.make_var_matching" + | _ :: argl -> + { cases = []; + args = argl; + default = Default_environment.specialize get_args_var def + } let divide_var ctx pm = - divide_line ctx_lshift make_var_matching get_args_var omega ctx pm + divide_line Context.lshift make_var_matching get_args_var omega ctx pm (* Matching and forcing a lazy value *) -let get_arg_lazy p rem = match p with -| {pat_desc = Tpat_any} -> omega :: rem -| {pat_desc = Tpat_lazy arg} -> arg :: rem -| _ -> assert false +let get_arg_lazy p rem = + match p with + | { pat_desc = Tpat_any } -> omega :: rem + | { pat_desc = Tpat_lazy arg } -> arg :: rem + | _ -> assert false -let matcher_lazy p rem = match p.pat_desc with -| Tpat_or (_,_,_) -> raise OrPat -| Tpat_any -| Tpat_var _ -> omega :: rem -| Tpat_lazy arg -> arg :: rem -| _ -> raise NoMatch +let matcher_lazy p rem = + match p.pat_desc with + | Tpat_or (_, _, _) -> raise OrPat + | Tpat_any + | Tpat_var _ -> + omega :: rem + | Tpat_lazy arg -> arg :: rem + | _ -> raise NoMatch (* Inlining the tag tests before calling the primitive that works on lazy blocks. This is also used in translcore.ml. No other call than Obj.tag when the value has been forced before. *) -let prim_obj_tag = - Primitive.simple ~name:"caml_obj_tag" ~arity:1 ~alloc:false +let prim_obj_tag = Primitive.simple ~name:"caml_obj_tag" ~arity:1 ~alloc:false let get_mod_field modname field = - lazy ( - let mod_ident = Ident.create_persistent modname in - let env = Env.add_persistent_structure mod_ident Env.initial_safe_string in - match Env.open_pers_signature modname env with - | exception Not_found -> fatal_error ("Module "^modname^" unavailable.") - | env -> begin - match Env.lookup_value (Longident.Lident field) env with - | exception Not_found -> - fatal_error ("Primitive "^modname^"."^field^" not found.") - | (path, _) -> transl_value_path Location.none env path - end - ) - -let code_force_lazy_block = - get_mod_field "CamlinternalLazy" "force_lazy_block" -let code_force_lazy = - get_mod_field "CamlinternalLazy" "force" -;; + lazy + (let mod_ident = Ident.create_persistent modname in + let env = + Env.add_persistent_structure mod_ident Env.initial_safe_string + in + match Env.open_pers_signature modname env with + | exception Not_found -> + fatal_error ("Module " ^ modname ^ " unavailable.") + | env -> ( + match Env.find_value_by_name (Longident.Lident field) env with + | exception Not_found -> + fatal_error ("Primitive " ^ modname ^ "." ^ field ^ " not found.") + | path, _ -> transl_value_path Location.none env path + )) + +let code_force_lazy_block = get_mod_field "CamlinternalLazy" "force_lazy_block" + +let code_force_lazy = get_mod_field "CamlinternalLazy" "force" (* inline_lazy_force inlines the beginning of the code of Lazy.force. When the value argument is tagged as: @@ -1496,50 +1790,75 @@ let inline_lazy_force_cond arg loc = let idarg = Ident.create_local "lzarg" in let varg = Lvar idarg in let tag = Ident.create_local "tag" in + let tag_var = Lvar tag in let force_fun = Lazy.force code_force_lazy_block in - Llet(Strict, Pgenval, idarg, arg, - Llet(Alias, Pgenval, tag, Lprim(Pccall prim_obj_tag, [varg], loc), - Lifthenelse( - (* if (tag == Obj.forward_tag) then varg.(0) else ... *) - Lprim(Pintcomp Ceq, - [Lvar tag; Lconst(Const_base(Const_int Obj.forward_tag))], - loc), - Lprim(Pfield 0, [varg], loc), - Lifthenelse( - (* ... if (tag == Obj.lazy_tag) then Lazy.force varg else ... *) - Lprim(Pintcomp Ceq, - [Lvar tag; Lconst(Const_base(Const_int Obj.lazy_tag))], - loc), - Lapply{ap_should_be_tailcall=false; - ap_loc=loc; - ap_func=force_fun; - ap_args=[varg]; - ap_inlined=Default_inline; - ap_specialised=Default_specialise}, - (* ... arg *) - varg)))) + Llet + ( Strict, + Pgenval, + idarg, + arg, + Llet + ( Alias, + Pgenval, + tag, + Lprim (Pccall prim_obj_tag, [ varg ], loc), + Lifthenelse + ( (* if (tag == Obj.forward_tag) then varg.(0) else ... *) + Lprim + ( Pintcomp Ceq, + [ tag_var; Lconst (Const_base (Const_int Obj.forward_tag)) ], + loc ), + Lprim (Pfield 0, [ varg ], loc), + Lifthenelse + ( (* if (tag == Obj.lazy_tag) then Lazy.force varg else ... *) + Lprim + ( Pintcomp Ceq, + [ tag_var; Lconst (Const_base (Const_int Obj.lazy_tag)) ], + loc ), + Lapply + { ap_should_be_tailcall = false; + ap_loc = loc; + ap_func = force_fun; + ap_args = [ varg ]; + ap_inlined = Default_inline; + ap_specialised = Default_specialise + }, + (* ... arg *) + varg ) ) ) ) let inline_lazy_force_switch arg loc = let idarg = Ident.create_local "lzarg" in let varg = Lvar idarg in let force_fun = Lazy.force code_force_lazy_block in - Llet(Strict, Pgenval, idarg, arg, - Lifthenelse( - Lprim(Pisint, [varg], loc), varg, - (Lswitch - (varg, - { sw_numconsts = 0; sw_consts = []; - sw_numblocks = 256; (* PR#6033 - tag ranges from 0 to 255 *) - sw_blocks = - [ (Obj.forward_tag, Lprim(Pfield 0, [varg], loc)); - (Obj.lazy_tag, - Lapply{ap_should_be_tailcall=false; - ap_loc=loc; - ap_func=force_fun; - ap_args=[varg]; - ap_inlined=Default_inline; - ap_specialised=Default_specialise}) ]; - sw_failaction = Some varg }, loc )))) + Llet + ( Strict, + Pgenval, + idarg, + arg, + Lifthenelse + ( Lprim (Pisint, [ varg ], loc), + varg, + Lswitch + ( varg, + { sw_numconsts = 0; + sw_consts = []; + sw_numblocks = 256; + (* PR#6033 - tag ranges from 0 to 255 *) + sw_blocks = + [ (Obj.forward_tag, Lprim (Pfield 0, [ varg ], loc)); + ( Obj.lazy_tag, + Lapply + { ap_should_be_tailcall = false; + ap_loc = loc; + ap_func = force_fun; + ap_args = [ varg ]; + ap_inlined = Default_inline; + ap_specialised = Default_specialise + } ) + ]; + sw_failaction = Some varg + }, + loc ) ) ) let inline_lazy_force arg loc = if !Clflags.afl_instrument then @@ -1547,166 +1866,172 @@ let inline_lazy_force arg loc = so that the GC forwarding optimisation is not visible in the instrumentation output. (see https://github.com/stedolan/crowbar/issues/14) *) - Lapply{ap_should_be_tailcall = false; - ap_loc=loc; - ap_func=Lazy.force code_force_lazy; - ap_args=[arg]; - ap_inlined=Default_inline; - ap_specialised=Default_specialise} + Lapply + { ap_should_be_tailcall = false; + ap_loc = loc; + ap_func = Lazy.force code_force_lazy; + ap_args = [ arg ]; + ap_inlined = Default_inline; + ap_specialised = Default_specialise + } + else if !Clflags.native_code then + (* Lswitch generates compact and efficient native code *) + inline_lazy_force_switch arg loc else - if !Clflags.native_code then - (* Lswitch generates compact and efficient native code *) - inline_lazy_force_switch arg loc - else - (* generating bytecode: Lswitch would generate too many rather big + (* generating bytecode: Lswitch would generate too many rather big tables (~ 250 elts); conditionals are better *) - inline_lazy_force_cond arg loc + inline_lazy_force_cond arg loc let make_lazy_matching def = function - [] -> fatal_error "Matching.make_lazy_matching" - | (arg,_mut) :: argl -> + | [] -> fatal_error "Matching.make_lazy_matching" + | (arg, _mut) :: argl -> { cases = []; - args = - (inline_lazy_force arg Location.none, Strict) :: argl; - default = make_default matcher_lazy def } + args = (inline_lazy_force arg Location.none, Strict) :: argl; + default = Default_environment.specialize matcher_lazy def + } let divide_lazy p ctx pm = - divide_line - (filter_ctx p) - make_lazy_matching - get_arg_lazy - p ctx pm + divide_line (Context.specialize p) make_lazy_matching get_arg_lazy p ctx pm (* Matching against a tuple pattern *) +let get_args_tuple arity p rem = + match p with + | { pat_desc = Tpat_any } -> omegas arity @ rem + | { pat_desc = Tpat_tuple args } -> args @ rem + | _ -> assert false -let get_args_tuple arity p rem = match p with -| {pat_desc = Tpat_any} -> omegas arity @ rem -| {pat_desc = Tpat_tuple args} -> - args @ rem -| _ -> assert false - -let matcher_tuple arity p rem = match p.pat_desc with -| Tpat_or (_,_,_) -> raise OrPat -| Tpat_any -| Tpat_var _ -> omegas arity @ rem -| Tpat_tuple args when List.length args = arity -> args @ rem -| _ -> raise NoMatch +let matcher_tuple arity p rem = + match p.pat_desc with + | Tpat_or (_, _, _) -> raise OrPat + | Tpat_any + | Tpat_var _ -> + omegas arity @ rem + | Tpat_tuple args when List.length args = arity -> args @ rem + | _ -> raise NoMatch let make_tuple_matching loc arity def = function - [] -> fatal_error "Matching.make_tuple_matching" + | [] -> fatal_error "Matching.make_tuple_matching" | (arg, _mut) :: argl -> let rec make_args pos = - if pos >= arity - then argl - else (Lprim(Pfield pos, [arg], loc), Alias) :: make_args (pos + 1) in - {cases = []; args = make_args 0 ; - default=make_default (matcher_tuple arity) def} - + if pos >= arity then + argl + else + (Lprim (Pfield pos, [ arg ], loc), Alias) :: make_args (pos + 1) + in + { cases = []; + args = make_args 0; + default = Default_environment.specialize (matcher_tuple arity) def + } let divide_tuple arity p ctx pm = - divide_line - (filter_ctx p) + divide_line (Context.specialize p) (make_tuple_matching p.pat_loc arity) - (get_args_tuple arity) p ctx pm + (get_args_tuple arity) p ctx pm (* Matching against a record pattern *) - let record_matching_line num_fields lbl_pat_list = let patv = Array.make num_fields omega in List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list; Array.to_list patv -let get_args_record num_fields p rem = match p with -| {pat_desc=Tpat_any} -> - record_matching_line num_fields [] @ rem -| {pat_desc=Tpat_record (lbl_pat_list,_)} -> - record_matching_line num_fields lbl_pat_list @ rem -| _ -> assert false - -let matcher_record num_fields p rem = match p.pat_desc with -| Tpat_or (_,_,_) -> raise OrPat -| Tpat_any -| Tpat_var _ -> - record_matching_line num_fields [] @ rem -| Tpat_record ([], _) when num_fields = 0 -> rem -| Tpat_record ((_, lbl, _) :: _ as lbl_pat_list, _) - when Array.length lbl.lbl_all = num_fields -> - record_matching_line num_fields lbl_pat_list @ rem -| _ -> raise NoMatch +let get_args_record num_fields p rem = + match p with + | { pat_desc = Tpat_any } -> record_matching_line num_fields [] @ rem + | { pat_desc = Tpat_record (lbl_pat_list, _) } -> + record_matching_line num_fields lbl_pat_list @ rem + | _ -> assert false + +let matcher_record num_fields p rem = + match p.pat_desc with + | Tpat_or (_, _, _) -> raise OrPat + | Tpat_any + | Tpat_var _ -> + record_matching_line num_fields [] @ rem + | Tpat_record ([], _) when num_fields = 0 -> rem + | Tpat_record (((_, lbl, _) :: _ as lbl_pat_list), _) + when Array.length lbl.lbl_all = num_fields -> + record_matching_line num_fields lbl_pat_list @ rem + | _ -> raise NoMatch let make_record_matching loc all_labels def = function - [] -> fatal_error "Matching.make_record_matching" - | ((arg, _mut) :: argl) -> + | [] -> fatal_error "Matching.make_record_matching" + | (arg, _mut) :: argl -> let rec make_args pos = - if pos >= Array.length all_labels then argl else begin + if pos >= Array.length all_labels then + argl + else let lbl = all_labels.(pos) in let access = match lbl.lbl_repres with - | Record_regular | Record_inlined _ -> - Lprim (Pfield lbl.lbl_pos, [arg], loc) + | Record_regular + | Record_inlined _ -> + Lprim (Pfield lbl.lbl_pos, [ arg ], loc) | Record_unboxed _ -> arg - | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [arg], loc) - | Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1), [arg], loc) + | Record_float -> Lprim (Pfloatfield lbl.lbl_pos, [ arg ], loc) + | Record_extension _ -> + Lprim (Pfield (lbl.lbl_pos + 1), [ arg ], loc) in let str = match lbl.lbl_mut with - Immutable -> Alias - | Mutable -> StrictOpt in - (access, str) :: make_args(pos + 1) - end in + | Immutable -> Alias + | Mutable -> StrictOpt + in + (access, str) :: make_args (pos + 1) + in let nfields = Array.length all_labels in - let def= make_default (matcher_record nfields) def in - {cases = []; args = make_args 0 ; default = def} - + let def = Default_environment.specialize (matcher_record nfields) def in + { cases = []; args = make_args 0; default = def } let divide_record all_labels p ctx pm = let get_args = get_args_record (Array.length all_labels) in - divide_line - (filter_ctx p) + divide_line (Context.specialize p) (make_record_matching p.pat_loc all_labels) - get_args - p ctx pm + get_args p ctx pm (* Matching against an array pattern *) let get_key_array = function - | {pat_desc=Tpat_array patl} -> List.length patl + | { pat_desc = Tpat_array patl } -> List.length patl | _ -> assert false -let get_args_array p rem = match p with -| {pat_desc=Tpat_array patl} -> patl@rem -| _ -> assert false +let get_args_array p rem = + match p with + | { pat_desc = Tpat_array patl } -> patl @ rem + | _ -> assert false -let matcher_array len p rem = match p.pat_desc with -| Tpat_or (_,_,_) -> raise OrPat -| Tpat_array args when List.length args=len -> args @ rem -| Tpat_any -> Parmatch.omegas len @ rem -| _ -> raise NoMatch +let matcher_array len p rem = + match p.pat_desc with + | Tpat_or (_, _, _) -> raise OrPat + | Tpat_array args when List.length args = len -> args @ rem + | Tpat_any -> Parmatch.omegas len @ rem + | _ -> raise NoMatch let make_array_matching kind p def ctx = function | [] -> fatal_error "Matching.make_array_matching" - | ((arg, _mut) :: argl) -> + | (arg, _mut) :: argl -> let len = get_key_array p in let rec make_args pos = - if pos >= len - then argl - else (Lprim(Parrayrefu kind, - [arg; Lconst(Const_base(Const_int pos))], - p.pat_loc), - StrictOpt) :: make_args (pos + 1) in - let def = make_default (matcher_array len) def - and ctx = filter_ctx p ctx in - {pm={cases = []; args = make_args 0 ; default = def} ; - ctx=ctx ; - pat = normalize_pat p} + if pos >= len then + argl + else + ( Lprim + ( Parrayrefu kind, + [ arg; Lconst (Const_base (Const_int pos)) ], + p.pat_loc ), + StrictOpt ) + :: make_args (pos + 1) + in + let def = Default_environment.specialize (matcher_array len) def + and ctx = Context.specialize p ctx in + { pm = { cases = []; args = make_args 0; default = def }; + ctx; + discr = normalize_pat p + } let divide_array kind ctx pm = - divide - (make_array_matching kind) - (=) get_key_array get_args_array ctx pm - + divide (make_array_matching kind) ( = ) get_key_array get_args_array ctx pm (* Specific string test sequence @@ -1725,73 +2050,70 @@ let divide_array kind ctx pm = let strings_test_threshold = 8 let prim_string_notequal = - Pccall(Primitive.simple - ~name:"caml_string_notequal" - ~arity:2 - ~alloc:false) + Pccall (Primitive.simple ~name:"caml_string_notequal" ~arity:2 ~alloc:false) let prim_string_compare = - Pccall(Primitive.simple - ~name:"caml_string_compare" - ~arity:2 - ~alloc:false) - -let bind_sw arg k = match arg with -| Lvar _ -> k arg -| _ -> - let id = Ident.create_local "switch" in - Llet (Strict,Pgenval,id,arg,k (Lvar id)) + Pccall (Primitive.simple ~name:"caml_string_compare" ~arity:2 ~alloc:false) +let bind_sw arg k = + match arg with + | Lvar _ -> k arg + | _ -> + let id = Ident.create_local "switch" in + Llet (Strict, Pgenval, id, arg, k (Lvar id)) (* Sequential equality tests *) let make_string_test_sequence loc arg sw d = - let d,sw = match d with - | None -> - begin match sw with - | (_,d)::sw -> d,sw - | [] -> assert false - end - | Some d -> d,sw in - bind_sw arg - (fun arg -> + let d, sw = + match d with + | None -> ( + match sw with + | (_, d) :: sw -> (d, sw) + | [] -> assert false + ) + | Some d -> (d, sw) + in + bind_sw arg (fun arg -> List.fold_right - (fun (s,lam) k -> + (fun (str, lam) k -> Lifthenelse - (Lprim - (prim_string_notequal, - [arg; Lconst (Const_immstring s)], loc), - k,lam)) + ( Lprim + ( prim_string_notequal, + [ arg; Lconst (Const_immstring str) ], + loc ), + k, + lam )) sw d) -let rec split k xs = match xs with -| [] -> assert false -| x0::xs -> - if k <= 1 then [],x0,xs - else - let xs,y0,ys = split (k-2) xs in - x0::xs,y0,ys +let rec split k xs = + match xs with + | [] -> assert false + | x0 :: xs -> + if k <= 1 then + ([], x0, xs) + else + let xs, y0, ys = split (k - 2) xs in + (x0 :: xs, y0, ys) -let zero_lam = Lconst (Const_base (Const_int 0)) +let zero_lam = Lconst (Const_base (Const_int 0)) let tree_way_test loc arg lt eq gt = Lifthenelse - (Lprim (Pintcomp Clt,[arg;zero_lam], loc),lt, - Lifthenelse(Lprim (Pintcomp Clt,[zero_lam;arg], loc),gt,eq)) + ( Lprim (Pintcomp Clt, [ arg; zero_lam ], loc), + lt, + Lifthenelse (Lprim (Pintcomp Clt, [ zero_lam; arg ], loc), gt, eq) ) (* Dichotomic tree *) - let rec do_make_string_test_tree loc arg sw delta d = let len = List.length sw in - if len <= strings_test_threshold+delta then + if len <= strings_test_threshold + delta then make_string_test_sequence loc arg sw d else - let lt,(s,act),gt = split len sw in + let lt, (s, act), gt = split len sw in bind_sw - (Lprim - (prim_string_compare, - [arg; Lconst (Const_immstring s)], loc)) + (Lprim (prim_string_compare, [ arg; Lconst (Const_immstring s) ], loc)) (fun r -> tree_way_test loc r (do_make_string_test_tree loc arg lt delta d) @@ -1799,15 +2121,13 @@ let rec do_make_string_test_tree loc arg sw delta d = (do_make_string_test_tree loc arg gt delta d)) (* Entry point *) -let expand_stringswitch loc arg sw d = match d with -| None -> - bind_sw arg - (fun arg -> do_make_string_test_tree loc arg sw 0 None) -| Some e -> - bind_sw arg - (fun arg -> - make_catch e - (fun d -> do_make_string_test_tree loc arg sw 1 (Some d))) +let expand_stringswitch loc arg sw d = + match d with + | None -> bind_sw arg (fun arg -> do_make_string_test_tree loc arg sw 0 None) + | Some e -> + bind_sw arg (fun arg -> + make_catch e (fun d -> + do_make_string_test_tree loc arg sw 1 (Some d))) (**********************) (* Generic test trees *) @@ -1818,702 +2138,748 @@ let expand_stringswitch loc arg sw d = match d with (* Add handler, if shared *) let handle_shared () = let hs = ref (fun x -> x) in - let handle_shared act = match act with - | Switch.Single act -> act - | Switch.Shared act -> - let i,h = make_catch_delayed act in - let ohs = !hs in - hs := (fun act -> h (ohs act)) ; - make_exit i in - hs,handle_shared - + let handle_shared act = + match act with + | Switch.Single act -> act + | Switch.Shared act -> + let i, h = make_catch_delayed act in + let ohs = !hs in + (hs := fun act -> h (ohs act)); + make_exit i + in + (hs, handle_shared) let share_actions_tree sw d = let store = StoreExp.mk_store () in -(* Default action is always shared *) + (* Default action is always shared *) let d = match d with | None -> None - | Some d -> Some (store.Switch.act_store_shared () d) in -(* Store all other actions *) + | Some d -> Some (store.Switch.act_store_shared () d) + in + (* Store all other actions *) let sw = - List.map (fun (cst,act) -> cst,store.Switch.act_store () act) sw in - -(* Retrieve all actions, including potential default *) + List.map (fun (cst, act) -> (cst, store.Switch.act_store () act)) sw + in + (* Retrieve all actions, including potential default *) let acts = store.Switch.act_get_shared () in - -(* Array of actual actions *) - let hs,handle_shared = handle_shared () in + (* Array of actual actions *) + let hs, handle_shared = handle_shared () in let acts = Array.map handle_shared acts in - -(* Reconstruct default and switch list *) - let d = match d with - | None -> None - | Some d -> Some (acts.(d)) in - let sw = List.map (fun (cst,j) -> cst,acts.(j)) sw in - !hs,sw,d + (* Reconstruct default and switch list *) + let d = + match d with + | None -> None + | Some d -> Some acts.(d) + in + let sw = List.map (fun (cst, j) -> (cst, acts.(j))) sw in + (!hs, sw, d) (* Note: dichotomic search requires sorted input with no duplicates *) -let rec uniq_lambda_list sw = match sw with - | []|[_] -> sw - | (c1,_ as p1)::((c2,_)::sw2 as sw1) -> - if const_compare c1 c2 = 0 then uniq_lambda_list (p1::sw2) - else p1::uniq_lambda_list sw1 +let rec uniq_lambda_list sw = + match sw with + | [] + | [ _ ] -> + sw + | ((c1, _) as p1) :: ((c2, _) :: sw2 as sw1) -> + if const_compare c1 c2 = 0 then + uniq_lambda_list (p1 :: sw2) + else + p1 :: uniq_lambda_list sw1 let sort_lambda_list l = - let l = - List.stable_sort (fun (x,_) (y,_) -> const_compare x y) l in + let l = List.stable_sort (fun (x, _) (y, _) -> const_compare x y) l in uniq_lambda_list l -let rec cut n l = - if n = 0 then [],l - else match l with - [] -> raise (Invalid_argument "cut") - | a::l -> let l1,l2 = cut (n-1) l in a::l1, l2 - let rec do_tests_fail loc fail tst arg = function | [] -> fail - | (c, act)::rem -> + | (c, act) :: rem -> Lifthenelse - (Lprim (tst, [arg ; Lconst (Const_base c)], loc), - do_tests_fail loc fail tst arg rem, - act) + ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc), + do_tests_fail loc fail tst arg rem, + act ) let rec do_tests_nofail loc tst arg = function | [] -> fatal_error "Matching.do_tests_nofail" - | [_,act] -> act - | (c,act)::rem -> + | [ (_, act) ] -> act + | (c, act) :: rem -> Lifthenelse - (Lprim (tst, [arg ; Lconst (Const_base c)], loc), - do_tests_nofail loc tst arg rem, - act) + ( Lprim (tst, [ arg; Lconst (Const_base c) ], loc), + do_tests_nofail loc tst arg rem, + act ) let make_test_sequence loc fail tst lt_tst arg const_lambda_list = let const_lambda_list = sort_lambda_list const_lambda_list in - let hs,const_lambda_list,fail = - share_actions_tree const_lambda_list fail in - + let hs, const_lambda_list, fail = + share_actions_tree const_lambda_list fail + in let rec make_test_sequence const_lambda_list = if List.length const_lambda_list >= 4 && lt_tst <> Pignore then split_sequence const_lambda_list - else match fail with - | None -> do_tests_nofail loc tst arg const_lambda_list - | Some fail -> do_tests_fail loc fail tst arg const_lambda_list - + else + match fail with + | None -> do_tests_nofail loc tst arg const_lambda_list + | Some fail -> do_tests_fail loc fail tst arg const_lambda_list and split_sequence const_lambda_list = let list1, list2 = - cut (List.length const_lambda_list / 2) const_lambda_list in - Lifthenelse(Lprim(lt_tst, - [arg; Lconst(Const_base (fst(List.hd list2)))], - loc), - make_test_sequence list1, make_test_sequence list2) + rev_split_at (List.length const_lambda_list / 2) const_lambda_list + in + Lifthenelse + ( Lprim (lt_tst, [ arg; Lconst (Const_base (fst (List.hd list2))) ], loc), + make_test_sequence list1, + make_test_sequence list2 ) in hs (make_test_sequence const_lambda_list) - module SArg = struct type primitive = Lambda.primitive let eqint = Pintcomp Ceq + let neint = Pintcomp Cne + let leint = Pintcomp Cle + let ltint = Pintcomp Clt + let geint = Pintcomp Cge + let gtint = Pintcomp Cgt type act = Lambda.lambda - let make_prim p args = Lprim (p,args,Location.none) - let make_offset arg n = match n with - | 0 -> arg - | _ -> Lprim (Poffsetint n,[arg],Location.none) + let make_prim p args = Lprim (p, args, Location.none) + + let make_offset arg n = + match n with + | 0 -> arg + | _ -> Lprim (Poffsetint n, [ arg ], Location.none) let bind arg body = - let newvar,newarg = match arg with - | Lvar v -> v,arg - | _ -> - let newvar = Ident.create_local "switcher" in - newvar,Lvar newvar in + let newvar, newarg = + match arg with + | Lvar v -> (v, arg) + | _ -> + let newvar = Ident.create_local "switcher" in + (newvar, Lvar newvar) + in bind Alias newvar arg (body newarg) + let make_const i = Lconst (Const_base (Const_int i)) - let make_isout h arg = Lprim (Pisout, [h ; arg],Location.none) - let make_isin h arg = Lprim (Pnot,[make_isout h arg],Location.none) + + let make_isout h arg = Lprim (Pisout, [ h; arg ], Location.none) + + let make_isin h arg = Lprim (Pnot, [ make_isout h arg ], Location.none) + let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot) + let make_switch loc arg cases acts = let l = ref [] in - for i = Array.length cases-1 downto 0 do - l := (i,acts.(cases.(i))) :: !l - done ; - Lswitch(arg, - {sw_numconsts = Array.length cases ; sw_consts = !l ; - sw_numblocks = 0 ; sw_blocks = [] ; - sw_failaction = None}, loc) - let make_catch = make_catch_delayed - let make_exit = make_exit + for i = Array.length cases - 1 downto 0 do + l := (i, acts.(cases.(i))) :: !l + done; + Lswitch + ( arg, + { sw_numconsts = Array.length cases; + sw_consts = !l; + sw_numblocks = 0; + sw_blocks = []; + sw_failaction = None + }, + loc ) + + let make_catch = make_catch_delayed + let make_exit = make_exit end (* Action sharing for Lswitch argument *) let share_actions_sw sw = -(* Attempt sharing on all actions *) + (* Attempt sharing on all actions *) let store = StoreExp.mk_store () in - let fail = match sw.sw_failaction with - | None -> None - | Some fail -> - (* Fail is translated to exit, whatever happens *) - Some (store.Switch.act_store_shared () fail) in + let fail = + match sw.sw_failaction with + | None -> None + | Some fail -> + (* Fail is translated to exit, whatever happens *) + Some (store.Switch.act_store_shared () fail) + in let consts = - List.map - (fun (i,e) -> i,store.Switch.act_store () e) - sw.sw_consts + List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_consts and blocks = - List.map - (fun (i,e) -> i,store.Switch.act_store () e) - sw.sw_blocks in + List.map (fun (i, e) -> (i, store.Switch.act_store () e)) sw.sw_blocks + in let acts = store.Switch.act_get_shared () in - let hs,handle_shared = handle_shared () in + let hs, handle_shared = handle_shared () in let acts = Array.map handle_shared acts in - let fail = match fail with - | None -> None - | Some fail -> Some (acts.(fail)) in - !hs, - { sw with - sw_consts = List.map (fun (i,j) -> i,acts.(j)) consts ; - sw_blocks = List.map (fun (i,j) -> i,acts.(j)) blocks ; - sw_failaction = fail; } + let fail = + match fail with + | None -> None + | Some fail -> Some acts.(fail) + in + ( !hs, + { sw with + sw_consts = List.map (fun (i, j) -> (i, acts.(j))) consts; + sw_blocks = List.map (fun (i, j) -> (i, acts.(j))) blocks; + sw_failaction = fail + } ) (* Reintroduce fail action in switch argument, for the sake of avoiding carrying over huge switches *) -let reintroduce_fail sw = match sw.sw_failaction with -| None -> - let t = Hashtbl.create 17 in - let seen (_,l) = match as_simple_exit l with - | Some i -> - let old = try Hashtbl.find t i with Not_found -> 0 in - Hashtbl.replace t i (old+1) - | None -> () in - List.iter seen sw.sw_consts ; - List.iter seen sw.sw_blocks ; - let i_max = ref (-1) - and max = ref (-1) in - Hashtbl.iter - (fun i c -> - if c > !max then begin - i_max := i ; - max := c - end) t ; - if !max >= 3 then - let default = !i_max in - let remove = - List.filter - (fun (_,lam) -> match as_simple_exit lam with - | Some j -> j <> default - | None -> true) in - {sw with - sw_consts = remove sw.sw_consts ; - sw_blocks = remove sw.sw_blocks ; - sw_failaction = Some (make_exit default)} - else sw -| Some _ -> sw - - -module Switcher = Switch.Make(SArg) +let reintroduce_fail sw = + match sw.sw_failaction with + | None -> + let t = Hashtbl.create 17 in + let seen (_, l) = + match as_simple_exit l with + | Some i -> + let old = try Hashtbl.find t i with Not_found -> 0 in + Hashtbl.replace t i (old + 1) + | None -> () + in + List.iter seen sw.sw_consts; + List.iter seen sw.sw_blocks; + let i_max = ref (-1) and max = ref (-1) in + Hashtbl.iter + (fun i c -> + if c > !max then ( + i_max := i; + max := c + )) + t; + if !max >= 3 then + let default = !i_max in + let remove = + List.filter (fun (_, lam) -> + match as_simple_exit lam with + | Some j -> j <> default + | None -> true) + in + { sw with + sw_consts = remove sw.sw_consts; + sw_blocks = remove sw.sw_blocks; + sw_failaction = Some (make_exit default) + } + else + sw + | Some _ -> sw + +module Switcher = Switch.Make (SArg) open Switch let rec last def = function | [] -> def - | [x,_] -> x - | _::rem -> last def rem - -let get_edges low high l = match l with -| [] -> low, high -| (x,_)::_ -> x, last high l + | [ (x, _) ] -> x + | _ :: rem -> last def rem +let get_edges low high l = + match l with + | [] -> (low, high) + | (x, _) :: _ -> (x, last high l) let as_interval_canfail fail low high l = let store = StoreExp.mk_store () in - let do_store _tag act = - - let i = store.act_store () act in -(* + let i = store.act_store () act in + (* eprintf "STORE [%s] %i %s\n" tag i (string_of_lam act) ; *) - i in - + i + in let rec nofail_rec cur_low cur_high cur_act = function | [] -> if cur_high = high then - [cur_low,cur_high,cur_act] + [ (cur_low, cur_high, cur_act) ] else - [(cur_low,cur_high,cur_act) ; (cur_high+1,high, 0)] - | ((i,act_i)::rem) as all -> + [ (cur_low, cur_high, cur_act); (cur_high + 1, high, 0) ] + | (i, act_i) :: rem as all -> let act_index = do_store "NO" act_i in - if cur_high+1= i then - if act_index=cur_act then + if cur_high + 1 = i then + if act_index = cur_act then nofail_rec cur_low i cur_act rem - else if act_index=0 then - (cur_low,i-1, cur_act)::fail_rec i i rem + else if act_index = 0 then + (cur_low, i - 1, cur_act) :: fail_rec i i rem else - (cur_low, i-1, cur_act)::nofail_rec i i act_index rem + (cur_low, i - 1, cur_act) :: nofail_rec i i act_index rem else if act_index = 0 then - (cur_low, cur_high, cur_act):: - fail_rec (cur_high+1) (cur_high+1) all + (cur_low, cur_high, cur_act) + :: fail_rec (cur_high + 1) (cur_high + 1) all else - (cur_low, cur_high, cur_act):: - (cur_high+1,i-1,0):: - nofail_rec i i act_index rem - + (cur_low, cur_high, cur_act) + :: (cur_high + 1, i - 1, 0) + :: nofail_rec i i act_index rem and fail_rec cur_low cur_high = function - | [] -> [(cur_low, cur_high, 0)] - | (i,act_i)::rem -> + | [] -> [ (cur_low, cur_high, 0) ] + | (i, act_i) :: rem -> let index = do_store "YES" act_i in - if index=0 then fail_rec cur_low i rem + if index = 0 then + fail_rec cur_low i rem else - (cur_low,i-1,0):: - nofail_rec i i index rem in - + (cur_low, i - 1, 0) :: nofail_rec i i index rem + in let init_rec = function - | [] -> [low,high,0] - | (i,act_i)::rem -> + | [] -> [ (low, high, 0) ] + | (i, act_i) :: rem -> let index = do_store "INIT" act_i in - if index=0 then + if index = 0 then fail_rec low i rem + else if low < i then + (low, i - 1, 0) :: nofail_rec i i index rem else - if low < i then - (low,i-1,0)::nofail_rec i i index rem - else - nofail_rec i i index rem in + nofail_rec i i index rem + in + assert (do_store "FAIL" fail = 0); - assert (do_store "FAIL" fail = 0) ; (* fail has action index 0 *) + (* fail has action index 0 *) let r = init_rec l in - Array.of_list r, store + (Array.of_list r, store) let as_interval_nofail l = let store = StoreExp.mk_store () in let rec some_hole = function - | []|[_] -> false - | (i,_)::((j,_)::_ as rem) -> - j > i+1 || some_hole rem in + | [] + | [ _ ] -> + false + | (i, _) :: ((j, _) :: _ as rem) -> j > i + 1 || some_hole rem + in let rec i_rec cur_low cur_high cur_act = function - | [] -> - [cur_low, cur_high, cur_act] - | (i,act)::rem -> + | [] -> [ (cur_low, cur_high, cur_act) ] + | (i, act) :: rem -> let act_index = store.act_store () act in if act_index = cur_act then i_rec cur_low i cur_act rem else - (cur_low, cur_high, cur_act):: - i_rec i i act_index rem in - let inters = match l with - | (i,act)::rem -> - let act_index = - (* In case there is some hole and that a switch is emitted, + (cur_low, cur_high, cur_act) :: i_rec i i act_index rem + in + let inters = + match l with + | (i, act) :: rem -> + let act_index = + (* In case there is some hole and that a switch is emitted, action 0 will be used as the action of unreachable cases (cf. switch.ml, make_switch). Hence, this action will be shared *) - if some_hole rem then - store.act_store_shared () act - else - store.act_store () act in - assert (act_index = 0) ; - i_rec i i act_index rem - | _ -> assert false in - - Array.of_list inters, store - + if some_hole rem then + store.act_store_shared () act + else + store.act_store () act + in + assert (act_index = 0); + i_rec i i act_index rem + | _ -> assert false + in + (Array.of_list inters, store) let sort_int_lambda_list l = List.sort - (fun (i1,_) (i2,_) -> - if i1 < i2 then -1 - else if i2 < i1 then 1 - else 0) + (fun (i1, _) (i2, _) -> + if i1 < i2 then + -1 + else if i2 < i1 then + 1 + else + 0) l let as_interval fail low high l = let l = sort_int_lambda_list l in - get_edges low high l, - (match fail with - | None -> as_interval_nofail l - | Some act -> as_interval_canfail act low high l) + ( get_edges low high l, + match fail with + | None -> as_interval_nofail l + | Some act -> as_interval_canfail act low high l ) let call_switcher loc fail arg low high int_lambda_list = - let edges, (cases, actions) = - as_interval fail low high int_lambda_list in + let edges, (cases, actions) = as_interval fail low high int_lambda_list in Switcher.zyva loc edges arg cases actions - let rec list_as_pat = function | [] -> fatal_error "Matching.list_as_pat" - | [pat] -> pat - | pat::rem -> - {pat with pat_desc = Tpat_or (pat,list_as_pat rem,None)} - + | [ pat ] -> pat + | pat :: rem -> { pat with pat_desc = Tpat_or (pat, list_as_pat rem, None) } let complete_pats_constrs = function - | p::_ as pats -> - List.map - (pat_of_constr p) + | p :: _ as pats -> + List.map (pat_of_constr p) (complete_constrs p (List.map get_key_constr pats)) | _ -> assert false - (* Following two ``failaction'' function compute n, the trap handler to jump to in case of failure of elementary tests *) -let mk_failaction_neg partial ctx def = match partial with -| Partial -> - begin match def with - | (_,idef)::_ -> - Some (Lstaticraise (idef,[])),jumps_singleton idef ctx - | [] -> - (* Act as Total, this means +let mk_failaction_neg partial ctx def = + match partial with + | Partial -> ( + match Default_environment.pop def with + | Some ((_, idef), _) -> + (Some (Lstaticraise (idef, [])), Jumps.singleton idef ctx) + | None -> + (* Act as Total, this means If no appropriate default matrix exists, then this switch cannot fail *) - None, jumps_empty - end -| Total -> - None, jumps_empty - - + (None, Jumps.empty) + ) + | Total -> (None, Jumps.empty) (* In line with the article and simpler than before *) -let mk_failaction_pos partial seen ctx defs = - if dbg then begin - Format.eprintf "**POS**\n" ; - pretty_def defs ; +let mk_failaction_pos partial seen ctx defs = + if dbg then ( + Format.eprintf "**POS**\n"; + Default_environment.pp defs; () - end ; - let rec scan_def env to_test defs = match to_test,defs with - | ([],_)|(_,[]) -> - List.fold_left - (fun (klist,jumps) (pats,i)-> - let action = Lstaticraise (i,[]) in - let klist = - List.fold_right - (fun pat r -> (get_key_constr pat,action)::r) - pats klist - and jumps = - jumps_add i (ctx_lub (list_as_pat pats) ctx) jumps in - klist,jumps) - ([],jumps_empty) env - | _,(pss,idef)::rem -> - let now, later = - List.partition - (fun (_p,p_ctx) -> ctx_match p_ctx pss) to_test in - match now with - | [] -> scan_def env to_test rem - | _ -> scan_def ((List.map fst now,idef)::env) later rem in - + ); + let rec scan_def env to_test defs = + match (to_test, Default_environment.pop defs) with + | [], _ + | _, None -> + List.fold_left + (fun (klist, jumps) (pats, i) -> + let action = Lstaticraise (i, []) in + let klist = + List.fold_right + (fun pat r -> (get_key_constr pat, action) :: r) + pats klist + and jumps = + Jumps.add i (Context.lub (list_as_pat pats) ctx) jumps + in + (klist, jumps)) + ([], Jumps.empty) env + | _, Some ((pss, idef), rem) -> ( + let now, later = + List.partition (fun (_p, p_ctx) -> Context.matches p_ctx pss) to_test + in + match now with + | [] -> scan_def env to_test rem + | _ -> scan_def ((List.map fst now, idef) :: env) later rem + ) + in let fail_pats = complete_pats_constrs seen in - if List.length fail_pats < !Clflags.match_context_rows then begin - let fail,jmps = - scan_def - [] - (List.map - (fun pat -> pat, ctx_lub pat ctx) - fail_pats) - defs in - if dbg then begin + if List.length fail_pats < !Clflags.match_context_rows then ( + let fail, jmps = + scan_def [] + (List.map (fun pat -> (pat, Context.lub pat ctx)) fail_pats) + defs + in + if dbg then ( eprintf "POSITIVE JUMPS [%i]:\n" (List.length fail_pats); - pretty_jumps jmps - end ; - None,fail,jmps - end else begin (* Too many non-matched constructors -> reduced information *) - if dbg then eprintf "POS->NEG!!!\n%!" ; - let fail,jumps = mk_failaction_neg partial ctx defs in + Jumps.eprintf jmps + ); + (None, fail, jmps) + ) else ( + (* Too many non-matched constructors -> reduced information *) + if dbg then eprintf "POS->NEG!!!\n%!"; + let fail, jumps = mk_failaction_neg partial ctx defs in if dbg then eprintf "FAIL: %s\n" - (match fail with + ( match fail with | None -> "" - | Some lam -> string_of_lam lam) ; - fail,[],jumps - end + | Some lam -> string_of_lam lam + ); + (fail, [], jumps) + ) let combine_constant loc arg cst partial ctx def (const_lambda_list, total, _pats) = - let fail, local_jumps = - mk_failaction_neg partial ctx def in + let fail, local_jumps = mk_failaction_neg partial ctx def in let lambda1 = match cst with | Const_int _ -> let int_lambda_list = - List.map (function Const_int n, l -> n,l | _ -> assert false) - const_lambda_list in + List.map + (function + | Const_int n, l -> (n, l) + | _ -> assert false) + const_lambda_list + in call_switcher loc fail arg min_int max_int int_lambda_list | Const_char _ -> let int_lambda_list = - List.map (function Const_char c, l -> (Char.code c, l) - | _ -> assert false) - const_lambda_list in + List.map + (function + | Const_char c, l -> (Char.code c, l) + | _ -> assert false) + const_lambda_list + in call_switcher loc fail arg 0 255 int_lambda_list | Const_string _ -> -(* Note as the bytecode compiler may resort to dichotomic search, + (* Note as the bytecode compiler may resort to dichotomic search, the clauses of stringswitch are sorted with duplicates removed. This partly applies to the native code compiler, which requires no duplicates *) let const_lambda_list = sort_lambda_list const_lambda_list in let sw = List.map - (fun (c,act) -> match c with - | Const_string (s,_) -> s,act - | _ -> assert false) - const_lambda_list in - let hs,sw,fail = share_actions_tree sw fail in - hs (Lstringswitch (arg,sw,fail,loc)) + (fun (c, act) -> + match c with + | Const_string (s, _) -> (s, act) + | _ -> assert false) + const_lambda_list + in + let hs, sw, fail = share_actions_tree sw fail in + hs (Lstringswitch (arg, sw, fail, loc)) | Const_float _ -> - make_test_sequence loc - fail - (Pfloatcomp CFneq) (Pfloatcomp CFlt) - arg const_lambda_list + make_test_sequence loc fail (Pfloatcomp CFneq) (Pfloatcomp CFlt) arg + const_lambda_list | Const_int32 _ -> - make_test_sequence loc - fail - (Pbintcomp(Pint32, Cne)) (Pbintcomp(Pint32, Clt)) + make_test_sequence loc fail + (Pbintcomp (Pint32, Cne)) + (Pbintcomp (Pint32, Clt)) arg const_lambda_list | Const_int64 _ -> - make_test_sequence loc - fail - (Pbintcomp(Pint64, Cne)) (Pbintcomp(Pint64, Clt)) + make_test_sequence loc fail + (Pbintcomp (Pint64, Cne)) + (Pbintcomp (Pint64, Clt)) arg const_lambda_list | Const_nativeint _ -> - make_test_sequence loc - fail - (Pbintcomp(Pnativeint, Cne)) (Pbintcomp(Pnativeint, Clt)) + make_test_sequence loc fail + (Pbintcomp (Pnativeint, Cne)) + (Pbintcomp (Pnativeint, Clt)) arg const_lambda_list - in lambda1,jumps_union local_jumps total - - + in + (lambda1, Jumps.union local_jumps total) let split_cases tag_lambda_list = let rec split_rec = function - [] -> ([], []) - | (cstr, act) :: rem -> - let (consts, nonconsts) = split_rec rem in + | [] -> ([], []) + | (cstr, act) :: rem -> ( + let consts, nonconsts = split_rec rem in match cstr with - Cstr_constant n -> ((n, act) :: consts, nonconsts) - | Cstr_block n -> (consts, (n, act) :: nonconsts) - | Cstr_unboxed -> (consts, (0, act) :: nonconsts) - | Cstr_extension _ -> assert false in + | Cstr_constant n -> ((n, act) :: consts, nonconsts) + | Cstr_block n -> (consts, (n, act) :: nonconsts) + | Cstr_unboxed -> (consts, (0, act) :: nonconsts) + | Cstr_extension _ -> assert false + ) + in let const, nonconst = split_rec tag_lambda_list in - sort_int_lambda_list const, - sort_int_lambda_list nonconst + (sort_int_lambda_list const, sort_int_lambda_list nonconst) let split_extension_cases tag_lambda_list = let rec split_rec = function - [] -> ([], []) - | (cstr, act) :: rem -> - let (consts, nonconsts) = split_rec rem in + | [] -> ([], []) + | (cstr, act) :: rem -> ( + let consts, nonconsts = split_rec rem in match cstr with - Cstr_extension(path, true) -> ((path, act) :: consts, nonconsts) - | Cstr_extension(path, false) -> (consts, (path, act) :: nonconsts) - | _ -> assert false in + | Cstr_extension (path, true) -> ((path, act) :: consts, nonconsts) + | Cstr_extension (path, false) -> (consts, (path, act) :: nonconsts) + | _ -> assert false + ) + in split_rec tag_lambda_list - let combine_constructor loc arg ex_pat cstr partial ctx def (tag_lambda_list, total1, pats) = - if cstr.cstr_consts < 0 then begin - (* Special cases for extensions *) - let fail, local_jumps = - mk_failaction_neg partial ctx def in - let lambda1 = - let consts, nonconsts = split_extension_cases tag_lambda_list in - let default, consts, nonconsts = - match fail with - | None -> - begin match consts, nonconsts with - | _, (_, act)::rem -> act, consts, rem - | (_, act)::rem, _ -> act, rem, nonconsts - | _ -> assert false - end - | Some fail -> fail, consts, nonconsts in - let nonconst_lambda = - match nonconsts with - [] -> default - | _ -> - let tag = Ident.create_local "tag" in - let tests = - List.fold_right - (fun (path, act) rem -> - let ext = transl_extension_path loc ex_pat.pat_env path in - Lifthenelse(Lprim(Pintcomp Ceq, [Lvar tag; ext], loc), - act, rem)) - nonconsts - default - in - Llet(Alias, Pgenval,tag, Lprim(Pfield 0, [arg], loc), tests) - in + match cstr.cstr_tag with + | Cstr_extension _ -> + (* Special cases for extensions *) + let fail, local_jumps = mk_failaction_neg partial ctx def in + let lambda1 = + let consts, nonconsts = split_extension_cases tag_lambda_list in + let default, consts, nonconsts = + match fail with + | None -> ( + match (consts, nonconsts) with + | _, (_, act) :: rem -> (act, consts, rem) + | (_, act) :: rem, _ -> (act, rem, nonconsts) + | _ -> assert false + ) + | Some fail -> (fail, consts, nonconsts) + in + let nonconst_lambda = + match nonconsts with + | [] -> default + | _ -> + let tag = Ident.create_local "tag" in + let tests = + List.fold_right + (fun (path, act) rem -> + let ext = transl_extension_path loc ex_pat.pat_env path in + Lifthenelse + (Lprim (Pintcomp Ceq, [ Lvar tag; ext ], loc), act, rem)) + nonconsts default + in + Llet (Alias, Pgenval, tag, Lprim (Pfield 0, [ arg ], loc), tests) + in List.fold_right (fun (path, act) rem -> - let ext = transl_extension_path loc ex_pat.pat_env path in - Lifthenelse(Lprim(Pintcomp Ceq, [arg; ext], loc), - act, rem)) - consts - nonconst_lambda - in - lambda1, jumps_union local_jumps total1 - end else begin - (* Regular concrete type *) - let ncases = List.length tag_lambda_list - and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in - let sig_complete = ncases = nconstrs in - let fail_opt,fails,local_jumps = - if sig_complete then None,[],jumps_empty - else - mk_failaction_pos partial pats ctx def in - - let tag_lambda_list = fails @ tag_lambda_list in - let (consts, nonconsts) = split_cases tag_lambda_list in - let lambda1 = - match fail_opt,same_actions tag_lambda_list with - | None,Some act -> act (* Identical actions, no failure *) - | _ -> - match - (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts) - with - | (1, 1, [0, act1], [0, act2]) -> - (* Typically, match on lists, will avoid isint primitive in that + let ext = transl_extension_path loc ex_pat.pat_env path in + Lifthenelse (Lprim (Pintcomp Ceq, [ arg; ext ], loc), act, rem)) + consts nonconst_lambda + in + (lambda1, Jumps.union local_jumps total1) + | _ -> + (* Regular concrete type *) + let ncases = List.length tag_lambda_list + and nconstrs = cstr.cstr_consts + cstr.cstr_nonconsts in + let sig_complete = ncases = nconstrs in + let fail_opt, fails, local_jumps = + if sig_complete then + (None, [], Jumps.empty) + else + mk_failaction_pos partial pats ctx def + in + let tag_lambda_list = fails @ tag_lambda_list in + let consts, nonconsts = split_cases tag_lambda_list in + let lambda1 = + match (fail_opt, same_actions tag_lambda_list) with + | None, Some act -> act (* Identical actions, no failure *) + | _ -> ( + match + (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts) + with + | 1, 1, [ (0, act1) ], [ (0, act2) ] -> + (* Typically, match on lists, will avoid isint primitive in that case *) - Lifthenelse(arg, act2, act1) - | (n,0,_,[]) -> (* The type defines constant constructors only *) - call_switcher loc fail_opt arg 0 (n-1) consts - | (n, _, _, _) -> - let act0 = - (* = Some act when all non-const constructors match to act *) - match fail_opt,nonconsts with - | Some a,[] -> Some a - | Some _,_ -> - if List.length nonconsts = cstr.cstr_nonconsts then - same_actions nonconsts - else None - | None,_ -> same_actions nonconsts in - match act0 with - | Some act -> - Lifthenelse - (Lprim (Pisint, [arg], loc), - call_switcher loc - fail_opt arg - 0 (n-1) consts, - act) -(* Emit a switch, as bytecode implements this sophisticated instruction *) - | None -> - let sw = - {sw_numconsts = cstr.cstr_consts; sw_consts = consts; - sw_numblocks = cstr.cstr_nonconsts; sw_blocks = nonconsts; - sw_failaction = fail_opt} in - let hs,sw = share_actions_sw sw in - let sw = reintroduce_fail sw in - hs (Lswitch (arg,sw,loc)) in - lambda1, jumps_union local_jumps total1 - end + Lifthenelse (arg, act2, act1) + | n, 0, _, [] -> + (* The type defines constant constructors only *) + call_switcher loc fail_opt arg 0 (n - 1) consts + | n, _, _, _ -> ( + let act0 = + (* = Some act when all non-const constructors match to act *) + match (fail_opt, nonconsts) with + | Some a, [] -> Some a + | Some _, _ -> + if List.length nonconsts = cstr.cstr_nonconsts then + same_actions nonconsts + else + None + | None, _ -> same_actions nonconsts + in + match act0 with + | Some act -> + Lifthenelse + ( Lprim (Pisint, [ arg ], loc), + call_switcher loc fail_opt arg 0 (n - 1) consts, + act ) + | None -> + (* Emit a switch, as bytecode implements this sophisticated + instruction *) + let sw = + { sw_numconsts = cstr.cstr_consts; + sw_consts = consts; + sw_numblocks = cstr.cstr_nonconsts; + sw_blocks = nonconsts; + sw_failaction = fail_opt + } + in + let hs, sw = share_actions_sw sw in + let sw = reintroduce_fail sw in + hs (Lswitch (arg, sw, loc)) + ) + ) + in + (lambda1, Jumps.union local_jumps total1) let make_test_sequence_variant_constant fail arg int_lambda_list = - let _, (cases, actions) = - as_interval fail min_int max_int int_lambda_list in + let _, (cases, actions) = as_interval fail min_int max_int int_lambda_list in Switcher.test_sequence arg cases actions let call_switcher_variant_constant loc fail arg int_lambda_list = call_switcher loc fail arg min_int max_int int_lambda_list - let call_switcher_variant_constr loc fail arg int_lambda_list = let v = Ident.create_local "variant" in - Llet(Alias, Pgenval, v, Lprim(Pfield 0, [arg], loc), - call_switcher loc - fail (Lvar v) min_int max_int int_lambda_list) - -let combine_variant loc row arg partial ctx def - (tag_lambda_list, total1, _pats) = + Llet + ( Alias, + Pgenval, + v, + Lprim (Pfield 0, [ arg ], loc), + call_switcher loc fail (Lvar v) min_int max_int int_lambda_list ) + +let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, _pats) + = let row = Btype.row_repr row in let num_constr = ref 0 in if row.row_closed then List.iter (fun (_, f) -> match Btype.row_field_repr f with - Rabsent | Reither(true, _::_, _, _) -> () + | Rabsent + | Reither (true, _ :: _, _, _) -> + () | _ -> incr num_constr) row.row_fields else num_constr := max_int; let test_int_or_block arg if_int if_block = - Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in - let sig_complete = List.length tag_lambda_list = !num_constr + Lifthenelse (Lprim (Pisint, [ arg ], loc), if_int, if_block) + in + let sig_complete = List.length tag_lambda_list = !num_constr and one_action = same_actions tag_lambda_list in let fail, local_jumps = if - sig_complete || (match partial with Total -> true | _ -> false) + sig_complete + || + match partial with + | Total -> true + | _ -> false then - None, jumps_empty + (None, Jumps.empty) else - mk_failaction_neg partial ctx def in - let (consts, nonconsts) = split_cases tag_lambda_list in - let lambda1 = match fail, one_action with - | None, Some act -> act - | _,_ -> - match (consts, nonconsts) with - | ([_, act1], [_, act2]) when fail=None -> - test_int_or_block arg act1 act2 - | (_, []) -> (* One can compare integers and pointers *) - make_test_sequence_variant_constant fail arg consts - | ([], _) -> - let lam = call_switcher_variant_constr loc - fail arg nonconsts in - (* One must not dereference integers *) - begin match fail with - | None -> lam - | Some fail -> test_int_or_block arg fail lam - end - | (_, _) -> - let lam_const = - call_switcher_variant_constant loc - fail arg consts - and lam_nonconst = - call_switcher_variant_constr loc - fail arg nonconsts in - test_int_or_block arg lam_const lam_nonconst + mk_failaction_neg partial ctx def in - lambda1, jumps_union local_jumps total1 - + let consts, nonconsts = split_cases tag_lambda_list in + let lambda1 = + match (fail, one_action) with + | None, Some act -> act + | _, _ -> ( + match (consts, nonconsts) with + | [ (_, act1) ], [ (_, act2) ] when fail = None -> + test_int_or_block arg act1 act2 + | _, [] -> + (* One can compare integers and pointers *) + make_test_sequence_variant_constant fail arg consts + | [], _ -> ( + let lam = call_switcher_variant_constr loc fail arg nonconsts in + (* One must not dereference integers *) + match fail with + | None -> lam + | Some fail -> test_int_or_block arg fail lam + ) + | _, _ -> + let lam_const = call_switcher_variant_constant loc fail arg consts + and lam_nonconst = + call_switcher_variant_constr loc fail arg nonconsts + in + test_int_or_block arg lam_const lam_nonconst + ) + in + (lambda1, Jumps.union local_jumps total1) -let combine_array loc arg kind partial ctx def - (len_lambda_list, total1, _pats) = - let fail, local_jumps = mk_failaction_neg partial ctx def in +let combine_array loc arg kind partial ctx def (len_lambda_list, total1, _pats) + = + let fail, local_jumps = mk_failaction_neg partial ctx def in let lambda1 = let newvar = Ident.create_local "len" in let switch = - call_switcher loc - fail (Lvar newvar) - 0 max_int len_lambda_list in - bind - Alias newvar (Lprim(Parraylength kind, [arg], loc)) switch in - lambda1, jumps_union local_jumps total1 + call_switcher loc fail (Lvar newvar) 0 max_int len_lambda_list + in + bind Alias newvar (Lprim (Parraylength kind, [ arg ], loc)) switch + in + (lambda1, Jumps.union local_jumps total1) (* Insertion of debugging events *) let rec event_branch repr lam = - begin match lam, repr with - (_, None) -> - lam - | (Levent(lam', ev), Some r) -> + match (lam, repr) with + | _, None -> lam + | Levent (lam', ev), Some r -> incr r; - Levent(lam', {lev_loc = ev.lev_loc; - lev_kind = ev.lev_kind; - lev_repr = repr; - lev_env = ev.lev_env}) - | (Llet(str, k, id, lam, body), _) -> - Llet(str, k, id, lam, event_branch repr body) - | Lstaticraise _,_ -> lam - | (_, Some _) -> - Printlambda.lambda Format.str_formatter lam ; - fatal_error - ("Matching.event_branch: "^Format.flush_str_formatter ()) - end - + Levent + ( lam', + { lev_loc = ev.lev_loc; + lev_kind = ev.lev_kind; + lev_repr = repr; + lev_env = ev.lev_env + } ) + | Llet (str, k, id, lam, body), _ -> + Llet (str, k, id, lam, event_branch repr body) + | Lstaticraise _, _ -> lam + | _, Some _ -> + Printlambda.lambda Format.str_formatter lam; + fatal_error ("Matching.event_branch: " ^ Format.flush_str_formatter ()) (* This exception is raised when the compiler cannot produce code @@ -2532,170 +2898,167 @@ let rec event_branch repr lam = exception Unused let compile_list compile_fun division = - let rec c_rec totals = function - | [] -> [], jumps_unions totals, [] - | (key, cell) :: rem -> - begin match cell.ctx with - | [] -> c_rec totals rem - | _ -> + | [] -> ([], Jumps.unions totals, []) + | (key, cell) :: rem -> ( + if Context.is_empty cell.ctx then + c_rec totals rem + else try - let (lambda1, total1) = compile_fun cell.ctx cell.pm in - let c_rem, total, new_pats = - c_rec - (jumps_map ctx_combine total1::totals) rem in - ((key,lambda1)::c_rem), total, (cell.pat::new_pats) - with - | Unused -> c_rec totals rem - end in + let lambda1, total1 = compile_fun cell.ctx cell.pm in + let c_rem, total, new_discrs = + c_rec (Jumps.map Context.combine total1 :: totals) rem + in + ((key, lambda1) :: c_rem, total, cell.discr :: new_discrs) + with Unused -> c_rec totals rem + ) + in c_rec [] division - let compile_orhandlers compile_fun lambda1 total1 ctx to_catch = let rec do_rec r total_r = function - | [] -> r,total_r - | (mat,i,vars,pm)::rem -> - begin try - let ctx = select_columns mat ctx in - let handler_i, total_i = - compile_fun ctx pm in + | [] -> (r, total_r) + | { provenance = mat; exit = i; vars; pm } :: rem -> ( + try + let ctx = Context.select_columns mat ctx in + let handler_i, total_i = compile_fun ctx pm in match raw_action r with - | Lstaticraise (j,args) -> - if i=j then - List.fold_right2 (bind_with_value_kind Alias) - vars args handler_i, - jumps_map (ctx_rshift_num (ncols mat)) total_i + | Lstaticraise (j, args) -> + if i = j then + ( List.fold_right2 + (bind_with_value_kind Alias) + vars args handler_i, + Jumps.map (Context.rshift_num (ncols mat)) total_i ) else do_rec r total_r rem | _ -> do_rec - (Lstaticcatch (r,(i,vars), handler_i)) - (jumps_union - (jumps_remove i total_r) - (jumps_map (ctx_rshift_num (ncols mat)) total_i)) - rem - with - | Unused -> - do_rec (Lstaticcatch (r, (i,vars), lambda_unit)) total_r rem - end in + (Lstaticcatch (r, (i, vars), handler_i)) + (Jumps.union (Jumps.remove i total_r) + (Jumps.map (Context.rshift_num (ncols mat)) total_i)) + rem + with Unused -> + do_rec (Lstaticcatch (r, (i, vars), lambda_unit)) total_r rem + ) + in do_rec lambda1 total1 to_catch - let compile_test compile_fun partial divide combine ctx to_match = let division = divide ctx to_match in - let c_div = compile_list compile_fun division in + let c_div = compile_list compile_fun division.cells in match c_div with - | [],_,_ -> - begin match mk_failaction_neg partial ctx to_match.default with - | None,_ -> raise Unused - | Some l,total -> l,total - end - | _ -> - combine ctx to_match.default c_div + | [], _, _ -> ( + match mk_failaction_neg partial ctx to_match.default with + | None, _ -> raise Unused + | Some l, total -> (l, total) + ) + | _ -> combine ctx to_match.default c_div (* Attempt to avoid some useless bindings by lowering them *) (* Approximation of v present in lam *) let rec approx_present v = function | Lconst _ -> false - | Lstaticraise (_,args) -> + | Lstaticraise (_, args) -> List.exists (fun lam -> approx_present v lam) args - | Lprim (_,args,_) -> - List.exists (fun lam -> approx_present v lam) args - | Llet (Alias, _k, _, l1, l2) -> - approx_present v l1 || approx_present v l2 + | Lprim (_, args, _) -> List.exists (fun lam -> approx_present v lam) args + | Llet (Alias, _k, _, l1, l2) -> approx_present v l1 || approx_present v l2 | Lvar vv -> Ident.same v vv | _ -> true -let rec lower_bind v arg lam = match lam with -| Lifthenelse (cond, ifso, ifnot) -> - let pcond = approx_present v cond - and pso = approx_present v ifso - and pnot = approx_present v ifnot in - begin match pcond, pso, pnot with - | false, false, false -> lam - | false, true, false -> - Lifthenelse (cond, lower_bind v arg ifso, ifnot) - | false, false, true -> - Lifthenelse (cond, ifso, lower_bind v arg ifnot) - | _,_,_ -> bind Alias v arg lam - end -| Lswitch (ls,({sw_consts=[i,act] ; sw_blocks = []} as sw), loc) +let rec lower_bind v arg lam = + match lam with + | Lifthenelse (cond, ifso, ifnot) -> ( + let pcond = approx_present v cond + and pso = approx_present v ifso + and pnot = approx_present v ifnot in + match (pcond, pso, pnot) with + | false, false, false -> lam + | false, true, false -> Lifthenelse (cond, lower_bind v arg ifso, ifnot) + | false, false, true -> Lifthenelse (cond, ifso, lower_bind v arg ifnot) + | _, _, _ -> bind Alias v arg lam + ) + | Lswitch (ls, ({ sw_consts = [ (i, act) ]; sw_blocks = [] } as sw), loc) when not (approx_present v ls) -> - Lswitch (ls, {sw with sw_consts = [i,lower_bind v arg act]}, loc) -| Lswitch (ls,({sw_consts=[] ; sw_blocks = [i,act]} as sw), loc) + Lswitch (ls, { sw with sw_consts = [ (i, lower_bind v arg act) ] }, loc) + | Lswitch (ls, ({ sw_consts = []; sw_blocks = [ (i, act) ] } as sw), loc) when not (approx_present v ls) -> - Lswitch (ls, {sw with sw_blocks = [i,lower_bind v arg act]}, loc) -| Llet (Alias, k, vv, lv, l) -> - if approx_present v lv then - bind Alias v arg lam - else - Llet (Alias, k, vv, lv, lower_bind v arg l) -| _ -> - bind Alias v arg lam - -let bind_check str v arg lam = match str,arg with -| _, Lvar _ ->bind str v arg lam -| Alias,_ -> lower_bind v arg lam -| _,_ -> bind str v arg lam - -let comp_exit ctx m = match m.default with -| (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx -| _ -> fatal_error "Matching.comp_exit" + Lswitch (ls, { sw with sw_blocks = [ (i, lower_bind v arg act) ] }, loc) + | Llet (Alias, k, vv, lv, l) -> + if approx_present v lv then + bind Alias v arg lam + else + Llet (Alias, k, vv, lv, lower_bind v arg l) + | _ -> bind Alias v arg lam +let bind_check str v arg lam = + match (str, arg) with + | _, Lvar _ -> bind str v arg lam + | Alias, _ -> lower_bind v arg lam + | _, _ -> bind str v arg lam +let comp_exit ctx m = + match Default_environment.pop m.default with + | Some ((_, i), _) -> (Lstaticraise (i, []), Jumps.singleton i ctx) + | None -> fatal_error "Matching.comp_exit" -let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = +let rec comp_match_handlers comp_fun partial ctx first_match next_matchs = match next_matchs with - | [] -> comp_fun partial ctx arg first_match - | rem -> + | [] -> comp_fun partial ctx first_match + | rem -> ( let rec c_rec body total_body = function - | [] -> body, total_body + | [] -> (body, total_body) (* Hum, -1 means never taken | (-1,pm)::rem -> c_rec body total_body rem *) - | (i,pm)::rem -> - let ctx_i,total_rem = jumps_extract i total_body in - begin match ctx_i with - | [] -> c_rec body total_body rem - | _ -> - try - let li,total_i = - comp_fun - (match rem with [] -> partial | _ -> Partial) - ctx_i arg pm in - c_rec - (Lstaticcatch (body,(i,[]),li)) - (jumps_union total_i total_rem) - rem - with - | Unused -> - c_rec (Lstaticcatch (body,(i,[]),lambda_unit)) - total_rem rem - end in - try - let first_lam,total = comp_fun Partial ctx arg first_match in - c_rec first_lam total rem - with Unused -> match next_matchs with - | [] -> raise Unused - | (_,x)::xs -> comp_match_handlers comp_fun partial ctx arg x xs + | (i, pm) :: rem -> ( + let ctx_i, total_rem = Jumps.extract i total_body in + if Context.is_empty ctx_i then + c_rec body total_body rem + else + try + let li, total_i = + comp_fun + ( match rem with + | [] -> partial + | _ -> Partial + ) + ctx_i pm + in + c_rec + (Lstaticcatch (body, (i, []), li)) + (Jumps.union total_i total_rem) + rem + with Unused -> + c_rec (Lstaticcatch (body, (i, []), lambda_unit)) total_rem rem + ) + in + try + let first_lam, total = comp_fun Partial ctx first_match in + c_rec first_lam total rem + with Unused -> ( + match next_matchs with + | [] -> raise Unused + | (_, x) :: xs -> comp_match_handlers comp_fun partial ctx x xs + ) + ) (* To find reasonable names for variables *) let rec name_pattern default = function - (pat :: _, _) :: rem -> - begin match pat.pat_desc with - Tpat_var (id, _) -> id - | Tpat_alias(_, id, _) -> id + | (pat :: _, _) :: rem -> ( + match pat.pat_desc with + | Tpat_var (id, _) -> id + | Tpat_alias (_, id, _) -> id | _ -> name_pattern default rem - end + ) | _ -> Ident.create_local default -let arg_to_var arg cls = match arg with -| Lvar v -> v,arg -| _ -> - let v = name_pattern "*match*" cls in - v,Lvar v - +let arg_to_var arg cls = + match arg with + | Lvar v -> (v, arg) + | _ -> + let v = name_pattern "*match*" cls in + (v, Lvar v) (* The main compilation function. @@ -2708,99 +3071,122 @@ let arg_to_var arg cls = match arg with Output: a lambda term, a jump summary {..., exit number -> context, .. } *) -let rec compile_match repr partial ctx m = match m with -| { cases = []; args = [] } -> comp_exit ctx m -| { cases = ([], action) :: rem } -> - if is_guarded action then begin - let (lambda, total) = - compile_match None partial ctx { m with cases = rem } in - event_branch repr (patch_guarded lambda action), total - end else - (event_branch repr action, jumps_empty) -| { args = (arg, str)::argl } -> - let v,newarg = arg_to_var arg m.cases in - let first_match,rem = - split_precompile (Some v) - { m with args = (newarg, Alias) :: argl } in - let (lam, total) = - comp_match_handlers - ((if dbg then do_compile_matching_pr else do_compile_matching) repr) - partial ctx newarg first_match rem in - bind_check str v arg lam, total -| _ -> assert false - +let rec compile_match repr partial ctx (m : pattern_matching) = + match m with + | { cases = []; args = [] } -> comp_exit ctx m + | { cases = ([], action) :: rem } -> + if is_guarded action then + let lambda, total = + compile_match None partial ctx { m with cases = rem } + in + (event_branch repr (patch_guarded lambda action), total) + else + (event_branch repr action, Jumps.empty) + | { args = (arg, str) :: argl } -> + let v, newarg = arg_to_var arg m.cases in + let first_match, rem = + split_and_precompile (Some v) { m with args = (newarg, Alias) :: argl } + in + let lam, total = + comp_match_handlers + (( if dbg then + do_compile_matching_pr + else + do_compile_matching + ) + repr) + partial ctx first_match rem + in + (bind_check str v arg lam, total) + | _ -> assert false (* verbose version of do_compile_matching, for debug *) - -and do_compile_matching_pr repr partial ctx arg x = +and do_compile_matching_pr repr partial ctx x = Format.eprintf "COMPILE: %s\nMATCH\n" - (match partial with Partial -> "Partial" | Total -> "Total") ; - pretty_precompiled x ; - Format.eprintf "CTX\n" ; - pretty_ctx ctx ; - let (_, jumps) as r = do_compile_matching repr partial ctx arg x in - Format.eprintf "JUMPS\n" ; - pretty_jumps jumps ; + ( match partial with + | Partial -> "Partial" + | Total -> "Total" + ); + pretty_precompiled x; + Format.eprintf "CTX\n"; + Context.eprintf ctx; + let ((_, jumps) as r) = do_compile_matching repr partial ctx x in + Format.eprintf "JUMPS\n"; + Jumps.eprintf jumps; r -and do_compile_matching repr partial ctx arg pmh = match pmh with -| Pm pm -> - let pat = what_is_cases pm.cases in - begin match pat.pat_desc with - | Tpat_any -> - compile_no_test - divide_var ctx_rshift repr partial ctx pm - | Tpat_tuple patl -> - compile_no_test - (divide_tuple (List.length patl) (normalize_pat pat)) ctx_combine - repr partial ctx pm - | Tpat_record ((_, lbl,_)::_,_) -> - compile_no_test - (divide_record lbl.lbl_all (normalize_pat pat)) - ctx_combine repr partial ctx pm - | Tpat_constant cst -> - compile_test - (compile_match repr partial) partial - divide_constant - (combine_constant pat.pat_loc arg cst partial) - ctx pm - | Tpat_construct (_, cstr, _) -> - compile_test - (compile_match repr partial) partial - divide_constructor - (combine_constructor pat.pat_loc arg pat cstr partial) - ctx pm - | Tpat_array _ -> - let kind = Typeopt.array_pattern_kind pat in - compile_test (compile_match repr partial) partial - (divide_array kind) (combine_array pat.pat_loc arg kind partial) - ctx pm - | Tpat_lazy _ -> - compile_no_test - (divide_lazy (normalize_pat pat)) - ctx_combine repr partial ctx pm - | Tpat_variant(_, _, row) -> - compile_test (compile_match repr partial) partial - (divide_variant !row) - (combine_variant pat.pat_loc !row arg partial) - ctx pm - | _ -> assert false - end -| PmVar {inside=pmh ; var_arg=arg} -> - let lam, total = - do_compile_matching repr partial (ctx_lshift ctx) arg pmh in - lam, jumps_map ctx_rshift total -| PmOr {body=body ; handlers=handlers} -> - let lam, total = compile_match repr partial ctx body in - compile_orhandlers (compile_match repr partial) lam total ctx handlers +and do_compile_matching repr partial ctx pmh = + match pmh with + | Pm pm -> ( + let arg = + match pm.args with + | (first_arg, _) :: _ -> first_arg + | _ -> + (* We arrive in do_compile_matching from: + - compile_matching + - recursive call on PmVars + The first one explicitly checks that [args] is nonempty, the + second one is only generated when the inner pm first looks at + a variable (i.e. there is something to look at). + *) + assert false + in + let pat = what_is_cases pm.cases in + match pat.pat_desc with + | Tpat_any -> + compile_no_test divide_var Context.rshift repr partial ctx pm + | Tpat_tuple patl -> + compile_no_test + (divide_tuple (List.length patl) (normalize_pat pat)) + Context.combine repr partial ctx pm + | Tpat_record ((_, lbl, _) :: _, _) -> + compile_no_test + (divide_record lbl.lbl_all (normalize_pat pat)) + Context.combine repr partial ctx pm + | Tpat_constant cst -> + compile_test + (compile_match repr partial) + partial divide_constant + (combine_constant pat.pat_loc arg cst partial) + ctx pm + | Tpat_construct (_, cstr, _) -> + compile_test + (compile_match repr partial) + partial divide_constructor + (combine_constructor pat.pat_loc arg pat cstr partial) + ctx pm + | Tpat_array _ -> + let kind = Typeopt.array_pattern_kind pat in + compile_test + (compile_match repr partial) + partial (divide_array kind) + (combine_array pat.pat_loc arg kind partial) + ctx pm + | Tpat_lazy _ -> + compile_no_test + (divide_lazy (normalize_pat pat)) + Context.combine repr partial ctx pm + | Tpat_variant (_, _, row) -> + compile_test + (compile_match repr partial) + partial (divide_variant !row) + (combine_variant pat.pat_loc !row arg partial) + ctx pm + | _ -> assert false + ) + | PmVar { inside = pmh } -> + let lam, total = + do_compile_matching repr partial (Context.lshift ctx) pmh + in + (lam, Jumps.map Context.rshift total) + | PmOr { body; handlers } -> + let lam, total = compile_match repr partial ctx body in + compile_orhandlers (compile_match repr partial) lam total ctx handlers and compile_no_test divide up_ctx repr partial ctx to_match = - let {pm=this_match ; ctx=this_ctx } = divide ctx to_match in - let lambda,total = compile_match repr partial this_ctx this_match in - lambda, jumps_map up_ctx total - - - + let { pm = this_match; ctx = this_ctx } = divide ctx to_match in + let lambda, total = compile_match repr partial this_ctx this_match in + (lambda, Jumps.map up_ctx total) (* The entry points *) @@ -2822,121 +3208,131 @@ LM: I have generalized the patch, so as to also find mutable fields. *) -let find_in_pat pred = - let rec find_rec p = - pred p.pat_desc || - begin match p.pat_desc with - | Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) | Tpat_lazy p -> - find_rec p - | Tpat_tuple ps|Tpat_construct (_,_,ps) | Tpat_array ps -> - List.exists find_rec ps - | Tpat_record (lpats,_) -> - List.exists - (fun (_, _, p) -> find_rec p) - lpats - | Tpat_or (p,q,_) -> - find_rec p || find_rec q - | Tpat_constant _ | Tpat_var _ - | Tpat_any | Tpat_variant (_,None,_) -> false - | Tpat_exception _ -> assert false - end in - find_rec - -let is_lazy_pat = function +let is_lazy_pat p = match p.pat_desc with | Tpat_lazy _ -> true - | Tpat_alias _ | Tpat_variant _ | Tpat_record _ - | Tpat_tuple _|Tpat_construct _ | Tpat_array _ - | Tpat_or _ | Tpat_constant _ | Tpat_var _ | Tpat_any - -> false + | Tpat_alias _ + | Tpat_variant _ + | Tpat_record _ + | Tpat_tuple _ + | Tpat_construct _ + | Tpat_array _ + | Tpat_or _ + | Tpat_constant _ + | Tpat_var _ + | Tpat_any -> + false | Tpat_exception _ -> assert false -let is_lazy p = find_in_pat is_lazy_pat p +let has_lazy p = + Typedtree.exists_pattern is_lazy_pat p -let have_mutable_field p = match p with -| Tpat_record (lps,_) -> - List.exists - (fun (_,lbl,_) -> - match lbl.Types.lbl_mut with - | Mutable -> true - | Immutable -> false) - lps -| Tpat_alias _ | Tpat_variant _ | Tpat_lazy _ -| Tpat_tuple _|Tpat_construct _ | Tpat_array _ -| Tpat_or _ -| Tpat_constant _ | Tpat_var _ | Tpat_any - -> false -| Tpat_exception _ -> assert false - -let is_mutable p = find_in_pat have_mutable_field p +let is_record_with_mutable_field p = + match p.pat_desc with + | Tpat_record (lps, _) -> + List.exists + (fun (_, lbl, _) -> + match lbl.Types.lbl_mut with + | Mutable -> true + | Immutable -> false) + lps + | Tpat_alias _ + | Tpat_variant _ + | Tpat_lazy _ + | Tpat_tuple _ + | Tpat_construct _ + | Tpat_array _ + | Tpat_or _ + | Tpat_constant _ + | Tpat_var _ + | Tpat_any -> + false + | Tpat_exception _ -> assert false + +let has_mutable p = + Typedtree.exists_pattern is_record_with_mutable_field p (* Downgrade Total when 1. Matching accesses some mutable fields; 2. And there are guards or lazy patterns. *) -let check_partial is_mutable is_lazy pat_act_list = function +let check_partial has_mutable has_lazy pat_act_list = function | Partial -> Partial | Total -> if - pat_act_list = [] || (* allow empty case list *) - List.exists - (fun (pats, lam) -> - is_mutable pats && (is_guarded lam || is_lazy pats)) - pat_act_list - then Partial - else Total + pat_act_list = [] + || (* allow empty case list *) + List.exists + (fun (pats, lam) -> + has_mutable pats && (is_guarded lam || has_lazy pats)) + pat_act_list + then + Partial + else + Total let check_partial_list = - check_partial (List.exists is_mutable) (List.exists is_lazy) -let check_partial = check_partial is_mutable is_lazy + check_partial (List.exists has_mutable) (List.exists has_lazy) -(* have toplevel handler when appropriate *) +let check_partial = check_partial has_mutable has_lazy -let start_ctx n = [{left=[] ; right = omegas n}] +(* have toplevel handler when appropriate *) let check_total total lambda i handler_fun = - if jumps_is_empty total then + if Jumps.is_empty total then lambda - else begin - Lstaticcatch(lambda, (i,[]), handler_fun()) - end + else + Lstaticcatch (lambda, (i, []), handler_fun ()) let compile_matching repr handler_fun arg pat_act_list partial = let partial = check_partial pat_act_list partial in match partial with - | Partial -> + | Partial -> ( let raise_num = next_raise_count () in let pm = - { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list; - args = [arg, Strict] ; - default = [[[omega]],raise_num]} in - begin try - let (lambda, total) = compile_match repr partial (start_ctx 1) pm in + { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list; + args = [ (arg, Strict) ]; + default = Default_environment.(cons [ [ omega ] ] raise_num empty) + } + in + try + let lambda, total = compile_match repr partial (Context.start 1) pm in check_total total lambda raise_num handler_fun - with - | Unused -> assert false (* ; handler_fun() *) - end + with Unused -> assert false + (* ; handler_fun() *) + ) | Total -> let pm = - { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list; - args = [arg, Strict] ; - default = []} in - let (lambda, total) = compile_match repr partial (start_ctx 1) pm in - assert (jumps_is_empty total) ; + { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list; + args = [ (arg, Strict) ]; + default = Default_environment.empty + } + in + let lambda, total = compile_match repr partial (Context.start 1) pm in + assert (Jumps.is_empty total); lambda - let partial_function loc () = let slot = - transl_extension_path loc - Env.initial_safe_string Predef.path_match_failure + transl_extension_path loc Env.initial_safe_string Predef.path_match_failure in - let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in - Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Immutable, None), - [slot; Lconst(Const_block(0, - [Const_base(Const_string (fname, None)); - Const_base(Const_int line); - Const_base(Const_int char)]))], loc)], loc) + let fname, line, char = Location.get_pos_info loc.Location.loc_start in + Lprim + ( Praise Raise_regular, + [ Lprim + ( Pmakeblock (0, Immutable, None), + [ slot; + Lconst + (Const_block + ( 0, + [ Const_base (Const_string (fname, None)); + Const_base (Const_int line); + Const_base (Const_int char) + ] )) + ], + loc ) + ], + loc ) let for_function loc repr param pat_act_list partial = compile_matching repr (partial_function loc) param pat_act_list partial @@ -2944,12 +3340,11 @@ let for_function loc repr param pat_act_list partial = (* In the following two cases, exhaustiveness info is not available! *) let for_trywith param pat_act_list = compile_matching None - (fun () -> Lprim(Praise Raise_reraise, [param], Location.none)) + (fun () -> Lprim (Praise Raise_reraise, [ param ], Location.none)) param pat_act_list Partial let simple_for_let loc param pat body = - compile_matching None (partial_function loc) param [pat, body] Partial - + compile_matching None (partial_function loc) param [ (pat, body) ] Partial (* Optimize binding of immediate tuples @@ -3009,7 +3404,7 @@ let rec map_return f = function | Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2) | Lstaticcatch (l1, b, l2) -> Lstaticcatch (map_return f l1, b, map_return f l2) - | Lstaticraise _ | Lprim(Praise _, _, _) as l -> l + | (Lstaticraise _ | Lprim (Praise _, _, _)) as l -> l | l -> f l (* The 'opt' reference indicates if the optimization is worthy. @@ -3028,22 +3423,22 @@ let rec map_return f = function *) let assign_pat opt nraise catch_ids loc pat lam = - let rec collect acc pat lam = match pat.pat_desc, lam with - | Tpat_tuple patl, Lprim(Pmakeblock _, lams, _) -> - opt := true; - List.fold_left2 collect acc patl lams - | Tpat_tuple patl, Lconst(Const_block(_, scl)) -> - opt := true; - let collect_const acc pat sc = collect acc pat (Lconst sc) in - List.fold_left2 collect_const acc patl scl - | _ -> - (* pattern idents will be bound in staticcatch (let body), so we + let rec collect acc pat lam = + match (pat.pat_desc, lam) with + | Tpat_tuple patl, Lprim (Pmakeblock _, lams, _) -> + opt := true; + List.fold_left2 collect acc patl lams + | Tpat_tuple patl, Lconst (Const_block (_, scl)) -> + opt := true; + let collect_const acc pat sc = collect acc pat (Lconst sc) in + List.fold_left2 collect_const acc patl scl + | _ -> + (* pattern idents will be bound in staticcatch (let body), so we refresh them here to guarantee binders uniqueness *) - let pat_ids = pat_bound_idents pat in - let fresh_ids = List.map (fun id -> id, Ident.rename id) pat_ids in - (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc + let pat_ids = pat_bound_idents pat in + let fresh_ids = List.map (fun id -> (id, Ident.rename id)) pat_ids in + (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc in - (* sublets were accumulated by 'collect' with the leftmost tuple pattern at the bottom of the list; to respect right-to-left evaluation order for tuples, we must evaluate sublets @@ -3056,7 +3451,7 @@ let assign_pat opt nraise catch_ids loc pat lam = let add_ids acc (ids, _pat, _lam) = List.fold_left add acc ids in let tbl = List.fold_left add_ids Ident.empty rev_sublets in let fresh_var id = Lvar (Ident.find_same id tbl) in - Lstaticraise(nraise, List.map fresh_var catch_ids) + Lstaticraise (nraise, List.map fresh_var catch_ids) in let push_sublet code (_ids, pat, lam) = simple_for_let loc lam pat code in List.fold_left push_sublet exit rev_sublets @@ -3066,23 +3461,26 @@ let for_let loc param pat body = | Tpat_any -> (* This eliminates a useless variable (and stack slot in bytecode) for "let _ = ...". See #6865. *) - Lsequence(param, body) + Lsequence (param, body) | Tpat_var (id, _) -> (* fast path, and keep track of simple bindings to unboxable numbers *) let k = Typeopt.value_kind pat.pat_env pat.pat_type in - Llet(Strict, k, id, param, body) + Llet (Strict, k, id, param, body) | _ -> let opt = ref false in let nraise = next_raise_count () in let catch_ids = pat_bound_idents_full pat in let ids_with_kinds = - List.map (fun (id, _, typ) -> id, Typeopt.value_kind pat.pat_env typ) + List.map + (fun (id, _, typ) -> (id, Typeopt.value_kind pat.pat_env typ)) catch_ids in let ids = List.map (fun (id, _, _) -> id) catch_ids in let bind = map_return (assign_pat opt nraise ids loc pat) param in - if !opt then Lstaticcatch(bind, (nraise, ids_with_kinds), body) - else simple_for_let loc param pat body + if !opt then + Lstaticcatch (bind, (nraise, ids_with_kinds), body) + else + simple_for_let loc param pat body (* Handling of tupled functions and matchings *) @@ -3090,151 +3488,134 @@ let for_let loc param pat body = let for_tupled_function loc paraml pats_act_list partial = let partial = check_partial_list pats_act_list partial in let raise_num = next_raise_count () in - let omegas = [List.map (fun _ -> omega) paraml] in + let omegas = [ List.map (fun _ -> omega) paraml ] in let pm = { cases = pats_act_list; - args = List.map (fun id -> (Lvar id, Strict)) paraml ; - default = [omegas,raise_num] - } in + args = List.map (fun id -> (Lvar id, Strict)) paraml; + default = Default_environment.(cons omegas raise_num empty) + } + in try - let (lambda, total) = compile_match None partial - (start_ctx (List.length paraml)) pm in + let lambda, total = + compile_match None partial (Context.start (List.length paraml)) pm + in check_total total lambda raise_num (partial_function loc) - with - | Unused -> partial_function loc () - - + with Unused -> partial_function loc () -let flatten_pattern size p = match p.pat_desc with -| Tpat_tuple args -> args -| Tpat_any -> omegas size -| _ -> raise Cannot_flatten - -let rec flatten_pat_line size p k = match p.pat_desc with -| Tpat_any -> omegas size::k -| Tpat_tuple args -> args::k -| Tpat_or (p1,p2,_) -> flatten_pat_line size p1 (flatten_pat_line size p2 k) -| Tpat_alias (p,_,_) -> (* Note: if this 'as' pat is here, then this is a - useless binding, solves PR#3780 *) - flatten_pat_line size p k -| _ -> fatal_error "Matching.flatten_pat_line" +let flatten_pattern size p = + match p.pat_desc with + | Tpat_tuple args -> args + | Tpat_any -> omegas size + | _ -> raise Cannot_flatten let flatten_cases size cases = List.map - (fun (ps,action) -> match ps with - | [p] -> flatten_pattern size p,action - | _ -> fatal_error "Matching.flatten_case") + (fun (ps, action) -> + match ps with + | [ p ] -> (flatten_pattern size p, action) + | _ -> fatal_error "Matching.flatten_case") cases -let flatten_matrix size pss = - List.fold_right - (fun ps r -> match ps with - | [p] -> flatten_pat_line size p r - | _ -> fatal_error "Matching.flatten_matrix") - pss [] - -let flatten_def size def = - List.map - (fun (pss,i) -> flatten_matrix size pss,i) - def - let flatten_pm size args pm = - {args = args ; cases = flatten_cases size pm.cases ; - default = flatten_def size pm.default} - - -let flatten_precompiled size args pmh = match pmh with -| Pm pm -> Pm (flatten_pm size args pm) -| PmOr {body=b ; handlers=hs ; or_matrix=m} -> - PmOr - {body=flatten_pm size args b ; - handlers= - List.map - (fun (mat,i,vars,pm) -> flatten_matrix size mat,i,vars,pm) - hs ; - or_matrix=flatten_matrix size m ;} -| PmVar _ -> assert false + { args; + cases = flatten_cases size pm.cases; + default = Default_environment.flatten size pm.default + } + +let flatten_handler size handler = + { handler with provenance = flatten_matrix size handler.provenance } + +let flatten_precompiled size args pmh = + match pmh with + | Pm pm -> Pm (flatten_pm size args pm) + | PmOr { body = b; handlers = hs; or_matrix = m } -> + PmOr + { body = flatten_pm size args b; + handlers = List.map (flatten_handler size) hs; + or_matrix = flatten_matrix size m + } + | PmVar _ -> assert false (* compiled_flattened is a ``comp_fun'' argument to comp_match_handlers. Hence it needs a fourth argument, which it ignores *) -let compile_flattened repr partial ctx _ pmh = match pmh with -| Pm pm -> compile_match repr partial ctx pm -| PmOr {body=b ; handlers=hs} -> - let lam, total = compile_match repr partial ctx b in - compile_orhandlers (compile_match repr partial) lam total ctx hs -| PmVar _ -> assert false +let compile_flattened repr partial ctx pmh = + match pmh with + | Pm pm -> compile_match repr partial ctx pm + | PmOr { body = b; handlers = hs } -> + let lam, total = compile_match repr partial ctx b in + compile_orhandlers (compile_match repr partial) lam total ctx hs + | PmVar _ -> assert false let do_for_multiple_match loc paraml pat_act_list partial = let repr = None in let partial = check_partial pat_act_list partial in - let raise_num,pm1 = - match partial with - | Partial -> - let raise_num = next_raise_count () in - raise_num, - { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list; - args = [Lprim(Pmakeblock(0, Immutable, None), paraml, loc), Strict]; - default = [[[omega]],raise_num] } - | _ -> - -1, - { cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list; - args = [Lprim(Pmakeblock(0, Immutable, None), paraml, loc), Strict]; - default = [] } in - + let raise_num, pm1 = + let raise_num, default = + match partial with + | Partial -> + let raise_num = next_raise_count () in + (raise_num, Default_environment.(cons [ [ omega ] ] raise_num empty)) + | Total -> (-1, Default_environment.empty) + in + ( raise_num, + { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list; + args = + [ (Lprim (Pmakeblock (0, Immutable, None), paraml, loc), Strict) ]; + default + } ) + in try try -(* Once for checking that compilation is possible *) - let next, nexts = split_precompile None pm1 in - + (* Once for checking that compilation is possible *) + let next, nexts = split_and_precompile None pm1 in let size = List.length paraml and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in - let args = List.map (fun id -> Lvar id, Alias) idl in - + let args = List.map (fun id -> (Lvar id, Alias)) idl in let flat_next = flatten_precompiled size args next and flat_nexts = - List.map - (fun (e,pm) -> e,flatten_precompiled size args pm) - nexts in - + List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts + in let lam, total = - comp_match_handlers - (compile_flattened repr) - partial (start_ctx size) () flat_next flat_nexts in + comp_match_handlers (compile_flattened repr) partial + (Context.start size) flat_next flat_nexts + in List.fold_right2 (bind Strict) idl paraml - (match partial with - | Partial -> - check_total total lam raise_num (partial_function loc) + ( match partial with + | Partial -> check_total total lam raise_num (partial_function loc) | Total -> - assert (jumps_is_empty total) ; - lam) - with Cannot_flatten -> - let (lambda, total) = compile_match None partial (start_ctx 1) pm1 in - begin match partial with - | Partial -> - check_total total lambda raise_num (partial_function loc) + assert (Jumps.is_empty total); + lam + ) + with Cannot_flatten -> ( + let lambda, total = compile_match None partial (Context.start 1) pm1 in + match partial with + | Partial -> check_total total lambda raise_num (partial_function loc) | Total -> - assert (jumps_is_empty total) ; + assert (Jumps.is_empty total); lambda - end - with Unused -> - assert false (* ; partial_function loc () *) + ) + with Unused -> assert false + +(* ; partial_function loc () *) (* PR#4828: Believe it or not, the 'paraml' argument below may not be side effect free. *) -let param_to_var param = match param with -| Lvar v -> v,None -| _ -> Ident.create_local "*match*",Some param +let param_to_var param = + match param with + | Lvar v -> (v, None) + | _ -> (Ident.create_local "*match*", Some param) -let bind_opt (v,eo) k = match eo with -| None -> k -| Some e -> Lambda.bind Strict v e k +let bind_opt (v, eo) k = + match eo with + | None -> k + | Some e -> Lambda.bind Strict v e k let for_multiple_match loc paraml pat_act_list partial = let v_paraml = List.map param_to_var paraml in - let paraml = List.map (fun (v,_) -> Lvar v) v_paraml in + let paraml = List.map (fun (v, _) -> Lvar v) v_paraml in List.fold_right bind_opt v_paraml (do_for_multiple_match loc paraml pat_act_list partial) diff --git a/lambda/simplif.ml b/lambda/simplif.ml index 2aa6e66a..8cc7fe5e 100644 --- a/lambda/simplif.ml +++ b/lambda/simplif.ml @@ -56,13 +56,13 @@ let rec eliminate_ref id = function sw_blocks = List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks; sw_failaction = - Misc.may_map (eliminate_ref id) sw.sw_failaction; }, + Option.map (eliminate_ref id) sw.sw_failaction; }, loc) | Lstringswitch(e, sw, default, loc) -> Lstringswitch (eliminate_ref id e, List.map (fun (s, e) -> (s, eliminate_ref id e)) sw, - Misc.may_map (eliminate_ref id) default, loc) + Option.map (eliminate_ref id) default, loc) | Lstaticraise (i,args) -> Lstaticraise (i,List.map (eliminate_ref id) args) | Lstaticcatch(e1, i, e2) -> @@ -254,7 +254,7 @@ let simplify_exits lam = let new_l = simplif l and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks - and new_fail = Misc.may_map simplif sw.sw_failaction in + and new_fail = Option.map simplif sw.sw_failaction in Lswitch (new_l, {sw with sw_consts = new_consts ; sw_blocks = new_blocks; @@ -263,7 +263,7 @@ let simplify_exits lam = | Lstringswitch(l,sw,d,loc) -> Lstringswitch (simplif l,List.map (fun (s,l) -> s,simplif l) sw, - Misc.may_map simplif d,loc) + Option.map simplif d,loc) | Lstaticraise (i,[]) as l -> begin try let _,handler = Hashtbl.find subst i in @@ -329,6 +329,25 @@ let simplify_exits lam = Assumes |args| = |params|. *) +let exact_application {kind; params; _} args = + match kind with + | Curried -> + if List.length params <> List.length args + then None + else Some args + | Tupled -> + begin match args with + | [Lprim(Pmakeblock _, tupled_args, _)] -> + if List.length params <> List.length tupled_args + then None + else Some tupled_args + | [Lconst(Const_block (_, const_args))] -> + if List.length params <> List.length const_args + then None + else Some (List.map (fun cst -> Lconst cst) const_args) + | _ -> None + end + let beta_reduce params body args = List.fold_left2 (fun l (param, kind) arg -> Llet(Strict, kind, param, arg, l)) body params args @@ -383,15 +402,17 @@ let simplify_lets lam = | Lconst _ -> () | Lvar v -> use_var bv v 1 - | Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args} - when optimize && List.length params = List.length args -> - count bv (beta_reduce params body args) - | Lapply{ap_func = Lfunction{kind = Tupled; params; body}; - ap_args = [Lprim(Pmakeblock _, args, _)]} - when optimize && List.length params = List.length args -> - count bv (beta_reduce params body args) - | Lapply{ap_func = l1; ap_args = ll} -> - count bv l1; List.iter (count bv) ll + | Lapply{ap_func = ll; ap_args = args} -> + let no_opt () = count bv ll; List.iter (count bv) args in + begin match ll with + | Lfunction lf when optimize -> + begin match exact_application lf args with + | None -> no_opt () + | Some exact_args -> + count bv (beta_reduce lf.params lf.body exact_args) + end + | _ -> no_opt () + end | Lfunction {body} -> count Ident.Map.empty body | Llet(_str, _k, v, Lvar w, l2) when optimize -> @@ -477,15 +498,19 @@ let simplify_lets lam = l end | Lconst _ as l -> l - | Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args} - when optimize && List.length params = List.length args -> - simplif (beta_reduce params body args) - | Lapply{ap_func = Lfunction{kind = Tupled; params; body}; - ap_args = [Lprim(Pmakeblock _, args, _)]} - when optimize && List.length params = List.length args -> - simplif (beta_reduce params body args) - | Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func; - ap_args = List.map simplif ap.ap_args} + | Lapply ({ap_func = ll; ap_args = args} as ap) -> + let no_opt () = + Lapply {ap with ap_func = simplif ap.ap_func; + ap_args = List.map simplif ap.ap_args} in + begin match ll with + | Lfunction lf when optimize -> + begin match exact_application lf args with + | None -> no_opt () + | Some exact_args -> + simplif (beta_reduce lf.params lf.body exact_args) + end + | _ -> no_opt () + end | Lfunction{kind; params; return=return1; body = l; attr; loc} -> begin match simplif l with Lfunction{kind=Curried; params=params'; return=return2; body; attr; loc} @@ -536,7 +561,7 @@ let simplify_lets lam = let new_l = simplif l and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks - and new_fail = Misc.may_map simplif sw.sw_failaction in + and new_fail = Option.map simplif sw.sw_failaction in Lswitch (new_l, {sw with sw_consts = new_consts ; sw_blocks = new_blocks; @@ -545,7 +570,7 @@ let simplify_lets lam = | Lstringswitch (l,sw,d,loc) -> Lstringswitch (simplif l,List.map (fun (s,l) -> s,simplif l) sw, - Misc.may_map simplif d,loc) + Option.map simplif d,loc) | Lstaticraise (i,ls) -> Lstaticraise (i, List.map simplif ls) | Lstaticcatch(l1, (i,args), l2) -> @@ -615,13 +640,13 @@ let rec emit_tail_infos is_tail lambda = emit_tail_infos false lam; list_emit_tail_infos_fun snd is_tail sw.sw_consts; list_emit_tail_infos_fun snd is_tail sw.sw_blocks; - Misc.may (emit_tail_infos is_tail) sw.sw_failaction + Option.iter (emit_tail_infos is_tail) sw.sw_failaction | Lstringswitch (lam, sw, d, _) -> emit_tail_infos false lam; List.iter (fun (_,lam) -> emit_tail_infos is_tail lam) sw ; - Misc.may (emit_tail_infos is_tail) d + Option.iter (emit_tail_infos is_tail) d | Lstaticraise (_, l) -> list_emit_tail_infos false l | Lstaticcatch (body, _, handler) -> @@ -729,7 +754,7 @@ let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body ~attr ~loc = type slot = { - nargs: int; + func: lfunction; mutable scope: lambda option; } @@ -762,9 +787,8 @@ let simplify_local_functions lam = -> false in let rec tail = function - | Llet (_str, _kind, id, Lfunction lf, cont) - when Lambda.function_is_curried lf && enabled lf.attr -> - let r = {nargs=List.length lf.params; scope=None} in + | Llet (_str, _kind, id, Lfunction lf, cont) when enabled lf.attr -> + let r = {func = lf; scope = None} in Hashtbl.add slots id r; tail cont; begin match Hashtbl.find_opt slots id with @@ -787,7 +811,8 @@ let simplify_local_functions lam = end | Lapply {ap_func = Lvar id; ap_args; _} -> begin match Hashtbl.find_opt slots id with - | Some {nargs; _} when nargs <> List.length ap_args -> + | Some {func; _} + when exact_application func ap_args = None -> (* Wrong arity *) Hashtbl.remove slots id | Some {scope = Some scope; _} when scope != !current_scope -> @@ -822,7 +847,13 @@ let simplify_local_functions lam = | Llet (_, _, id, _, cont) when Hashtbl.mem static_id id -> rewrite cont | Lapply {ap_func = Lvar id; ap_args; _} when Hashtbl.mem static_id id -> - Lstaticraise (Hashtbl.find static_id id, List.map rewrite ap_args) + let st = Hashtbl.find static_id id in + let slot = Hashtbl.find slots id in + begin match exact_application slot.func ap_args with + | None -> assert false + | Some exact_args -> + Lstaticraise (st, List.map rewrite exact_args) + end | lam -> Lambda.shallow_map rewrite lam in diff --git a/lambda/switch.ml b/lambda/switch.ml index 89bfe83a..36c7026f 100644 --- a/lambda/switch.ml +++ b/lambda/switch.ml @@ -659,8 +659,8 @@ let rec pkey chan = function and right = {s with cases=right} in if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then - make_if_ne - ctx.arg 0 + Arg.make_if + ctx.arg (c_test ctx right) (c_test ctx left) else if less_tests cright cleft then make_if_lt diff --git a/lambda/translcore.ml b/lambda/translcore.ml index 6fe2dcbb..fc88d055 100644 --- a/lambda/translcore.ml +++ b/lambda/translcore.ml @@ -84,7 +84,7 @@ let extract_float = function type binding = | Bind_value of value_binding list - | Bind_module of Ident.t * string loc * module_presence * module_expr + | Bind_module of Ident.t * string option loc * module_presence * module_expr let rec push_defaults loc bindings cases partial = match cases with @@ -105,7 +105,7 @@ let rec push_defaults loc bindings cases partial = | [{c_lhs=pat; c_guard=None; c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#modulepat"};_}]; exp_desc = Texp_letmodule - (id, name, pres, mexpr, + (Some id, name, pres, mexpr, ({exp_desc = Texp_function _} as e2))}}] -> push_defaults loc (Bind_module (id, name, pres, mexpr) :: bindings) [{c_lhs=pat;c_guard=None;c_rhs=e2}] @@ -118,7 +118,7 @@ let rec push_defaults loc bindings cases partial = match binds with | Bind_value binds -> Texp_let(Nonrecursive, binds, exp) | Bind_module (id, name, pres, mexpr) -> - Texp_letmodule (id, name, pres, mexpr, exp)}) + Texp_letmodule (Some id, name, pres, mexpr, exp)}) case.c_rhs bindings in [{case with c_rhs=exp}] @@ -465,7 +465,10 @@ and transl_exp0 e = (Lvar cpy) var expr, rem)) modifs (Lvar cpy)) - | Texp_letmodule(id, loc, Mp_present, modl, body) -> + | Texp_letmodule(None, loc, Mp_present, modl, body) -> + let lam = !transl_module Tcoerce_none None modl in + Lsequence(Lprim(Pignore, [lam], loc.loc), transl_exp body) + | Texp_letmodule(Some id, loc, Mp_present, modl, body) -> let defining_expr = Levent (!transl_module Tcoerce_none None modl, { lev_loc = loc.loc; @@ -644,12 +647,16 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline) in let args, args' = if List.for_all (fun (_,opt) -> opt) args then [], args - else args, [] in + else args, [] + in let lam = - if args = [] then lam else lapply lam (List.rev_map fst args) in - let handle = protect "func" lam - and l = List.map (fun (arg, opt) -> may_map (protect "arg") arg, opt) l - and id_arg = Ident.create_local "param" in + if args = [] then lam else lapply lam (List.rev_map fst args) + in + let handle = protect "func" lam in + let l = + List.map (fun (arg, opt) -> Option.map (protect "arg") arg, opt) l + in + let id_arg = Ident.create_local "param" in let body = match build_apply handle ((Lvar id_arg, optional)::args') l with Lfunction{kind = Curried; params = ids; return; @@ -679,7 +686,7 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline) lapply lam (List.rev_map fst args) in (build_apply lam [] (List.map (fun (l, x) -> - may_map transl_exp x, Btype.is_optional l) + Option.map transl_exp x, Btype.is_optional l) sargs) : Lambda.lambda) diff --git a/lambda/translmod.ml b/lambda/translmod.ml index be6ecc31..5a617365 100644 --- a/lambda/translmod.ml +++ b/lambda/translmod.ml @@ -32,13 +32,20 @@ type unsafe_component = | Unsafe_non_function | Unsafe_typext -type unsafe_info = { reason:unsafe_component; loc:Location.t; subid:Ident.t } +type unsafe_info = + | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t } + | Unnamed type error = Circular_dependency of (Ident.t * unsafe_info) list | Conflicting_inline_attributes exception Error of Location.t * error +let cons_opt x_opt xs = + match x_opt with + | None -> xs + | Some x -> x :: xs + (* Keep track of the root path (from the root of the namespace to the currently compiled module expression). Useful for naming extensions. *) @@ -218,12 +225,14 @@ let init_shape id modl = match Mtype.scrape env mty with Mty_ident _ | Mty_alias _ -> - raise (Initialization_failure {reason=Unsafe_module_binding;loc;subid}) + raise (Initialization_failure + (Unsafe {reason=Unsafe_module_binding;loc;subid})) | Mty_signature sg -> Const_block(0, [Const_block(0, init_shape_struct env sg)]) | Mty_functor _ -> (* can we do better? *) - raise (Initialization_failure {reason=Unsafe_functor;loc;subid}) + raise (Initialization_failure + (Unsafe {reason=Unsafe_functor;loc;subid})) and init_shape_struct env sg = match sg with [] -> [] @@ -235,7 +244,9 @@ let init_shape id modl = | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t -> Const_pointer 1 (* camlinternalMod.Lazy *) | _ -> - let not_a_function = {reason=Unsafe_non_function; loc; subid } in + let not_a_function = + Unsafe {reason=Unsafe_non_function; loc; subid } + in raise (Initialization_failure not_a_function) in init_v :: init_shape_struct env rem | Sig_value(_, {val_kind=Val_prim _}, _) :: rem -> @@ -245,7 +256,7 @@ let init_shape id modl = | Sig_type(id, tdecl, _, _) :: rem -> init_shape_struct (Env.add_type ~check:false id tdecl env) rem | Sig_typext (subid, {ext_loc=loc},_,_) :: _ -> - raise (Initialization_failure {reason=Unsafe_typext; loc; subid}) + raise (Initialization_failure (Unsafe {reason=Unsafe_typext;loc;subid})) | Sig_module(id, Mp_present, md, _, _) :: rem -> init_shape_mod id md.md_loc env md.md_type :: init_shape_struct (Env.add_module_declaration ~check:false @@ -274,9 +285,18 @@ type binding_status = | Inprogress of int option (** parent node *) | Defined +type id_or_ignore_loc = + | Id of Ident.t + | Ignore_loc of Location.t + let extract_unsafe_cycle id status init cycle_start = let info i = match init.(i) with - | Result.Error r -> id.(i), r + | Result.Error r -> + begin match id.(i) with + | Id id -> id, r + | Ignore_loc _ -> + assert false (* Can't refer to something without a name. *) + end | Ok _ -> assert false in let rec collect stop l i = match status.(i) with | Inprogress None | Undefined | Defined -> assert false @@ -310,7 +330,9 @@ let reorder_rec_bindings bindings = if is_unsafe i then begin status.(i) <- Inprogress parent; for j = 0 to num_bindings - 1 do - if Ident.Set.mem id.(j) fv.(i) then emit_binding (Some i) j + match id.(j) with + | Id id when Ident.Set.mem id fv.(i) -> emit_binding (Some i) j + | _ -> () done end; res := (id.(i), init_res i, rhs.(i)) :: !res; @@ -329,9 +351,10 @@ let eval_rec_bindings bindings cont = let rec bind_inits = function [] -> bind_strict bindings - | (_id, None, _rhs) :: rem -> + | (Ignore_loc _, _, _) :: rem + | (_, None, _) :: rem -> bind_inits rem - | (id, Some(loc, shape), _rhs) :: rem -> + | (Id id, Some(loc, shape), _rhs) :: rem -> Llet(Strict, Pgenval, id, Lapply{ap_should_be_tailcall=false; ap_loc=Location.none; @@ -343,16 +366,19 @@ let eval_rec_bindings bindings cont = and bind_strict = function [] -> patch_forwards bindings - | (id, None, rhs) :: rem -> + | (Ignore_loc loc, None, rhs) :: rem -> + Lsequence(Lprim(Pignore, [rhs], loc), bind_strict rem) + | (Id id, None, rhs) :: rem -> Llet(Strict, Pgenval, id, rhs, bind_strict rem) | (_id, Some _, _rhs) :: rem -> bind_strict rem and patch_forwards = function [] -> cont - | (_id, None, _rhs) :: rem -> + | (Ignore_loc _, _, _rhs) :: rem + | (_, None, _rhs) :: rem -> patch_forwards rem - | (id, Some(_loc, shape), rhs) :: rem -> + | (Id id, Some(_loc, shape), rhs) :: rem -> Lsequence(Lapply{ap_should_be_tailcall=false; ap_loc=Location.none; ap_func=mod_prim "update_mod"; @@ -367,8 +393,13 @@ let compile_recmodule compile_rhs bindings cont = eval_rec_bindings (reorder_rec_bindings (List.map - (fun {mb_id=id; mb_expr=modl; mb_loc=loc; _} -> - (id, modl.mod_loc, init_shape id modl, compile_rhs id modl loc)) + (fun {mb_id=id; mb_name; mb_expr=modl; mb_loc=loc; _} -> + let id_or_ignore_loc, shape = + match id with + | None -> Ignore_loc mb_name.loc, Result.Error Unnamed + | Some id -> Id id, init_shape id modl + in + (id_or_ignore_loc, modl.mod_loc, shape, compile_rhs id modl loc)) bindings)) cont @@ -397,7 +428,7 @@ let merge_functors mexp coercion root_path = let rec merge mexp coercion path acc inline_attribute = let finished = acc, mexp, path, coercion, inline_attribute in match mexp.mod_desc with - | Tmod_functor (param, _, _, body) -> + | Tmod_functor (param, body) -> let inline_attribute' = Translattribute.get_inline_attribute mexp.mod_attributes in @@ -409,7 +440,14 @@ let merge_functors mexp coercion root_path = | _ -> fatal_error "Translmod.merge_functors: bad coercion" in let loc = mexp.mod_loc in - let path = functor_path path param in + let path, param = + match param with + | Unit -> None, Ident.create_local "*" + | Named (None, _, _) -> + let id = Ident.create_local "_" in + functor_path path id, id + | Named (Some id, _, _) -> functor_path path id, id + in let inline_attribute = merge_inline_attributes inline_attribute inline_attribute' loc in @@ -547,8 +585,9 @@ and transl_structure loc fields cc rootpath final_env = function Lsequence(transl_exp expr, body), size | Tstr_value(rec_flag, pat_expr_list) -> (* Translate bindings first *) - let mk_lam_let = transl_let rec_flag pat_expr_list in - let ext_fields = rev_let_bound_idents pat_expr_list @ fields in + let mk_lam_let = transl_let rec_flag pat_expr_list in + let ext_fields = + List.rev_append (let_bound_idents pat_expr_list) fields in (* Then, translate remainder of struct *) let body, size = transl_structure loc ext_fields cc rootpath final_env rem @@ -581,7 +620,8 @@ and transl_structure loc fields cc rootpath final_env = function let id = mb.mb_id in (* Translate module first *) let module_body = - transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr + transl_module Tcoerce_none (Option.bind id (field_path rootpath)) + mb.mb_expr in let module_body = Translattribute.add_inline_attribute module_body mb.mb_loc @@ -589,42 +629,48 @@ and transl_structure loc fields cc rootpath final_env = function in (* Translate remainder second *) let body, size = - transl_structure loc (id :: fields) cc rootpath final_env rem - in - let module_body = - Levent (module_body, { - lev_loc = mb.mb_loc; - lev_kind = Lev_module_definition id; - lev_repr = None; - lev_env = Env.empty; - }) + transl_structure loc (cons_opt id fields) cc rootpath final_env rem in - Llet(pure_module mb.mb_expr, Pgenval, id, - module_body, - body), size + begin match id with + | None -> + Lsequence (Lprim(Pignore, [module_body], mb.mb_name.loc), body), + size + | Some id -> + let module_body = + Levent (module_body, { + lev_loc = mb.mb_loc; + lev_kind = Lev_module_definition id; + lev_repr = None; + lev_env = Env.empty; + }) + in + Llet(pure_module mb.mb_expr, Pgenval, id, module_body, body), size + end | Tstr_module {mb_presence=Mp_absent} -> transl_structure loc fields cc rootpath final_env rem | Tstr_recmodule bindings -> let ext_fields = - List.rev_append (List.map (fun mb -> mb.mb_id) bindings) fields + List.rev_append (List.filter_map (fun mb -> mb.mb_id) bindings) + fields in let body, size = transl_structure loc ext_fields cc rootpath final_env rem in let lam = - compile_recmodule - (fun id modl loc -> - let module_body = - transl_module Tcoerce_none (field_path rootpath id) modl - in - Levent (module_body, { - lev_loc = loc; - lev_kind = Lev_module_definition id; - lev_repr = None; - lev_env = Env.empty; - })) - bindings - body + compile_recmodule (fun id modl loc -> + match id with + | None -> transl_module Tcoerce_none None modl + | Some id -> + let module_body = + transl_module Tcoerce_none (field_path rootpath id) modl + in + Levent (module_body, { + lev_loc = loc; + lev_kind = Lev_module_definition id; + lev_repr = None; + lev_env = Env.empty; + }) + ) bindings body in lam, size | Tstr_class cl_list -> @@ -767,10 +813,12 @@ let rec defined_idents = function List.map (fun ext -> ext.ext_id) tyext.tyext_constructors @ defined_idents rem | Tstr_exception ext -> ext.tyexn_constructor.ext_id :: defined_idents rem - | Tstr_module {mb_id; mb_presence=Mp_present} -> mb_id :: defined_idents rem - | Tstr_module {mb_presence=Mp_absent} -> defined_idents rem + | Tstr_module {mb_id = Some id; mb_presence=Mp_present} -> + id :: defined_idents rem + | Tstr_module ({mb_id = None} + |{mb_presence=Mp_absent}) -> defined_idents rem | Tstr_recmodule decls -> - List.map (fun mb -> mb.mb_id) decls @ defined_idents rem + List.filter_map (fun mb -> mb.mb_id) decls @ defined_idents rem | Tstr_modtype _ -> defined_idents rem | Tstr_open od -> bound_value_identifiers od.open_bound_items @ defined_idents rem @@ -832,7 +880,7 @@ and all_idents = function @ all_idents rem | Tstr_exception ext -> ext.tyexn_constructor.ext_id :: all_idents rem | Tstr_recmodule decls -> - List.map (fun mb -> mb.mb_id) decls @ all_idents rem + List.filter_map (fun mb -> mb.mb_id) decls @ all_idents rem | Tstr_modtype _ -> all_idents rem | Tstr_open od -> let rest = all_idents rem in @@ -857,15 +905,19 @@ and all_idents = function bound_value_identifiers incl.incl_type @ all_idents rem | Tstr_module - {mb_id;mb_presence=Mp_present;mb_expr={mod_desc = Tmod_structure str}} + { mb_id = Some id; + mb_presence=Mp_present; + mb_expr={mod_desc = Tmod_structure str} } | Tstr_module - {mb_id;mb_presence=Mp_present; - mb_expr= - {mod_desc = - Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} -> - mb_id :: all_idents str.str_items @ all_idents rem - | Tstr_module {mb_id;mb_presence=Mp_present} -> mb_id :: all_idents rem - | Tstr_module {mb_presence=Mp_absent} -> all_idents rem + { mb_id = Some id; + mb_presence = Mp_present; + mb_expr = + {mod_desc = + Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} -> + id :: all_idents str.str_items @ all_idents rem + | Tstr_module {mb_id = Some id;mb_presence=Mp_present} -> + id :: all_idents rem + | Tstr_module ({mb_id = None} | {mb_presence=Mp_absent}) -> all_idents rem | Tstr_attribute _ -> all_idents rem @@ -950,7 +1002,17 @@ let transl_store_structure glob map prims aliases str = store_ident ext.tyexn_constructor.ext_loc id), transl_store rootpath (add_ident false id subst) cont rem) - | Tstr_module{mb_id=id;mb_loc=loc;mb_presence=Mp_present; + | Tstr_module + {mb_id=None; mb_name; mb_presence=Mp_present; mb_expr=modl; + mb_loc=loc; mb_attributes} -> + let lam = + Translattribute.add_inline_attribute + (transl_module Tcoerce_none None modl) + loc mb_attributes + in + Lsequence(Lprim(Pignore, [lam], mb_name.loc), + transl_store rootpath subst cont rem) + | Tstr_module{mb_id=Some id;mb_loc=loc;mb_presence=Mp_present; mb_expr={mod_desc = Tmod_structure str} as mexp; mb_attributes} -> List.iter (Translattribute.check_attribute_on_module mexp) @@ -972,7 +1034,7 @@ let transl_store_structure glob map prims aliases str = (add_ident true id subst) cont rem))) | Tstr_module{ - mb_id=id;mb_loc=loc;mb_presence=Mp_present; + mb_id=Some id;mb_loc=loc;mb_presence=Mp_present; mb_expr= { mod_desc = Tmod_constraint ( {mod_desc = Tmod_structure str} as mexp, _, _, @@ -1000,7 +1062,7 @@ let transl_store_structure glob map prims aliases str = (add_ident true id subst) cont rem))) | Tstr_module - {mb_id=id; mb_presence=Mp_present; mb_expr=modl; + {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl; mb_loc=loc; mb_attributes} -> let lam = Translattribute.add_inline_attribute @@ -1020,12 +1082,12 @@ let transl_store_structure glob map prims aliases str = | Tstr_module {mb_presence=Mp_absent} -> transl_store rootpath subst cont rem | Tstr_recmodule bindings -> - let ids = List.map (fun mb -> mb.mb_id) bindings in + let ids = List.filter_map (fun mb -> mb.mb_id) bindings in compile_recmodule (fun id modl _loc -> Lambda.subst no_env_update subst (transl_module Tcoerce_none - (field_path rootpath id) modl)) + (Option.bind id (field_path rootpath)) modl)) bindings (Lsequence(store_idents Location.none ids, transl_store rootpath (add_idents true ids subst) @@ -1348,16 +1410,19 @@ let transl_toplevel_item item = set_toplevel_unique_name ext.tyexn_constructor.ext_id; toploop_setvalue ext.tyexn_constructor.ext_id (transl_extension_constructor item.str_env None ext.tyexn_constructor) - | Tstr_module {mb_id=id; mb_presence=Mp_present; mb_expr=modl} -> + | Tstr_module {mb_id=None; mb_presence=Mp_present; mb_expr=modl} -> + transl_module Tcoerce_none None modl + | Tstr_module {mb_id=Some id; mb_presence=Mp_present; mb_expr=modl} -> (* we need to use the unique name for the module because of issues with "open" (PR#8133) *) set_toplevel_unique_name id; let lam = transl_module Tcoerce_none (Some(Pident id)) modl in toploop_setvalue id lam | Tstr_recmodule bindings -> - let idents = List.map (fun mb -> mb.mb_id) bindings in + let idents = List.filter_map (fun mb -> mb.mb_id) bindings in compile_recmodule - (fun id modl _loc -> transl_module Tcoerce_none (Some(Pident id)) modl) + (fun id modl _loc -> + transl_module Tcoerce_none (Option.map (fun i -> Pident i) id) modl) bindings (make_sequence toploop_setvalue_id idents) | Tstr_class cl_list -> @@ -1522,20 +1587,24 @@ let print_cycle ppf cycle = (Ident.name @@ fst @@ List.hd cycle) (* we repeat the first element to make the cycle more apparent *) -let explanation_submsg (id, {reason;loc;subid}) = - let print fmt = - let printer = Format.dprintf fmt (Ident.name id) (Ident.name subid) in - Location.mkloc printer loc in - match reason with - | Unsafe_module_binding -> print "Module %s defines an unsafe module, %s ." - | Unsafe_functor -> print "Module %s defines an unsafe functor, %s ." - | Unsafe_typext -> - print "Module %s defines an unsafe extension constructor, %s ." - | Unsafe_non_function -> print "Module %s defines an unsafe value, %s ." +let explanation_submsg (id, unsafe_info) = + match unsafe_info with + | Unnamed -> assert false (* can't be part of a cycle. *) + | Unsafe {reason;loc;subid} -> + let print fmt = + let printer = Format.dprintf fmt (Ident.name id) (Ident.name subid) in + Location.mkloc printer loc in + match reason with + | Unsafe_module_binding -> + print "Module %s defines an unsafe module, %s ." + | Unsafe_functor -> print "Module %s defines an unsafe functor, %s ." + | Unsafe_typext -> + print "Module %s defines an unsafe extension constructor, %s ." + | Unsafe_non_function -> print "Module %s defines an unsafe value, %s ." let report_error loc = function | Circular_dependency cycle -> - let[@manual.ref "s-recursive-modules"] chapter, section = 8, 2 in + let[@manual.ref "s:recursive-modules"] chapter, section = 8, 2 in Location.errorf ~loc ~sub:(List.map explanation_submsg cycle) "Cannot safely evaluate the definition of the following cycle@ \ of recursively-defined modules:@ %a.@ \ diff --git a/lambda/translmod.mli b/lambda/translmod.mli index d0898c76..af042d6a 100644 --- a/lambda/translmod.mli +++ b/lambda/translmod.mli @@ -48,7 +48,9 @@ type unsafe_component = | Unsafe_non_function | Unsafe_typext -type unsafe_info = { reason:unsafe_component; loc:Location.t; subid:Ident.t } +type unsafe_info = + | Unsafe of { reason:unsafe_component; loc:Location.t; subid:Ident.t } + | Unnamed type error = Circular_dependency of (Ident.t * unsafe_info) list diff --git a/lex/Makefile b/lex/Makefile index b643073b..edf6a0c2 100644 --- a/lex/Makefile +++ b/lex/Makefile @@ -25,7 +25,7 @@ CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc CAMLC = $(BOOT_OCAMLC) -strict-sequence -nostdlib \ -I $(ROOTDIR)/boot -use-prims $(ROOTDIR)/runtime/primitives CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -COMPFLAGS = $(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \ +COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \ -safe-string -strict-sequence -strict-formats -bin-annot LINKFLAGS = YACCFLAGS = -v @@ -61,7 +61,7 @@ clean:: beforedepend:: parser.ml parser.mli lexer.ml: lexer.mll - $(CAMLLEX) lexer.mll + $(CAMLLEX) $(OCAMLLEX_FLAGS) $< clean:: rm -f lexer.ml diff --git a/man/Makefile b/man/Makefile index 179d7421..52d1c19f 100644 --- a/man/Makefile +++ b/man/Makefile @@ -16,6 +16,7 @@ ROOTDIR = .. include $(ROOTDIR)/Makefile.config +DESTDIR ?= INSTALL_DIR=$(DESTDIR)$(MANDIR)/man$(PROGRAMS_MAN_SECTION) install: diff --git a/man/ocaml.m b/man/ocaml.m index 7d436e69..63b84a6b 100644 --- a/man/ocaml.m +++ b/man/ocaml.m @@ -302,8 +302,14 @@ is invoked, it will read phrases from an initialization file before giving control to the user. The default file is .B .ocamlinit in the current directory if it exists, otherwise +.B XDG_CONFIG_HOME/ocaml/init.ml +according to the XDG base directory specification lookup if it exists (on +Windows this is skipped), otherwise .B .ocamlinit -in the user's home directory. You can specify a different initialization file +in the user's home directory ( +.B HOME +variable). +You can specify a different initialization file by using the .BI \-init \ file option, and disable initialization files by using the @@ -327,7 +333,10 @@ When printing error messages, the toplevel system attempts to underline visually the location of the error. It consults the TERM variable to determines the type of output terminal and look up its capabilities in the terminal database. - +.TP +.B XDG_CONFIG_HOME HOME +.B .ocamlinit +lookup procedure (see above). .SH SEE ALSO .BR ocamlc (1), \ ocamlopt (1), \ ocamlrun (1). .br diff --git a/man/ocamlc.m b/man/ocamlc.m index 3fdaf6f1..6b853009 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -1018,7 +1018,7 @@ mentioned here corresponds to the empty set. .IP The default setting is -.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-32..42\-44\-45\-48\-50\-60\-66 . +.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 . Note that warnings .BR 5 \ and \ 10 are not always triggered, depending on the internals of the type checker. diff --git a/man/ocamlrun.m b/man/ocamlrun.m index eb44f830..fea7ef8d 100644 --- a/man/ocamlrun.m +++ b/man/ocamlrun.m @@ -150,9 +150,10 @@ The initial size of the major heap (in words). .TP .BR a \ (allocation_policy) The policy used for allocating in the OCaml heap. Possible values -are 0 for the next-fit policy, and 1 for the first-fit -policy. Next-fit is usually faster, but first-fit is better for -avoiding fragmentation and the associated heap compactions. +are 0 for the next-fit policy, 1 for the first-fit +policy, and 2 for the best-fit policy. Best-fit is still experimental, +but probably the best of the three. The default is 0. +See the Gc module documentation for details. .TP .BR s \ (minor_heap_size) The size of the minor heap (in words). diff --git a/manual/LICENSE-for-the-manual b/manual/LICENSE-for-the-manual index c104a053..a40dfa12 100644 --- a/manual/LICENSE-for-the-manual +++ b/manual/LICENSE-for-the-manual @@ -1,20 +1,36 @@ -The present documentation is copyright Institut National de Recherche -en Informatique et en Automatique (INRIA). +The OCaml documentation and user's manual is copyright +Institut National de Recherche en Informatique et en Automatique (INRIA). -The OCaml documentation and user's manual may be reproduced and -distributed in whole or in part, subject to the following conditions: +The OCaml documentation and user's manual is licensed under a Creative +Commons Attribution-ShareAlike 4.0 International License (CC BY-SA 4.0) +https://creativecommons.org/licenses/by-sa/4.0/ -- The copyright notice above and this permission notice must be - preserved complete on all complete or partial copies. +This is a human-readable summary of (and not a substitute for) the +license, which is available at +https://creativecommons.org/licenses/by-sa/4.0/legalcode -- Any translation or derivative work of the OCaml documentation and - user's manual must be approved by the authors in writing before - distribution. +You are free to: -- If you distribute the OCaml documentation and user's manual in part, - instructions for obtaining the complete version of this manual must - be included, and a means for obtaining a complete version provided. +Share - copy and redistribute the material in any medium or format + +Adapt - remix, transform, and build upon the material + for any purpose, even commercially. + +The licensor cannot revoke these freedoms as long as you follow the +license terms. + +Under the following terms: + +Attribution - You must give appropriate credit, provide a link to + the license, and indicate if changes were made. You may do so in + any reasonable manner, but not in any way that suggests the + licensor endorses you or your use. + +ShareAlike - If you remix, transform, or build upon the material, + you must distribute your contributions under the same license as + the original. + +No additional restrictions - You may not apply legal terms or + technological measures that legally restrict others from doing + anything the license permits. -- Small portions may be reproduced as illustrations for reviews or - quotes in other works without this permission notice if proper - citation is given. diff --git a/manual/README.md b/manual/README.md index b7972b51..bf7e3c51 100644 --- a/manual/README.md +++ b/manual/README.md @@ -113,6 +113,24 @@ of `unified-options.etex` contains the relevant information. Latex extensions ---------------- +### Sections (and subsections, and subsubsections) + +In order to provide stable links to all part of the manual, the standard +`\section`, `\subsection` and `\subsubsection` macros are replaced by +variants that take the section label as their first argument. +For instance, in the manual, you have to write +```latex +\section{s:basics}{Basics} +``` +rather than +```latex +\section{Basics\label{s:basics}} +``` +This restriction ensures that hevea picks the section label when generating the +header ids. + +A similar macro, `\lparagraph`, is provided for paragraphs. + ### Caml environments The tool `tools/caml-tex` is used to generate the latex code for the examples diff --git a/manual/manual/Makefile b/manual/manual/Makefile index 51871610..fbee1e02 100644 --- a/manual/manual/Makefile +++ b/manual/manual/Makefile @@ -23,9 +23,11 @@ TEXINPUTS = ".:..:../refman:../library:../cmds:../tutorials:../../styles:" RELEASE = $$HOME/release/$${RELEASENAME} HEVEA = hevea HACHA = hacha -INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 +# We suppress warnings in info and text mode (with -s) because hevea listings emit +# DIV blocks that the text modes do not know how to interpret. +INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 -s HTML_FLAGS = -fix -exec xxdate.exe -O -TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 +TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s manual: files diff --git a/manual/manual/anchored_book.hva b/manual/manual/anchored_book.hva new file mode 100644 index 00000000..093d3859 --- /dev/null +++ b/manual/manual/anchored_book.hva @@ -0,0 +1,30 @@ +%hevea book class with anchor links in headers +\input{bookcommon.hva} +\newcommand{\@book@attr}[1]{\@secid\envclass@attr{#1}} +\newcommand{\@titlesecanchor}{\@open{a}{class="section-anchor" href="\#\@sec@id@attr" aria-hidden="true"}\@print@u{xfeff}\@close{a}} +\@makesection + {\part}{-2}{part} + {\@opencell{class="center"}{}{}\@open{h1}{\@book@attr{part}}}% + {\partname~\thepart}{\\}% + {\@close{h1}\@closecell} +\newstyle{.part}{margin:2ex auto;text-align:center} +\@makesection + {\chapter}{-1}{chapter} + {\@open{h1}{\@book@attr{chapter}}}{\chaptername~\thechapter}{\quad}{\@close{h1}} +\@makesection + {\section}{0}{section} + {\@open{h2}{\@book@attr{section}}\@titlesecanchor}{\thesection}{\quad}{\@close{h2}}% +\@makesection + {\subsection}{1}{subsection} + {\@open{h3}{\@book@attr{subsection}}\@titlesecanchor}{\thesubsection}{\quad}{\@close{h3}}% +\@makesection + {\subsubsection}{2}{subsubsection} + {\@open{h4}{\@book@attr{subsubsection}}\@titlesecanchor}{\thesubsubsection}{\quad}{\@close{h4}}% +\@makesection + {\paragraph}{3}{paragraph} + {\@open{h5}{\@book@attr{paragraph}}\@titlesecanchor}{\theparagraph}{\quad}{\@close{h5}}% +\@makesection + {\subparagraph}{4}{subparagraph} + {\@open{h6}{\@book@attr{subparagraph}}\@titlesecanchor}{\thesubparagraph}{\quad}{\@close{h6}}% +\newcommand{\hacha@style}{book}% +\styleloadedtrue diff --git a/manual/manual/cmds/afl-fuzz.etex b/manual/manual/cmds/afl-fuzz.etex index 9cda1b5d..5426918f 100644 --- a/manual/manual/cmds/afl-fuzz.etex +++ b/manual/manual/cmds/afl-fuzz.etex @@ -1,7 +1,7 @@ \chapter{Fuzzing with afl-fuzz} %HEVEA\cutname{afl-fuzz.html} -\section{Overview} +\section{s:afl-overview}{Overview} American fuzzy lop (``afl-fuzz'') is a {\em fuzzer}, a tool for testing software by providing randomly-generated inputs, searching for @@ -25,7 +25,7 @@ For more information on afl-fuzz, see the website at {\tt http://lcamtuf.coredump.cx/afl/} \fi -\section{Generating instrumentation} +\section{s:afl-generate}{Generating instrumentation} The instrumentation that afl-fuzz requires is not generated by default, and must be explicitly enabled, by passing the {\tt @@ -36,7 +36,7 @@ To fuzz a large system without modifying build tools, OCaml's {\tt OCaml is configured with {\tt afl-instrument}, then all programs compiled by {\tt ocamlopt} will be instrumented. -\subsection{Advanced options} +\subsection{ss:afl-advanced}{Advanced options} In rare cases, it is useful to control the amount of instrumentation generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt @@ -44,7 +44,7 @@ generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt generated for only N\% of branches. (See the afl-fuzz documentation on the parameter {\tt AFL\_INST\_RATIO} for the precise effect of this). -\section{Example} +\section{s:afl-example}{Example} As an example, we fuzz-test the following program, {\tt readline.ml}: diff --git a/manual/manual/cmds/comp.etex b/manual/manual/cmds/comp.etex index 39de94fc..649c9d56 100644 --- a/manual/manual/cmds/comp.etex +++ b/manual/manual/cmds/comp.etex @@ -7,7 +7,7 @@ these object files to produce standalone bytecode executable files. These executable files are then run by the bytecode interpreter "ocamlrun". -\section{Overview of the compiler} +\section{s:comp-overview}{Overview of the compiler} The "ocamlc" command has a command-line interface similar to the one of most C compilers. It accepts several types of arguments and processes them @@ -111,7 +111,7 @@ The AST is partial if type checking was unsuccessful. These ".cmt" and ".cmti" files are typically useful for code inspection tools. -\section{Options}\label{s:comp-options} +\section{s:comp-options}{Options} The following command-line options are recognized by "ocamlc". The options "-pack", "-a", "-c" and "-output-obj" are mutually exclusive. @@ -123,7 +123,7 @@ The options "-pack", "-a", "-c" and "-output-obj" are mutually exclusive. % compilers and toplevel \input{unified-options.tex} -\paragraph{Contextual control of command-line options} +\paragraph{contextual-cli-control}{Contextual control of command-line options} The compiler command line can be modified ``from the outside'' with the following mechanisms. These are experimental @@ -148,7 +148,7 @@ Windows for "flexlink" instead of the configured value. Primarily used for bootstrapping. \end{options} -\section{Modules and the file system} +\section{s:modules-file-system}{Modules and the file system} This short section is intended to clarify the relationship between the names of the modules corresponding to compilation units and the names @@ -188,7 +188,7 @@ to find by itself the ".cmo" file that implements a module with a given name: it relies instead on the user providing the list of ".cmo" files by hand. -\section{Common errors} \label{s:comp-errors} +\section{s:comp-errors}{Common errors} This section describes and explains the most frequently encountered error messages. @@ -354,11 +354,11 @@ command line, and possibly the "-custom" option. \end{options} -\section{Warning reference} \label{s:comp-warnings} +\section{s:comp-warnings}{Warning reference} This section describes and explains in detail some warnings: -\subsection{Warning 9: missing fields in a record pattern} +\subsection{ss:warn9}{Warning 9: missing fields in a record pattern} When pattern matching on records, it can be useful to match only few fields of a record. Eliding fields can be done either implicitly @@ -377,8 +377,7 @@ let dx { x } = x (* implicit field elision: trigger warning 9 *) let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *) \end{verbatim} -\subsection{Warning 52: fragile constant pattern} -\label{ss:warn52} +\subsection{ss:warn52}{Warning 52: fragile constant pattern} Some constructors, such as the exception constructors "Failure" and "Invalid_argument", take as parameter a "string" value holding @@ -465,7 +464,7 @@ try (int_of_string count_str, bool_of_string choice_str) with | Failure "bool_of_string" -> (-1, false) \end{verbatim} should be rewritten into more atomic tests. For example, - using the "exception" patterns documented in Section~\ref{s:exception-match}, + using the "exception" patterns documented in Section~\ref{sss:exception-match}, one can write: \begin{verbatim} match int_of_string count_str with @@ -484,8 +483,7 @@ specific string values. This is dangerous API design and it should be discouraged: it's better to define more precise exception constructors than store useful information in strings. -\subsection{Warning 57: Ambiguous or-pattern variables under guard} -\label{ss:warn57} +\subsection{ss:warn57}{Warning 57: Ambiguous or-pattern variables under guard} The semantics of or-patterns in OCaml is specified with a left-to-right bias: a value \var{v} matches the pattern \var{p} "|" \var{q} diff --git a/manual/manual/cmds/debugger.etex b/manual/manual/cmds/debugger.etex index d77361e9..e9fc6dc0 100644 --- a/manual/manual/cmds/debugger.etex +++ b/manual/manual/cmds/debugger.etex @@ -12,7 +12,7 @@ BSD sockets. OCaml, but not under the native Win32 ports. \end{windows} -\section{Compiling for debugging} +\section{s:debugger-compilation}{Compiling for debugging} Before the debugger can be used, the program must be compiled and linked with the "-g" option: all ".cmo" and ".cma" files that are part @@ -24,9 +24,9 @@ programs: object files and bytecode executable files are bigger and take longer to produce, but the executable files run at exactly the same speed as if they had been compiled without "-g". -\section{Invocation} +\section{s:debugger-invocation}{Invocation} -\subsection{Starting the debugger} +\subsection{ss:debugger-start}{Starting the debugger} The OCaml debugger is invoked by running the program "ocamldebug" with the name of the bytecode executable file as first @@ -58,7 +58,7 @@ files and compiled files. (See also the "directory" command.) \item["-s "\var{socket}] Use \var{socket} for communicating with the debugged program. See the -description of the command "set socket" (section~\ref{s:communication}) +description of the command "set socket" (section~\ref{ss:debugger-communication}) for the format of \var{socket}. \item["-version"] @@ -72,23 +72,23 @@ Display a short usage summary and exit. % \end{options} -\subsection{Initialization file} +\subsection{ss:debugger-init-file}{Initialization file} On start-up, the debugger will read commands from an initialization file before giving control to the user. The default file is ".ocamldebug" in the current directory if it exists, otherwise ".ocamldebug" in the user's home directory. -\subsection{Exiting the debugger} +\subsection{ss:debugger-exut}{Exiting the debugger} The command "quit" exits the debugger. You can also exit the debugger by typing an end-of-file character (usually "ctrl-D"). Typing an interrupt character (usually "ctrl-C") will not exit the debugger, but will terminate the action of any debugger command that is in -progress and return to the debugger command level. +progress and return to the debugger command level. -\section{Commands} \label{s:debugger-commands} +\section{s:debugger-commands}{Commands} A debugger command is a single line of input. It starts with a command name, which is followed by arguments depending on this name. Examples: @@ -108,7 +108,7 @@ stands for "run" even though there are others commands starting with If the previous command has been successful, a blank line (typing just "RET") will repeat it. -\subsection{Getting help} +\subsection{ss:debugger-help}{Getting help} The OCaml debugger has a simple on-line help system, which gives a brief description of each command and variable. @@ -128,7 +128,7 @@ variables can be obtained with "help set". Give help about \var{topic}. Use "help info" to get a list of known topics. \end{options} -\subsection{Accessing the debugger state} +\subsection{ss:debugger-state}{Accessing the debugger state} \begin{options} \item["set "\var{variable} \var{value}] @@ -142,9 +142,9 @@ Give information about the given subject. For instance, "info breakpoints" will print the list of all breakpoints. \end{options} -\section{Executing a program} +\section{s:debugger-execution}{Executing a program} -\subsection{Events} +\subsection{ss:debugger-events}{Events} Events are ``interesting'' locations in the source code, corresponding to the beginning or end of evaluation of ``interesting'' @@ -196,7 +196,7 @@ event is put after the function application. % Also, no event is put after a function application when the function % is external (written in C). -\subsection{Starting the debugged program} +\subsection{ss:debugger-starting-program}{Starting the debugged program} The debugger starts executing the debugged program only when needed. This allows setting breakpoints or assigning debugger variables before @@ -219,7 +219,7 @@ These commands must be used before program execution starts. If you try to change the arguments or the working directory after starting your program, the debugger will kill the program (after asking for confirmation). -\subsection{Running the program} +\subsection{ss:debugger-running}{Running the program} The following commands execute the program forward or backward, starting at the current time. The execution will stop either when @@ -247,7 +247,7 @@ it \var{count} times. before the current function invocation. \end{options} -\subsection{Time travel} +\subsection{ss:debugger-time-travel}{Time travel} You can jump directly to a given time, without stopping on breakpoints, using the "goto" command. @@ -268,14 +268,14 @@ argument, do it \var{count} times. Set the size of the execution history. \end{options} -\subsection{Killing the program} +\subsection{ss:debugger-kill}{Killing the program} \begin{options} \item["kill"] Kill the program being executed. This command is mainly useful if you wish to recompile the program without leaving the debugger. \end{options} -\section{Breakpoints} \label{s:breakpoints} +\section{s:breakpoints}{Breakpoints} A breakpoint causes the program to stop whenever a certain point in the program is reached. It can be set in several ways using the @@ -310,8 +310,13 @@ column \var{column}. Set a breakpoint in module \var{module} at the event closest to character number \var{character}. -\item["break "\var{address}] -Set a breakpoint at the code address \var{address}. +\item["break " \var{frag}":"\var{pc}, "break " \var{pc}] +Set a breakpoint at code address \var{frag}":"\var{pc}. The integer +\var{frag} is the identifier of a code fragment, a set of modules that +have been loaded at once, either initially or with the "Dynlink" +module. The integer \var{pc} is the instruction counter within this +code fragment. If \var{frag} is ommited, it defaults to 0, which is +the code fragment of the program loaded initially. \item["delete "\optvar{breakpoint-numbers}] Delete the specified breakpoints. Without argument, all breakpoints @@ -320,7 +325,7 @@ are deleted (after asking for confirmation). \item["info breakpoints"] Print the list of all breakpoints. \end{options} -\section{The call stack} +\section{s:debugger-callstack}{The call stack} Each time the program performs a function application, it saves the location of the application (the return address) in a block of data @@ -365,7 +370,7 @@ that is, the frame that was called by the selected frame. An argument says how many frames to go down. \end{options} -\section{Examining variable values} +\section{s:debugger-examining-values}{Examining variable values} The debugger can print the current value of simple expressions. The expressions can involve program variables: all the identifiers that @@ -415,14 +420,14 @@ are forgotten as soon as the program resumes execution. \begin{options} \item["set print_depth" \var{d}] -Limit the printing of values to a maximal depth of \var{d}. +Limit the printing of values to a maximal depth of \var{d}. \item["set print_length" \var{l}] Limit the printing of values to at most \var{l} nodes printed. \end{options} -\section{Controlling the debugger} +\section{s:debugger-control}{Controlling the debugger} -\subsection{Setting the program name and arguments} +\subsection{ss:debugger-name-and-arguments}{Setting the program name and arguments} \begin{options} \item["set program" \var{file}] @@ -439,7 +444,7 @@ recommended to redirect their input from a file (using input to the debugger are not properly separated, and inputs are not properly replayed when running the program backwards. -\subsection{How programs are loaded} +\subsection{ss:debugger-loading}{How programs are loaded} The "loadingmode" variable controls how the program is executed. @@ -452,10 +457,10 @@ Rarely useful; moreover it prevents the debugging of programs compiled in ``custom runtime'' mode. \item["set loadingmode manual"] The user starts manually the program, when asked by the debugger. -Allows remote debugging (see section~\ref{s:communication}). +Allows remote debugging (see section~\ref{ss:debugger-communication}). \end{options} -\subsection{Search path for files} +\subsection{ss:debugger-search-path}{Search path for files} The debugger searches for source files and compiled interface files in a list of directories, the search path. The search path initially @@ -479,7 +484,7 @@ been packed into \var{modulename}. Reset the search path. This requires confirmation. \end{options} -\subsection{Working directory} +\subsection{ss:debugger-working-dir}{Working directory} Each time a program is started in the debugger, it inherits its working directory from the current working directory of the debugger. This @@ -496,7 +501,7 @@ Set the working directory for "ocamldebug" to \var{directory}. Print the working directory for "ocamldebug". \end{options} -\subsection{Turning reverse execution on and off} +\subsection{ss:debugger-reverse-execution}{Turning reverse execution on and off} In some cases, you may want to turn reverse execution off. This speeds up the program execution, and is also sometimes useful for interactive @@ -513,8 +518,34 @@ checkpoints. Select whether the debugger makes checkpoints or not. \end{options} -\subsection{Communication between the debugger and the program} -\label{s:communication} +\subsection{ss:debugger-fork}{Behavior of the debugger with respect to "fork"} + +When the program issues a call to "fork", the debugger can either +follow the child or the parent. By default, the debugger follows the +parent process. The variable \var{follow_fork_mode} controls this +behavior: + +\begin{options} +\item["set follow_fork_mode" \var{child/parent}] +Select whether to follow the child or the parent in case of a call to +"fork". +\end{options} + +\subsection{ss:debugger-stop-at-new-load}{Stopping execution when new code is loaded} + +The debugger is compatible with the "Dynlink" module. However, when an +external module is not yet loaded, it is impossible to set a +breakpoint in its code. In order to facilitate setting breakpoints in +dynamically loaded code, the debugger stops the program each time new +modules are loaded. This behavior can be disabled using the +\var{break_on_load} variable: + +\begin{options} +\item["set break_on_load" \var{on/off}] +Select whether to stop after loading new code. +\end{options} + +\subsection{ss:debugger-communication}{Communication between the debugger and the program} The debugger communicate with the program being debugged through a Unix socket. You may need to change the socket name, for example if @@ -531,7 +562,7 @@ address in dot notation, and \var{port} is a port number on the host. On the debugged program side, the socket name is passed through the "CAML_DEBUG_SOCKET" environment variable. -\subsection{Fine-tuning the debugger} \label{s:fine-tuning} +\subsection{ss:debugger-fine-tuning}{Fine-tuning the debugger} Several variables enables to fine-tune the debugger. Reasonable defaults are provided, and you should normally not have to change them. @@ -570,7 +601,7 @@ Print a list of checkpoints. Print the list of events in the given module (the current module, by default). \end{options} -\subsection{User-defined printers} +\subsection{ss:debugger-printers}{User-defined printers} Just as in the toplevel system (section~\ref{s:toplevel-directives}), the user can register functions for printing values of certain types. @@ -605,7 +636,7 @@ reference the functions of the program being debugged. Remove the named function from the table of value printers. \end{options} -\section{Miscellaneous commands} +\section{s:debugger-misc-cmds}{Miscellaneous commands} \begin{options} \item["list" \optvar{module} \optvar{beginning} \optvar{end}] @@ -617,7 +648,7 @@ position. Read debugger commands from the script \var{filename}. \end{options} -\section{Running the debugger under Emacs} \label{s:inf-debugger} +\section{s:inf-debugger}{Running the debugger under Emacs} The most user-friendly way to use the debugger is to run it under Emacs. See the file "emacs/README" in the distribution for information on how diff --git a/manual/manual/cmds/flambda.etex b/manual/manual/cmds/flambda.etex index eff8c84a..51782fc8 100644 --- a/manual/manual/cmds/flambda.etex +++ b/manual/manual/cmds/flambda.etex @@ -1,7 +1,7 @@ \chapter{Optimisation with Flambda} %HEVEA\cutname{flambda.html} -\section{Overview} +\section{s:flambda-overview}{Overview} {\em Flambda} is the term used to describe a series of optimisation passes provided by the native code compilers as of OCaml 4.03. @@ -33,8 +33,8 @@ bytecode. Flambda should not in general affect the semantics of existing programs. Two exceptions to this rule are: possible elimination of pure code -that is being benchmarked (see section\ \ref{inhibition}) and changes in -behaviour of code using unsafe operations (see section\ \ref{unsafe}). +that is being benchmarked (see section\ \ref{s:flambda-inhibition}) and changes in +behaviour of code using unsafe operations (see section\ \ref{s:flambda-unsafe}). Flambda does not yet optimise array or string bounds checks. Neither does it take hints for optimisation from any assertions written by the @@ -43,7 +43,7 @@ user in the code. Consult the {\em Glossary} at the end of this chapter for definitions of technical terms used below. -\section{Command-line flags} +\section{s:flambda-cli}{Command-line flags} The Flambda optimisers provide a variety of command-line flags that may be used to control their behaviour. Detailed descriptions of each flag @@ -54,7 +54,7 @@ Commonly-used options: \begin{options} \item[\machine{-O2}] Perform more optimisation than usual. Compilation times may be lengthened. (This flag is an abbreviation for a certain -set of parameters described in section\ \ref{defaults}.) +set of parameters described in section\ \ref{s:flambda-defaults}.) \item[\machine{-O3}] Perform even more optimisation than usual, possibly including unrolling of recursive functions. Compilation times may be significantly lengthened. @@ -78,10 +78,10 @@ Less commonly-used options: \item[\machine{-remove-unused-arguments}] Remove unused function arguments even when the argument is not specialised. This may have a small performance penalty. -See section\ \ref{remove-unused-args}. +See section\ \ref{ss:flambda-remove-unused-args}. \item[\machine{-unbox-closures}] Pass free variables via specialised arguments rather than closures (an optimisation for reducing allocation). See -section\ \ref{unbox-closures}. This may have a small performance penalty. +section\ \ref{ss:flambda-unbox-closures}. This may have a small performance penalty. \end{options} Advanced options, only needed for detailed tuning: @@ -91,46 +91,46 @@ is used. \begin{itemize} \item When not in {\tt -Oclassic} mode, {\tt -inline} limits the total size of functions considered for inlining during any speculative inlining -search. (See section\ \ref{speculation}.) Note that +search. (See section\ \ref{ss:flambda-speculation}.) Note that this parameter does {\bf not} control the assessment as to whether any particular function may be inlined. Raising it to excessive amounts will not necessarily cause more functions to be inlined. \item When in {\tt -Oclassic} mode, {\tt -inline} behaves as in previous versions of the compiler: it is the maximum size of function to -be considered for inlining. See section\ \ref{classic}. +be considered for inlining. See section\ \ref{ss:flambda-classic}. \end{itemize} \item[\machine{-inline-toplevel}] The equivalent of {\tt -inline} but used when speculative inlining starts at toplevel. See -section\ \ref{speculation}. +section\ \ref{ss:flambda-speculation}. Not used in {\tt -Oclassic} mode. \item[\machine{-inline-branch-factor}] Controls how the inliner assesses whether a code path is likely to be hot or cold. See -section\ \ref{assessment-inlining}. +section\ \ref{ss:flambda-assessment-inlining}. \item[\machine{-inline-alloc-cost}, \machine{-inline-branch-cost}, \machine{-inline-call-cost}] Controls how the inliner assesses the runtime performance penalties associated with various operations. See - section\ \ref{assessment-inlining}. + section\ \ref{ss:flambda-assessment-inlining}. \item[\machine{-inline-indirect-cost}, \machine{-inline-prim-cost}] Likewise. \item[\machine{-inline-lifting-benefit}] Controls inlining of functors -at toplevel. See section\ \ref{assessment-inlining}. +at toplevel. See section\ \ref{ss:flambda-assessment-inlining}. \item[\machine{-inline-max-depth}] The maximum depth of any -speculative inlining search. See section\ \ref{speculation}. +speculative inlining search. See section\ \ref{ss:flambda-speculation}. \item[\machine{-inline-max-unroll}] The maximum depth of any unrolling of recursive functions during any speculative inlining search. -See section\ \ref{speculation}. +See section\ \ref{ss:flambda-speculation}. \item[\machine{-no-unbox-free-vars-of-closures}] % -Do not unbox closure variables. See section\ \ref{unbox-fvs}. +Do not unbox closure variables. See section\ \ref{ss:flambda-unbox-fvs}. \item[\machine{-no-unbox-specialised-args}] % Do not unbox arguments to which functions have been specialised. See -section\ \ref{unbox-spec-args}. +section\ \ref{ss:flambda-unbox-spec-args}. \item[\machine{-rounds}] How many rounds of optimisation to perform. -See section\ \ref{rounds}. +See section\ \ref{ss:flambda-rounds}. \item[\machine{-unbox-closures-factor}] Scaling factor for benefit calculation when using {\tt -unbox-closures}. See -section\ \ref{unbox-closures}. +section\ \ref{ss:flambda-unbox-closures}. \end{options} \paragraph{Notes} @@ -159,7 +159,7 @@ in effect. releases. \end{itemize} -\subsection{Specification of optimisation parameters by round}\label{rounds} +\subsection{ss:flambda-rounds}{Specification of optimisation parameters by round} Flambda operates in {\em rounds}: one round consists of a certain sequence of transformations that may then be repeated in order to achieve more @@ -185,7 +185,7 @@ other flags, meaning that certain parameters may be overridden without having to specify every parameter usually invoked by the given optimisation level. -\section{Inlining} +\section{s:flambda-inlining}{Inlining} {\em Inlining} refers to the copying of the code of a function to a place where the function is called. @@ -237,7 +237,7 @@ let n = 4 * fact 3 Flambda provides significantly enhanced inlining capabilities relative to previous versions of the compiler. -\subsubsection{Aside: when inlining is performed} +\subsubsection{sss:flambda-inlining-aside}{Aside: when inlining is performed} Inlining is performed together with all of the other Flambda optimisation passes, that is to say, after closure conversion. This has three particular @@ -258,15 +258,15 @@ it becomes more straightforward to control which variables end up in which closures, helping to avoid closure bloat. \end{itemize} -\subsection{Classic inlining heuristic}\label{classic} +\subsection{ss:flambda-classic}{Classic inlining heuristic} In {\tt -Oclassic} mode the behaviour of the Flambda inliner mimics previous versions of the compiler. (Code may still be subject to further optimisations not performed by previous versions of the compiler: functors may be inlined, constants are lifted and unused code is eliminated all as described elsewhere -in this chapter. See sections \ref{functors},\ \ref{lift-const} % -and\ \ref{remove-unused}. +in this chapter. See sections \ref{sss:flambda-functors},\ \ref{ss:flambda-lift-const} % +and\ \ref{s:flambda-remove-unused}. At the definition site of a function, the body of the function is measured. It will then be marked as eligible for inlining (and hence inlined at every direct call site) if: @@ -303,7 +303,7 @@ below). \end{itemize} The Flambda mode is described in the next section. -\subsection{Overview of ``Flambda'' inlining heuristics} +\subsection{ss:flambda-inlining-overview}{Overview of ``Flambda'' inlining heuristics} The Flambda inlining heuristics, used whenever the compiler is configured for Flambda and {\tt -Oclassic} was not specified, make inlining decisions @@ -356,9 +356,9 @@ if {\tt -O3} optimisation level is selected and/or the {\tt -inline-max-unroll} flag is passed with an argument greater than zero.) -\subsection{Handling of specific language constructs} +\subsection{ss:flambda-by-constructs}{Handling of specific language constructs} -\subsubsection{Functors}\label{functors} +\subsubsection{sss:flambda-functors}{Functors} There is nothing particular about functors that inhibits inlining compared to normal functions. To the inliner, these both look the same, except @@ -372,18 +372,18 @@ Applications of functors not at toplevel, for example in a local module inside some other expression, are treated by the inliner identically to normal function calls. -\subsubsection{First-class modules} +\subsubsection{sss:flambda-first-class-modules}{First-class modules} The inliner will be able to consider inlining a call to a function in a first class module if it knows which particular function is going to be called. The presence of the first-class module record that wraps the set of functions in the module does not per se inhibit inlining. -\subsubsection{Objects} +\subsubsection{sss:flambda-objects}{Objects} Method calls to objects are not at present inlined by Flambda. -\subsection{Inlining reports} +\subsection{ss:flambda-inlining-reports}{Inlining reports} If the {\tt -inlining-report} option is provided to the compiler then a file will be emitted corresponding to each round of optimisation. For the @@ -393,7 +393,7 @@ with {\em round} a zero-based integer. Inside the files, which are formatted as ``org mode'', will be found English prose describing the decisions that the inliner took. -\subsection{Assessment of inlining benefit}\label{assessment-inlining} +\subsection{ss:flambda-assessment-inlining}{Assessment of inlining benefit} Inlining typically results in an increase in code size, which if left unchecked, may not only @@ -428,7 +428,7 @@ The individual costs for the various kinds of operations may be adjusted using the various {\tt -inline-...-cost} flags as follows. Costs are specified as integers. All of these flags accept a single argument describing such integers using the conventions -detailed in section\ \ref{rounds}. +detailed in section\ \ref{ss:flambda-rounds}. \begin{options} \item[\machine{-inline-alloc-cost}] The cost of an allocation. \item[\machine{-inline-branch-cost}] The cost of a branch. @@ -437,7 +437,7 @@ detailed in section\ \ref{rounds}. \item[\machine{-inline-prim-cost}] The cost of a {\em primitive}. Primitives encompass operations including arithmetic and memory access. \end{options} -(Default values are described in section\ \ref{defaults} below.) +(Default values are described in section\ \ref{s:flambda-defaults} below.) The initial benefit value is then scaled by a factor that attempts to compensate for the fact that the current point in the code, if under some @@ -464,7 +464,7 @@ an additional benefit (which may be controlled by the {\tt -inline-lifting-benefit} flag) to bias inlining in such situations towards keeping the inlined version. -\subsection{Control of speculation}\label{speculation} +\subsection{ss:flambda-speculation}{Control of speculation} As described above, there are three parameters that restrict the search for inlining opportunities during speculation: @@ -509,7 +509,7 @@ the depth is incremented by one when examining the resulting body. If the depth reaches the limit set by {\tt -inline-max-unroll} then speculation stops. -\section{Specialisation}\label{specialisation} +\section{s:flambda-specialisation}{Specialisation} The inliner may discover a call site to a recursive function where something is known about the arguments: for example, they may be equal to @@ -625,7 +625,7 @@ let rec iter_swap f g l = iter_swap f g t \end{verbatim} -\subsection{Assessment of specialisation benefit} +\subsection{ss:flambda-assessment-specialisation}{Assessment of specialisation benefit} The benefit of specialisation is assessed in a similar way as for inlining. Specialised argument information may mean that the body of the function @@ -634,7 +634,7 @@ into a benefit. This, together with the size of the duplicated (specialised) function declaration, is then assessed against the size of the call to the original function. -\section{Default settings of parameters}\label{defaults} +\section{s:flambda-defaults}{Default settings of parameters} The default settings (when not using {\tt -Oclassic}) are for one round of optimisation using the following parameters. @@ -655,7 +655,7 @@ round of optimisation using the following parameters. \entree{{\tt -unbox-closures-factor}}{10} \end{tableau} -\subsection{Settings at -O2 optimisation level} +\subsection{ss:flambda-o2}{Settings at -O2 optimisation level} When {\tt -O2} is specified two rounds of optimisation are performed. The first round uses the default parameters (see above). The second uses @@ -676,7 +676,7 @@ the following parameters. \entree{{\tt -unbox-closures-factor}}{Same as default} \end{tableau} -\subsection{Settings at -O3 optimisation level} +\subsection{ss:flambda-o3}{Settings at -O3 optimisation level} When {\tt -O3} is specified three rounds of optimisation are performed. The first two rounds are as for {\tt -O2}. The third round uses @@ -697,7 +697,7 @@ the following parameters. \entree{{\tt -unbox-closures-factor}}{Same as default} \end{tableau} -\section{Manual control of inlining and specialisation} +\section{s:flambda-manual-control}{Manual control of inlining and specialisation} Should the inliner prove recalcitrant and refuse to inline a particular function, or if the observed inlining decisions are not to the programmer's @@ -778,7 +778,7 @@ end [@@inline never] module X = F [@inlined] (struct type t = int end) \end{verbatim} -\section{Simplification} +\section{s:flambda-simplification}{Simplification} Simplification, which is run in conjunction with inlining, propagates information (known as {\em approximations}) about which @@ -808,9 +808,9 @@ Note that no information is propagated about the contents of strings, even in {\tt safe-string} mode, because it cannot yet be guaranteed that they are immutable throughout a given program. -\section{Other code motion transformations} +\section{s:flambda-other-transfs}{Other code motion transformations} -\subsection{Lifting of constants}\label{lift-const} +\subsection{ss:flambda-lift-const}{Lifting of constants} Expressions found to be constant will be lifted to symbol bindings---that is to say, they will be statically allocated in the @@ -852,7 +852,7 @@ into a fresh value on the OCaml heap. \end{itemize} \end{itemize} -\subsection{Lifting of toplevel let bindings} +\subsection{ss:flambda-lift-toplevel-let}{Lifting of toplevel let bindings} Toplevel {\tt let}-expressions may be lifted to symbol bindings to ensure that the corresponding bound variables are not captured by closures. If the @@ -879,14 +879,14 @@ indeed the function declaration itself---marked as to never be inlined. This technique prevents lifting of the definition of the value in question (assuming of course that it is not constant). -\section{Unboxing transformations} +\section{s:flambda-unboxing}{Unboxing transformations} The transformations in this section relate to the splitting apart of {\em boxed} (that is to say, non-immediate) values. They are largely intended to reduce allocation, which tends to result in a runtime performance profile with lower variance and smaller tails. -\subsection{Unboxing of closure variables}\label{unbox-fvs} +\subsection{ss:flambda-unbox-fvs}{Unboxing of closure variables} This transformation is enabled unless {\tt -no-unbox-free-vars-of-closures} is provided. @@ -934,7 +934,7 @@ The allocation of the pair has been eliminated. This transformation does not operate if it would cause the closure to contain more than twice as many closure variables as it did beforehand. -\subsection{Unboxing of specialised arguments}\label{unbox-spec-args} +\subsection{ss:flambda-unbox-spec-args}{Unboxing of specialised arguments} This transformation is enabled unless {\tt -no-unbox-specialised-args} is provided. @@ -1011,7 +1011,7 @@ a small penalty owing to having to bounce through the wrapper. The technique of {\em direct call surrogates} used for {\tt -unbox-closures} is not used by the transformation to unbox specialised arguments.) -\subsection{Unboxing of closures}\label{unbox-closures} +\subsection{ss:flambda-unbox-closures}{Unboxing of closures} This transformation is {\em not} enabled by default. It may be enabled using the {\tt -unbox-closures} flag. @@ -1100,22 +1100,22 @@ passes the free variables via function arguments in order to eliminate all closure allocation in this example (aside from any that might be performed inside {\tt printf}). -\section{Removal of unused code and values}\label{remove-unused} +\section{s:flambda-remove-unused}{Removal of unused code and values} -\subsection{Removal of redundant let expressions} +\subsection{ss:flambda-redundant-let}{Removal of redundant let expressions} The simplification pass removes unused {\tt let} bindings so long as their corresponding defining expressions have ``no effects''. See the section ``Treatment of effects'' below for the precise definition of this term. -\subsection{Removal of redundant program constructs} +\subsection{ss:flambda-redundant}{Removal of redundant program constructs} This transformation is analogous to the removal of {\tt let}-expressions whose defining expressions have no effects. It operates instead on symbol bindings, removing those that have no effects. -\subsection{Removal of unused arguments}\label{remove-unused-args} +\subsection{ss:flambda-remove-unused-args}{Removal of unused arguments} This transformation is only enabled by default for specialised arguments. It may be enabled for all arguments using the {\tt -remove-unused-arguments} @@ -1131,7 +1131,7 @@ through the wrapper. (The technique of {\em direct call surrogates} used to reduce this penalty during unboxing of closure variables (see above) does not yet apply to the pass that removes unused arguments.) -\subsection{Removal of unused closure variables} +\subsection{ss:flambda-removal-closure-vars}{Removal of unused closure variables} This transformation performs an analysis across the whole compilation unit to determine whether there exist closure variables @@ -1140,9 +1140,9 @@ this has to be a whole-unit analysis because a projection of a closure variable from some particular closure may have propagated to an arbitrary location within the code due to inlining.) -\section{Other code transformations} +\section{s:flambda-other}{Other code transformations} -\subsection{Transformation of non-escaping references into mutable variables} +\subsection{ss:flambda-non-escaping-refs}{Transformation of non-escaping references into mutable variables} Flambda performs a simple analysis analogous to that performed elsewhere in the compiler that can transform {\tt ref}s into mutable variables @@ -1150,14 +1150,14 @@ that may then be held in registers (or on the stack as appropriate) rather than being allocated on the OCaml heap. This only happens so long as the reference concerned can be shown to not escape from its defining scope. -\subsection{Substitution of closure variables for specialised arguments} +\subsection{ss:flambda-subst-closure-vars}{Substitution of closure variables for specialised arguments} This transformation discovers closure variables that are known to be equal to specialised arguments. Such closure variables are replaced by the specialised arguments; the closure variables may then be removed by the ``removal of unused closure variables'' pass (see below). -\section{Treatment of effects} +\section{s:flambda-effects}{Treatment of effects} The Flambda optimisers classify expressions in order to determine whether an expression: @@ -1213,7 +1213,7 @@ It is assumed in the compiler that, subject to data dependencies, expressions with neither effects nor coeffects may be reordered with respect to other expressions. -\section{Compilation of statically-allocated modules} +\section{s:flambda-static-modules}{Compilation of statically-allocated modules} Compilation of modules that are able to be statically allocated (for example, the module corresponding to an entire compilation unit, as opposed to a first @@ -1223,7 +1223,7 @@ interspersed with arbitrary effects, surrounds a record creation that becomes the module block. The Flambda-specific transformation follows: these bindings are lifted to toplevel symbols, as described above. -\section{Inhibition of optimisation}\label{inhibition} +\section{s:flambda-inhibition}{Inhibition of optimisation} Especially when writing benchmarking suites that run non-side-effecting algorithms in loops, it may be found that the optimiser entirely @@ -1232,7 +1232,7 @@ using the {\tt Sys.opaque\_identity} function (which indeed behaves as a normal OCaml function and does not possess any ``magic'' semantics). The documentation of the {\tt Sys} module should be consulted for further details. -\section{Use of unsafe operations}\label{unsafe} +\section{s:flambda-unsafe}{Use of unsafe operations} The behaviour of the Flambda simplification pass means that certain unsafe operations, which may without Flambda or when using previous versions of @@ -1285,7 +1285,7 @@ to add type annotations that claim some mutable value is always immediate if it might be possible for an unsafe operation to update it to a boxed value. -\section{Glossary} +\section{s:flambda-glossary}{Glossary} The following terminology is used in this chapter of the manual. @@ -1327,7 +1327,7 @@ definition of a single compilation unit (i.e. {\tt .cmx} file). \item[{\bf Specialised argument}] An argument to a function that is known to always hold a particular value at runtime. These are introduced by the inliner when specialising recursive functions; and the {\tt unbox-closures} -pass. (See section\ \ref{specialisation}.) +pass. (See section\ \ref{s:flambda-specialisation}.) \item[{\bf Symbol}] A name referencing a particular place in an object file or executable image. At that particular place will be some constant value. Symbols may be examined using operating system-specific tools (for diff --git a/manual/manual/cmds/intf-c.etex b/manual/manual/cmds/intf-c.etex index 70376a2c..e95b1801 100644 --- a/manual/manual/cmds/intf-c.etex +++ b/manual/manual/cmds/intf-c.etex @@ -5,9 +5,9 @@ This chapter describes how user-defined primitives, written in C, can be linked with OCaml code and called from OCaml functions, and how these C functions can call back to OCaml code. -\section{Overview and compilation information} +\section{s:c-overview}{Overview and compilation information} -\subsection{Declaring primitives} +\subsection{ss:c-prim-decl}{Declaring primitives} \begin{syntax} definition: ... @@ -74,7 +74,7 @@ The language accepts external declarations with one or two flag strings in addition to the C function's name. These flags are reserved for the implementation of the standard library. -\subsection{Implementing primitives} +\subsection{ss:c-prim-impl}{Implementing primitives} User primitives with arity $n \leq 5$ are implemented by C functions that take $n$ arguments of type "value", and return a result of type @@ -174,37 +174,36 @@ objects)} \entree{"caml/memory.h"}{miscellaneous memory-related functions and macros (for GC interface, in-place modification of structures, etc).} \entree{"caml/fail.h"}{functions for raising exceptions -(see section~\ref{s:c-exceptions})} +(see section~\ref{ss:c-exceptions})} \entree{"caml/callback.h"}{callback from C to OCaml (see -section~\ref{s:callback}).} +section~\ref{s:c-callback}).} \entree{"caml/custom.h"}{operations on custom blocks (see -section~\ref{s:custom}).} +section~\ref{s:c-custom}).} \entree{"caml/intext.h"}{operations for writing user-defined serialization and deserialization functions for custom blocks -(see section~\ref{s:custom}).} +(see section~\ref{s:c-custom}).} \entree{"caml/threads.h"}{operations for interfacing in the presence of multiple threads (see section~\ref{s:C-multithreading}).} \end{tableau} +Before including any of these files, you should define the "OCAML_NAME_SPACE" +macro. For instance, +\begin{verbatim} +#define CAML_NAME_SPACE +#include "caml/mlvalues.h" +#include "caml/fail.h" +\end{verbatim} These files reside in the "caml/" subdirectory of the OCaml standard library directory, which is returned by the command "ocamlc -where" (usually "/usr/local/lib/ocaml" or "/usr/lib/ocaml"). -By default, header files in the "caml/" subdirectory give only access -to the public interface of the OCaml runtime. It is possible to define -the macro "CAML_INTERNALS" to get access to a lower-level interface, -but this lower-level interface is more likely to change and break -programs that use it. +{\bf Note:} +Including the header files without first defining "CAML_NAME_SPACE" +introduces in scope short names for most functions. +Those short names are deprecated, and may be removed in the future +because they usually produce clashes with names defined by other +C libraries. -{\bf Note:} It is recommended to define the macro "CAML_NAME_SPACE" -before including these header files. If you do not define it, the -header files will also define short names (without the "caml_" prefix) -for most functions, which usually produce clashes with names defined -by other C libraries that you might use. Including the header files -without "CAML_NAME_SPACE" is only supported for backward -compatibility. - -\subsection{Statically linking C code with OCaml code} -\label{staticlink-c-code} +\subsection{ss:staticlink-c-code}{Statically linking C code with OCaml code} The OCaml runtime system comprises three main parts: the bytecode interpreter, the memory manager, and a set of C functions that @@ -216,7 +215,7 @@ In the default mode, the OCaml linker produces bytecode for the standard runtime system, with a standard set of primitives. References to primitives that are not in this standard set result in the ``unavailable C primitive'' error. (Unless dynamic loading of C -libraries is supported -- see section~\ref{dynlink-c-code} below.) +libraries is supported -- see section~\ref{ss:dynlink-c-code} below.) In the ``custom runtime'' mode, the OCaml linker scans the object files and determines the set of required primitives. Then, it @@ -287,8 +286,7 @@ options themselves at link-time: The former alternative is more convenient for the final users of the library, however. -\subsection{Dynamically linking C code with OCaml code} -\label{dynlink-c-code} +\subsection{ss:dynlink-c-code}{Dynamically linking C code with OCaml code} Starting with Objective Caml 3.03, an alternative to static linking of C code using the "-custom" code is provided. In this mode, the OCaml linker @@ -311,7 +309,7 @@ operating system), and 2- building a shared library from the resulting object files. The resulting shared library or DLL file must be installed in a place where "ocamlrun" can find it later at program start-up time (see -section~\ref{s-ocamlrun-dllpath}). +section~\ref{s:ocamlrun-dllpath}). Finally (step 3), execute the "ocamlc" command with \begin{itemize} \item the names of the desired OCaml object files (".cmo" and ".cma" files) ; @@ -322,8 +320,8 @@ in one of the standard library directories can also be specified as "-dllib -l"\var{name}. \end{itemize} Do {\em not} set the "-custom" flag, otherwise you're back to static linking -as described in section~\ref{staticlink-c-code}. -The "ocamlmklib" tool (see section~\ref{s-ocamlmklib}) +as described in section~\ref{ss:staticlink-c-code}. +The "ocamlmklib" tool (see section~\ref{s:ocamlmklib}) automates steps 2 and 3. As in the case of static linking, it is possible (and recommended) to @@ -348,7 +346,7 @@ Using this mechanism, users of the library "mylib.cma" do not need to known that it references C code, nor whether this C code must be statically linked (using "-custom") or dynamically linked. -\subsection{Choosing between static linking and dynamic linking} +\subsection{ss:c-static-vs-dynamic}{Choosing between static linking and dynamic linking} After having described two different ways of linking C code with OCaml code, we now review the pros and cons of each, to help developers of @@ -386,7 +384,7 @@ compile to position-independent code and build a shared library vary wildly between different Unix systems. Also, dynamic linking is not supported on all Unix systems, requiring a fall-back case to static linking in the Makefile for the library. The "ocamlmklib" command -(see section~\ref{s-ocamlmklib}) tries to hide some of these system +(see section~\ref{s:ocamlmklib}) tries to hide some of these system dependencies. In conclusion: dynamic linking is highly recommended under the native @@ -397,8 +395,7 @@ enhances platform-independence of bytecode executables. For new or rarely-used libraries, static linking is much simpler to set up in a portable way. -\subsection{Building standalone custom runtime systems} -\label{s:custom-runtime} +\subsection{ss:custom-runtime}{Building standalone custom runtime systems} It is sometimes inconvenient to build a custom runtime system each time OCaml code is linked with C libraries, like "ocamlc -custom" does. @@ -432,7 +429,7 @@ knows which C primitives are required) and also when building the bytecode executable (so that the bytecode from "unix.cma" and "threads.cma" is actually linked in). -\section{The \texttt{value} type} +\section{s:c-value}{The \texttt{value} type} All OCaml objects are represented by the C type "value", defined in the include file "caml/mlvalues.h", along with macros to @@ -446,12 +443,12 @@ allocated by "malloc", or to a C variable). %%% FIXME will change in 4.02.0 (?) \end{itemize} -\subsection{Integer values} +\subsection{ss:c-int}{Integer values} Integer values encode 63-bit signed integers (31-bit on 32-bit architectures). They are unboxed (unallocated). -\subsection{Blocks} +\subsection{ss:c-blocks}{Blocks} Blocks in the heap are garbage-collected, and therefore have strict structure constraints. Each block includes a header containing the @@ -480,7 +477,7 @@ floating-point numbers.} serialization and deserialization functions attached.} \end{tableau} -\subsection{Pointers outside the heap} +\subsection{ss:c-outside-head}{Pointers outside the heap} Any word-aligned pointer to an address outside the heap can be safely cast to and from the type "value". This includes pointers returned by @@ -498,12 +495,12 @@ the OCaml heap, and this can crash the garbage collector. To avoid these problems, it is preferable to wrap the pointer in a OCaml block with tag "Abstract_tag" or "Custom_tag". -\section{Representation of OCaml data types} +\section{s:c-ocaml-datatype-repr}{Representation of OCaml data types} This section describes how OCaml data types are encoded in the "value" type. -\subsection{Atomic types} +\subsection{ss:c-atomic}{Atomic types} \begin{tableau}{|l|l|}{OCaml type}{Encoding} \entree{"int"}{Unboxed integer values.} @@ -516,8 +513,7 @@ This section describes how OCaml data types are encoded in the \entree{"nativeint"}{Blocks with tag "Custom_tag".} \end{tableau} -\subsection{Tuples and records} -\label{ss:tuples-and-records} +\subsection{ss:c-tuples-and-records}{Tuples and records} Tuples are represented by pointers to blocks, with tag~0. @@ -548,7 +544,7 @@ order of priority: default is the boxed representation. \end{itemize} -\subsection{Arrays} +\subsection{ss:c-arrays}{Arrays} Arrays of integers and pointers are represented like tuples, that is, as pointers to blocks tagged~0. They are accessed with the @@ -560,7 +556,7 @@ These arrays are represented by pointers to blocks with tag "Double_array_tag". They should be accessed with the "Double_field" and "Store_double_field" macros. -\subsection{Concrete data types} +\subsection{ss:c-concrete-datatypes}{Concrete data types} Constructed terms are represented either by unboxed integers (for constant constructors) or by blocks whose tag encode the constructor @@ -602,9 +598,9 @@ specially; a concrete data type is unboxable if it has exactly one constructor and this constructor has exactly one argument. Unboxable concrete data types are represented in the same ways as unboxable record types: see the description in -section~\ref{ss:tuples-and-records}. +section~\ref{ss:c-tuples-and-records}. -\subsection{Objects} +\subsection{ss:c-objects}{Objects} Objects are represented as blocks with tag "Object_tag". The first field of the block refers to the object's class and associated method @@ -627,7 +623,7 @@ to do the method call "foo#bar" from the C side, you should call: callback(caml_get_public_method(foo, hash_variant("bar")), foo); \end{verbatim} -\subsection{Polymorphic variants} +\subsection{ss:c-polyvar}{Polymorphic variants} Like constructed terms, polymorphic variant values are represented either as integers (for polymorphic variants without argument), or as blocks @@ -651,9 +647,9 @@ of size 2, whose field number 1 contains the representation of the pair "("\var{v}", "\var{w}")", rather than a block of size 3 containing \var{v} and \var{w} in fields 1 and 2. -\section{Operations on values} +\section{s:c-ops-on-values}{Operations on values} -\subsection{Kind tests} +\subsection{ss:c-kind-tests}{Kind tests} \begin{itemize} \item "Is_long("\var{v}")" is true if value \var{v} is an immediate integer, @@ -662,7 +658,7 @@ false otherwise and false if it is an immediate integer. \end{itemize} -\subsection{Operations on integers} +\subsection{ss:c-int-ops}{Operations on integers} \begin{itemize} \item "Val_long("\var{l}")" returns the value encoding the "long int" \var{l}. @@ -676,7 +672,7 @@ truth value of the C integer \var{x}. \item "Val_true", "Val_false" represent the OCaml booleans "true" and "false". \end{itemize} -\subsection{Accessing blocks} +\subsection{ss:c-block-access}{Accessing blocks} \begin{itemize} \item "Wosize_val("\var{v}")" returns the size of the block \var{v}, in words, @@ -739,9 +735,9 @@ Assigning directly to "Field("\var{v}", "\var{n}")" must be done with care to avoid confusing the garbage collector (see below). -\subsection{Allocating blocks} +\subsection{ss:c-block-allocation}{Allocating blocks} -\subsubsection{Simple interface} +\subsubsection{sss:c-simple-allocation}{Simple interface} \begin{itemize} \item @@ -799,7 +795,7 @@ any boxed type) whose field is the value \var{v}. representation of unboxable types in the current version of OCaml. \end{itemize} -\subsubsection{Low-level interface} +\subsubsection{sss:c-low-level-alloc}{Low-level interface} The following functions are slightly more efficient than "caml_alloc", but also much more difficult to use. @@ -834,7 +830,7 @@ with legal values (using the "caml_initialize" function described below) before the next allocation. \end{itemize} -\subsection{Raising exceptions} \label{s:c-exceptions} +\subsection{ss:c-exceptions}{Raising exceptions} Two functions are provided to raise two standard exceptions: \begin{itemize} @@ -848,7 +844,7 @@ with argument \var{s}. Raising arbitrary exceptions from C is more delicate: the exception identifier is dynamically allocated by the OCaml program, and therefore must be communicated to the C function using the -registration facility described below in section~\ref{s:register-exn}. +registration facility described below in section~\ref{ss:c-register-exn}. Once the exception identifier is recovered in C, the following functions actually raise the exception: \begin{itemize} @@ -864,13 +860,13 @@ null-terminated C string, raises the exception \var{id} with a copy of the C string \var{s} as argument. \end{itemize} -\section{Living in harmony with the garbage collector} +\section{s:c-gc-harmony}{Living in harmony with the garbage collector} Unused blocks in the heap are automatically reclaimed by the garbage collector. This requires some cooperation from C code that manipulates heap-allocated blocks. -\subsection{Simple interface} +\subsection{ss:c-simple-gc-harmony}{Simple interface} All the macros described in this section are declared in the "memory.h" header file. @@ -982,14 +978,33 @@ invalidate the first argument after it is computed. Use the normal C array syntax instead. \begin{gcrule} Global variables containing values must be registered -with the garbage collector using the "caml_register_global_root" function. +with the garbage collector using the "caml_register_global_root" function, +save that global variables and locations that will only ever contain OCaml +integers (and never pointers) do not have to be registered. + +The same is true for any memory location outside the OCaml heap that contains a +value and is not guaranteed to be reachable---for as long as it contains such +value---from either another registered global variable or location, local +variable declared with "CAMLlocal" or function parameter declared with +"CAMLparam". \end{gcrule} Registration of a global variable "v" is achieved by calling -"caml_register_global_root(&v)" just before or just after a valid -value is stored in "v" for the first time. You must not call any -of the OCaml runtime functions or macros between registering and -storing the value. +"caml_register_global_root(&v)" just before or just after a valid value is +stored in "v" for the first time; likewise, registration of an arbitrary +location "p" is achieved by calling "caml_register_global_root(p)". + +You must not call any of the OCaml runtime functions or macros between +registering and storing the value. Neither must you store anything in the +variable "v" (likewise, the location "p") that is not a valid value. + +The registration causes the contents of the variable or memory location to be +updated by the garbage collector whenever the value in such variable or location +is moved within the OCaml heap. In the presence of threads care must be taken to +ensure appropriate synchronisation with the OCaml runtime to avoid a race +condition against the garbage collector when reading or writing the value. (See +section +\ref{ss:parallel-execution-long-running-c-code}.) A registered global variable "v" can be un-registered by calling "caml_remove_global_root(&v)". @@ -1011,7 +1026,7 @@ modifications of "v" happen less often than minor collections. identifiers, structure tags) that start with "caml__". Do not use any identifier starting with "caml__" in your programs. -\subsection{Low-level interface} +\subsection{ss:c-low-level-gc-harmony}{Low-level interface} % Il faudrait simplifier violemment ce qui suit. % En gros, dire quand on n'a pas besoin de declarer les variables @@ -1166,7 +1181,40 @@ It would be incorrect to perform has taken place since "r" was allocated. -\section{A complete example} +\subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions} + +Since 4.10, allocation functions are guaranteed not to call any OCaml +callbacks from C, including finalisers and signal handlers, and delay +their execution instead. + +The function \verb"caml_process_pending_actions" from +"" executes any pending signal handlers and +finalisers, Memprof callbacks, and requested minor and major garbage +collections. In particular, it can raise asynchronous exceptions. It +is recommended to call it regularly at safe points inside long-running +non-blocking C code. + +The variant \verb"caml_process_pending_actions_exn" is provided, that +returns the exception instead of raising it directly into OCaml code. +Its result must be tested using {\tt Is_exception_result}, and +followed by {\tt Extract_exception} if appropriate. It is typically +used for clean up before re-raising: + +\begin{verbatim} + CAMLlocal1(exn); + ... + exn = caml_process_pending_actions_exn(); + if(Is_exception_result(exn)) { + exn = Extract_exception(exn); + ...cleanup... + caml_raise(exn); + } +\end{verbatim} + +Correct use of exceptional return, in particular in the presence of +garbage collection, is further detailed in Section~\ref{ss:c-callbacks}. + +\section{s:c-intf-example}{A complete example} This section outlines how the functions from the Unix "curses" library can be made available to OCaml programs. First of all, here is @@ -1198,6 +1246,7 @@ The stub code file, "curses_stubs.c", looks like this: \begin{verbatim} /* File curses_stubs.c -- stub code for curses */ #include +#define CAML_NAME_SPACE #include #include #include @@ -1223,7 +1272,7 @@ static struct custom_operations curses_window_ops = { /* Allocating an OCaml custom block to hold the given WINDOW * */ static value alloc_window(WINDOW * w) { - value v = alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1); + value v = caml_alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1); Window_val(v) = w; return v; } @@ -1328,14 +1377,14 @@ instead of "-cclib -lcurses".) %% Note by Damien: when I launch the program, it only displays "Hello" %% and not "world". Why? -\section{Advanced topic: callbacks from C to OCaml} \label{s:callback} +\section{s:c-callback}{Advanced topic: callbacks from C to OCaml} So far, we have described how to call C functions from OCaml. In this section, we show how C functions can call OCaml functions, either as callbacks (OCaml calls C which calls OCaml), or with the main program written in C. -\subsection{Applying OCaml closures from C} \label{s:callbacks} +\subsection{ss:c-callbacks}{Applying OCaml closures from C} C functions can apply OCaml function values (closures) to OCaml values. The following functions are provided to perform the applications: @@ -1392,7 +1441,7 @@ Example: } \end{verbatim} -\subsection{Obtaining or registering OCaml closures for use in C functions} +\subsection{ss:c-closures}{Obtaining or registering OCaml closures for use in C functions} There are two ways to obtain OCaml function values (closures) to be passed to the "callback" functions described above. One way is to @@ -1456,7 +1505,7 @@ calls "caml_named_value" only once: } \end{verbatim} -\subsection{Registering OCaml exceptions for use in C functions} \label{s:register-exn} +\subsection{ss:c-register-exn}{Registering OCaml exceptions for use in C functions} The registration mechanism described above can also be used to communicate exception identifiers from OCaml to C. The OCaml code @@ -1471,7 +1520,7 @@ exception to register. For example: The C code can then recover the exception identifier using "caml_named_value" and pass it as first argument to the functions "raise_constant", "raise_with_arg", and "raise_with_string" (described -in section~\ref{s:c-exceptions}) to actually raise the exception. For +in section~\ref{ss:c-exceptions}) to actually raise the exception. For example, here is a C function that raises the "Error" exception with the given argument: \begin{verbatim} @@ -1481,7 +1530,7 @@ the given argument: } \end{verbatim} -\subsection{Main program in C} \label{s:main-c} +\subsection{ss:main-c}{Main program in C} In normal operation, a mixed OCaml/C program starts by executing the OCaml initialization code, which then may proceed to call C @@ -1512,10 +1561,10 @@ Once the OCaml initialization code is complete, control returns to the C code that called "caml_main". \item The C code can then invoke OCaml functions using the callback -mechanism (see section~\ref{s:callbacks}). +mechanism (see section~\ref{ss:c-callbacks}). \end{itemize} -\subsection{Embedding the OCaml code in the C code} \label{s:embedded-code} +\subsection{ss:c-embedded-code}{Embedding the OCaml code in the C code} The bytecode compiler in custom runtime mode ("ocamlc -custom") normally appends the bytecode to the executable file containing the @@ -1523,7 +1572,7 @@ custom runtime. This has two consequences. First, the final linking step must be performed by "ocamlc". Second, the OCaml runtime library must be able to find the name of the executable file from the command-line arguments. When using "caml_main(argv)" as in -section~\ref{s:main-c}, this means that "argv[0]" or "argv[1]" must +section~\ref{ss:main-c}, this means that "argv[0]" or "argv[1]" must contain the executable file name. An alternative is to embed the bytecode in the C code. The @@ -1625,7 +1674,7 @@ gracefully, which equals the following: \begin{itemize} \item Running the functions that were registered with "Stdlib.at_exit". \item Triggering finalization of allocated custom blocks (see -section~\ref{s:custom}). For example, "Stdlib.in_channel" and +section~\ref{s:c-custom}). For example, "Stdlib.in_channel" and "Stdlib.out_channel" are represented by custom blocks that enclose file descriptors, which are to be released. \item Unloading the dependent shared libraries that were loaded by the runtime, @@ -1650,10 +1699,10 @@ shared library and reinitializing its static data. Therefore, at the moment, the facility is only useful for building reloadable shared libraries. -\section{Advanced example with callbacks} +\section{s:c-advexample}{Advanced example with callbacks} This section illustrates the callback facilities described in -section~\ref{s:callback}. We are going to package some OCaml functions +section~\ref{s:c-callback}. We are going to package some OCaml functions in such a way that they can be linked with C code and called from C just like any C functions. The OCaml functions are defined in the following "mod.ml" OCaml source: @@ -1744,14 +1793,14 @@ To build the whole program, just invoke the C compiler as follows: (On some machines, you may need to put "-ltermcap" or "-lcurses -ltermcap" instead of "-lcurses".) -\section{Advanced topic: custom blocks} \label{s:custom} +\section{s:c-custom}{Advanced topic: custom blocks} Blocks with tag "Custom_tag" contain both arbitrary user data and a pointer to a C struct, with type "struct custom_operations", that associates user-provided finalization, comparison, hashing, serialization and deserialization functions to this block. -\subsection{The "struct custom_operations"} +\subsection{ss:c-custom-ops}{The "struct custom_operations"} The "struct custom_operations" is defined in "" and contains the following fields: @@ -1845,6 +1894,7 @@ do not register the "struct custom_operations" with the deserializer using "register_custom_operations" (see below). \item "const struct custom_fixed_length* fixed_length" \\ +(Since 4.08.0) Normally, space in the serialized output is reserved to write the "bsize_32" and "bsize_64" fields returned by "serialize". However, for very short custom blocks, this space can be larger than the data @@ -1861,7 +1911,7 @@ OCaml allocation functions, and do not perform a callback into OCaml code. Do not use "CAMLparam" to register the parameters to these functions, and do not use "CAMLreturn" to return the result. -\subsection{Allocating custom blocks} +\subsection{ss:c-custom-alloc}{Allocating custom blocks} Custom blocks must be allocated via "caml_alloc_custom" or "caml_alloc_custom_mem": @@ -1928,7 +1978,7 @@ control of the user (via the "custom_major_ratio", "custom_minor_ratio", and "custom_minor_max_size" parameters) and proportional to the heap sizes. -\subsection{Accessing custom blocks} +\subsection{ss:c-custom-access}{Accessing custom blocks} The data part of a custom block \var{v} can be accessed via the pointer "Data_custom_val("\var{v}")". This pointer @@ -1942,7 +1992,7 @@ and do not use "Field", "Store_field" nor "caml_modify" to access the data part of a custom block. Conversely, any C data structure (not containing heap pointers) can be stored in a custom block. -\subsection{Writing custom serialization and deserialization functions} +\subsection{ss:c-custom-serialization}{Writing custom serialization and deserialization functions} The following functions, defined in "", are provided to write and read back the contents of custom blocks in a portable way. @@ -1991,7 +2041,7 @@ of the size specified in the input stream, searching the registered "struct custom_operation" blocks for one with the same identifier, and calling its "deserialize" function to fill the data part of the custom block. -\subsection{Choosing identifiers} +\subsection{ss:c-custom-idents}{Choosing identifiers} Identifiers in "struct custom_operations" must be chosen carefully, since they must identify uniquely the data structure for serialization @@ -2008,7 +2058,7 @@ or a Java-style package name ("com.mydomain.mymachine.mylibrary.version-number") as identifiers, to minimize the risk of identifier collision. -\subsection{Finalized blocks} +\subsection{ss:c-finalized}{Finalized blocks} Custom blocks generalize the finalized blocks that were present in OCaml prior to version 3.00. For backward compatibility, the @@ -2023,19 +2073,18 @@ word is reserved for storing the custom operations; the other \var{used} and \var{max} are used to control the speed of garbage collection, as described for "caml_alloc_custom". -\section{Advanced topic: Bigarrays and the OCaml-C interface} -\label{s:C-Bigarrays} +\section{s:C-Bigarrays}{Advanced topic: Bigarrays and the OCaml-C interface} This section explains how C stub code that interfaces C or Fortran code with OCaml code can use Bigarrays. -\subsection{Include file} +\subsection{ss:C-Bigarrays-include}{Include file} The include file "" must be included in the C stub file. It declares the functions, constants and macros discussed below. -\subsection{Accessing an OCaml bigarray from C or Fortran} +\subsection{ss:C-Bigarrays-access}{Accessing an OCaml bigarray from C or Fortran} If \var{v} is a OCaml "value" representing a Bigarray, the expression "Caml_ba_data_val("\var{v}")" returns a pointer to the data part of the array. @@ -2081,7 +2130,7 @@ to a C function and a Fortran function. } \end{verbatim} -\subsection{Wrapping a C or Fortran array as an OCaml Bigarray} +\subsection{ss:C-Bigarrays-wrap}{Wrapping a C or Fortran array as an OCaml Bigarray} A pointer \var{p} to an already-allocated C or Fortran array can be wrapped and returned to OCaml as a Bigarray using the "caml_ba_alloc" @@ -2128,8 +2177,7 @@ Fortran arrays can be made available to OCaml. } \end{verbatim} -\section{Advanced topic: cheaper C call} -\label{s:C-cheaper-call} +\section{s:C-cheaper-call}{Advanced topic: cheaper C call} This section describe how to make calling C functions cheaper. @@ -2137,7 +2185,7 @@ This section describe how to make calling C functions cheaper. use any of these methods, you have to provide an alternative byte-code stub that ignores all the special annotations. -\subsection{Passing unboxed values} +\subsection{ss:c-unboxed}{Passing unboxed values} We said earlier that all OCaml objects are represented by the C type "value", and one has to use macros such as "Int_val" to decode data from @@ -2225,7 +2273,7 @@ The corresponding C type must be "intnat". {\bf Note:} do not use the C "int" type in correspondence with "(int [\@untagged])". This is because they often differ in size. -\subsection{Direct C call} +\subsection{ss:c-direct-call}{Direct C call} In order to be able to run the garbage collector in the middle of a C function, the OCaml native-code compiler generates some bookkeeping @@ -2234,8 +2282,9 @@ code around C calls. Technically it wraps every C call with the C function For small functions that are called repeatedly, this indirection can have a big impact on performances. However this is not needed if we know that -the C function doesn't allocate and doesn't raise exceptions. We can -instruct the OCaml native-code compiler of this fact by annotating the +the C function doesn't allocate, doesn't raise exceptions, and doesn't release +the master lock (see section~\ref{ss:parallel-execution-long-running-c-code}). +We can instruct the OCaml native-code compiler of this fact by annotating the external declaration with the attribute "[\@\@noalloc]": \begin{verbatim} @@ -2246,7 +2295,7 @@ In this case calling "bar" from OCaml is as cheap as calling any other OCaml function, except for the fact that the OCaml compiler can't inline C functions... -\subsection{Example: calling C library functions without indirection} +\subsection{ss:c-direct-call-example}{Example: calling C library functions without indirection} Using these attributes, it is possible to call C library functions with no indirection. For instance many math functions are defined this @@ -2264,14 +2313,13 @@ external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] (** Natural logarithm. *) \end{verbatim} -\section{Advanced topic: multithreading} -\label{s:C-multithreading} +\section{s:C-multithreading}{Advanced topic: multithreading} Using multiple threads (shared-memory concurrency) in a mixed OCaml/C application requires special precautions, which are described in this section. -\subsection{Registering threads created from C} +\subsection{ss:c-thread-register}{Registering threads created from C} Callbacks from C to OCaml are possible only if the calling thread is known to the OCaml run-time system. Threads created from OCaml (through @@ -2294,7 +2342,7 @@ Returns 1 on success, 0 on error. If the calling thread was not previously registered, does nothing and returns 0. \end{itemize} -\subsection{Parallel execution of long-running C code} +\subsection{ss:parallel-execution-long-running-c-code}{Parallel execution of long-running C code} The OCaml run-time system is not reentrant: at any time, at most one thread can be executing OCaml code or C code that uses the OCaml @@ -2326,6 +2374,11 @@ resources. It may block until no other thread uses the OCaml run-time system. \end{itemize} +These functions poll for pending signals by calling asynchronous +callbacks (section~\ref{ss:c-process-pending-actions}) before releasing and +after acquiring the lock. They can therefore execute arbitrary OCaml +code including raising an asynchronous exception. + After "caml_release_runtime_system()" was called and until "caml_acquire_runtime_system()" is called, the C code must not access any OCaml data, nor call any function of the run-time system, nor call @@ -2395,8 +2448,7 @@ names, declared in "": Intuition: a ``blocking section'' is a piece of C code that does not use the OCaml run-time system, typically a blocking input/output operation. -\section{Advanced topic: interfacing with Windows Unicode APIs} -\label{s:interfacing-windows-unicode-apis} +\section{s:interfacing-windows-unicode-apis}{Advanced topic: interfacing with Windows Unicode APIs} This section contains some general guidelines for writing C stubs that use Windows Unicode APIs. @@ -2508,6 +2560,7 @@ The rest of the binding is the same for both platforms: \begin{verbatim} /* The following define is necessary because the API is experimental */ +#define CAML_NAME_SPACE #define CAML_INTERNALS #include @@ -2536,8 +2589,7 @@ CAMLprim value stub_getenv(value var_name) } \end{verbatim} -\section{Building mixed C/OCaml libraries: \texttt{ocamlmklib}} -\label{s-ocamlmklib} +\section{s:ocamlmklib}{Building mixed C/OCaml libraries: \texttt{ocamlmklib}} The "ocamlmklib" command facilitates the construction of libraries containing both OCaml code and C code, and usable both in static @@ -2653,3 +2705,55 @@ support libraries ("-lz") and the corresponding options ("-L/usr/local/zlib") must be given on all three invocations of "ocamlmklib", because they are needed at different times depending on whether shared libraries are supported. + + +\section{s:c-internal-guidelines}{Cautionary words: the internal runtime API} + +Not all header available in the "caml/" directory were described in previous +sections. All those unmentioned headers are part of the internal runtime API, +for which there is \emph{no} stability guarantee. If you really need access +to this internal runtime API, this section provides some guidelines +that may help you to write code that might not break on every new version +of OCaml. +\paragraph{Note} Programmers which come to rely on the internal API +for a use-case which they find realistic and useful are encouraged to open +a request for improvement on the bug tracker. + +\subsection{ss:c-internals}{Internal variables and CAML_INTERNALS} +Since OCaml 4.04, it is possible to get access to every part of the internal +runtime API by defining the "CAML_INTERNALS" macro before loading caml header files. +If this macro is not defined, parts of the internal runtime API are hidden. + +If you are using internal C variables, do not redefine them by hand. You should +import those variables by including the corresponding header files. The +representation of those variables has already changed once in OCaml 4.10, and is +still under evolution. +If your code relies on such internal and brittle properties, it will be broken +at some point in time. + +For instance, rather than redefining "caml_young_limit": +\begin{verbatim} +extern int caml_young_limit; +\end{verbatim} +which breaks in OCaml $\ge$ 4.10, you should include the "minor_gc" header: +\begin{verbatim} +#include +\end{verbatim} + +\subsection{ss:c-internal-macros}{OCaml version macros} +Finally, if including the right headers is not enough, or if you need to support +version older than OCaml 4.04, the header file "caml/version.h" should help +you to define your own compatibility layer. +This file provides few macros defining the current OCaml version. +In particular, the "OCAML_VERSION" macro describes the current version, +its format is "MmmPP". +For example, if you need some specific handling for versions older than 4.10.0, +you could write +\begin{verbatim} +#include +#if OCAML_VERSION >= 41000 +... +#else +... +#endif +\end{verbatim} diff --git a/manual/manual/cmds/lexyacc.etex b/manual/manual/cmds/lexyacc.etex index 5456acee..ad6d41ba 100644 --- a/manual/manual/cmds/lexyacc.etex +++ b/manual/manual/cmds/lexyacc.etex @@ -18,7 +18,7 @@ principles, techniques, and tools'' by Aho, Sethi and Ullman (Addison-Wesley, 1986), or ``Lex $\&$ Yacc'', by Levine, Mason and Brown (O'Reilly, 1992). -\section{Overview of \texttt{ocamllex}} +\section{s:ocamllex-overview}{Overview of \texttt{ocamllex}} The "ocamllex" command produces a lexical analyzer from a set of regular expressions with attached semantic actions, in the style of @@ -44,7 +44,7 @@ semantic actions compute a value belonging to the type "token" defined by the generated parsing module. (See the description of "ocamlyacc" below.) -\subsection{Options} +\subsection{ss:ocamllex-options}{Options} The following command-line options are recognized by "ocamllex". \begin{options} @@ -74,7 +74,7 @@ Display a short usage summary and exit. % \end{options} -\section{Syntax of lexer definitions} +\section{s:ocamllex-syntax}{Syntax of lexer definitions} The format of lexer definitions is as follows: \begin{alltt} @@ -97,7 +97,7 @@ the semantic consequences explained below. Refill handlers are a recent (optional) feature introduced in 4.02, documented below in subsection~\ref{ss:refill-handlers}. -\subsection{Header and trailer} +\subsection{ss:ocamllex-header-trailer}{Header and trailer} The {\it header} and {\it trailer} sections are arbitrary OCaml text enclosed in curly braces. Either or both can be omitted. If present, the header text is copied as is at the beginning of the @@ -106,7 +106,7 @@ header section contains the "open" directives required by the actions, and possibly some auxiliary functions used in the actions. -\subsection{Naming regular expressions} +\subsection{ss:ocamllex-named-regexp}{Naming regular expressions} Between the header and the entry points, one can give names to frequently-occurring regular expressions. This is written @@ -114,7 +114,7 @@ frequently-occurring regular expressions. This is written In regular expressions that follow this declaration, the identifier \var{ident} can be used as shorthand for \var{regexp}. -\subsection{Entry points} +\subsection{ss:ocamllex-entry-points}{Entry points} The names of the entry points must be valid identifiers for OCaml values (starting with a lowercase letter). @@ -143,7 +143,7 @@ may facilitate the use of "ocamllex" as a simple text processing tool. -\subsection{Regular expressions} +\subsection{ss:ocamllex-regexp}{Regular expressions} The regular expressions are in the style of "lex", with a more OCaml-like syntax. @@ -224,7 +224,7 @@ Concerning the precedences of operators, "#" has the highest precedence, followed by "*", "+" and "?", then concatenation, then "|" (alternation), then "as". -\subsection{Actions} +\subsection{ss:ocamllex-actions}{Actions} The actions are arbitrary OCaml expressions. They are evaluated in a context where the identifiers defined by using the "as" construct @@ -262,7 +262,7 @@ Useful for lexing nested comments, for example. \end{options} -\subsection{Variables in regular expressions} +\subsection{ss:ocamllex-variables}{Variables in regular expressions} The "as" construct is similar to ``\emph{groups}'' as provided by numerous regular expression packages. The type of these variables can be "string", "char", "string option" @@ -308,8 +308,7 @@ expressions will select one of the possible resulting sets of bindings. The selected set of bindings is purposely left unspecified. -\subsection{Refill handlers} -\label{ss:refill-handlers} +\subsection{ss:refill-handlers}{Refill handlers} By default, when ocamllex reaches the end of its lexing buffer, it will silently call the "refill_buff" function of "lexbuf" structure @@ -372,13 +371,13 @@ end } \end{verbatim} -\subsection{Reserved identifiers} +\subsection{ss:ocamllex-reserved-ident}{Reserved identifiers} All identifiers starting with "__ocaml_lex" are reserved for use by "ocamllex"; do not use any such identifier in your programs. -\section{Overview of \texttt{ocamlyacc}} +\section{s:ocamlyacc-overview}{Overview of \texttt{ocamlyacc}} The "ocamlyacc" command produces a parser from a context-free grammar specification with attached semantic actions, in the style of "yacc". @@ -400,7 +399,7 @@ implemented in the standard library module "Lexing". Tokens are values from the concrete type "token", defined in the interface file \var{grammar}".mli" produced by "ocamlyacc". -\section{Syntax of grammar definitions} +\section{s:ocamlyacc-syntax}{Syntax of grammar definitions} Grammar definitions have the following format: \begin{alltt} @@ -418,7 +417,7 @@ Comments are enclosed between \verb|/*| and \verb|*/| (as in C) in the ``declarations'' and ``rules'' sections, and between \verb|(*| and \verb|*)| (as in OCaml) in the ``header'' and ``trailer'' sections. -\subsection{Header and trailer} +\subsection{ss:ocamlyacc-header-trailer}{Header and trailer} The header and the trailer sections are OCaml code that is copied as is into file \var{grammar}".ml". Both sections are optional. The header @@ -426,7 +425,7 @@ goes at the beginning of the output file; it usually contains "open" directives and auxiliary functions required by the semantic actions of the rules. The trailer goes at the end of the output file. -\subsection{Declarations} +\subsection{ss:ocamlyacc-declarations}{Declarations} Declarations are given one per line. They all start with a \verb"%" sign. @@ -509,7 +508,7 @@ resolve reduce/reduce and shift/reduce conflicts: \end{options} -\subsection{Rules} +\subsection{ss:ocamlyacc-rules}{Rules} The syntax for rules is as usual: \begin{alltt} @@ -541,7 +540,7 @@ Actions occurring in the middle of rules are not supported. Nonterminal symbols are like regular OCaml symbols, except that they cannot end with "'" (single quote). -\subsection{Error handling} +\subsection{ss:ocamlyacc-error-handling}{Error handling} Error recovery is supported as follows: when the parser reaches an error state (no grammar rules can apply), it calls a function named @@ -564,7 +563,7 @@ exception. Refer to documentation on "yacc" for more details and guidance in how to use error recovery. -\section{Options} +\section{s:ocamlyacc-options}{Options} The "ocamlyacc" command recognizes the following options: @@ -601,13 +600,13 @@ command line. At run-time, the "ocamlyacc"-generated parser can be debugged by setting the "p" option in the "OCAMLRUNPARAM" environment variable -(see section~\ref{ocamlrun-options}). This causes the pushdown +(see section~\ref{s:ocamlrun-options}). This causes the pushdown automaton executing the parser to print a trace of its action (tokens shifted, rules reduced, etc). The trace mentions rule numbers and state numbers that can be interpreted by looking at the file \var{grammar}".output" generated by "ocamlyacc -v". -\section{A complete example} +\section{s:lexyacc-example}{A complete example} The all-time favorite: a desk calculator. This program reads arithmetic expressions on standard input, one per line, and prints @@ -680,7 +679,7 @@ To compile everything, execute: ocamlc -o calc lexer.cmo parser.cmo calc.cmo \end{verbatim} -\section{Common errors} +\section{s:lexyacc-common-errors}{Common errors} \begin{options} diff --git a/manual/manual/cmds/native.etex b/manual/manual/cmds/native.etex index 99c69d03..a9b6bf7d 100644 --- a/manual/manual/cmds/native.etex +++ b/manual/manual/cmds/native.etex @@ -19,7 +19,7 @@ compiled entirely with "ocamlopt" or entirely with "ocamlc". Native-code object files produced by "ocamlopt" cannot be loaded in the toplevel system "ocaml". -\section{Overview of the compiler} +\section{s:native-overview}{Overview of the compiler} The "ocamlopt" command has a command-line interface very close to that of "ocamlc". It accepts the same types of arguments, and processes them @@ -99,7 +99,7 @@ The AST is partial if type checking was unsuccessful. These ".cmt" and ".cmti" files are typically useful for code inspection tools. -\section{Options} +\section{s:native-options}{Options} The following command-line options are recognized by "ocamlopt". The options "-pack", "-a", "-shared", "-c" and "-output-obj" are mutually @@ -163,12 +163,12 @@ Windows for "flexlink" instead of the configured value. Primarily used for bootstrapping. \end{options} -\section{Common errors} +\section{s:native-common-errors}{Common errors} The error messages are almost identical to those of "ocamlc". See section~\ref{s:comp-errors}. -\section{Running executables produced by ocamlopt} +\section{s:native:running-executable}{Running executables produced by ocamlopt} Executables generated by "ocamlopt" are native, stand-alone executable files that can be invoked directly. They do @@ -179,7 +179,7 @@ During execution of an "ocamlopt"-generated executable, the following environment variables are also consulted: \begin{options} \item["OCAMLRUNPARAM"] Same usage as in "ocamlrun" - (see section~\ref{ocamlrun-options}), except that option "l" + (see section~\ref{s:ocamlrun-options}), except that option "l" is ignored (the operating system's stack size limit is used instead). \item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the @@ -187,8 +187,7 @@ the following environment variables are also consulted: "CAMLRUNPARAM" is not found, then the default values will be used. \end{options} -\section{Compatibility with the bytecode compiler} -\label{s:compat-native-bytecode} +\section{s:compat-native-bytecode}{Compatibility with the bytecode compiler} This section lists the known incompatibilities between the bytecode compiler and the native-code compiler. Except on those points, the two @@ -201,13 +200,6 @@ allocation in the heap. That is, if a signal is delivered while in a piece of code that does not allocate, its handler will not be called until the next heap allocation. -\item Stack overflow, typically caused by excessively deep recursion, -is not always turned into a "Stack_overflow" exception like the -bytecode compiler does. The runtime system makes a best effort to -trap stack overflows and raise the "Stack_overflow" exception, but -sometimes it fails and a ``segmentation fault'' or another system fault -occurs instead. - \item On ARM and PowerPC processors (32 and 64 bits), fused multiply-add (FMA) instructions can be generated for a floating-point multiplication followed by a floating-point addition @@ -239,4 +231,11 @@ not be linked and executed. A workaround is to compile "M" with the not referenced. See also the "Sys.opaque_identity" function from the "Sys" standard library module. +\item Before 4.10, stack overflows, typically caused by excessively + deep recursion, are not always turned into a "Stack_overflow" + exception like with the bytecode compiler. The runtime system makes + a best effort to trap stack overflows and raise the "Stack_overflow" + exception, but sometimes it fails and a ``segmentation fault'' or + another system fault occurs instead. + \end{itemize} diff --git a/manual/manual/cmds/ocamldep.etex b/manual/manual/cmds/ocamldep.etex index 1c2ab78e..185543c8 100644 --- a/manual/manual/cmds/ocamldep.etex +++ b/manual/manual/cmds/ocamldep.etex @@ -19,7 +19,7 @@ dependencies. (See below for a typical "Makefile".) Dependencies are generated both for compiling with the bytecode compiler "ocamlc" and with the native-code compiler "ocamlopt". -\section{Options} +\section{s:ocamldep-options}{Options} The following command-line options are recognized by "ocamldep". @@ -140,7 +140,7 @@ Display a short usage summary and exit. % \end{options} -\section{A typical Makefile} +\section{s:ocamldep-makefile}{A typical Makefile} Here is a template "Makefile" for a OCaml program. diff --git a/manual/manual/cmds/ocamldoc.etex b/manual/manual/cmds/ocamldoc.etex index e65a2937..65986611 100644 --- a/manual/manual/cmds/ocamldoc.etex +++ b/manual/manual/cmds/ocamldoc.etex @@ -17,16 +17,16 @@ a module, an exception, a module type, a type constructor, a record field, a class, a class type, a class method, a class value or a class inheritance clause. -\section{Usage} \label{s:ocamldoc-usage} +\section{s:ocamldoc-usage}{Usage} -\subsection{Invocation} +\subsection{ss:ocamldoc-invocation}{Invocation} OCamldoc is invoked via the command "ocamldoc", as follows: \begin{alltt} ocamldoc \var{options} \var{sourcefiles} \end{alltt} -\subsubsection*{Options for choosing the output format} +\subsubsection*{sss:ocamldoc-output}{Options for choosing the output format} The following options determine the format for the generated documentation. @@ -68,7 +68,7 @@ Use "dot ocamldoc.out" to display it. \item["-g" \var{file.cm[o,a,xs]}] Dynamically load the given file, which defines a custom documentation -generator. See section \ref{s:ocamldoc-compilation-and-usage}. This +generator. See section \ref{ss:ocamldoc-compilation-and-usage}. This option is supported by the "ocamldoc" command (to load ".cmo" and ".cma" files) and by its native-code version "ocamldoc.opt" (to load ".cmxs" files). If the given file is a simple one and does not exist in @@ -84,7 +84,7 @@ Add the given directory to the path where to look for custom generators. \end{options} -\subsubsection*{General options} +\subsubsection*{sss:ocamldoc-options}{General options} \begin{options} @@ -117,7 +117,7 @@ Load information from \var{file}, which has been produced by \item["-m" \var{flags}] Specify merge options between interfaces and implementations. -(see section \ref{s:ocamldoc-merge} for details). +(see section \ref{ss:ocamldoc-merge} for details). \var{flags} can be one or several of the following characters: \begin{options} \item["d"] merge description @@ -134,7 +134,7 @@ Specify merge options between interfaces and implementations. \end{options} \item["-no-custom-tags"] -Do not allow custom \@-tags (see section \ref{s:ocamldoc-tags}). +Do not allow custom \@-tags (see section \ref{ss:ocamldoc-tags}). \item["-no-stop"] Keep elements placed after/between the "(**/**)" special comment(s) @@ -195,7 +195,7 @@ Display a short usage summary and exit. % \end{options} -\subsubsection*{Type-checking options} +\subsubsection*{sss:ocamldoc-type-checking}{Type-checking options} OCamldoc calls the OCaml type-checker to obtain type information. The following options impact the type-checking phase. @@ -215,7 +215,7 @@ Allow arbitrary recursive types. (See the "-rectypes" option to "ocamlc".) \end{options} -\subsubsection*{Options for generating HTML pages} +\subsubsection*{sss:ocamldoc-html}{Options for generating HTML pages} The following options apply in conjunction with the "-html" option: @@ -250,7 +250,7 @@ module M (A:Module) (B:Module2) : sig .. end \end{options} -\subsubsection*{Options for generating \LaTeX\ files} +\subsubsection*{sss:ocamldoc-latex}{Options for generating \LaTeX\ files} The following options apply in conjunction with the "-latex" option: @@ -291,7 +291,7 @@ Generate one ".tex" file per toplevel module, instead of the global "ocamldoc.out" file. \end{options} -\subsubsection*{Options for generating TeXinfo files} +\subsubsection*{sss:ocamldoc-info}{Options for generating TeXinfo files} The following options apply in conjunction with the "-texi" option: @@ -315,7 +315,7 @@ Do not build index for Info files. Suppress trailer in generated documentation. \end{options} -\subsubsection*{Options for generating "dot" graphs} +\subsubsection*{sss:ocamldoc-dot}{Options for generating "dot" graphs} The following options apply in conjunction with the "-dot" option: @@ -344,7 +344,7 @@ Output "dot" code describing the type dependency graph instead of the module dependency graph. \end{options} -\subsubsection*{Options for generating man files} +\subsubsection*{sss:ocamldoc-man}{Options for generating man files} The following options apply in conjunction with the "-man" option: @@ -362,8 +362,7 @@ Set the section number used for generated man filenames. Default is '"3"'. \end{options} -\subsection{Merging of module information} -\label{s:ocamldoc-merge} +\subsection{ss:ocamldoc-merge}{Merging of module information} Information on a module can be extracted either from the ".mli" or ".ml" file, or both, depending on the files given on the command line. @@ -384,8 +383,7 @@ If a description is present in the ".ml" file and not in the In either case, all the information given in the ".mli" file is kept. \end{itemize} -\subsection{Coding rules} -\label{s:ocamldoc-rules} +\subsection{ss:ocamldoc-rules}{Coding rules} The following rules must be respected in order to avoid name clashes resulting in cross-reference errors: \begin{itemize} @@ -419,22 +417,21 @@ In this case, OCamldoc will associate "Bar.x" to the "x" of module opened module "Foo". \end{itemize} -\section{Syntax of documentation comments} -\label{s:ocamldoc-comments} +\section{s:ocamldoc-comments}{Syntax of documentation comments} Comments containing documentation material are called {\em special comments} and are written between "(**" and "*)". Special comments must start exactly with "(**". Comments beginning with "(" and more than two "*" are ignored. -\subsection{Placement of documentation comments} +\subsection{ss:ocamldoc-placement}{Placement of documentation comments} OCamldoc can associate comments to some elements of the language encountered in the source files. The association is made according to the locations of comments with respect to the language elements. The locations of comments in ".mli" and ".ml" files are different. %%%%%%%%%%%%% -\subsubsection{Comments in ".mli" files} +\subsubsection{sss:ocamldoc-mli}{Comments in ".mli" files} A special comment is associated to an element if it is placed before or after the element.\\ A special comment before an element is associated to this element if~: @@ -574,7 +571,7 @@ module type my_module_type = \end{caml_example*} %%%%%%%%%%%%% -\subsubsection{Comments in {\tt .ml} files} +\subsubsection{sss:ocamldoc-comments-ml}{Comments in {\tt .ml} files} A special comment is associated to an element if it is placed before the element and there is no blank line between the comment and the @@ -659,7 +656,7 @@ module type my_module_type = \end{caml_example} %%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{The Stop special comment} +\subsection{ss:ocamldoc-stop}{The Stop special comment} The special comment "(**/**)" tells OCamldoc to discard elements placed after this comment, up to the end of the current class, class type, module or module type, or up to the next stop comment. @@ -694,7 +691,7 @@ The {\bf\tt -no-stop} option to "ocamldoc" causes the Stop special comments to be ignored. %%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Syntax of documentation comments} +\subsection{ss:ocamldoc-syntax}{Syntax of documentation comments} The inside of documentation comments "(**"\ldots"*)" consists of free-form text with optional formatting annotations, followed by @@ -722,7 +719,7 @@ At last, "(**)" is the empty documentation comment. % enable section numbering for subsubsections (PR#6189, item 3) \setcounter{secnumdepth}{3} -\subsection{Text formatting} +\subsection{ss:ocamldoc-formatting}{Text formatting} Here is the BNF grammar for the simple markup language used to format text descriptions. @@ -762,9 +759,9 @@ text: {{text-element}} @||@&@ '{v' string 'v}' @ & set the given @string@ in verbatim style. \\ @||@&@ '{%' string '%}' @ & target-specific content (\LaTeX\ code by default, see details - in \ref{sss:target-specific-syntax}) \\ + in \ref{sss:ocamldoc-target-specific-syntax}) \\ @||@&@ '{!' string '}' @ & insert a cross-reference to an element - (see section \ref{sss:crossref} for the syntax of cross-references).\\ + (see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\ @||@&@ '{!modules:' string string ... '}' @ & insert an index table for the given module names. Used in HTML only.\\ @||@&@ '{!indexlist}' @ & insert a table of links to the various indexes @@ -777,7 +774,7 @@ must be escaped by a '"\\"'\\ @||@& \nt{blank-line} & force a new line. \end{tabular} \\ -\subsubsection{List formatting} +\subsubsection{sss:ocamldoc-list}{List formatting} \begin{syntax} list: @@ -807,8 +804,7 @@ The same shortcut is available for enumerated lists, using '"+"' instead of '"-"'. Note that only one list can be defined by this shortcut in nested lists. -\subsubsection{Cross-reference formatting} -\label{sss:crossref} +\subsubsection{sss:ocamldoc-crossref}{Cross-reference formatting} Cross-references are fully qualified element names, as in the example "{!Foo.Bar.t}". This is an ambiguous reference as it may designate @@ -842,7 +838,7 @@ names. For example, the constructor "Node" of the type "tree" will be referenced as "{!tree.Node}" or "{!const:tree.Node}", or possibly "{!Mod1.Mod2.tree.Node}" from outside the module. -\subsubsection{First sentence} +\subsubsection{sss:ocamldoc-preamble}{First sentence} In the description of a value, type, exception, module, module type, class or class type, the {\em first sentence} is sometimes used in indexes, or @@ -863,8 +859,7 @@ outside of the following text formatting : @ '{^' text '}' @, @ '{_' text '}' @. -\subsubsection{Target-specific formatting} -\label{sss:target-specific-syntax} +\subsubsection{sss:ocamldoc-target-specific-syntax}{Target-specific formatting} The content inside "{%foo: ... %}" is target-specific and will only be interpreted by the backend "foo", and ignored by the others. The @@ -872,7 +867,7 @@ backends of the distribution are "latex", "html", "texi" and "man". If no target is specified (syntax "{% ... %}"), "latex" is chosen by default. Custom generators may support their own target prefix. -\subsubsection{Recognized HTML tags} +\subsubsection{sss:ocamldoc-html-tags}{Recognized HTML tags} The HTML tags "..", "..", "..", @@ -894,10 +889,10 @@ The HTML tags "..", \setcounter{secnumdepth}{2} %%%%%%%%%%%%% -\subsection{Documentation tags (\@-tags)} -\label{s:ocamldoc-tags} +\subsection{ss:ocamldoc-tags}{Documentation tags (\@-tags)} -\subsubsection{Predefined tags} + +\subsubsection{sss:ocamldoc-builtin-tags}{Predefined tags} The following table gives the list of predefined \@-tags, with their syntax and meaning.\\ @@ -939,8 +934,7 @@ to the given \nt{version} in order to document compatibility issues. \\ \hline @ "@version" string @ & The version number for the element. \\ \hline \end{tabular} -\subsubsection{Custom tags} -\label{s:ocamldoc-custom-tags} +\subsubsection{sss:ocamldoc-custom-tags}{Custom tags} You can use custom tags in the documentation comments, but they will have no effect if the generator used does not handle them. To use a custom tag, for example "foo", just put "\@foo" with some text in your @@ -952,11 +946,10 @@ comment, as in: \end{verbatim} To handle custom tags, you need to define a custom generator, -as explained in section \ref{s:ocamldoc-handling-custom-tags}. +as explained in section \ref{ss:ocamldoc-handling-custom-tags}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Custom generators} -\label{s:ocamldoc-custom-generators} +\section{s:ocamldoc-custom-generators}{Custom generators} OCamldoc operates in two steps: \begin{enumerate} @@ -975,7 +968,7 @@ The files you can use to define custom generators are installed in the "ocamldoc" sub-directory of the OCaml standard library. %%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{The generator modules} +\subsection{ss:ocamldoc-generators}{The generator modules} The type of a generator module depends on the kind of generated documentation. Here is the list of generator module types, with the name of the generator class in the module~: @@ -1003,7 +996,7 @@ It is recommended to inherit from the current generator of the same kind as the one you want to define. Doing so, it is possible to load various custom generators to combine improvements brought by each one. -This is done using first class modules (see chapter \ref{s-first-class-modules}). +This is done using first class modules (see chapter \ref{s:first-class-modules}). The easiest way to define a custom generator is the following this example, here extending the current HTML generator. We don't have to know if this is @@ -1042,13 +1035,12 @@ kind of generator you are extending~: \end{itemize} %%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Handling custom tags} -\label{s:ocamldoc-handling-custom-tags} +\subsection{ss:ocamldoc-handling-custom-tags}{Handling custom tags} Making a custom generator handle custom tags (see -\ref{s:ocamldoc-custom-tags}) is very simple. +\ref{sss:ocamldoc-custom-tags}) is very simple. -\subsubsection*{For HTML} +\subsubsection*{sss:ocamldoc-html-generator}{For HTML} Here is how to develop a HTML generator handling your custom tags. The class "Odoc_html.Generator.html" inherits @@ -1079,11 +1071,11 @@ function associated to a custom tag and apply it to the text given to the tag. If no function is associated to a custom tag, then the method prints a warning message on "stderr". -\subsubsection{For other generators} +\subsubsection{sss:ocamldoc-other-generators}{For other generators} You can act the same way for other kinds of generators. %%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Adding command line options} +\section{s:ocamldoc-adding-flags}{Adding command line options} The command line analysis is performed after loading the module containing the documentation generator, thus allowing command line options to be added to the list of existing ones. Adding an option can be done with the function @@ -1094,11 +1086,10 @@ documentation generator, thus allowing command line options to be added to the this function. %%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Compilation and usage} -\label{s:ocamldoc-compilation-and-usage} +\subsection{ss:ocamldoc-compilation-and-usage}{Compilation and usage} %%%%%%%%%%%%%% -\subsubsection{Defining a custom generator class in one file} +\subsubsection{sss:ocamldoc-generator-class}{Defining a custom generator class in one file} Let "custom.ml" be the file defining a new generator class. Compilation of "custom.ml" can be performed by the following command~: \begin{alltt} @@ -1114,7 +1105,7 @@ Compilation of "custom.ml" can be performed by the following command~: custom one is ignored. %%%%%%%%%%%%%% -\subsubsection{Defining a custom generator class in several files} +\subsubsection{sss:ocamldoc-modular-generator}{Defining a custom generator class in several files} It is possible to define a generator class in several modules, which are defined in several files \var{\nth{file}{1}}".ml"["i"], \var{\nth{file}{2}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]. A ".cma" diff --git a/manual/manual/cmds/profil.etex b/manual/manual/cmds/profil.etex index 18029dbc..7826fab3 100644 --- a/manual/manual/cmds/profil.etex +++ b/manual/manual/cmds/profil.etex @@ -5,7 +5,7 @@ This chapter describes how the execution of OCaml programs can be profiled, by recording how many times functions are called, branches of conditionals are taken, \ldots -\section{Compiling for profiling} +\section{s:ocamlprof-compiling}{Compiling for profiling} Before profiling an execution, the program must be compiled in profiling mode, using the "ocamlcp" front-end to the "ocamlc" compiler @@ -16,7 +16,7 @@ compiling the modules (production of ".cmo" or ".cmx" files), and can also be used (though this is not strictly necessary) when linking them together. -\paragraph{Note} If a module (".ml" file) doesn't have a corresponding +\lparagraph{p:ocamlprof-warning}{Note} If a module (".ml" file) doesn't have a corresponding interface (".mli" file), then compiling it with "ocamlcp" will produce object files (".cmi" and ".cmo") that are not compatible with the ones produced by "ocamlc", which may lead to problems (if the ".cmi" or @@ -25,7 +25,7 @@ non-profiling compilations. To avoid this problem, you should always have a ".mli" file for each ".ml" file. The same problem exists with "ocamloptp". -\paragraph{Note} To make sure your programs can be compiled in +\lparagraph{p:ocamlprof-reserved}{Note} To make sure your programs can be compiled in profiling mode, avoid using any identifier that begins with "__ocaml_prof". @@ -64,7 +64,7 @@ the corresponding "ocamlc" or "ocamlopt" compiler, except the "-pp" (preprocessing) option. -\section{Profiling an execution} +\section{s:ocamlprof-profiling}{Profiling an execution} Running an executable that has been compiled with "ocamlcp" or "ocamloptp" records the execution counts for the specified parts of @@ -85,7 +85,7 @@ different inputs. Note that dump files produced by byte-code executables (compiled with "ocamlcp") are compatible with the dump files produced by native executables (compiled with "ocamloptp"). -\section{Printing profiling information} +\section{s:ocamlprof-printing}{Printing profiling information} The "ocamlprof" command produces a source listing of the program modules where execution counts have been inserted as comments. For instance, @@ -136,7 +136,7 @@ Display a short usage summary and exit. % \end{options} -\section{Time profiling} +\section{s:ocamlprof-time-profiling}{Time profiling} Profiling with "ocamlprof" only records execution counts, not the actual time spent within each function. There is currently no way to perform diff --git a/manual/manual/cmds/runtime.etex b/manual/manual/cmds/runtime.etex index 5b146508..0e93eb25 100644 --- a/manual/manual/cmds/runtime.etex +++ b/manual/manual/cmds/runtime.etex @@ -4,7 +4,7 @@ The "ocamlrun" command executes bytecode files produced by the linking phase of the "ocamlc" command. -\section{Overview} +\section{s:ocamlrun-overview}{Overview} The "ocamlrun" command comprises three main parts: the bytecode interpreter, that actually executes bytecode files; the memory @@ -44,8 +44,7 @@ to always give ".exe" names to bytecode executables, e.g. compile with "ocamlc -o myprog.exe ..." rather than "ocamlc -o myprog ...". \end{windows} -\section{Options} \label{ocamlrun-options} - +\section{s:ocamlrun-options}{Options} The following command-line options are recognized by "ocamlrun". \begin{options} @@ -61,7 +60,7 @@ in the "OCAMLRUNPARAM" environment variable (see below). \item["-I" \var{dir}] Search the directory \var{dir} for dynamically-loaded libraries, in addition to the standard search path (see -section~\ref{s-ocamlrun-dllpath}). +section~\ref{s:ocamlrun-dllpath}). \item["-m"] Print the magic number of the bytecode executable given as argument and exit. @@ -86,12 +85,12 @@ The following environment variables are also consulted: \begin{options} \item["CAML_LD_LIBRARY_PATH"] Additional directories to search for - dynamically-loaded libraries (see section~\ref{s-ocamlrun-dllpath}). + dynamically-loaded libraries (see section~\ref{s:ocamlrun-dllpath}). \item["OCAMLLIB"] The directory containing the OCaml standard library. (If "OCAMLLIB" is not set, "CAMLLIB" will be used instead.) Used to locate the "ld.conf" configuration file for - dynamic loading (see section~\ref{s-ocamlrun-dllpath}). If not set, + dynamic loading (see section~\ref{s:ocamlrun-dllpath}). If not set, default to the library directory specified when compiling OCaml. \item["OCAMLRUNPARAM"] Set the runtime system options @@ -126,15 +125,17 @@ The following environment variables are also consulted: \fi This option takes no argument. \item[h] The initial size of the major heap (in words). - \item[a] ("allocation_policy") The policy used for allocating in the - OCaml heap. Possible values are 0 for the next-fit policy, and 1 - for the first-fit policy. Next-fit is usually faster, but first-fit - is better for avoiding fragmentation and the associated heap - compactions. + \item[a] ("allocation_policy") + The policy used for allocating in the OCaml heap. Possible values + are "0" for the next-fit policy, "1" for the first-fit + policy, and "2" for the best-fit policy. Best-fit is still experimental, + but probably the best of the three. The default is "0" (next-fit). + See the Gc module documentation for details. \item[s] ("minor_heap_size") Size of the minor heap. (in words) \item[i] ("major_heap_increment") Default size increment for the major heap. (in words) \item[o] ("space_overhead") The major GC speed setting. + See the Gc module documentation for details. \item[O] ("max_overhead") The heap compaction trigger setting. \item[l] ("stack_limit") The limit (in words) of the stack size. \item[v] ("verbose") What GC messages to print to stderr. This @@ -154,7 +155,7 @@ The following environment variables are also consulted: \item[1024 (= 0x400)] Output GC statistics at program exit. \end{options} \item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see - "caml_shutdown" in section~\ref{s:embedded-code}). The option also enables + "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables pooling (as in "caml_startup_pooled"). This mode can be used to detect leaks with a third-party memory debugger. % FIXME missing: H, t, w, W see MPR#7870 @@ -204,13 +205,13 @@ The following environment variables are also consulted: executable file. \end{options} -\section{Dynamic loading of shared libraries} \label{s-ocamlrun-dllpath} +\section{s:ocamlrun-dllpath}{Dynamic loading of shared libraries} On platforms that support dynamic loading, "ocamlrun" can link dynamically with C shared libraries (DLLs) providing additional C primitives beyond those provided by the standard runtime system. The names for these libraries are provided at link time as described in -section~\ref{dynlink-c-code}), and recorded in the bytecode executable +section~\ref{ss:dynlink-c-code}), and recorded in the bytecode executable file; "ocamlrun", then, locates these libraries and resolves references to their primitives when the bytecode executable program starts. @@ -241,7 +242,7 @@ system directories, plus the directories listed in the "PATH" environment variable. \end{enumerate} -\section{Common errors} +\section{s:ocamlrun-common-errors}{Common errors} This section describes and explains the most frequently encountered error messages. diff --git a/manual/manual/cmds/spacetime-chapter.etex b/manual/manual/cmds/spacetime-chapter.etex index 0c39a2e8..5b75eb86 100644 --- a/manual/manual/cmds/spacetime-chapter.etex +++ b/manual/manual/cmds/spacetime-chapter.etex @@ -1,7 +1,7 @@ \chapter{Memory profiling with Spacetime} %HEVEA\cutname{spacetime.html} -\section{Overview} +\section{s:spacetime-overview}{Overview} Spacetime is the name given to functionality within the OCaml compiler that provides for accurate profiling of the memory behaviour of a program. @@ -16,7 +16,7 @@ Spacetime only analyses the memory behaviour of a program with respect to the OCaml heap allocators and garbage collector. It does not analyse allocation on the C heap. Spacetime does not affect the memory behaviour of a program being profiled with the exception of any change caused by the -overhead of profiling (see section\ \ref{runtimeoverhead})---for example +overhead of profiling (see section\ \ref{s:spacetime-runtimeoverhead})---for example the program running slower might cause it to allocate less memory in total. Spacetime is currently only available for x86-64 targets and has only been @@ -25,9 +25,9 @@ Unix-like systems and provision has been made for running under Windows). It is expected that the set of supported platforms will be extended in the future. -\section{How to use it} +\section{s:spacetime-howto}{How to use it} -\subsection{Building} +\subsection{ss:spacetime-building}{Building} To use Spacetime it is necessary to use an OCaml compiler that was configured with the {\tt -spacetime} option. It is not possible to select @@ -55,12 +55,12 @@ Spacetime-configured compilers run slower and occupy more memory than their counterparts. It is hoped this will be fixed in the future as part of improved cross compilation support. -\subsection{Running} +\subsection{ss:spacetime-running}{Running} Programs built with Spacetime instrumentation have a dependency on the {\tt libunwind} library unless that was unavailable at configure time or the {\tt -disable-libunwind} option was specified -(see section\ \ref{runtimeoverhead}). +(see section\ \ref{s:spacetime-runtimeoverhead}). Setting the {\tt OCAML\_SPACETIME\_INTERVAL} environment variable to an integer representing a number of milliseconds before running a program built @@ -88,7 +88,7 @@ are then not relevant.) Full documentation as regards this method of profiling is provided in the standard library documentation (section\ \ref{c:stdlib}) for the {\tt Spacetime} module. -\subsection{Analysis} +\subsection{ss:spacetime-analysis}{Analysis} The compiler distribution does not itself provide the facility for analysing Spacetime output files; this is left to external tools. The first such tool @@ -96,7 +96,7 @@ will appear in OPAM as a package called {\tt prof_spacetime}. That tool will provide interactive graphical and terminal-based visualisation of the results of profiling. -\section{Runtime overhead}\label{runtimeoverhead} +\section{s:spacetime-runtimeoverhead}{Runtime overhead} The runtime overhead imposed by Spacetime varies considerably depending on the particular program being profiled. The overhead may be as low as @@ -112,7 +112,7 @@ Programs running with Spacetime instrumentation consume significantly more memory than their non-instrumented counterparts. It is expected that this memory overhead will also be reduced in the future. -\section{For developers} +\section{s:spacetime-dev}{For developers} The compiler distribution provides an ``{\tt otherlibs}'' library called {\tt raw\_spacetime\_lib} for decoding Spacetime files. This library diff --git a/manual/manual/cmds/top.etex b/manual/manual/cmds/top.etex index ddf68915..ed9ac338 100644 --- a/manual/manual/cmds/top.etex +++ b/manual/manual/cmds/top.etex @@ -66,20 +66,16 @@ its contents are read as a sequence of OCaml phrases and executed as per the "#use" directive described in section~\ref{s:toplevel-directives}. The evaluation outcode for each phrase are not displayed. -If the current directory does not contain an ".ocamlinit" file, but -the user's home directory (environment variable "HOME") does, the -latter is read and executed as described below. +If the current directory does not contain an ".ocamlinit" file, +the file "XDG_CONFIG_HOME/ocaml/init.ml" is looked up according +to the XDG base directory specification and used instead (on Windows +this is skipped). If that file doesn't exist then an [.ocamlinit] file +in the users' home directory (determined via environment variable "HOME") is +used if existing. The toplevel system does not perform line editing, but it can easily be used in conjunction with an external line editor such as -"ledit", "ocaml2" or "rlwrap" -\begin{latexonly} -(see the Caml Hump "http://caml.inria.fr/humps/index_framed_caml.html"). -\end{latexonly} -\begin{htmlonly} -(see the -\ahref{http://caml.inria.fr/humps/index\_framed\_caml.html}{Caml Hump}). -\end{htmlonly} +"ledit", or "rlwrap". An improved toplevel, "utop", is also available. Another option is to use "ocaml" under Gnu Emacs, which gives the full editing power of Emacs (command "run-caml" from library "inf-caml"). @@ -111,7 +107,7 @@ of the script: \end{unix} -\section{Options} \label{s:toplevel-options} +\section{s:toplevel-options}{Options} The following command-line options are recognized by the "ocaml" command. % Configure boolean variables used by the macros in unified-options.etex @@ -139,12 +135,12 @@ attempts to underline visually the location of the error. It consults the "TERM" variable to determines the type of output terminal and look up its capabilities in the terminal database. -\item["HOME"] Directory where the ".ocamlinit" file is searched. +\item["XDG_CONFIG_HOME", "HOME"] +".ocamlinit" lookup procedure (see above). \end{options} \end{unix} -\section{Toplevel directives} -\label{s:toplevel-directives} +\section{s:toplevel-directives}{Toplevel directives} The following directives control the toplevel behavior, load files in memory, and trace program execution. @@ -314,7 +310,7 @@ directories: \end{options} -\section{The toplevel and the module system} \label{s:toplevel-modules} +\section{s:toplevel-modules}{The toplevel and the module system} Toplevel phrases can refer to identifiers defined in compilation units with the same mechanisms as for separately compiled units: either by @@ -336,7 +332,7 @@ implementation of \var{Mod} has been loaded. The error ``reference to undefined global \var{Mod}'' will occur only when executing a value or module definition that refers to \var{Mod}. -\section{Common errors} +\section{s:toplevel-common-errors}{Common errors} This section describes and explains the most frequently encountered error messages. @@ -370,7 +366,7 @@ with "#load". See section~\ref{s:toplevel-modules} above. \end{options} -\section{Building custom toplevel systems: \texttt{ocamlmktop}} +\section{s:custom-toplevel}{Building custom toplevel systems: \texttt{ocamlmktop}} The "ocamlmktop" command builds OCaml toplevels that contain user code preloaded at start-up. @@ -402,7 +398,7 @@ not opened, though; you still have to do \end{verbatim} yourself, if this is what you wish. -\subsection{Options} +\subsection{ss:ocamlmktop-options}{Options} The following command-line options are recognized by "ocamlmktop". @@ -432,7 +428,7 @@ The default is "a.out". \end{options} -\section{The native toplevel: \texttt{ocamlnat}\ (experimental)} +\section{s:ocamlnat}{The native toplevel: \texttt{ocamlnat}\ (experimental)} {\bf This section describes a tool that is not yet officially supported % but may be found useful.} diff --git a/manual/manual/cmds/unified-options.etex b/manual/manual/cmds/unified-options.etex index 81f60937..68e0c0a6 100644 --- a/manual/manual/cmds/unified-options.etex +++ b/manual/manual/cmds/unified-options.etex @@ -223,7 +223,7 @@ C libraries. At link-time, shared libraries are searched in the standard search path (the one corresponding to the "-I" option). The "-dllpath" option simply stores \var{dir} in the produced executable file, where "ocamlrun" can find it and use it as -described in section~\ref{s-ocamlrun-dllpath}. +described in section~\ref{s:ocamlrun-dllpath}. }%comp \notop{% @@ -246,7 +246,7 @@ Add debugging information while compiling and linking. This option is required in order to \comp{be able to debug the program with "ocamldebug" (see chapter~\ref{c:debugger}), and to} produce stack backtraces when the program terminates on an uncaught exception (see -section~\ref{ocamlrun-options}). +section~\ref{s:ocamlrun-options}). }%notop \notop{% @@ -287,7 +287,8 @@ the toplevel is running with the "#directory" directive \item["-init" \var{file}] Load the given file instead of the default initialization file. The default file is ".ocamlinit" in the current directory if it -exists, otherwise ".ocamlinit" in the user's home directory. +exists, otherwise "XDG_CONFIG_HOME/ocaml/init.ml" or +".ocamlinit" in the user's home directory. }%top \notop{% @@ -350,7 +351,7 @@ incorporating the C object files and libraries given on the command line. This custom runtime system can be used later to execute bytecode executables produced with the "ocamlc -use-runtime" \var{runtime-name} option. -See section~\ref{s:custom-runtime} for more information. +See section~\ref{ss:custom-runtime} for more information. }%comp \notop{% @@ -490,12 +491,21 @@ Cause the linker to produce a C object file instead of \comp{a bytecode executable file}\nat{an executable file}. This is useful to wrap OCaml code as a C library, callable from any C program. See chapter~\ref{c:intf-c}, -section~\ref{s:embedded-code}. The name of the output object file +section~\ref{ss:c-embedded-code}. The name of the output object file must be set with the "-o" option. This option can also be used to produce a \comp{C source file (".c" extension) or a} compiled shared/dynamic library (".so" extension, ".dll" under Windows). }%notop +\comp{% +\item["-output-complete-exe"] +Build a self-contained executable by linking a C object file containing the +bytecode program, the OCaml runtime system and any other static C code given to +"ocamlc". The resulting effect is similar to "-custom", except that the bytecode +is embedded in the C code so it is no longer accessible to tools such as +"ocamldebug". On the other hand, the resulting binary is resistant to "strip". +}%comp + \nat{% \item["-pack"] Build an object file (".cmx" and ".o"/".obj" files) and its associated compiled @@ -676,7 +686,7 @@ be used with new software. Generate a bytecode executable file that can be executed on the custom runtime system \var{runtime-name}, built earlier with "ocamlc -make-runtime" \var{runtime-name}. -See section~\ref{s:custom-runtime} for more information. +See section~\ref{ss:custom-runtime} for more information. }%comp \item["-v"] diff --git a/manual/manual/foreword.etex b/manual/manual/foreword.etex index 6c68d7e2..70817510 100644 --- a/manual/manual/foreword.etex +++ b/manual/manual/foreword.etex @@ -20,7 +20,7 @@ index of keywords. \end{latexonly} \end{itemize} -\section*{Conventions} +\section*{conventions}{Conventions} OCaml runs on several operating systems. The parts of this manual that are specific to one operating system are presented as @@ -34,7 +34,7 @@ systems, including Linux and \hbox{MacOS~X}. (XP, Vista, 7, 8, 10). \end{windows} -\section*{License} +\section*{license}{License} The OCaml system is copyright \copyright\ 1996--\number\year\ Institut National de Recherche en Informatique et en @@ -45,27 +45,26 @@ The OCaml system is open source and can be freely redistributed. See the file "LICENSE" in the distribution for licensing information. -The present documentation is copyright \copyright\ \number\year\ +The OCaml documentation and user's manual is +copyright \copyright\ \number\year\ Institut National de Recherche en Informatique et en -Automatique (INRIA). The OCaml documentation and user's -manual may be reproduced and distributed in whole or -in part, subject to the following conditions: -\begin{itemize} -\item The copyright notice above and this permission notice must be -preserved complete on all complete or partial copies. -\item Any translation or derivative work of the OCaml -documentation and user's manual must be approved by the authors in -writing before distribution. -\item If you distribute the OCaml -documentation and user's manual in part, instructions for obtaining -the complete version of this manual must be included, and a -means for obtaining a complete version provided. -\item Small portions may be reproduced as illustrations for reviews or -quotes in other works without this permission notice if proper -citation is given. -\end{itemize} +Automatique (INRIA). + +\begin{latexonly} +The OCaml documentation and user's manual is licensed under a Creative +Commons Attribution-ShareAlike 4.0 International License (CC BY-SA +4.0), \url{https://creativecommons.org/licenses/by-sa/4.0/}. +\end{latexonly} + +\begin{htmlonly} +\begin{rawhtml} + +The OCaml documentation and user's manual is licensed under a +Creative Commons Attribution-ShareAlike 4.0 International License. +\end{rawhtml} +\end{htmlonly} -\section*{Availability} +\section*{availability}{Availability} \begin{latexonly} The complete OCaml distribution can be accessed via the Web diff --git a/manual/manual/library/builtin.etex b/manual/manual/library/builtin.etex index 81c7f429..f63d3248 100644 --- a/manual/manual/library/builtin.etex +++ b/manual/manual/library/builtin.etex @@ -1,4 +1,4 @@ -\section{Built-in types and predefined exceptions} +\section{s:core-builtins}{Built-in types and predefined exceptions} The following built-in types and predefined exceptions are always defined in the @@ -6,7 +6,7 @@ compilation environment, but are not part of any module. As a consequence, they can only be referred by their short names. %\vspace{0.1cm} -\subsection*{Built-in types} +\subsection{ss:builtin-types}*{Built-in types} %\vspace{0.1cm} \begin{ocamldoccode} @@ -154,7 +154,7 @@ type 'a lazy_t \end{ocamldocdescription} %\vspace{0.1cm} -\subsection*{Predefined exceptions} +\subsection*{ss:predef-exn}{Predefined exceptions} %\vspace{0.1cm} \begin{ocamldoccode} @@ -215,8 +215,9 @@ exception Out_of_memory \end{ocamldoccode} \index{Outofmemory@\verb`Out_of_memory`} \begin{ocamldocdescription} - Exception raised by the garbage collector - when there is insufficient memory to complete the computation. + Exception raised by the garbage collector when there is + insufficient memory to complete the computation. (Not reliable for + allocations on the minor heap.) \end{ocamldocdescription} \begin{ocamldoccode} @@ -225,10 +226,9 @@ exception Stack_overflow \index{Stackoverflow@\verb`Stack_overflow`} \begin{ocamldocdescription} Exception raised by the bytecode interpreter when the evaluation - stack reaches its maximal size. This often indicates infinite - or excessively deep recursion in the user's program. - (Not fully implemented by the native-code compiler; - see section~\ref{s:compat-native-bytecode}.) + stack reaches its maximal size. This often indicates infinite or + excessively deep recursion in the user's program. Before 4.10, it + was not fully implemented by the native-code compiler. \end{ocamldocdescription} \begin{ocamldoccode} @@ -276,7 +276,7 @@ exception Undefined_recursive_module of (string * int * int) \index{Undefinedrecursivemodule@\verb`Undefined_recursive_module`} \begin{ocamldocdescription} Exception raised when an ill-founded recursive module definition - is evaluated. (See section~\ref{s-recursive-modules}.) + is evaluated. (See section~\ref{s:recursive-modules}.) The arguments are the location of the definition in the source code (file name, line number, column number). \end{ocamldocdescription} diff --git a/manual/manual/library/compilerlibs.etex b/manual/manual/library/compilerlibs.etex index e4fb5e3a..84d9919a 100644 --- a/manual/manual/library/compilerlibs.etex +++ b/manual/manual/library/compilerlibs.etex @@ -41,6 +41,7 @@ type\\*"#load \"compiler-libs/ocamlcommon.cma\";;". \end{links} \else +{\ocamldocinputstart % Ast_helper is excluded from the PDF and text manuals. % It is over 20 pages long and does not have doc-comments. It is expected % that Ast_helper will be only useful in the HTML manual (to look up signatures). @@ -53,5 +54,6 @@ type\\*"#load \"compiler-libs/ocamlcommon.cma\";;". \input{Parse.tex} \input{Parsetree.tex} \input{Pprintast.tex} +} % \input{Printast.tex} \fi diff --git a/manual/manual/library/core.etex b/manual/manual/library/core.etex index d3f31cd1..3d981633 100644 --- a/manual/manual/library/core.etex +++ b/manual/manual/library/core.etex @@ -15,7 +15,7 @@ unqualified identifiers to refer to the functions provided by the "Stdlib" module, without adding a "open Stdlib" directive. \end{itemize} -\section*{Conventions} +\section*{s:core-conventions}{Conventions} The declarations of the built-in types and the components of module "Stdlib" are printed one by one in typewriter font, followed by a @@ -23,14 +23,16 @@ short comment. All library modules and the components they provide are indexed at the end of this report. \input{builtin.tex} - \ifouthtml -\section{Module {\tt Stdlib}: the initially opened module} +\section{s:stdlib-module}{Module {\tt Stdlib}: the initially opened module} \begin{links} \item \ahref{libref/Stdlib.html}{Module \texttt{Stdlib}: the initially opened module} \item \ahref{libref/Pervasives.html}{Module \texttt{Pervasives}: deprecated alias for Stdlib} \end{links} \else +{ +\ocamldocinputstart \input{Stdlib.tex} +} \fi diff --git a/manual/manual/library/libstr.etex b/manual/manual/library/libstr.etex index 10015d80..180052fc 100644 --- a/manual/manual/library/libstr.etex +++ b/manual/manual/library/libstr.etex @@ -25,6 +25,7 @@ start "ocaml" and type "#load \"str.cma\";;". \end{links} \else +\ocamldocinputstart \input{Str.tex} \fi diff --git a/manual/manual/library/libunix.etex b/manual/manual/library/libunix.etex index 42ef42b5..ed79a74a 100644 --- a/manual/manual/library/libunix.etex +++ b/manual/manual/library/libunix.etex @@ -39,9 +39,11 @@ more information on the functions that are not supported under Windows. \end{windows} \begin{latexonly} +{ +\ocamldocinputstart \input{Unix.tex} -\section{Module \texttt{UnixLabels}: labelized version of the interface} +\section{s:Module \texttt{UnixLabels}: labelized version of the interface} \label{UnixLabels} \index{UnixLabels (module)@\verb~UnixLabels~ (module)}% @@ -50,6 +52,7 @@ the addition of labels. You may see these labels directly by looking at "unixLabels.mli", or by using the "ocamlbrowser" tool. \newpage +} \end{latexonly} \begin{windows} diff --git a/manual/manual/library/stdlib-blurb.etex b/manual/manual/library/stdlib-blurb.etex index dab6ca55..600177f4 100644 --- a/manual/manual/library/stdlib-blurb.etex +++ b/manual/manual/library/stdlib-blurb.etex @@ -15,7 +15,7 @@ provided by these modules, or to add "open" directives. \label{stdlib:top} -\section*{Conventions} +\section*{s:stdlib-conv}{Conventions} For easy reference, the modules are listed below in alphabetical order of module names. @@ -25,11 +25,11 @@ All modules and the identifiers they export are indexed at the end of this report. \begin{latexonly} -\section*{Overview} +\section*{s:stdlib-overview}{Overview} Here is a short listing, by theme, of the standard library modules. -\subsubsection*{Data structures:} +\subsubsection*{sss:stdlib-data-structures}{Data structures:} \begin{tabular}{lll} % Beware: these entries must be written in a very rigidly-defined % format, or the check-stdlib-modules script will complain. @@ -63,7 +63,7 @@ from being garbage-collected \\ "Ephemeron" & p.~\pageref{Ephemeron} & ephemerons and weak hash tables \\ "Bigarray" & p.~\pageref{Bigarray} & large, multi-dimensional, numerical arrays \end{tabular} -\subsubsection*{Arithmetic:} +\subsubsection*{sss:stdlib-arith}{Arithmetic:} \begin{tabular}{lll} "Complex" & p.~\pageref{Complex} & Complex numbers \\ "Float" & p.~\pageref{Float} & Floating-point numbers \\ @@ -72,7 +72,7 @@ from being garbage-collected \\ "Nativeint" & p.~\pageref{Nativeint} & operations on platform-native integers \end{tabular} -\subsubsection{Input/output:} +\subsubsection{sss:stdlib-io}{Input/output:} \begin{tabular}{lll} "Format" & p.~\pageref{Format} & pretty printing with automatic indentation and line breaking \\ @@ -81,14 +81,14 @@ indentation and line breaking \\ "Scanf" & p.~\pageref{Scanf} & formatted input functions \\ "Digest" & p.~\pageref{Digest} & MD5 message digest \\ \end{tabular} -\subsubsection{Parsing:} +\subsubsection{sss:stdlib-parsing}{Parsing:} \begin{tabular}{lll} "Genlex" & p.~\pageref{Genlex} & a generic lexer over streams \\ "Lexing" & p.~\pageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\ "Parsing" & p.~\pageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\ "Stream" & p.~\pageref{Stream} & basic functions over streams \\ \end{tabular} -\subsubsection{System interface:} +\subsubsection{sss:stdlib-system}{System interface:} \begin{tabular}{lll} "Arg" & p.~\pageref{Arg} & parsing of command line arguments \\ "Callback" & p.~\pageref{Callback} & registering OCaml functions to @@ -99,7 +99,7 @@ be called from C \\ "Spacetime" & p.~\pageref{Spacetime} & memory profiler \\ "Sys" & p.~\pageref{Sys} & system interface \\ \end{tabular} -\subsubsection{Misc:} +\subsubsection{sss:stdlib-misc}{Misc:} \begin{tabular}{lll} "Fun" & p.~\pageref{Fun} & function values \\ \end{tabular} @@ -161,6 +161,7 @@ be called from C \\ \item \ahref{libref/Weak.html}{Module \texttt{Weak}: arrays of weak pointers} \end{links} \else +{\ocamldocinputstart \input{Arg.tex} \input{Array.tex} \input{ArrayLabels.tex} @@ -214,4 +215,5 @@ be called from C \\ \input{Unit.tex} \input{Weak.tex} \input{Ocamloperators.tex} +} \fi diff --git a/manual/manual/macros.hva b/manual/manual/macros.hva index bbaf4e56..f98139ce 100644 --- a/manual/manual/macros.hva +++ b/manual/manual/macros.hva @@ -1,10 +1,61 @@ +% Section macros with mandatory labels +% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side + +% First, we save the normal macros +\let\@oldsection=\section +\let\@oldsubsection=\subsection +\let\@oldsubsubsection=\subsubsection +% The *-version are distincts macros in hevea +\let\@oldsection*=\section* +\let\@oldsubsection*=\subsection* +\let\@oldsubsubsection*=\subsubsection* + +%We go back to standard macros for ocamldoc generated files +\newcommand{\ocamldocinputstart}{% +\let\section=\@oldsection +\let\subsection=\@oldsubsection +\let\subsubsection=\@oldsubsubsection +% The *-version are distincts macros in hevea +\let\section*=\@oldsection* +\let\subsection*=\@oldsubsection* +\let\subsubsection*=\@oldsubsubsection* +} + +\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}} +\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}} +\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}} +\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}} +\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}} +\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}} + +% For paragraph, we do not make labels compulsory +\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}} + % Colors for links + +\newstyle{a.section-anchor::after}{ + content:"\@print@u{128279}"; + font-size:smaller; + margin-left:-1.5em; + padding-right:0.5em; +} + + +\newstyle{a.section-anchor}{ + visibility:hidden; + color:grey !important; + text-decoration:none !important; +} + +\newstyle{*:hover>a.section-anchor}{ + visibility:visible; +} + \def\visited@color{\#0d46a3} \def\link@color{\#4286f4} -\def\hover@color{\@getstylecolor{subsection}} \newstyle{a:link}{color:\link@color;text-decoration:underline;} \newstyle{a:visited}{color:\visited@color;text-decoration:underline;} -\newstyle{a:hover}{color:black;text-decoration:underline;background-color:\hover@color} +\newstyle{a:hover}{color:black;text-decoration:underline;} \newstyle{@media all}{@font-face \{ @@ -43,13 +94,58 @@ border-bottom: 1px solid black; } -\newstyle{pre}{ + +\newstyle{div.ocaml}{ + margin:2ex 0px; font-size: 1rem; background: beige; border: 1px solid grey; padding: 10px; overflow-y:auto; - white-space: pre-wrap; + display:flex; + flex-direction: column; + flex-wrap: nowrap; +} + +\newstyle{div.ocaml .pre}{ + white-space: pre; + font-family:mono; +} + + + +\newstyle{.ocamlkeyword}{ + font-weight:bold; +} + + +\newstyle{.ocamlhighlight}{ + font-weight:bold; + text-decoration:underline; +} + +\newstyle{.ocamlerror}{ + font-weight:bold; + color:red; +} + +\newstyle{.ocamlwarning}{ + font-weight:bold; + color:purple; +} + +\newstyle{.ocamlcomment}{ + color:grey; +} + +\newstyle{.ocamlstring}{ + opacity:0.75; +} + +% Creative commons license logo +\newstyle{\#cc_license_logo}{ + float:left; + margin-right: 1em; } % More spacing between lines and inside tables @@ -58,12 +154,12 @@ %Styles for caml-example and friends \newstyle{div.caml-output}{color:maroon;} -\newstyle{div.caml-example pre}{margin:2ex 0px;} % Styles for toplevel mode only \newstyle{div.caml-example.toplevel div.caml-input::before} {content:"\#"; color:black;} \newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;} -%%% + +%%% Code examples \newcommand{\input@color}{\htmlcolor{006000}} \newcommand{\output@color}{\maroon} \newcommand{\machine}{\tt} @@ -73,14 +169,10 @@ \newcommand{\nextline}{\examplespace\ } \newcommand{\@zyva}{\firstline\renewcommand{\?}{\nextline}} \let\?=\@zyva -\newenvironment{camlunder}{\@style{U}}{} -\newcommand{\caml}{\begin{alltt}\renewcommand{\;}{}\renewcommand{\\}{\char92}\def\<{\begin{camlunder}}\def\>{\end{camlunder}}\activebracefalse} -\newcommand{\endcaml}{\activebracetrue\end{alltt} -} \renewcommand{\:}{\renewcommand{\?}{\@zyva}} \newcommand{\var}[1]{\textit{#1}} -% Caml-example environment +%% Caml-example environment \newcommand{\camlexample}[1]{ \ifthenelse{\equal{#1}{toplevel}} {\renewcommand{\examplespace}{\ }} @@ -93,14 +185,16 @@ \renewcommand{\examplespace}{\ } } -\newcommand{\camlinput}{\@open{div}{class="caml-input"}} -\newcommand{\endcamlinput}{\@close{div}} -\newcommand{\camloutput}{\@open{div}{class="caml-output ok"}} -\newcommand{\endcamloutput}{\@close{div}} -\newcommand{\camlerror}{\@open{div}{class="caml-output error"}} -\newcommand{\endcamlerror}{\@close{div}} -\newcommand{\camlwarn}{\@open{div}{class="caml-output warn"}} -\newcommand{\endcamlwarn}{\@close{div}} +\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}} +\newcommand{\ocamlkeyword}{\@span{class="ocamlkeyword"}} +\newcommand{\ocamlhighlight}{\@span{class="ocamlhighlight"}} +\newcommand{\ocamlerror}{\@span{class="ocamlerror"}} +\newcommand{\ocamlwarning}{\@span{class="ocamlwarning"}} +\newcommand{\ocamlcomment}{\@span{class="ocamlcomment"}} +\newcommand{\ocamlstring}{\@span{class="ocamlstring"}} + + +%%% End of code example \newenvironment{library}{}{} \newcounter{page} @@ -184,7 +278,7 @@ \newcommand{\vfill}{} \def\number{} -\def\year{2019} +\def\year{\arabic{year}} % Pour alltt \def\rminalltt#1{{\rm #1}} diff --git a/manual/manual/macros.tex b/manual/manual/macros.tex index 471861f8..553e6dd5 100644 --- a/manual/manual/macros.tex +++ b/manual/manual/macros.tex @@ -1,4 +1,5 @@ \makeatletter + % Pour hevea \newif\ifouthtml\outhtmlfalse \newcommand{\cutname}[1]{} @@ -10,6 +11,31 @@ \def\event{$\bowtie$} \def\fromoneto#1#2{$#1 = 1, \ldots, #2$} + +% Redefining sections macros to make label mandatory +\let\@oldsection=\section +\let\@oldsubsection=\subsection +\let\@oldsubsubsection=\subsection + +\newcommand{\ocamldocinputstart}{ +\let\section=\@oldsection +\let\subsection=\@oldsubsection +\let\subsubsection=\@oldsubsubsection +} + +\renewcommand{\section}{\@ifstar{\@lsectionstar}{\@lsection}} +\renewcommand{\subsection}{\@ifstar{\@lsubsectionstar}{\@lsubsection}} +\renewcommand{\subsubsection}{\@ifstar{\@lsubsubsectionstar}{\@lsubsubsection}} + +\newcommand{\@lsection}[2]{\@oldsection{\label{#1}#2}} +\newcommand{\@lsectionstar}[2]{\@oldsection*{\label{#1}#2}} +\newcommand{\@lsubsection}[2]{\@oldsubsection{\label{#1}#2}} +\newcommand{\@lsubsectionstar}[2]{\@oldsubsection*{\label{#1}#2}} +\newcommand{\@lsubsubsection}[2]{\@oldsubsubsection{\label{#1}#2}} +\newcommand{\@lsubsubsectionstar}[2]{\@oldsubsubsection*{\label{#1}#2}} + +\newcommand{\lparagraph}[1]{\paragraph{\label{#1}#1}} + % Numerotation \setcounter{secnumdepth}{2} % Pour numeroter les \subsection \setcounter{tocdepth}{1} % Pour ne pas mettre les \subsection @@ -205,4 +231,27 @@ \newenvironment{maintitle}{\begin{center}}{\end{center}} + + +% Caml-example related command +\newenvironment{camlexample}[1]{ + \ifnum\pdfstrcmp{#1}{toplevel}=0 + \renewcommand{\hash}{\#} + \else + \renewcommand{\hash}{} + \fi +}{} +\newenvironment{caml}{}{} +\newcommand{\ocamlkeyword}{\bfseries} +\newcommand{\ocamlhighlight}{\bfseries\uline} +\newcommand{\ocamlerror}{\bfseries} +\newcommand{\ocamlwarning}{\bfseries} + +\definecolor{gray}{gray}{0.5} +\newcommand{\ocamlcomment}{\color{gray}\normalfont\small} +\newcommand{\ocamlstring}{\color{gray}\bfseries} + +\newcommand{\?}{\normalsize\tt\hash{} } +\renewcommand{\:}{\small\ttfamily\slshape} + \makeatother diff --git a/manual/manual/manual.hva b/manual/manual/manual.hva index 942dde96..62e2dbc9 100644 --- a/manual/manual/manual.hva +++ b/manual/manual/manual.hva @@ -1,3 +1,3 @@ -\input{book.hva} +\input{anchored_book.hva} \input{macros.hva} \newif\ifouthtml\outhtmltrue diff --git a/manual/manual/manual.inf b/manual/manual/manual.inf index 65f64104..ed1f50fa 100644 --- a/manual/manual/manual.inf +++ b/manual/manual/manual.inf @@ -4,18 +4,19 @@ \newcommand{\machine}{\tt} \newenvironment{machineenv}{\begin{alltt}}{\end{alltt}} \newenvironment{camlunder}{\@style{U}}{} -\newcommand{\caml}{\begin{alltt}\renewcommand{\\}{\char92}\def\<{\begin{camlunder}}\def\>{\end{camlunder}}\activebracefalse} -\newcommand{\endcaml}{\activebracetrue\end{alltt}} \newcommand{\?}{\black\#\blue } \renewcommand{\:}{\maroon} -\def\camlinput{} -\def\endcamlinput{} -\def\camloutput{} -\def\endcamloutput{} -\def\camlerror{} -\def\endcamlerror{} -\def\camlwarn{} -\def\endcamlwarn{} + +\newcommand{\ocamlkeyword}{\bfseries} +\newcommand{\ocamlhighlight}{\bfseries\underline} +\newcommand{\ocamlerror}{\bfseries} +\newcommand{\ocamlwarning}{\bfseries} +\newcommand{\ocamlcomment}{\normalfont\small} +\newcommand{\ocamlstring}{\bfseries} + +\newenvironment{caml}{\begin{alltt}}{\\\end{alltt}} +\newenvironment{camlexample}[1]{}{} + \newcommand{\var}[1]{\textit{#1}} \newenvironment{library}{}{} @@ -24,6 +25,38 @@ \newcommand{\nth}[2]{\({#1}_{#2}\)} \newenvironment{options}{\begin{description}}{\end{description}} +% Section macros with mandatory labels +% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side + +% First, we save the normal macros +\let\@oldsection=\section +\let\@oldsubsection=\subsection +\let\@oldsubsubsection=\subsubsection +% The *-version are distincts macros in hevea +\let\@oldsection*=\section* +\let\@oldsubsection*=\subsection* +\let\@oldsubsubsection*=\subsubsection* + +%We go back to standard macros for ocamldoc generated files +\newcommand{\ocamldocinputstart}{% +\let\section=\@oldsection +\let\subsection=\@oldsubsection +\let\subsubsection=\@oldsubsubsection +% The *-version are distincts macros in hevea +\let\section*=\@oldsection* +\let\subsection*=\@oldsubsection* +\let\subsubsection*=\@oldsubsubsection* +} + +\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}} +\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}} +\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}} +\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}} +\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}} +\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}} + +% For paragraph, we do not make labels compulsory +\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}} %%venant de macros.tex \newif\ifouthtml\outhtmlfalse diff --git a/manual/manual/manual.tex b/manual/manual/manual.tex index dbdc5698..5fce5c66 100644 --- a/manual/manual/manual.tex +++ b/manual/manual/manual.tex @@ -3,17 +3,109 @@ \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} % HEVEA\@def@charset{UTF-8}% -\usepackage{alltt} \usepackage{fullpage} \usepackage{syntaxdef} \usepackage{multind} \usepackage{html} \usepackage{textcomp} -\usepackage{caml-sl} \usepackage{ocamldoc} \usepackage{xspace} +\usepackage{color} + +% Package for code examples: +\usepackage{listings} +\usepackage{alltt} +\usepackage{lmodern}% for supporting bold ttfamily in code examples +\usepackage[normalem]{ulem}% for underlining errors in code examples \input{macros.tex} +\newcommand{\hash}{\#} +\lstnewenvironment{camloutput}{ + \lstset{ + basicstyle=\small\ttfamily\slshape, + showstringspaces=false, + language=caml, + escapeinside={$}{$}, + columns=fullflexible, + stringstyle=\ocamlstring, + keepspaces=true, + keywordstyle=\ocamlkeyword, + keywords={[2]{val}}, keywordstyle={[2]\ocamlkeyword}, + aboveskip=0\baselineskip, + } +\ifouthtml + \setenvclass{lstlisting}{pre caml-output ok} + \lstset {basicstyle=\ttfamily} +\else + \lstset{ + upquote=true, + literate={'"'}{\textquotesingle "\textquotesingle}3 + {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4, +} +\fi +}{} + +\lstnewenvironment{camlinput}{ + \lstset{ + basicstyle=\ttfamily, + showstringspaces=false, + language=caml, + escapeinside={$}{$}, + columns=fullflexible, + stringstyle=\ocamlstring, + commentstyle=\ocamlcomment, + keepspaces=true, + keywordstyle=\ocamlkeyword, + moredelim=[is][\ocamlhighlight]{<<}{>>}, + moredelim=[s][\ocamlstring]{\{|}{|\}}, + moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}}, + keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword}, + belowskip=0\baselineskip + } +\ifouthtml + \setenvclass{lstlisting}{pre caml-input} +\else +%not implemented in hevea: upquote and literate + \lstset{ + upquote=true, + literate={'"'}{\textquotesingle "\textquotesingle}3 + {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4, +} +\fi +}{} + +\lstnewenvironment{camlerror}{ + \lstset{ + escapeinside={$}{$}, + showstringspaces=false, + basicstyle=\small\ttfamily\slshape, + emph={Error}, emphstyle={\ocamlerror}, + } +\ifouthtml + \setenvclass{lstlisting}{pre caml-output error} + \lstset { basicstyle=\ttfamily } +\else +\lstset{upquote=true} +\fi +} +{} + +\lstnewenvironment{camlwarn}{ + \lstset{ + escapeinside={$}{$}, + showstringspaces=false, + basicstyle=\small\ttfamily\slshape, + emph={Warning}, emphstyle={\ocamlwarning}, + } +\ifouthtml +\setenvclass{lstlisting}{pre caml-output warn} +\lstset { basicstyle=\ttfamily } +\else +\lstset{upquote=true} +\fi +}{} + + % Add meta tag to the generated head tag \ifouthtml @@ -30,11 +122,10 @@ %\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother \def\th{^{\hbox{\scriptsize th}}} + \raggedbottom \input{version.tex} %HEVEA\tocnumber %HEVEA\setcounter{cuttingdepth}{1} %HEVEA\title{The OCaml system, release \ocamlversion} \input{allfiles.tex} - - diff --git a/manual/manual/refman/classes.etex b/manual/manual/refman/classes.etex index d9ee57bc..2a59f949 100644 --- a/manual/manual/refman/classes.etex +++ b/manual/manual/refman/classes.etex @@ -1,9 +1,9 @@ -\section{Classes} +\section{s:classes}{Classes} %HEVEA\cutname{classes.html} Classes are defined using a small language, similar to the module language. -\subsection{Class types} +\subsection{ss:classes:class-types}{Class types} Class types are the class-level equivalent of type expressions: they specify the general shape and type properties of classes. @@ -41,7 +41,7 @@ See also the following language extensions: \hyperref[s:attributes]{attributes} and \hyperref[s:extension-nodes]{extension nodes}. -\subsubsection*{Simple class expressions} +\subsubsection*{sss:clty:simple}{Simple class expressions} The expression @classtype-path@ is equivalent to the class type bound to the name @classtype-path@. Similarly, the expression @@ -50,14 +50,14 @@ the parametric class type bound to the name @classtype-path@, in which type parameters have been instantiated to respectively @typexpr_1@, \ldots @typexpr_n@. -\subsubsection*{Class function type} +\subsubsection*{sss:clty-fun}{Class function type} The class type expression @typexpr '->' class-type@ is the type of class functions (functions from values to classes) that take as argument a value of type @typexpr@ and return as result a class of type @class-type@. -\subsubsection*{Class body type} +\subsubsection*{sss:clty:body}{Class body type} The class type expression @'object' ['(' typexpr ')'] {class-field-spec} 'end'@ @@ -75,11 +75,11 @@ virtual method will match a concrete method, which makes it possible to forget its implementation. An immutable instance variable will match a mutable instance variable. -\subsubsection*{Local opens} +\subsubsection*{sss:clty-open}{Local opens} Local opens are supported in class types since OCaml 4.06. -\subsubsection*{Inheritance} +\subsubsection*{sss:clty-inheritance}{Inheritance} \ikwd{inherit\@\texttt{inherit}} @@ -88,7 +88,7 @@ methods and instance variables from other class types. The instance variable and method types from @class-body-type@ are added into the current class type. -\subsubsection*{Instance variable specification} +\subsubsection*{sss:clty-variable}{Instance variable specification} \ikwd{val\@\texttt{val}} \ikwd{mutable\@\texttt{mutable}} @@ -107,8 +107,7 @@ initialized. It can be initialized later through inheritance. An instance variable specification will hide any previous specification of an instance variable of the same name. -\subsubsection*{Method specification} -\label{sec-methspec} +\subsubsection*{sss:clty-meth}{Method specification} \ikwd{method\@\texttt{method}} \ikwd{private\@\texttt{private}} @@ -129,7 +128,7 @@ If several specifications are present for the same method, they must have compatible types. Any non-private specification of a method forces it to be public. -\subsubsection*{Virtual method specification} +\subsubsection*{sss:class-virtual-meth-spec}{Virtual method specification} \ikwd{method\@\texttt{method}} \ikwd{private\@\texttt{private}} @@ -138,7 +137,7 @@ A virtual method specification is written @'method' ['private'] 'virtual' method-name ':' poly-typexpr@, where @method-name@ is the name of the method and @poly-typexpr@ its expected type. -\subsubsection*{Constraints on type parameters} +\subsubsection*{sss:class-constraints}{Constraints on type parameters} \ikwd{constraint\@\texttt{constraint}} @@ -147,7 +146,7 @@ type expressions to be equal. This is typically used to specify type parameters: in this way, they can be bound to specific type expressions. -\subsection{Class expressions} +\subsection{ss:class-expr}{Class expressions} Class expressions are the class-level equivalent of value expressions: they evaluate to classes, thus providing implementations for the @@ -203,7 +202,7 @@ See also the following language extensions: \hyperref[s:attributes]{attributes} and \hyperref[s:extension-nodes]{extension nodes}. -\subsubsection*{Simple class expressions} +\subsubsection*{sss:class-simple}{Simple class expressions} The expression @class-path@ evaluates to the class bound to the name @class-path@. Similarly, the expression @@ -222,7 +221,7 @@ implementation @class-expr@ meets the type specification @class-expr@, except that all components not specified in @class-type@ are hidden and can no longer be accessed. -\subsubsection*{Class application} +\subsubsection*{sss:class-app}{Class application} Class application is denoted by juxtaposition of (possibly labeled) expressions. It denotes the class whose constructor is the first @@ -232,7 +231,7 @@ only be evaluated when objects are created. In particular, side-effects caused by the application of the constructor will only occur at object creation time. -\subsubsection*{Class function} +\subsubsection*{sss:class-fun}{Class function} The expression @'fun' [['?']label-name':']pattern '->' class-expr@ evaluates to a function from values to classes. @@ -253,7 +252,7 @@ is a short form for @"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@ \end{center} -\subsubsection*{Local definitions} +\subsubsection*{sss:class-localdefs}{Local definitions} The {\tt let} and {\tt let rec} constructs bind value names locally, as for the core language expressions. @@ -263,11 +262,11 @@ definition, it will be evaluated when the class is created (just as if the definition was outside of the class). Otherwise, it will be evaluated when the object constructor is called. -\subsubsection*{Local opens} +\subsubsection*{sss:class-opens}{Local opens} Local opens are supported in class expressions since OCaml 4.06. -\subsubsection*{Class\label{ss:class-body} body} +\subsubsection*{sss:class-body}{Class body} \begin{syntax} class-body: ['(' pattern [':' typexpr] ')'] { class-field } \end{syntax} @@ -289,7 +288,7 @@ extensible. Since OCaml 4.01, it is an error if the same method or instance variable name is defined several times in the same class body. -\subsubsection*{Inheritance} +\subsubsection*{sss:class-inheritance}{Inheritance} \ikwd{inherit\@\texttt{inherit}} @@ -310,7 +309,7 @@ redefined in the current class. The scope of this ancestor binding is limited to the current class. The ancestor method may be called from a subclass but only indirectly. -\subsubsection*{Instance variable definition} +\subsubsection*{sss:class-variables}{Instance variable definition} \ikwd{val\@\texttt{val}} \ikwd{mutable\@\texttt{mutable}} @@ -333,7 +332,7 @@ However, if an instance variable is hidden by omitting it from an interface, it will be kept distinct from other instance variables with the same name. -\subsubsection*{Virtual instance variable definition} +\subsubsection*{sss:class-virtual-variable}{Virtual instance variable definition} \ikwd{val\@\texttt{val}} \ikwd{mutable\@\texttt{mutable}} @@ -344,7 +343,7 @@ modifiable, and gives its type. Virtual instance variables were added in version 3.10. -\subsubsection*{Method definition} +\subsubsection*{sss:class-method}{Method definition} \ikwd{method\@\texttt{method}} \ikwd{private\@\texttt{private}} @@ -396,7 +395,7 @@ instance variables @inst-var-name_1, \ldots, inst-var-name_n@ have been replaced by the values of the corresponding expressions @expr_1, \ldots, expr_n@. -\subsubsection*{Virtual method definition} +\subsubsection*{sss:class-virtual-meth}{Virtual method definition} \ikwd{method\@\texttt{method}} \ikwd{private\@\texttt{private}} @@ -406,7 +405,7 @@ method-name ':' poly-typexpr@. It specifies whether the method is public or private, and gives its type. If the method is intended to be polymorphic, the type must be explicitly polymorphic. -\subsubsection*{Explicit overriding} +\subsubsection*{sss:class-explicit-overriding}{Explicit overriding} Since Ocaml 3.12, the keywords @"inherit!"@, @"val!"@ and @"method!"@ have the same semantics as @"inherit"@, @"val"@ and @"method"@, but @@ -421,7 +420,7 @@ As a side-effect, these 3 keywords avoid the warnings~7 (method override) and~13 (instance variable override). Note that warning~7 is disabled by default. -\subsubsection*{Constraints on type parameters} +\subsubsection*{sss:class-type-constraints}{Constraints on type parameters} \ikwd{constraint\@\texttt{constraint}} The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two @@ -429,7 +428,7 @@ type expressions to be equals. This is typically used to specify type parameters: in that way they can be bound to specific type expressions. -\subsubsection*{Initializers} +\subsubsection*{sss:class-initializers}{Initializers} \ikwd{initializer\@\texttt{initializer}} @@ -437,7 +436,7 @@ A class initializer @'initializer' expr@ specifies an expression that will be evaluated whenever an object is created from the class, once all its instance variables have been initialized. -\subsection{Class definitions} +\subsection{ss:class-def}{Class definitions} \label{s:classdef} \ikwd{class\@\texttt{class}} @@ -466,15 +465,15 @@ the type of the class, and defines two type abbreviations : @class-name@ and @'#' class-name@. The first one is the type of objects of this class, while the second is more general as it unifies with the type of any object belonging to a subclass (see -section~\ref{s:sharp-types}). +section~\ref{sss:typexpr-sharp-types}). -\subsubsection*{Virtual class} +\subsubsection*{sss:class-virtual}{Virtual class} A class must be flagged virtual if one of its methods is virtual (that is, appears in the class type, but is not actually defined). Objects cannot be created from a virtual class. -\subsubsection*{Type parameters} +\subsubsection*{sss:class-type-params}{Type parameters} The class type parameters correspond to the ones of the class type and of the two type abbreviations defined by the class binding. They must @@ -483,8 +482,7 @@ constraints. So that the abbreviations are well-formed, type variables of the inferred type of the class must either be type parameters or be bound in the constraint clause. -\subsection{Class specifications} -\label{s:class-spec} +\subsection{ss:class-spec}{Class specifications} \ikwd{class\@\texttt{class}} \ikwd{and\@\texttt{and}} @@ -502,8 +500,7 @@ This is the counterpart in signatures of class definitions. A class specification matches a class definition if they have the same type parameters and their types match. -\subsection{Class type definitions} -\label{s:classtype} +\subsection{ss:classtype}{Class type definitions} \ikwd{class\@\texttt{class}} \ikwd{type\@\texttt{type}} diff --git a/manual/manual/refman/compunit.etex b/manual/manual/refman/compunit.etex index 14d5d996..2e85f890 100644 --- a/manual/manual/refman/compunit.etex +++ b/manual/manual/refman/compunit.etex @@ -1,4 +1,4 @@ -\section{Compilation units} +\section{s:compilation-units}{Compilation units} %HEVEA\cutname{compunit.html} \begin{syntax} diff --git a/manual/manual/refman/const.etex b/manual/manual/refman/const.etex index 9789522c..eca507ed 100644 --- a/manual/manual/refman/const.etex +++ b/manual/manual/refman/const.etex @@ -1,4 +1,4 @@ -\section{Constants} +\section{s:const}{Constants} %HEVEA\cutname{const.html} \ikwd{false\@\texttt{false}} @@ -25,7 +25,7 @@ constant: | "`"tag-name \end{syntax} See also the following language extension: -\hyperref[s:extension-literals]{extension literals}. +\hyperref[ss:extension-literals]{extension literals}. The syntactic class of constants comprises literals from the four base types (integers, floating-point numbers, characters, character diff --git a/manual/manual/refman/expr.etex b/manual/manual/refman/expr.etex index 30b7b05d..1a273733 100644 --- a/manual/manual/refman/expr.etex +++ b/manual/manual/refman/expr.etex @@ -1,4 +1,4 @@ -\section{Expressions\label{s:value-expr}} +\section{s:value-expr}{Expressions} %HEVEA\cutname{expr.html} \ikwd{in\@\texttt{in}|see{\texttt{let}}} \ikwd{and\@\texttt{and}} @@ -113,14 +113,14 @@ parameter: | '?' label-name ':' '(' pattern [':' typexpr] ['=' expr] ')' \end{syntax} See also the following language extensions: -\hyperref[s-first-class-modules]{first-class modules}, +\hyperref[s:first-class-modules]{first-class modules}, \hyperref[s:explicit-overriding-open]{overriding in open statements}, \hyperref[s:bigarray-access]{syntax for Bigarray access}, \hyperref[s:attributes]{attributes}, \hyperref[s:extension-nodes]{extension nodes} and \hyperref[s:index-operators]{extended indexing operators}. -\subsection{Precedence and associativity} +\subsection{ss:precedence-and-associativity}{Precedence and associativity} The table below shows the relative precedences and associativity of operators and non-closed constructions. The constructions with higher precedence come first. For infix and prefix symbols, we write @@ -165,19 +165,19 @@ precedence come first. For infix and prefix symbols, we write \entree{"let match fun function try"}{--} \end{tableau} -\subsection{Basic expressions} +\subsection{ss:expr-basic}{Basic expressions} -\subsubsection*{Constants} +\subsubsection*{sss:expr-constants}{Constants} An expression consisting in a constant evaluates to this constant. -\subsubsection*{Value paths} \label{expr:var} +\subsubsection*{sss:expr-var}{Value paths} An expression consisting in an access path evaluates to the value bound to this path in the current evaluation environment. The path can be either a value name or an access path to a value component of a module. -\subsubsection*{Parenthesized expressions} +\subsubsection*{sss:expr-parenthesized}{Parenthesized expressions} \ikwd{begin\@\texttt{begin}} \ikwd{end\@\texttt{end}} @@ -195,10 +195,10 @@ compatible with @typexpr@. Parenthesized expressions can also contain coercions @'(' expr [':' typexpr] ':>' typexpr')'@ (see -subsection~\ref{s:coercions} below). +subsection~\ref{ss:expr-coercions} below). -\subsubsection*{Function application} +\subsubsection*{sss:expr-functions-application}{Function application} Function application is denoted by juxtaposition of (possibly labeled) expressions. The expression @expr argument_1 \ldots argument_n@ @@ -240,7 +240,7 @@ parameters, the function type should be known at the application point. This can be ensured by adding a type constraint. Principality of the derivation can be checked in the "-principal" mode. -\subsubsection*{Function definition} +\subsubsection*{sss:expr-function-definition}{Function definition} Two syntactic forms are provided to define functions. The first form is introduced by the keyword "function": @@ -332,7 +332,7 @@ If the matching succeeds, the function returns the value of @expr@ in an environment enriched by the bindings performed during the matchings. If the matching fails, the exception "Match_failure" is raised. -\subsubsection*{Guards in pattern-matchings} +\subsubsection*{sss:guards-in-pattern-matchings}{Guards in pattern-matchings} \ikwd{when\@\texttt{when}} The cases of a pattern matching (in the @"function"@, @"match"@ and @@ -356,7 +356,7 @@ then @expr_i@ is evaluated and its value returned as the result of the matching, as usual. But if @@cond@_i@ evaluates to "false", the matching is resumed against the patterns following @pattern_i@. -\subsubsection*{Local definitions} \label{s:localdef} +\subsubsection*{sss:expr-localdef}{Local definitions} \ikwd{let\@\texttt{let}} @@ -416,7 +416,7 @@ The behavior of other forms of @"let" "rec"@ definitions is implementation-dependent. The current implementation also supports a certain class of recursive definitions of non-functional values, as explained in section~\ref{s:letrecvalues}. -\subsubsection{Explicit polymorphic type annotations} +\subsubsection{sss:expr-explicit-polytype}{Explicit polymorphic type annotations} (Introduced in OCaml 3.12) Polymorphic type annotations in @"let"@-definitions behave in a way @@ -444,14 +444,14 @@ true: let () = assert(gen () <> gen ()) \end{verbatim} -\subsection{Control structures} +\subsection{ss:expr-control}{Control structures} -\subsubsection*{Sequence} +\subsubsection*{sss:expr-sequence}{Sequence} The expression @expr_1 ";" expr_2@ evaluates @expr_1@ first, then @expr_2@, and returns the value of @expr_2@. -\subsubsection*{Conditional} +\subsubsection*{sss:expr-conditional}{Conditional} \ikwd{if\@\texttt{if}} The expression @"if" expr_1 "then" expr_2 "else" expr_3@ evaluates to @@ -462,7 +462,7 @@ and to the value of @expr_3@ if @expr_1@ evaluates to the boolean The @"else" expr_3@ part can be omitted, in which case it defaults to @"else" "()"@. -\subsubsection*{Case expression}\ikwd{match\@\texttt{match}} +\subsubsection*{sss:expr-case}{Case expression}\ikwd{match\@\texttt{match}} The expression $$\begin{array}{rlll} @@ -483,7 +483,7 @@ exception "Match_failure" is raised. % \index{Matchfailure\@\verb`Match_failure`} -\subsubsection*{Boolean operators} +\subsubsection*{sss:expr-boolean-operators}{Boolean operators} The expression @expr_1 '&&' expr_2@ evaluates to @'true'@ if both @expr_1@ and @expr_2@ evaluate to @'true'@; otherwise, it evaluates to @@ -510,7 +510,7 @@ exactly as The boolean operators @'&'@ and @'or'@ are deprecated synonyms for (respectively) @'&&'@ and @'||'@. -\subsubsection*{Loops} +\subsubsection*{sss:expr-loops}{Loops} \ikwd{while\@\texttt{while}} The expression @'while' expr_1 'do' expr_2 'done'@ repeatedly @@ -538,7 +538,7 @@ evaluates similarly, except that @name@ is successively bound to the values In both cases, the whole @'for'@ expression evaluates to the unit value @'()'@. -\subsubsection*{Exception handling} +\subsubsection*{sss:expr-exception-handling}{Exception handling} \ikwd{try\@\texttt{try}} The expression @@ -561,15 +561,15 @@ selected. If none of the patterns matches the value of @expr@, the exception value is raised again, thereby transparently ``passing through'' the @'try'@ construct. -\subsection{Operations on data structures} +\subsection{ss:expr-ops-on-data}{Operations on data structures} -\subsubsection*{Products} +\subsubsection*{sss:expr-products}{Products} The expression @expr_1 ',' \ldots ',' expr_n@ evaluates to the \var{n}-tuple of the values of expressions @expr_1@ to @expr_n@. The evaluation order of the subexpressions is not specified. -\subsubsection*{Variants} +\subsubsection*{sss:expr-variants}{Variants} The expression @constr expr@ evaluates to the unary variant value whose constructor is @constr@, and whose argument is the value of @@ -591,12 +591,12 @@ expr_n ']'@ is equivalent to @expr_1 '::' \ldots '::' expr_n '::' '[]'@, and therefore evaluates to the list whose elements are the values of @expr_1@ to @expr_n@. -\subsubsection*{Polymorphic variants} +\subsubsection*{sss:expr-polyvars}{Polymorphic variants} The expression @"`"tag-name expr@ evaluates to the polymorphic variant value whose tag is @tag-name@, and whose argument is the value of @expr@. -\subsubsection*{Records} +\subsubsection*{sss:expr-records}{Records} The expression @'{' field_1 ['=' expr_1] ';' \ldots ';' field_n ['=' expr_n ']}'@ evaluates to the record value @@ -641,7 +641,7 @@ declared @'mutable'@ in the definition of the record type. The whole expression @expr_1 '.' field '<-' expr_2@ evaluates to the unit value @'()'@. -\subsubsection*{Arrays} +\subsubsection*{sss:expr-arrays}{Arrays} The expression @'[|' expr_1 ';' \ldots ';' expr_n '|]'@ evaluates to a \var{n}-element array, whose elements are initialized with the values of @@ -659,7 +659,7 @@ the array denoted by @expr_1@, replacing element number @expr_2@ by the value of @expr_3@. The exception "Invalid_argument" is raised if the access is out of bounds. The value of the whole expression is @'()'@. -\subsubsection*{Strings} +\subsubsection*{sss:expr-strings}{Strings} The expression @expr_1 '.[' expr_2 ']'@ returns the value of character number @expr_2@ in the string denoted by @expr_1@. The first character @@ -677,7 +677,7 @@ compatibility with older versions of OCaml and will be removed in a future version. New code should use byte sequences and the "Bytes.set" function. -\subsection{Operators} +\subsection{ss:expr-operators}{Operators} \ikwd{mod\@\texttt{mod}} \ikwd{land\@\texttt{land}} \ikwd{lor\@\texttt{lor}} @@ -765,9 +765,9 @@ interpreted respectively as the functions @'(~-)'@ and @'(~-.)'@. \entree{"|| or"}{Boolean disjunction.} \end{tableau} -\subsection{Objects} \label{s:objects} +\subsection{ss:expr-obj}{Objects} \label{s:objects} -\subsubsection*{Object creation} +\subsubsection*{sss:expr-obj-creation}{Object creation} \ikwd{new\@\texttt{new}} @@ -779,14 +779,14 @@ When @class-path@ evaluates to a class function, @'new' class-path@ evaluates to a function expecting the same number of arguments and returning a new object of this class. -\subsubsection*{Immediate object creation} +\subsubsection*{sss:expr-obj-immediate}{Immediate object creation} \ikwd{object\@\texttt{object}} Creating directly an object through the @'object' class-body 'end'@ construct is operationally equivalent to defining locally a @'class' class-name '=' 'object' class-body 'end'@ ---see sections -\ref{ss:class-body} and following for the syntax of @class-body@--- +\ref{sss:class-body} and following for the syntax of @class-body@--- and immediately creating a single object from it by @'new' class-name@. The typing of immediate objects is slightly different from explicitly @@ -795,7 +795,7 @@ contain free type variables. Second, since the class body of an immediate object will never be extended, its self type can be unified with a closed object type. -\subsubsection*{Method invocation} +\subsubsection*{sss:expr-method}{Method invocation} The expression @expr '#' method-name@ invokes the method @method-name@ of the object denoted by @expr@. @@ -806,7 +806,7 @@ of a fresh object (@'let' ident = 'new' class-path \dots @) or if there is a type constraint. Principality of the derivation can be checked in the "-principal" mode. -\subsubsection*{Accessing and modifying instance variables} +\subsubsection*{sss:expr-obj-variables}{Accessing and modifying instance variables} The instance variables of a class are visible only in the body of the methods defined in the same class or a class that inherits from the @@ -817,7 +817,7 @@ variable @inst-var-name@, which must be mutable. The whole expression @inst-var-name '<-' expr@ evaluates to @"()"@. -\subsubsection*{Object duplication} +\subsubsection*{sss:expr-obj-duplication}{Object duplication} An object can be duplicated using the library function "Oo.copy" (see module \stdmoduleref{Oo}). Inside a method, the expression @@ -827,7 +827,7 @@ the values of the associated expressions. A single instance variable name @id@ stands for @id '=' id@. Other instance variables have the same value in the returned object as in self. -\subsection{Coercions} \label{s:coercions} +\subsection{ss:expr-coercions}{Coercions} Expressions whose type contains object or polymorphic variant types can be explicitly coerced (weakened) to a supertype. @@ -863,7 +863,7 @@ some instance of @typ_2@. % In the following paragraphs we describe the subtyping relation used. -\subsubsection*{Object types} +\subsubsection*{sss:expr-obj-types}{Object types} A fixed object type admits as subtype any object type that includes all its methods. The types of the methods shall be subtypes of those in @@ -891,7 +891,7 @@ type of its class: this is allowed if the type of @@self@@ does not appear in a contravariant position in the class type, {\em i.e.} if there are no binary methods. -\subsubsection*{Polymorphic variant types} +\subsubsection*{sss:expr-polyvar-types}{Polymorphic variant types} A polymorphic variant type @typ@ is a subtype of another polymorphic variant type @typ@$'$ if the upper bound of @typ@ ({\em i.e.} the @@ -910,7 +910,7 @@ which may be a shrinkable type, is a subtype of \end{center} which may be an extensible type, if every @typ_i@ is a subtype of @typ@$'_i$. -\subsubsection*{Variance} +\subsubsection*{sss:expr-variance}{Variance} Other types do not introduce new subtyping, but they may propagate the subtyping of their arguments. For instance, @typ_1 "*" typ_2@ is a @@ -933,14 +933,14 @@ A variance-free parameter may change freely through subtyping, it does not have to be a subtype or a supertype. % For abstract and private types, the variance must be given explicitly -(see section~\ref{s:type-defs}), +(see section~\ref{ss:typedefs}), otherwise the default is nonvariant. This is also the case for constrained arguments in type definitions. -\subsection{Other} +\subsection{ss:expr-other}{Other} -\subsubsection*{Assertion checking} +\subsubsection*{sss:expr-assertion}{Assertion checking} \ikwd{assert\@\texttt{assert}} @@ -963,7 +963,7 @@ the @"assert false"@ ``assertions'' cannot be turned off by the % \index{Assertfailure\@\verb`Assert_failure`} -\subsubsection*{Lazy expressions} +\subsubsection*{sss:expr-lazy}{Lazy expressions} \ikwd{lazy\@\texttt{lazy}} The expression @"lazy" expr@ returns a value \var{v} of type "Lazy.t" that @@ -972,9 +972,9 @@ evaluated at this point in the program. Instead, its evaluation will be performed the first time the function "Lazy.force" is applied to the value \var{v}, returning the actual value of @expr@. Subsequent applications of "Lazy.force" to \var{v} do not evaluate @expr@ again. Applications -of "Lazy.force" may be implicit through pattern matching (see~\ref{s:lazypat}). +of "Lazy.force" may be implicit through pattern matching (see~\ref{sss:pat-lazy}). -\subsubsection*{Local modules} +\subsubsection*{sss:expr-local-modules}{Local modules} \ikwd{let\@\texttt{let}} \ikwd{module\@\texttt{module}} @@ -992,7 +992,7 @@ let remove_duplicates comparison_fun string_list = (List.fold_right StringSet.add string_list StringSet.empty) \end{caml_example} -\subsubsection*{Local opens} +\subsubsection*{sss:local-opens}{Local opens} \ikwd{let\@\texttt{let}} \ikwd{module\@\texttt{open}} diff --git a/manual/manual/refman/exten.etex b/manual/manual/refman/exten.etex index c9a3756f..0c012d0a 100644 --- a/manual/manual/refman/exten.etex +++ b/manual/manual/refman/exten.etex @@ -7,11 +7,12 @@ OCaml reference manual. %HEVEA\cutdef{section} -\section{Recursive definitions of values} \label{s:letrecvalues} +\section{s:letrecvalues}{Recursive definitions of values} +%HEVEA\cutname{letrecvalues.html} (Introduced in Objective Caml 1.00) -As mentioned in section~\ref{s:localdef}, the @'let' 'rec'@ binding +As mentioned in section~\ref{sss:expr-localdef}, the @'let' 'rec'@ binding construct, in addition to the definition of recursive functions, also supports a certain class of recursive definitions of non-functional values, such as @@ -76,7 +77,7 @@ An expression @@e@@ is said to be {\em immediately linked to} the variable is immediately linked to @name@. \end{itemize} -\section{Recursive modules} \label{s-recursive-modules} +\section{s:recursive-modules}{Recursive modules} \ikwd{module\@\texttt{module}} \ikwd{and\@\texttt{and}} @@ -161,7 +162,8 @@ and N:sig val x: int val y:int end = struct let x = M.x let y = 0 end Note that, in the @specification@ case, the @module-type@s must be parenthesized if they use the @'with' mod-constraint@ construct. -\section{Private types}\label{s:private-types} +\section{s:private-types}{Private types} +%HEVEA\cutname{privatetypes.html} \ikwd{private\@\texttt{private}} Private type declarations in module signatures, of the form @@ -172,11 +174,12 @@ between abstract type declarations, where no information is revealed on the type implementation, and data type definitions and type abbreviations, where all aspects of the type implementation are publicized. Private type declarations come in three flavors: for -variant and record types (section~\ref{s-private-types-variant}), -for type abbreviations (section~\ref{s-private-types-abbrev}), -and for row types (section~\ref{s-private-rows}). +variant and record types (section~\ref{ss:private-types-variant}), +for type abbreviations (section~\ref{ss:private-types-abbrev}), +and for row types (section~\ref{ss:private-rows}). + +\subsection{ss:private-types-variant}{Private variant and record types} -\subsection{Private variant and record types} \label{s-private-types-variant} (Introduced in Objective Caml 3.07) @@ -217,7 +220,7 @@ handled like abstract types. That is, if a private type has parameters, their variance is the one explicitly given by prefixing the parameter by a `"+"' or a `"-"', it is invariant otherwise. -\subsection{Private type abbreviations} \label{s-private-types-abbrev} +\subsection{ss:private-types-abbrev}{Private type abbreviations} (Introduced in Objective Caml 3.11) @@ -262,7 +265,7 @@ you must use the full form @"(" expr ":" typexpr_1 ":>" typexpr_2 ")"@ where @typexpr_1@ is the expected type of @expr@. Concretely, this would be "(x : N.t :> int)" and "(l : N.t list :> int list)" for the above examples. -\subsection{Private row types} \label{s-private-rows} +\subsection{ss:private-rows}{Private row types} \ikwd{private\@\texttt{private}} (Introduced in Objective Caml 3.09) @@ -330,37 +333,11 @@ constructors of [t] could be present. Similarly to abstract types, the variance of type parameters is not inferred, and must be given explicitly. - -\section{Local opens for patterns} -\ikwd{let\@\texttt{let}} -\ikwd{open\@\texttt{open}} \label{s:local-opens} - -(Introduced in OCaml 4.04) - -\begin{syntax} -pattern: - ... - | module-path '.(' pattern ')' - | module-path '.[' pattern ']' - | module-path '.[|' pattern '|]' - | module-path '.{' pattern '}' - -\end{syntax} - -For patterns, local opens are limited to the -@module-path'.('pattern')'@ construction. This -construction locally open the module referred to by the module path -@module-path@ in the scope of the pattern @pattern@. - -When the body of a local open pattern is delimited by -@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted. -For example, @module-path'.['pattern']'@ is equivalent to -@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is -equivalent to @module-path'.([|' pattern '|])'@. - -\section{Locally abstract types} +\section{s:locally-abstract}{Locally abstract types} \ikwd{type\@\texttt{type}} -\ikwd{fun\@\texttt{fun}} \label{s:locally-abstract} +\ikwd{fun\@\texttt{fun}} +%HEVEA\cutname{locallyabstract.html} + (Introduced in OCaml 3.12, short syntax added in 4.03) @@ -415,10 +392,10 @@ let sort_uniq (type s) (cmp : s -> s -> int) = \end{caml_example*} It is also extremely useful for first-class modules (see -section~\ref{s-first-class-modules}) and generalized algebraic datatypes +section~\ref{s:first-class-modules}) and generalized algebraic datatypes (GADTs: see section~\ref{s:gadts}). -\paragraph{Polymorphic syntax} (Introduced in OCaml 4.00) +\lparagraph{p:polymorpic-locally-abstract}{Polymorphic syntax} (Introduced in OCaml 4.00) \begin{syntax} let-binding: @@ -451,11 +428,13 @@ GADTs, see the section~\ref{s:gadts} for a more detailed explanation. The same feature is provided for method definitions. -\section{First-class modules}\label{s-first-class-modules} +\section{s:first-class-modules}{First-class modules} \ikwd{module\@\texttt{module}} \ikwd{val\@\texttt{val}} \ikwd{with\@\texttt{with}} \ikwd{and\@\texttt{and}} +%HEVEA\cutname{firstclassmodules.html} + (Introduced in OCaml 3.12; pattern syntax and package type inference introduced in 4.00; structural comparison of package types introduced in 4.02.; @@ -534,7 +513,7 @@ It can also be used anywhere in the context of a local module binding @'let' 'module' module-name '=' '(' "val" expr_1 ":" package-type ')' "in" expr_2@. -\paragraph{Basic example} A typical use of first-class modules is to +\lparagraph{p:fst-mod-example}{Basic example} A typical use of first-class modules is to select at run-time among several implementations of a signature. Each implementation is a structure that we can encapsulate as a first-class module, then store in a data structure such as a hash @@ -551,7 +530,7 @@ module SVG = struct let draw () = () [@@ellipsis] end let _ = Hashtbl.add devices "SVG" (module SVG : DEVICE) module PDF = struct let draw () = () [@@ellipsis] end -let _ = Hashtbl.add devices "PDF" (module PDF: DEVICE) +let _ = Hashtbl.add devices "PDF" (module PDF : DEVICE) \end{caml_example*} We can then select one implementation based on command-line @@ -575,7 +554,7 @@ let draw_using_device device_name picture = Device.draw picture \end{caml_example*} -\paragraph{Advanced examples} +\lparagraph{p:fst-mod-advexamples}{Advanced examples} With first-class modules, it is possible to parametrize some code over the implementation of a module without using a functor. @@ -684,7 +663,8 @@ Note that this function uses an explicit polymorphic annotation to obtain polymorphic recursion. \fi -\section{Recovering the type of a module} \label{s:module-type-of} +\section{s:module-type-of}{Recovering the type of a module} +%HEVEA\cutname{moduletypeof.html} \ikwd{module\@\texttt{module}} \ikwd{type\@\texttt{type}} @@ -738,14 +718,14 @@ end This idiom guarantees that "Myset" is compatible with Set, but allows it to represent sets internally in a different way. -\section{Substituting inside a signature} +\section{s:signature-substitution}{Substituting inside a signature} \ikwd{with\@\texttt{with}} \ikwd{module\@\texttt{module}} \ikwd{type\@\texttt{type}} -\label{s:signature-substitution} +%HEVEA\cutname{signaturesubstitution.html} -\subsection{Destructive substitutions} -\label{ss:destructive-substitution} + +\subsection{ss:destructive-substitution}{Destructive substitutions} (Introduced in OCaml 3.12, generalized in 4.06) @@ -801,8 +781,7 @@ module type ComparableInt = Comparable with type t = int ;; module type CompareInt = ComparableInt with type t := int \end{caml_example} -\subsection{Local substitution declarations} -\label{ss:local-substitution} +\subsection{ss:local-substitution}{Local substitution declarations} (Introduced in OCaml 4.08) @@ -846,9 +825,9 @@ module type S = sig end [@@expect error];; \end{caml_example} -\section{Type-level module aliases} +\section{s:module-alias}{Type-level module aliases} \ikwd{module\@\texttt{module}} -\label{s:module-alias} +%HEVEA\cutname{modulealias.html} (Introduced in OCaml 4.02) @@ -882,9 +861,9 @@ module P = struct end module N = P \end{caml_example*} has type -\caml -\:module N = P -\endcaml +\begin{caml_example*}{signature} +module N = P +\end{caml_example*} Type-level module aliases are used when checking module path equalities. That is, in a context where module name @N@ is known to be @@ -961,8 +940,9 @@ compiler will always display @'Lib.FooBar'@ instead of all the user sees is the nicer dot names. This is how the OCaml standard library is compiled. -\section{Overriding in open statements}\label{s:explicit-overriding-open} +\section{s:explicit-overriding-open}{Overriding in open statements} \ikwd{open.\@\texttt{open\char33}} +%HEVEA\cutname{overridingopen.html} (Introduced in OCaml 4.01) @@ -997,8 +977,10 @@ intentional and should not trigger the warning. This is also available (since OCaml 4.06) for local opens in class expressions and class type expressions. -\section{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}} -\ikwd{match\@\texttt{match}} \label{s:gadts} +\section{s:gadts}{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}} +\ikwd{match\@\texttt{match}} +%HEVEA\cutname{gadts.html} + (Introduced in OCaml 4.00) @@ -1039,7 +1021,7 @@ If a constructor has some existential variables, fresh locally abstract types are generated, and they must not escape the scope of this branch. -\paragraph{Recursive functions} +\lparagraph{p:gadts-recfun}{Recursive functions} Here is a concrete example: \begin{caml_example*}{verbatim} @@ -1081,7 +1063,7 @@ In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in flow to the type variable "'a" and escape its scope. This triggers the above error. -\paragraph{Type inference} +\lparagraph{p:gadts-type-inference}{Type inference} Type inference for GADTs is notoriously hard. This is due to the fact some types may become ambiguous when escaping @@ -1134,7 +1116,7 @@ let get_int : int term -> int = function \end{caml_example*} -\paragraph{Refutation cases} (Introduced in OCaml 4.03) +\lparagraph{p:gadt-refutation-cases}{Refutation cases} (Introduced in OCaml 4.03) Usually, the exhaustiveness check only tries to check whether the cases omitted from the pattern matching are typable or not. @@ -1177,7 +1159,7 @@ Another addition is that the redundancy check is now aware of GADTs: a case will be detected as redundant if it could be replaced by a refutation case using the same pattern. -\paragraph{Advanced examples} +\lparagraph{p:gadts-advexamples}{Advanced examples} The "term" type we have defined above is an {\em indexed} type, where a type parameter reflects a property of the value contents. Another use of GADTs is {\em singleton} types, where a GADT value @@ -1239,8 +1221,7 @@ let get_dyn : type a. a typ -> dyn -> a option = | Some Eq -> Some x \end{caml_example*} -\paragraph{Existential type names in error messages}% -\label{p:existential-names} +\lparagraph{p:existential-names}{Existential type names in error messages}% (Updated in OCaml 4.03.0) The typing of pattern matching in presence of GADT can generate many @@ -1279,7 +1260,7 @@ which could not be named using one of the previous schemes. As shown by the last item, the current behavior is imperfect and may be improved in future versions. -\paragraph{Equations on non-local abstract types} (Introduced in OCaml +\lparagraph{p:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types} (Introduced in OCaml 4.04) GADT pattern-matching may also add type equations to non-local @@ -1301,7 +1282,8 @@ defined by the compiler itself, such as "int" or "array"), and abstract types defined by the local module, are non-instantiable, and as such cause a type error rather than introduce an equation. -\section{Syntax for Bigarray access}\label{s:bigarray-access} +\section{s:bigarray-access}{Syntax for Bigarray access} +%HEVEA\cutname{bigarray.html} (Introduced in Objective Caml 3.00) @@ -1341,7 +1323,8 @@ The short expressions are translated into calls to functions of the The last two entries are valid for any $n > 3$. -\section{Attributes}\label{s:attributes} +\section{s:attributes}{Attributes} +%HEVEA\cutname{attributes.html} \ikwd{when\@\texttt{when}} @@ -1533,8 +1516,7 @@ and[@bar] y = 3 in x + y === (let x = 2 [@@foo] and y = 3 [@bar] in x \end{verbatim} -\subsection{Built-in attributes} -\label{ss:builtin-attributes} +\subsection{ss:builtin-attributes}{Built-in attributes} Some attributes are understood by the type-checker: \begin{itemize} @@ -1610,6 +1592,11 @@ Some attributes are understood by the type-checker: enumerated types). Mutation of these immediate types does not activate the garbage collector's write barrier, which can significantly boost performance in programs relying heavily on mutable state. +\item + ``ocaml.immediate64'' or ``immediate64'' applied on an abstract type mark the + type as having a non-pointer implementation on 64 bit platforms. No assumption + is made on other platforms. In order to produce a type with the + ``immediate64`` attribute, one must use ``Sys.Immediate64.Make`` functor. \item "ocaml.unboxed" or "unboxed" can be used on a type definition if the type is a single-field record or a concrete type with a single @@ -1707,8 +1694,35 @@ end = struct end \end{caml_example*} +\begin{caml_example*}{verbatim} +module Int_or_int64 : sig + type t [@@immediate64] + val zero : t + val one : t + val add : t -> t -> t +end = struct + + include Sys.Immediate64.Make(Int)(Int64) + + module type S = sig + val zero : t + val one : t + val add : t -> t -> t + end -\section{Extension nodes}\label{s:extension-nodes} + let impl : (module S) = + match repr with + | Immediate -> + (module Int : S) + | Non_immediate -> + (module Int64 : S) + + include (val impl : S) +end +\end{caml_example*} + +\section{s:extension-nodes}{Extension nodes} +%HEVEA\cutname{extensionnodes.html} (Introduced in OCaml 4.02, infix notations for constructs other than expressions added in 4.03, @@ -1807,7 +1821,7 @@ different semantics than they expect. Moreover, giving semantics to a specific delimiter limits the freedom to change the delimiter to avoid escaping issues. -\subsection{Built-in extension nodes} +\subsection{ss:builtin-extension-nodes}{Built-in extension nodes} (Introduced in OCaml 4.03) @@ -1830,7 +1844,8 @@ let y = [%extension_constructor Y] x <> y;; \end{caml_example} -\section{Extensible variant types}\label{s:extensible-variants} +\section{s:extensible-variants}{Extensible variant types} +%HEVEA\cutname{extensiblevariants.html} (Introduced in OCaml 4.02) @@ -1924,7 +1939,7 @@ let inspection_works = function let construction_is_forbidden = B.Bool 1;; \end{caml_example} -\subsection{Private extensible variant types} +\subsection{ss:private-extensible}{Private extensible variant types} (Introduced in OCaml 4.06) @@ -1952,7 +1967,8 @@ end = struct end \end{caml_example*} -\section{Generative functors}\label{s:generative-functors} +\section{s:generative-functors}{Generative functors} +%HEVEA\cutname{generativefunctors.html} (Introduced in OCaml 4.02) @@ -1991,7 +2007,8 @@ types). As a side-effect of this generativity, one is allowed to unpack first-class modules in the body of generative functors. -\section{Extension-only syntax} +\section{s:extension-syntax}{Extension-only syntax} +%HEVEA\cutname{extensionsyntax.html} (Introduced in OCaml 4.02.2, extended in 4.03) Some syntactic constructions are accepted during parsing and rejected @@ -2000,7 +2017,7 @@ be used directly in vanilla OCaml. However, "-ppx" rewriters and other external tools can exploit this parser leniency to extend the language with these new syntactic constructions by rewriting them to vanilla constructions. -\subsection{Extension operators} \label{s:ext-ops} +\subsection{ss:extension-operators}{Extension operators} \label{s:ext-ops} (Introduced in OCaml 4.02.2) \begin{syntax} infix-symbol: @@ -2012,7 +2029,7 @@ infix-symbol: Operator names starting with a "#" character and containing more than one "#" character are reserved for extensions. -\subsection{Extension literals} \label{s:extension-literals} +\subsection{ss:extension-literals}{Extension literals} (Introduced in OCaml 4.03) \begin{syntax} float-literal: @@ -2042,7 +2059,8 @@ int-literal: Int and float literals followed by an one-letter identifier in the range @["g".."z"||"G".."Z"]@ are extension-only literals. -\section{Inline records} \label{s:inline-records} +\section{s:inline-records}{Inline records} +%HEVEA\cutname{inlinerecords.html} (Introduced in OCaml 4.03) \begin{syntax} constr-args: @@ -2088,7 +2106,8 @@ let invalid = function | Point p -> p \end{caml_example} -\section{Documentation comments} +\section{s:doc-comments}{Documentation comments} +%HEVEA\cutname{doccomments.html} (Introduced in OCaml 4.03) Comments which start with "**" are treated specially by the @@ -2106,7 +2125,7 @@ documentation generator (see \ref{c:ocamldoc}). The three comment forms recognised by the compiler are a subset of the forms accepted by ocamldoc (see \ref{s:ocamldoc-comments}). -\subsection{Floating comments} +\subsection{ss:floating-comments}{Floating comments} Comments surrounded by blank lines that appear within structures, signatures, classes or class types are converted into @@ -2130,7 +2149,7 @@ type t = T let mkT = T \end{caml_example*} -\subsection{Item comments} +\subsection{ss:item-comments}{Item comments} Comments which appear {\em immediately before} or {\em immediately after} a structure item, signature item, class item or class type item @@ -2179,7 +2198,7 @@ type s = S and the compiler will emit warning 50. -\subsection{Label comments} +\subsection{ss:label-comments}{Label comments} Comments which appear {\em immediately after} a labelled argument, record field, variant constructor, object method or polymorphic variant @@ -2271,13 +2290,17 @@ type t = T of string [@@ocaml.doc " Attaches to t "] \end{caml_example*} -\section{Extended indexing operators \label{s:index-operators} } +\section{s:index-operators}{Extended indexing operators } +%HEVEA\cutname{indexops.html} (Introduced in 4.06) \begin{syntax} dot-ext: - | ('!'||'$'||'%'||'&'||'*'||'+'||'-'||'/'||':'||'='||'>'||'?'||'@'||'^'||'|'||'~') { operator-char } + | dot-operator-char { operator-char } +; +dot-operator-char: + '!' || '?' || core-operator-char || '%' || ':' ; expr: ... @@ -2312,7 +2335,57 @@ dict.Dict.%{"one"};; let open Dict in dict.%{"two"};; \end{caml_example} -\section{Empty variant types\label{s:empty-variants} } +\subsection{ss:multiindexing}{Multi-index notation} +\begin{syntax} +expr: + ... + | expr '.' [module-path '.'] dot-ext '(' expr {{';' expr }} ')' [ '<-' expr ] + | expr '.' [module-path '.'] dot-ext '[' expr {{';' expr }} ']' [ '<-' expr ] + | expr '.' [module-path '.'] dot-ext '{' expr {{';' expr }} '}' [ '<-' expr ] +; +operator-name: + ... + | '.' dot-ext ('(;..)' || '[;..]' || '{;..}') ['<-'] +; +\end{syntax} + +Multi-index are also supported through a second variant of indexing operators + +\begin{caml_example*}{verbatim} +let (.%[;..]) = Bigarray.Genarray.get +let (.%{;..}) = Bigarray.Genarray.get +let (.%(;..)) = Bigarray.Genarray.get +\end{caml_example*} + +which is called when an index literals contain a semicolon separated list +of expressions with two and more elements: + +\begin{caml_example*}{verbatim} +let sum x y = x.%[1;2;3] + y.%[1;2] +(* is equivalent to *) +let sum x y = (.%[;..]) x [|1;2;3|] + (.%[;..]) y [|1;2|] +\end{caml_example*} + +In particular this multi-index notation makes it possible to uniformly handle +indexing Genarray and other implementations of multidimensional arrays. + +\begin{caml_example*}{verbatim} +module A = Bigarray.Genarray +let (.%{;..}) = A.get +let (.%{;..}<- ) = A.set +let (.%{ }) a k = A.get a [|k|] +let (.%{ }<-) a k x = A.set a [|k|] x +let syntax_compare vec mat t3 t4 = + vec.%{0} = A.get vec [|0|] + && mat.%{0;0} = A.get mat [|0;0|] + && t3.%{0;0;0} = A.get t3 [|0;0;0|] + && t4.%{0;0;0;0} = t4.{0,0,0,0} +\end{caml_example*} + + + +\section{s:empty-variants}{Empty variant types} +%HEVEA\cutname{emptyvariants.html} (Introduced in 4.07.0) \begin{syntax} @@ -2327,7 +2400,8 @@ type t = | let f (x: t) = match x with _ -> . \end{caml_example*} -\section{Alerts \label{s:alerts} } +\section{s:alerts}{Alerts} +%HEVEA\cutname{alerts.html} (Introduced in 4.08) Since OCaml 4.08, it is possible to mark components (such as value or @@ -2425,7 +2499,8 @@ val x: int [@@@ocaml.alert deprecated "Please do something else"] \end{verbatim} -\section{Generalized open statements\label{s:generalized-open}} +\section{s:generalized-open}{Generalized open statements} +%HEVEA\cutname{generalizedopens.html} (Introduced in 4.08) @@ -2543,15 +2618,16 @@ class c = ... \end{verbatim} -\section{Binding operators\label{s:binding-operators} } +\section{s:binding-operators}{Binding operators} +%HEVEA\cutname{bindingops.html} (Introduced in 4.08.0) \begin{syntax} let-operator: - | 'let' ('$'||'&'||'*'||'+'||'-'||'/'||'<'||'='||'>'||'@'||'^'||'|') { operator-char } + | 'let' (core-operator-char || '<') { dot-operator-char } ; and-operator: - | 'and' ('$'||'&'||'*'||'+'||'-'||'/'||'<'||'='||'>'||'@'||'^'||'|') { operator-char } + | 'and' (core-operator-char || '<') { dot-operator-char } ; operator-name : ... @@ -2638,7 +2714,7 @@ let sum3 z1 z2 z3 = (fun ((x1, x2), x3) -> x1 + x2 + x3) \end{caml_example} -\subsection{Rationale} +\subsection{ss:letops-rationale}{Rationale} This extension is intended to provide a convenient syntax for working with monads and applicatives. diff --git a/manual/manual/refman/lex.etex b/manual/manual/refman/lex.etex index 3ae76ee5..78d8b036 100644 --- a/manual/manual/refman/lex.etex +++ b/manual/manual/refman/lex.etex @@ -1,6 +1,6 @@ -\section{Lexical conventions} +\section{s:lexical-conventions}{Lexical conventions} %HEVEA\cutname{lex.html} -\subsubsection*{Blanks} +\subsubsection*{sss:lex:blanks}{Blanks} The following characters are considered as blanks: space, horizontal tabulation, carriage return, line feed and form feed. Blanks are @@ -8,7 +8,7 @@ ignored, but they separate adjacent identifiers, literals and keywords that would otherwise be confused as one single identifier, literal or keyword. -\subsubsection*{Comments} +\subsubsection*{sss:lex:comments}{Comments} Comments are introduced by the two characters @"(*"@, with no intervening blanks, and terminated by the characters @"*)"@, with @@ -16,7 +16,7 @@ no intervening blanks. Comments are treated as blank characters. Comments do not occur inside string or character literals. Nested comments are handled correctly. -\subsubsection*{Identifiers} +\subsubsection*{sss:lex:identifiers}{Identifiers} \begin{syntax} ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ; @@ -45,7 +45,7 @@ identifiers and identifiers that begin with a lowercase letter. The underscore character is considered a lowercase letter for this purpose. -\subsubsection*{Integer literals} +\subsubsection*{sss:integer-literals}{Integer literals} \begin{syntax} integer-literal: @@ -80,7 +80,7 @@ representable integer values is undefined. For convenience and readability, underscore characters (@"_"@) are accepted (and ignored) within integer literals. -\subsubsection*{Floating-point literals} +\subsubsection*{sss:floating-point-literals}{Floating-point literals} \begin{syntax} float-literal: @@ -116,7 +116,7 @@ It is written in decimal and interpreted as a power of 2. For convenience and readability, underscore characters (@"_"@) are accepted (and ignored) within floating-point literals. -\subsubsection*{Character literals} +\subsubsection*{sss:character-literals}{Character literals} \label{s:characterliteral} \begin{syntax} @@ -149,8 +149,7 @@ The two single quotes enclose either one character different from \entree{"\\o"\var{ooo}}{the character with ASCII code \var{ooo} in octal} \end{tableau} -\subsubsection*{String literals} -\label{s:stringliteral} +\subsubsection*{sss:stringliterals}{String literals} \begin{syntax} string-literal: @@ -199,8 +198,7 @@ such issue (e.g. "{|hello|}", "{ext|hello {|world|}|ext}", ...). The current implementation places practically no restrictions on the length of string literals. -\subsubsection*{Naming labels} -\label{s:labelname} +\subsubsection*{sss:labelname}{Naming labels} To avoid ambiguities, naming labels in expressions cannot just be defined syntactically as the sequence of the three tokens "~", @ident@ and @@ -224,14 +222,13 @@ used in grammars, for the sake of readability. Note also that inside type expressions, this expansion can be taken literally, {\em i.e.} there are really 3 tokens, with optional blanks between them. -\subsubsection*{Prefix and infix symbols} +\subsubsection*{sss:lex-ops-symbols}{Prefix and infix symbols} %% || '`' lowercase-ident '`' \begin{syntax} infix-symbol: - ('=' || '<' || '>' || '@' || '^' || '|' || '&' || - '+' || '-' || '*' || '/' || '$' || '%') { operator-char } + ( core-operator-char || '%' || '<' ) { operator-char } | "#" {{ operator-char }} ; prefix-symbol: @@ -239,13 +236,15 @@ prefix-symbol: | ('?' || '~') {{ operator-char }} ; operator-char: - '!' || '$' || '%' || '&' || '*' || '+' || '-' || '.' || - '/' || ':' || '<' || '=' || '>' || '?' || '@' || - '^' || '|' || '~' + '~' || '!' || '?' || core-operator-char || '%' || '<' || ':' || '.' +; +core-operator-char: + '$' || '&' || '*' || '+' || '-' || '/' || '=' || '>' || '@' || '^' || '|' \end{syntax} See also the following language extensions: -\hyperref[s:ext-ops]{extension operators} and -\hyperref[s:index-operators]{extended indexing operators}. +\hyperref[s:ext-ops]{extension operators}, +\hyperref[s:index-operators]{extended indexing operators}, +and \hyperref[s:binding-operators]{binding operators}. Sequences of ``operator characters'', such as "<=>" or "!!", are read as a single token from the @infix-symbol@ or @prefix-symbol@ @@ -255,7 +254,7 @@ expressions, but otherwise behave like normal identifiers. %% between backquote characters @'`' lowercase-ident '`'@ are also parsed %% as infix operators. -\subsubsection*{Keywords} +\subsubsection*{sss:keywords}{Keywords} The identifiers below are reserved as keywords, and cannot be employed otherwise: @@ -292,14 +291,14 @@ extensions and should be avoided for compatibility reasons. parser value $ $$ $: <: << >> ?? \end{verbatim} -\subsubsection*{Ambiguities} +\subsubsection*{sss:lex-ambiguities}{Ambiguities} Lexical ambiguities are resolved according to the ``longest match'' rule: when a character sequence can be decomposed into two tokens in several different ways, the decomposition retained is the one with the longest first token. -\subsubsection*{Line number directives} +\subsubsection*{sss:lex-linedir}{Line number directives} \begin{syntax} linenum-directive: diff --git a/manual/manual/refman/modtypes.etex b/manual/manual/refman/modtypes.etex index 6eaa7433..5d406db1 100644 --- a/manual/manual/refman/modtypes.etex +++ b/manual/manual/refman/modtypes.etex @@ -1,4 +1,4 @@ -\section{Module types (module specifications)} +\section{s:modtypes}{Module types (module specifications)} %HEVEA\cutname{modtypes.html} Module types are the module-level equivalent of type expressions: they @@ -58,14 +58,14 @@ See also the following language extensions: \hyperref[s:extension-nodes]{extension nodes} and \hyperref[s:generative-functors]{generative functors}. -\subsection{Simple module types} +\subsection{ss:mty-simple}{Simple module types} The expression @modtype-path@ is equivalent to the module type bound to the name @modtype-path@. The expression @'(' module-type ')'@ denotes the same type as @module-type@. -\subsection{Signatures} +\subsection{ss:mty-signatures}{Signatures} \ikwd{sig\@\texttt{sig}} \ikwd{end\@\texttt{end}} @@ -82,7 +82,7 @@ An optional @";;"@ is allowed after each specification in a signature. It serves as a syntactic separator with no semantic meaning. -\subsubsection*{Value specifications} +\subsubsection*{sss:mty-values}{Value specifications} \ikwd{val\@\texttt{val}} @@ -97,7 +97,7 @@ is similar, except that it requires in addition the name to be implemented as the external function specified in @external-declaration@ (see chapter~\ref{c:intf-c}). -\subsubsection*{Type specifications} +\subsubsection*{sss:mty-type}{Type specifications} \ikwd{type\@\texttt{type}} @@ -148,7 +148,7 @@ This case combines the previous two: the representation of the type is made visible to all users, and no fresh type is generated. \end{description} -\subsubsection*{Exception specification} +\subsubsection*{sss:mty-exn}{Exception specification} \ikwd{exception\@\texttt{exception}} @@ -157,7 +157,7 @@ matching structure to provide an exception with the name and arguments specified in the definition, and makes the exception available to all users of the structure. -\subsubsection*{Class specifications} +\subsubsection*{sss:mty-class}{Class specifications} \ikwd{class\@\texttt{class}} @@ -166,9 +166,9 @@ A specification of one or several classes in a signature is written of mutually recursive definitions of class names. Class specifications are described more precisely in -section~\ref{s:class-spec}. +section~\ref{ss:class-spec}. -\subsubsection*{Class type specifications} +\subsubsection*{sss:mty-classtype}{Class type specifications} \ikwd{class\@\texttt{class}} \ikwd{type\@\texttt{type}} @@ -177,9 +177,9 @@ A specification of one or several classe types in a signature is written @'class' 'type' classtype-def@ @{ 'and' classtype-def }@ and consists of a sequence of mutually recursive definitions of class type names. Class type specifications are described more precisely in -section~\ref{s:classtype}. +section~\ref{ss:classtype}. -\subsubsection*{Module specifications} +\subsubsection*{sss:mty-module}{Module specifications} \ikwd{module\@\texttt{module}} @@ -203,7 +203,7 @@ instead of '->' module-type@ \end{center} -\subsubsection*{Module type specifications} +\subsubsection*{sss:mty-mty}{Module type specifications} \ikwd{type\@\texttt{type}} \ikwd{module\@\texttt{module}} @@ -222,7 +222,7 @@ requires the name @modtype-name@ to be implemented by the module type @module-type@ in a matching signature, but makes the equality between @modtype-name@ and @module-type@ apparent to all users of the signature. -\subsubsection{Opening a module path} +\subsubsection{sss:mty-open}{Opening a module path} \ikwd{open\@\texttt{open}} @@ -233,7 +233,7 @@ of the signature, allowing components of the module denoted by path accesses @module-path '.' name@. The scope of the @"open"@ stops at the end of the signature expression. -\subsubsection{Including a signature} +\subsubsection{sss:mty-include}{Including a signature} \ikwd{include\@\texttt{include}} @@ -243,7 +243,7 @@ It behaves as if the components of the included signature were copied at the location of the @'include'@. The @module-type@ argument must refer to a module type that is a signature, not a functor type. -\subsection{Functor types} +\subsection{ss:mty-functors}{Functor types} \ikwd{functor\@\texttt{functor}} @@ -261,7 +261,7 @@ No restrictions are placed on the type of the functor argument; in particular, a functor may take another functor as argument (``higher-order'' functor). -\subsection{The "with" operator} +\subsection{ss:mty-with}{The "with" operator} \ikwd{with\@\texttt{with}} diff --git a/manual/manual/refman/modules.etex b/manual/manual/refman/modules.etex index 26216e59..ca9aef39 100644 --- a/manual/manual/refman/modules.etex +++ b/manual/manual/refman/modules.etex @@ -1,4 +1,4 @@ -\section{Module\label{s:module-expr} expressions (module implementations)} +\section{s:module-expr}{Module expressions (module implementations)} %HEVEA\cutname{modules.html} Module expressions are the module-level equivalent of value @@ -45,14 +45,14 @@ definition: | 'include' module-expr \end{syntax} See also the following language extensions: -\hyperref[s-recursive-modules]{recursive modules}, -\hyperref[s-first-class-modules]{first-class modules}, +\hyperref[s:recursive-modules]{recursive modules}, +\hyperref[s:first-class-modules]{first-class modules}, \hyperref[s:explicit-overriding-open]{overriding in open statements}, \hyperref[s:attributes]{attributes}, \hyperref[s:extension-nodes]{extension nodes} and \hyperref[s:generative-functors]{generative functors}. -\subsection{Simple module expressions} +\subsection{ss:mexpr-simple}{Simple module expressions} The expression @module-path@ evaluates to the module bound to the name @module-path@. @@ -70,7 +70,7 @@ expression evaluates to the same module as @module-expr@, except that all components not specified in @module-type@ are hidden and can no longer be accessed. -\subsection{Structures} +\subsection{ss:mexpr-structures}{Structures} \ikwd{struct\@\texttt{struct}} \ikwd{end\@\texttt{end}} @@ -90,13 +90,13 @@ a component of a structure. It is equivalent to @'let' '_' '=' expr@, i.e. @expr evaluated for its side-effects but is not bound to any identifier. If @expr@ is the first component of a structure, the preceding ";;" can be omitted. -\subsubsection*{Value definitions} +\subsubsection*{sss:mexpr-value-defs}{Value definitions} \ikwd{let\@\texttt{let}} A value definition @'let' ['rec'] let-binding { 'and' let-binding }@ bind value names in the same way as a @'let' \ldots 'in' \ldots@ expression -(see section~\ref{s:localdef}). The value names appearing in the +(see section~\ref{sss:expr-localdef}). The value names appearing in the left-hand sides of the bindings are bound to the corresponding values in the right-hand sides. @@ -106,7 +106,7 @@ A value definition @'external' value-name ':' typexpr '=' external-declaration@ implements @value-name@ as the external function specified in @external-declaration@ (see chapter~\ref{c:intf-c}). -\subsubsection*{Type definitions} +\subsubsection*{sss:mexpr-type-defs}{Type definitions} \ikwd{type\@\texttt{type}} @@ -114,23 +114,23 @@ A definition of one or several type components is written @'type' typedef { 'and' typedef }@ and consists of a sequence of mutually recursive definitions of type names. -\subsubsection*{Exception definitions} +\subsubsection*{sss:mexpr-exn-defs}{Exception definitions} \ikwd{exception\@\texttt{exception}} Exceptions are defined with the syntax @'exception' constr-decl@ or @'exception' constr-name '=' constr@. -\subsubsection*{Class definitions} +\subsubsection*{sss:mexpr-class-defs}{Class definitions} \ikwd{class\@\texttt{class}} A definition of one or several classes is written @'class' class-binding { 'and' class-binding }@ and consists of a sequence of mutually recursive definitions of class names. Class definitions are -described more precisely in section~\ref{s:classdef}. +described more precisely in section~\ref{ss:class-def}. -\subsubsection*{Class type definitions} +\subsubsection*{sss:mexpr-classtype-defs}{Class type definitions} \ikwd{class\@\texttt{class}} \ikwd{type\@\texttt{type}} @@ -139,9 +139,9 @@ A definition of one or several classes is written @'class' 'type' classtype-def { 'and' classtype-def }@ and consists of a sequence of mutually recursive definitions of class type names. Class type definitions are described more precisely in -section~\ref{s:classtype}. +section~\ref{ss:classtype}. -\subsubsection*{Module definitions} +\subsubsection*{sss:mexpr-module-defs}{Module definitions} \ikwd{module\@\texttt{module}} @@ -169,7 +169,7 @@ which is equivalent to '->' module-expr@ \end{center} -\subsubsection*{Module type definitions} +\subsubsection*{sss:mexpr-modtype-defs}{Module type definitions} \ikwd{type\@\texttt{type}} \ikwd{module\@\texttt{module}} @@ -179,7 +179,7 @@ A definition for a module type is written It binds the name @modtype-name@ to the module type denoted by the expression @module-type@. -\subsubsection*{Opening a module path} +\subsubsection*{sss:mexpr-open}{Opening a module path} \ikwd{open\@\texttt{open}} @@ -190,7 +190,7 @@ module denoted by @module-path@ to be referred to by their simple names @name@ instead of path accesses @module-path '.' name@. The scope of the @"open"@ stops at the end of the structure expression. -\subsubsection*{Including the components of another structure} +\subsubsection*{sss:mexpr-include}{Including the components of another structure} \ikwd{include\@\texttt{include}} @@ -214,9 +214,9 @@ structure, without defining any components of the current structure, while @'include'@ also adds definitions for the components of the included structure. -\subsection{Functors} +\subsection{ss:mexpr-functors}{Functors} -\subsubsection*{Functor definition} +\subsubsection*{sss:mexpr-functor-defs}{Functor definition} \ikwd{functor\@\texttt{functor}} @@ -228,7 +228,7 @@ resulting modules as results. No restrictions are placed on the type of the functor argument; in particular, a functor may take another functor as argument (``higher-order'' functor). -\subsubsection*{Functor application} +\subsubsection*{sss:mexpr-functor-app}{Functor application} The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates @module-expr_1@ to a functor and @module-expr_2@ to a module, and diff --git a/manual/manual/refman/names.etex b/manual/manual/refman/names.etex index 030347e9..1d06dc69 100644 --- a/manual/manual/refman/names.etex +++ b/manual/manual/refman/names.etex @@ -1,4 +1,4 @@ -\section{Names} \label{s:names} +\section{s:names}{Names} %HEVEA\cutname{names.html} Identifiers are used to give names to several classes of language @@ -6,7 +6,7 @@ objects and refer to these objects by name later: \begin{itemize} \item value names (syntactic class @value-name@), \item value constructors and exception constructors (class @constr-name@), -\item labels (@label-name@, defined in section~\ref{s:labelname}), +\item labels (@label-name@, defined in section~\ref{sss:labelname}), \item polymorphic variant tags (@tag-name@), \item type constructors (@typeconstr-name@), \item record fields (@field-name@), @@ -22,7 +22,7 @@ identifier is in lowercase (written @lowercase-ident@ below) or in uppercase (written @capitalized-ident@). Underscore is considered a lowercase letter for this purpose. -\subsubsection*{Naming objects} +\subsubsection*{sss:naming-objects}{Naming objects} \ikwd{mod\@\texttt{mod}} \ikwd{land\@\texttt{land}} \ikwd{lor\@\texttt{lor}} @@ -99,7 +99,7 @@ lowercase variant tags in addition to capitalized variant tags, but we suggest you avoid lowercase variant tags for portability and compatibility with future OCaml versions. -\subsubsection*{Referring to named objects} +\subsubsection*{sss:refer-named}{Referring to named objects} \begin{syntax} value-path: diff --git a/manual/manual/refman/patterns.etex b/manual/manual/refman/patterns.etex index 36b8679c..5136ff64 100644 --- a/manual/manual/refman/patterns.etex +++ b/manual/manual/refman/patterns.etex @@ -1,4 +1,4 @@ -\section{Patterns} +\section{s:patterns}{Patterns} \ikwd{as\@\texttt{as}} %HEVEA\cutname{patterns.html} \begin{syntax} @@ -22,10 +22,13 @@ pattern: | char-literal '..' char-literal | 'lazy' pattern | 'exception' pattern + | module-path '.(' pattern ')' + | module-path '.[' pattern ']' + | module-path '.[|' pattern '|]' + | module-path '.{' pattern '}' \end{syntax} See also the following language extensions: -\hyperref[s:local-opens]{local opens}, -\hyperref[s-first-class-modules]{first-class modules}, +\hyperref[s:first-class-modules]{first-class modules}, \hyperref[s:attributes]{attributes} and \hyperref[s:extension-nodes]{extension nodes}. @@ -35,7 +38,7 @@ higher precedences come first. \ikwd{as\@\texttt{as}} \begin{tableau}{|l|l|}{Operator}{Associativity} \entree{".."}{--} -\entree{"lazy" (see section~\ref{s:lazypat})}{--} +\entree{"lazy" (see section~\ref{sss:pat-lazy})}{--} \entree{Constructor application, Tag application}{right} \entree{"::"}{right} \entree{","}{--} @@ -50,7 +53,7 @@ outcome is either ``this value does not match this pattern'', or ``this value matches this pattern, resulting in the following bindings of names to values''. -\subsubsection*{Variable patterns} +\subsubsection*{sss:pat-variable}{Variable patterns} A pattern that consists in a value name matches any value, binding the name to the value. The pattern @"_"@ also matches @@ -61,7 +64,7 @@ a given pattern. In particular, there is no way to test for equality between two parts of a data structure using only a pattern (but @"when"@ guards can be used for this purpose). -\subsubsection*{Constant patterns} +\subsubsection*{sss:pat-const}{Constant patterns} A pattern consisting in a constant matches the values that are equal to this constant. @@ -69,7 +72,7 @@ are equal to this constant. %% FIXME for negative numbers, blanks are allowed between the minus %% sign and the first digit. -\subsubsection*{Alias patterns} +\subsubsection*{sss:pat-alias}{Alias patterns} \ikwd{as\@\texttt{as}} The pattern @pattern_1 "as" value-name@ matches the same values as @@ -77,7 +80,7 @@ The pattern @pattern_1 "as" value-name@ matches the same values as the name @value-name@ is bound to the matched value, in addition to the bindings performed by the matching against @pattern_1@. -\subsubsection*{Parenthesized patterns} +\subsubsection*{sss:pat-parenthesized}{Parenthesized patterns} The pattern @"(" pattern_1 ")"@ matches the same values as @pattern_1@. A type constraint can appear in a @@ -85,7 +88,7 @@ parenthesized pattern, as in @"(" pattern_1 ":" typexpr ")"@. This constraint forces the type of @pattern_1@ to be compatible with @typexpr@. -\subsubsection*{``Or'' patterns} +\subsubsection*{sss:pat-or}{``Or'' patterns} The pattern @pattern_1 "|" pattern_2@ represents the logical ``or'' of the two patterns @pattern_1@ and @pattern_2@. A value matches @@ -99,7 +102,7 @@ performed are those of @pattern_1@ when $v$ matches @pattern_1@. Otherwise, value~$v$ matches @pattern_2@ whose bindings are performed. -\subsubsection*{Variant patterns} +\subsubsection*{sss:pat-variant}{Variant patterns} The pattern @constr '(' pattern_1 ',' \ldots ',' pattern_n ')'@ matches all variants whose @@ -118,13 +121,13 @@ of length $n$ whose elements match @pattern_1@ \ldots @pattern_n@, respectively. This pattern behaves like @pattern_1 "::" \ldots "::" pattern_n "::" "[]"@. -\subsubsection*{Polymorphic variant patterns} +\subsubsection*{sss:pat-polyvar}{Polymorphic variant patterns} The pattern @"`"tag-name pattern_1@ matches all polymorphic variants whose tag is equal to @tag-name@, and whose argument matches @pattern_1@. -\subsubsection*{Polymorphic variant abbreviation patterns} +\subsubsection*{sss:pat-polyvar-abbrev}{Polymorphic variant abbreviation patterns} If the type @["('a,'b,"\ldots")"] typeconstr = "[" "`"tag-name_1 typexpr_1 "|" \ldots "|" "`"tag-name_n typexpr_n"]"@ is defined, then the pattern @"#"typeconstr@ @@ -132,14 +135,14 @@ is a shorthand for the following or-pattern: @"(" "`"tag-name_1"(_" ":" typexpr_1")" "|" \ldots "|" "`"tag-name_n"(_" ":" typexpr_n"))"@. It matches all values of type @"[<" typeconstr "]"@. -\subsubsection*{Tuple patterns} +\subsubsection*{sss:pat-tuple}{Tuple patterns} The pattern @pattern_1 "," \ldots "," pattern_n@ matches $n$-tuples whose components match the patterns @pattern_1@ through @pattern_n@. That is, the pattern matches the tuple values $(v_1, \ldots, v_n)$ such that @pattern_i@ matches $v_i$ for \fromoneto{i}{n}. -\subsubsection*{Record patterns} +\subsubsection*{sss:pat-record}{Record patterns} The pattern @"{" field_1 ["=" pattern_1] ";" \ldots ";" field_n ["=" pattern_n] "}"@ matches records that define at least the fields @@ -159,13 +162,13 @@ Optional type constraints can be added field by field with of @field_k@ to be compatible with @typexpr_k@. -\subsubsection*{Array patterns} +\subsubsection*{sss:pat-array}{Array patterns} The pattern @"[|" pattern_1 ";" \ldots ";" pattern_n "|]"@ matches arrays of length $n$ such that the $i$-th array element matches the pattern @pattern_i@, for \fromoneto{i}{n}. -\subsubsection*{Range patterns} +\subsubsection*{sss:pat-range}{Range patterns} The pattern @"'" @c@ "'" ".." "'" @d@ "'"@ is a shorthand for the pattern @@ -177,7 +180,7 @@ where \nth{c}{1}, \nth{c}{2}, \ldots, \nth{c}{n} are the characters that occur between \var{c} and \var{d} in the ASCII character set. For instance, the pattern "'0'"@'..'@"'9'" matches all characters that are digits. -\subsubsection{Lazy patterns} \label{s:lazypat} +\subsubsection{sss:pat-lazy}{Lazy patterns} \ikwd{lazy\@\texttt{lazy}} @@ -202,7 +205,7 @@ standard library (module \stdmoduleref{Lazy}). \index{Lazy (module)\@\verb`Lazy` (module)}% \index{force\@\verb`force`}% -\subsubsection*{Exception patterns} \label{s:exception-match} +\subsubsection*{sss:exception-match}{Exception patterns} (Introduced in OCaml 4.02) A new form of exception pattern, @ 'exception' pattern @, is allowed @@ -225,3 +228,18 @@ call. A pattern match must contain at least one value case. It is an error if all cases are exceptions, because there would be no code to handle the return of a value. + +\subsubsection*{sss:pat-open}{Local opens for patterns} +\ikwd{open\@\texttt{open}} +(Introduced in OCaml 4.04) + +For patterns, local opens are limited to the +@module-path'.('pattern')'@ construction. This +construction locally opens the module referred to by the module path +@module-path@ in the scope of the pattern @pattern@. + +When the body of a local open pattern is delimited by +@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted. +For example, @module-path'.['pattern']'@ is equivalent to +@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is +equivalent to @module-path'.([|' pattern '|])'@. diff --git a/manual/manual/refman/refman.etex b/manual/manual/refman/refman.etex index 496e9805..7124672c 100644 --- a/manual/manual/refman/refman.etex +++ b/manual/manual/refman/refman.etex @@ -2,9 +2,9 @@ %HEVEA\cutname{language.html} %better html output that way, sniff. -%HEVEA\subsection*{Foreword} +%HEVEA\subsection*{ss:foreword}{Foreword} %BEGIN LATEX -\section*{Foreword} +\section*{s:foreword}{Foreword} %END LATEX This document is intended as a reference manual for the OCaml @@ -20,7 +20,7 @@ mathematical framework required to express them, while they are definitely part of a full formal definition of the language. -\subsection*{Notations} +\subsection*{ss:notations}{Notations} The syntax of the language is given in BNF-like notation. Terminal symbols are set in typewriter font (@'like' 'this'@). diff --git a/manual/manual/refman/typedecl.etex b/manual/manual/refman/typedecl.etex index f3c94174..b9892ca2 100644 --- a/manual/manual/refman/typedecl.etex +++ b/manual/manual/refman/typedecl.etex @@ -1,8 +1,7 @@ -\section{Type and exception definitions} +\section{s:tydef}{Type and exception definitions} %HEVEA\cutname{typedecl.html}% -\subsection{Type definitions} -\label{s:type-defs} +\subsection{ss:typedefs}{Type definitions} Type definitions bind type constructors to data types: either variant types, record types, type abbreviations, or abstract data @@ -179,7 +178,8 @@ The type variables appearing as type parameters can optionally be prefixed by "+" or "-" to indicate that the type constructor is covariant or contravariant with respect to this parameter. This variance information is used to decide subtyping relations when -checking the validity of @":>"@ coercions (see section \ref{s:coercions}). +checking the validity of @":>"@ coercions +(see section \ref{ss:expr-coercions}). For instance, "type +'a t" declares "t" as an abstract type that is covariant in its parameter; this means that if the type $\tau$ is a @@ -208,7 +208,7 @@ parameter @ident@ has to be an instance of @typexpr@ (more precisely, @ident@ and @typexpr@ are unified). Type variables of @typexpr@ can appear in the type equation and the type declaration. -\subsection{Exception definitions} \label{s:excdef} +\subsection{ss:exndef}{Exception definitions} \ikwd{exception\@\texttt{exception}} \begin{syntax} diff --git a/manual/manual/refman/types.etex b/manual/manual/refman/types.etex index 5528ec42..d2602c6c 100644 --- a/manual/manual/refman/types.etex +++ b/manual/manual/refman/types.etex @@ -1,4 +1,4 @@ -\section{Type expressions} +\section{s:typexpr}{Type expressions} %HEVEA\cutname{types.html} \ikwd{as\@\texttt{as}} @@ -28,7 +28,7 @@ method-type: method-name ':' poly-typexpr \end{syntax} See also the following language extensions: -\hyperref[s-first-class-modules]{first-class modules}, +\hyperref[s:first-class-modules]{first-class modules}, \hyperref[s:attributes]{attributes} and \hyperref[s:extension-nodes]{extension nodes}. @@ -47,7 +47,7 @@ higher precedences come first. Type expressions denote types in definitions of data types as well as in type constraints over patterns and expressions. -\subsubsection*{Type variables} +\subsubsection*{sss:typexpr-variables}{Type variables} The type expression @"'" ident@ stands for the type variable named @ident@. The type expression @"_"@ stands for either an anonymous type @@ -62,18 +62,18 @@ variables is restricted to the type expression where they appear: 1) for universal (explicitly polymorphic) type variables; 2) for type variables that only appear in public method specifications (as those variables will be made universal, as described in -section~\ref{sec-methspec}); +section~\ref{sss:clty-meth}); 3) for variables used as aliases, when the type they are aliased to would be invalid in the scope of the enclosing definition ({\it i.e.} when it contains free universal type variables, or locally defined types.) -\subsubsection*{Parenthesized types} +\subsubsection*{sss:typexr:parenthesized}{Parenthesized types} The type expression @"(" typexpr ")"@ denotes the same type as @typexpr@. -\subsubsection*{Function types} +\subsubsection*{sss:typexr-fun}{Function types} The type expression @typexpr_1 '->' typexpr_2@ denotes the type of functions mapping arguments of type @typexpr_1@ to results of type @@ -87,13 +87,13 @@ mapping an optional labeled argument of type @typexpr_1@ to results of type @typexpr_2@. That is, the physical type of the function will be @typexpr_1 "option" '->' typexpr_2@. -\subsubsection*{Tuple types} +\subsubsection*{sss:typexpr-tuple}{Tuple types} The type expression @typexpr_1 '*' \ldots '*' typexpr_n@ denotes the type of tuples whose elements belong to types @typexpr_1, \ldots typexpr_n@ respectively. -\subsubsection*{Constructed types} +\subsubsection*{sss:typexpr-constructed}{Constructed types} Type constructors with no parameter, as in @typeconstr@, are type expressions. @@ -112,7 +112,7 @@ In the type expression @ "_" typeconstr @, the anonymous type expression @ ("_", \ldots,"_") @ with as many repetitions of "_" as the arity of @typeconstr@. -\subsubsection*{Aliased and recursive types} +\subsubsection*{sss:typexpr-aliased-recursive}{Aliased and recursive types} \ikwd{as\@\texttt{as}} @@ -130,7 +130,7 @@ If @"'" ident@ denotes an explicit polymorphic variable, and @typexpr@ denotes either an object or polymorphic variant type, the row variable of @typexpr@ is captured by @"'" ident@, and quantified upon. -\subsubsection*{Polymorphic variant types} +\subsubsection*{sss:typexpr-polyvar}{Polymorphic variant types} \ikwd{of\@\texttt{of}} \begin{syntax} @@ -194,7 +194,7 @@ Conjunctive constraints are mainly intended as output from the type checker. When they are used in source programs, unsolvable constraints may cause early failures. -\subsubsection*{Object types} +\subsubsection*{sss:typexpr-obj}{Object types} An object type @'<' [method-type { ';' method-type }] '>'@ @@ -213,8 +213,7 @@ methods represented by the ellipsis. This ellipsis actually is a special kind of type variable (called {\em row variable} in the literature) that stands for any number of extra method types. -\subsubsection*{\#-types} -\label{s:sharp-types} +\subsubsection*{sss:typexpr-sharp-types}{\#-types} The type @'#' class-path@ is a special kind of abbreviation. This abbreviation unifies with the type of any object belonging to a subclass @@ -234,9 +233,9 @@ If @@t@@ is an exact variant type then @"#"@t@@ translates to @"[<" @t@"]"@, and @"#"@t@"[>" "`"tag_1 \dots"`"tag_k"]"@ translates to @"[<" @t@ ">" "`"tag_1 \dots"`"tag_k"]"@ -\subsubsection*{Variant and record types} +\subsubsection*{sss:typexpr-variant-record}{Variant and record types} There are no type expressions describing (defined) variant types nor record types, since those are always named, i.e. defined before use and referred to by name. Type definitions are described in -section~\ref{s:type-defs}. +section~\ref{ss:typedefs}. diff --git a/manual/manual/refman/values.etex b/manual/manual/refman/values.etex index dd9ff953..d7e0b696 100644 --- a/manual/manual/refman/values.etex +++ b/manual/manual/refman/values.etex @@ -1,46 +1,46 @@ -\section{Values} +\section{s:values}{Values} %HEVEA\cutname{values.html} This section describes the kinds of values that are manipulated by OCaml programs. -\subsection{Base values} +\subsection{ss:values:base}{Base values} -\subsubsection*{Integer numbers} +\subsubsection*{sss:values:integer}{Integer numbers} Integer values are integer numbers from $-2^{30}$ to $2^{30}-1$, that is $-1073741824$ to $1073741823$. The implementation may support a wider range of integer values: on 64-bit platforms, the current implementation supports integers ranging from $-2^{62}$ to $2^{62}-1$. -\subsubsection*{Floating-point numbers} +\subsubsection*{sss:values:float}{Floating-point numbers} Floating-point values are numbers in floating-point representation. The current implementation uses double-precision floating-point numbers conforming to the IEEE 754 standard, with 53 bits of mantissa and an exponent ranging from $-1022$ to $1023$. -\subsubsection*{Characters} +\subsubsection*{sss:values:char}{Characters} Character values are represented as 8-bit integers between 0 and 255. Character codes between 0 and 127 are interpreted following the ASCII standard. The current implementation interprets character codes between 128 and 255 following the ISO 8859-1 standard. -\subsubsection*{Character strings} \label{s:string-val} +\subsubsection*{sss:values:string}{Character strings} String values are finite sequences of characters. The current implementation supports strings containing up to $2^{24} - 5$ characters (16777211 characters); on 64-bit platforms, the limit is $2^{57} - 9$. -\subsection{Tuples} +\subsection{ss:values:tuple}{Tuples} Tuples of values are written @'('@v@_1',' \ldots',' @v@_n')'@, standing for the $n$-tuple of values @@v@_1@ to @@v@_n@. The current implementation supports tuple of up to $2^{22} - 1$ elements (4194303 elements). -\subsection{Records} +\subsection{ss:values:records}{Records} Record values are labeled tuples of values. The record value written @'{' field_1 '=' @v@_1';' \ldots';' field_n '=' @v@_n '}'@ associates the value @@ -48,7 +48,7 @@ Record values are labeled tuples of values. The record value written implementation supports records with up to $2^{22} - 1$ fields (4194303 fields). -\subsection{Arrays} +\subsection{ss:values:array}{Arrays} Arrays are finite, variable-sized sequences of values of the same type. The current implementation supports arrays containing up to @@ -56,7 +56,7 @@ $2^{22} - 1$ elements (4194303 elements) unless the elements are floating-point numbers (2097151 elements in this case); on 64-bit platforms, the limit is $2^{54} - 1$ for all arrays. -\subsection{Variant values} +\subsection{ss:values:variant}{Variant values} Variant values are either a constant constructor, or a non-constant constructor applied to a number of values. The former case is written @@ -77,18 +77,18 @@ constructors: The current implementation limits each variant type to have at most 246 non-constant constructors and $2^{30}-1$ constant constructors. -\subsection{Polymorphic variants} +\subsection{ss:values:polyvars}{Polymorphic variants} Polymorphic variants are an alternate form of variant values, not belonging explicitly to a predefined variant type, and following specific typing rules. They can be either constant, written @"`"tag-name@, or non-constant, written @"`"tag-name'('@v@')'@. -\subsection{Functions} +\subsection{ss:values:fun}{Functions} Functional values are mappings from values to values. -\subsection{Objects} +\subsection{ss:values:obj}{Objects} Objects are composed of a hidden internal state which is a record of instance variables, and a set of methods for accessing and diff --git a/manual/manual/tutorials/advexamples.etex b/manual/manual/tutorials/advexamples.etex index c3037eb3..bd57a308 100644 --- a/manual/manual/tutorials/advexamples.etex +++ b/manual/manual/tutorials/advexamples.etex @@ -15,8 +15,7 @@ standard library can be expressed as classes. Lastly, we describe a programming pattern known as {\em virtual types} through the example of window managers. -\section{Extended example: bank accounts} -\label{ss:bank-accounts} +\section{s:extended-bank-accounts}{Extended example: bank accounts} In this section, we illustrate most aspects of Object and inheritance by refining, debugging, and specializing the following @@ -297,8 +296,7 @@ new Client.account (new Euro.c 100.);; \end{caml_eval} -\section{Simple modules as classes} -\label{ss:modules-as-classes} +\section{s:modules-as-classes}{Simple modules as classes} One may wonder whether it is possible to treat primitive types such as integers and strings as objects. Although this is usually uninteresting @@ -306,8 +304,7 @@ for integers or strings, there may be some situations where this is desirable. The class "money" above is such an example. We show here how to do it for strings. -\subsection{Strings} -\label{module:string} +\subsection{ss:string-as-class}{Strings} A naive definition of strings as objects could be: \begin{caml_example}{toplevel} @@ -329,7 +326,7 @@ class sub_string s = method sub start len = new sub_string (String.sub s start len) end;; \end{caml_example} -As seen in section \ref{ss:binary-methods}, the solution is to use +As seen in section~\ref{s:binary-methods}, the solution is to use functional update instead. We need to create an instance variable containing the representation "s" of the string. \begin{caml_example}{toplevel} @@ -369,10 +366,9 @@ class cstring n = ostring (String.make n ' ');; \end{caml_example} Here, exposing the representation of strings is probably harmless. We do could also hide the representation of strings as we hid the currency in the -class "money" of section~\ref{ss:friends}. +class "money" of section~\ref{s:friends}. -\subsubsection{Stacks} -\label{module:stack} +\subsubsection{sss:stack-as-class}{Stacks} There is sometimes an alternative between using modules or classes for parametric data types. @@ -432,8 +428,7 @@ class ['a] stack3 = % XXX Maps -\subsection{Hashtbl} -\label{module:hashtbl} +\subsection{ss:hashtbl-as-class}{Hashtbl} A simplified version of object-oriented hash tables should have the following class type. @@ -471,15 +466,14 @@ class ['a, 'b] hashtbl size : ['a, 'b] hash_table = % solution -\subsection{Sets} -\label{module:set} +\subsection{ss:set-as-class}{Sets} Implementing sets leads to another difficulty. Indeed, the method "union" needs to be able to access the internal representation of another object of the same class. -This is another instance of friend functions as seen in section -\ref{ss:friends}. Indeed, this is the same mechanism used in the module +This is another instance of friend functions as seen in +section~\ref{s:friends}. Indeed, this is the same mechanism used in the module "Set" in the absence of objects. In the object-oriented version of sets, we only need to add an additional @@ -529,8 +523,7 @@ module Set : SET = end;; \end{caml_example*} -\section{The subject/observer pattern} -\label{ss:subject-observer} +\section{s:subject-observer}{The subject/observer pattern} The following example, known as the subject/observer pattern, is often presented in the literature as a difficult inheritance problem with @@ -630,7 +623,7 @@ window#add_observer (new trace_observer);; window#move 1; window#resize 2;; \end{caml_example} -%\subsection{Classes used as modules with inheritance} +%\subsection{ss:Classes used as modules with inheritance} % % to be filled for next release... % diff --git a/manual/manual/tutorials/coreexamples.etex b/manual/manual/tutorials/coreexamples.etex index f105327e..8f8c8c77 100644 --- a/manual/manual/tutorials/coreexamples.etex +++ b/manual/manual/tutorials/coreexamples.etex @@ -11,7 +11,7 @@ object-oriented features, chapter~\ref{c:labl-examples} with extensions to the core language (labeled arguments and polymorphic variants), and chapter~\ref{c:advexamples} gives some advanced examples. -\section{Basics} +\section{s:basics}{Basics} For this overview of OCaml, we use the interactive system, which is started by running "ocaml" from the Unix shell, or by launching the @@ -48,7 +48,7 @@ let rec fib n = fib 10;; \end{caml_example} -\section{Data types} +\section{s:datatypes}{Data types} In addition to integers and floating-point numbers, OCaml offers the usual basic data types: @@ -132,7 +132,7 @@ The OCaml notation for the type of a function with multiple arguments is \\ the type inferred for "insert", "'a -> 'a list -> 'a list", means that "insert" takes two arguments, an element of any type "'a" and a list with elements of the same type "'a" and returns a list of the same type. -\section{Functions as values} +\section{s:functions-as-values}{Functions as values} OCaml is a functional language: functions in the full mathematical sense are supported and can be passed around freely just as any other @@ -169,8 +169,7 @@ let rec map f l = | hd :: tl -> f hd :: map f tl;; \end{caml_example} -\section{Records and variants} -\label{s:tut-recvariants} +\section{s:tut-recvariants}{Records and variants} User-defined data structures include records and variants. Both are defined with the "type" declaration. Here, we declare a record type to @@ -300,7 +299,7 @@ let rec insert x btree = \end{caml_example} -\subsection{Record and variant disambiguation} +\subsection{ss:record-and-variant-disambiguation}{Record and variant disambiguation} ( This subsection can be skipped on the first reading ) Astute readers may have wondered what happens when two or more record @@ -387,7 +386,7 @@ definition, or after opening a module (see chapter \ref{c:moduleexamples}). Consequently, adding explicit type annotations to guide disambiguation is more robust than relying on the last defined type disambiguation. -\section{Imperative features} +\section{s:imperative-features}{Imperative features} Though all examples so far were written in purely applicative style, OCaml is also equipped with full imperative features. This includes the @@ -471,7 +470,7 @@ r.id <- (fun x -> print_string "called id\n"; x);; g r;; \end{caml_example} -\section{Exceptions} +\section{s:exceptions}{Exceptions} OCaml provides exceptions for signalling and handling exceptional conditions. Exceptions can also be used as a general-purpose non-local @@ -580,7 +579,7 @@ let fixpoint f x = the function "f" cannot raise a "Done" exception, which removes an entire class of misbehaving functions. -\section{Lazy expressions} +\section{s:lazy-expr}{Lazy expressions} OCaml allows us to defer some computation until later when we need the result of that computation. @@ -653,7 +652,7 @@ The lazy expression "lazy_expr" is forced only if the "lazy_guard" value yields the lazy expression's evaluation. However, a pattern with keyword "lazy", even if it is wildcard, always forces the evaluation of the deferred computation. -\section{Symbolic processing of expressions} +\section{s:symb-expr}{Symbolic processing of expressions} We finish this introduction with a more complete example representative of the use of OCaml for symbolic processing: formal @@ -703,7 +702,7 @@ let rec deriv exp dv = deriv (Quot(Const 1.0, Var "x")) "x";; \end{caml_example} -\section{Pretty-printing} +\section{s:pretty-printing}{Pretty-printing} As shown in the examples above, the internal representation (also called {\em abstract syntax\/}) of expressions quickly becomes hard to @@ -750,7 +749,7 @@ print_expr e; print_newline ();; print_expr (deriv e "x"); print_newline ();; \end{caml_example} -\section{Printf formats} +\section{s:printf}{Printf formats} There is a "printf" function in the \stdmoduleref{Printf} module (see chapter~\ref{c:moduleexamples}) that allows you to make formatted @@ -927,7 +926,7 @@ Printf.printf str 3 4.5 "string value";; %% the second space in "x - 1" causes the lexer to return the three %% expected tokens: "Ident \"x\"", then "Kwd \"-\"", then "Int(1)". -\section{Standalone OCaml programs} +\section{s:standalone-programs}{Standalone OCaml programs} All examples given so far were executed under the interactive system. OCaml code can also be compiled separately and executed diff --git a/manual/manual/tutorials/lablexamples.etex b/manual/manual/tutorials/lablexamples.etex index e306b88e..773f0ecf 100644 --- a/manual/manual/tutorials/lablexamples.etex +++ b/manual/manual/tutorials/lablexamples.etex @@ -7,7 +7,7 @@ \noindent This chapter gives an overview of the new features in OCaml 3: labels, and polymorphic variants. -\section{Labels} +\section{s:labels}{Labels} If you have a look at modules ending in "Labels" in the standard library, you will see that function types have annotations you did not @@ -98,7 +98,7 @@ pattern, but you must prefix it with the label. h (fun ~x:_ ~y -> y+1);; \end{caml_example} -\subsection{Optional arguments} +\subsection{ss:optional-arguments}{Optional arguments} An interesting feature of labeled arguments is that they can be made optional. For optional parameters, the question mark "?" replaces the @@ -162,8 +162,7 @@ let test2 ?x ?y () = test ?x ?y () ();; test2 ?x:None;; \end{caml_example} -\subsection{Labels and type inference} -\label{ss:label-inference} +\subsection{ss:label-inference}{Labels and type inference} While they provide an increased comfort for writing function applications, labels and optional arguments have the pitfall that they @@ -229,7 +228,7 @@ including side-effects. That is, if the application of optional parameters shall produce side-effects, these are delayed until the received function is really applied to an argument. -\subsection{Suggestions for labeling} +\subsection{ss:label-suggestions}{Suggestions for labeling} Like for names, choosing labels for functions is not an easy task. A good labeling is a labeling which @@ -310,7 +309,7 @@ is only used when a more detailed specification is needed. \end{caml_eval} -\section{Polymorphic variants} +\section{s:polymorphic-variants}{Polymorphic variants} Variants as presented in section~\ref{s:tut-recvariants} are a powerful tool to build data structures and algorithms. However they @@ -328,7 +327,7 @@ system will just check that it is an admissible value according to its use. You need not define a type before using a variant tag. A variant type will be inferred independently for each of its uses. -\subsection*{Basic use} +\subsection*{ss:polyvariant:basic-use}{Basic use} In programs, polymorphic variants work like usual ones. You just have to prefix their names with a backquote character "`". @@ -363,7 +362,7 @@ let rec map f : 'a vlist -> 'b vlist = function ;; \end{caml_example} -\subsection*{Advanced use} +\subsection*{ss:polyvariant-advanced}{Advanced use} Type-checking polymorphic variants is a subtle thing, and some expressions may result in more complex type information. @@ -448,7 +447,7 @@ let g = function | `Tag3 -> "Tag3";; \end{caml_example} -\subsection{Weaknesses of polymorphic variants} +\subsection{ss:polyvariant-weaknesses}{Weaknesses of polymorphic variants} After seeing the power of polymorphic variants, one may wonder why they were added to core language variants, rather than replacing them. diff --git a/manual/manual/tutorials/moduleexamples.etex b/manual/manual/tutorials/moduleexamples.etex index bb68975c..8b0a4753 100644 --- a/manual/manual/tutorials/moduleexamples.etex +++ b/manual/manual/tutorials/moduleexamples.etex @@ -3,7 +3,7 @@ This chapter introduces the module system of OCaml. -\section{Structures} +\section{s:module:structures}{Structures} A primary motivation for modules is to package together related definitions (such as the definitions of a data type and associated @@ -99,6 +99,12 @@ becomes \begin{caml_example}{toplevel} PrioQueue.[insert empty 1 "hello"];; \end{caml_example} +This second form also works for patterns: +\begin{caml_example}{toplevel} + let at_most_one_element x = match x with + | PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true + | _ -> false ;; +\end{caml_example} It is also possible to copy the components of a module inside another module by using an "include" statement. This can be @@ -118,7 +124,7 @@ an exception when the priority queue is empty. end;; \end{caml_example} -\section{Signatures} +\section{s:signature}{Signatures} Signatures are interfaces for structures. A signature specifies which components of a structure are accessible from the outside, and @@ -172,7 +178,7 @@ module type PRIOQUEUE_WITH_OPT = \end{caml_example} -\section{Functors} +\section{s:functors}{Functors} Functors are ``functions'' from modules to modules. Functors let you create parameterized modules and then provide other modules as parameter(s) to get @@ -223,7 +229,7 @@ module StringSet = Set(OrderedString);; StringSet.member "bar" (StringSet.add "foo" StringSet.empty);; \end{caml_example} -\section{Functors and type abstraction} +\section{s:functors-and-abstraction}{Functors and type abstraction} As in the "PrioQueue" example, it would be good style to hide the actual implementation of the type "set", so that users of the @@ -312,7 +318,7 @@ operations from "AbstractStringSet" to values of type "NoCaseStringSet.set" could give incorrect results, or build lists that violate the invariants of "NoCaseStringSet". -\section{Modules and separate compilation} +\section{s:separate-compilation}{Modules and separate compilation} All examples of modules so far have been given in the context of the interactive system. However, modules are most useful for large, diff --git a/manual/manual/tutorials/objectexamples.etex b/manual/manual/tutorials/objectexamples.etex index 7298a0d4..0f733023 100644 --- a/manual/manual/tutorials/objectexamples.etex +++ b/manual/manual/tutorials/objectexamples.etex @@ -16,8 +16,7 @@ in those languages. OCaml has alternatives that are often more appropriate, such as modules and functors. Indeed, many OCaml programs do not use objects at all. -\section{Classes and objects} -\label{ss:classes-and-objects} +\section{s:classes-and-objects}{Classes and objects} The class "point" below defines one instance variable "x" and two methods "get_x" and "move". The initial value of the instance variable is "0". @@ -147,11 +146,10 @@ inherited. This ability provides class constructors as can be found in other languages. Several constructors can be defined this way to build objects of the same class but with different initialization patterns; an -alternative is to use initializers, as described below in section -\ref{ss:initializers}. +alternative is to use initializers, as described below in +section~\ref{s:initializers}. -\section{Immediate objects} -\label{ss:immediate-objects} +\section{s:immediate-objects}{Immediate objects} There is another, more direct way to create an object: create it without going through a class. @@ -183,10 +181,9 @@ let minmax x y = Immediate objects have two weaknesses compared to classes: their types are not abbreviated, and you cannot inherit from them. But these two weaknesses can be advantages in some situations, as we will see -in sections \ref{ss:reference-to-self} and \ref{ss:parameterized-classes}. +in sections~\ref{s:reference-to-self} and~\ref{s:parameterized-classes}. -\section{Reference to self} -\label{ss:reference-to-self} +\section{s:reference-to-self}{Reference to self} A method or an initializer can invoke methods on self (that is, the current object). For that, self must be explicitly bound, here to @@ -220,7 +217,7 @@ class my_int = You can ignore the first two lines of the error message. What matters is the last one: putting self into an external reference would make it impossible to extend it through inheritance. -We will see in section \ref{ss:using-coercions} a workaround to this +We will see in section~\ref{s:using-coercions} a workaround to this problem. Note however that, since immediate objects are not extensible, the problem does not occur with them. @@ -232,8 +229,7 @@ let my_int = end;; \end{caml_example} -\section{Initializers} -\label{ss:initializers} +\section{s:initializers}{Initializers} Let-bindings within class definitions are evaluated before the object is constructed. It is also possible to evaluate an expression @@ -255,11 +251,10 @@ let p = new printable_point 17;; Initializers cannot be overridden. On the contrary, all initializers are evaluated sequentially. Initializers are particularly useful to enforce invariants. -Another example can be seen in section \ref{ss:bank-accounts}. +Another example can be seen in section~\ref{s:extended-bank-accounts}. -\section{Virtual methods} -\label{ss:virtual-methods} +\section{s:virtual-methods}{Virtual methods} It is possible to declare a method without actually defining it, using the keyword "virtual". This method will be provided later in @@ -299,8 +294,7 @@ class point2 x_init = end;; \end{caml_example} -\section{Private methods} -\label{ss:private-methods} +\section{s:private-methods}{Private methods} Private methods are methods that do not appear in object interfaces. They can only be invoked from other methods of the same object. @@ -322,7 +316,7 @@ class. This is a direct consequence of the independence between types and classes in OCaml: two unrelated classes may produce objects of the same type, and there is no way at the type level to ensure that an object comes from a specific class. However a possible -encoding of friend methods is given in section \ref{ss:friends}. +encoding of friend methods is given in section~\ref{s:friends}. Private methods are inherited (they are by default visible in subclasses), unless they are hidden by signature matching, as described below. @@ -365,8 +359,7 @@ class point_again x = Of course, private methods can also be virtual. Then, the keywords must appear in this order "method private virtual". -\section{Class interfaces} -\label{ss:class-interfaces} +\section{s:class-interfaces}{Class interfaces} %XXX Differentiate class type and class interface ? @@ -408,8 +401,7 @@ module Point : POINT = struct end;; \end{caml_example} -\section{Inheritance} -\label{ss:inheritance} +\section{s:inheritance}{Inheritance} We illustrate inheritance by defining a class of colored points that inherits from the class of points. This class has all instance @@ -440,8 +432,7 @@ let set_x p = p#set_x;; let incr p = set_x p (get_succ_x p);; \end{caml_example} -\section{Multiple inheritance} -\label{ss:multiple-inheritance} +\section{s:multiple-inheritance}{Multiple inheritance} Multiple inheritance is allowed. Only the last definition of a method is kept: the redefinition in a subclass of a method that was visible in @@ -492,8 +483,7 @@ class another_printable_colored_point y c c' = end;; \end{caml_example} -\section{Parameterized classes} -\label{ss:parameterized-classes} +\section{s:parameterized-classes}{Parameterized classes} Reference cells can be implemented as objects. The naive definition fails to typecheck: @@ -598,8 +588,7 @@ class ['a] colored_circle c = end;; \end{caml_example} -\section{Polymorphic methods} -\label{ss:polymorphic-methods} +\section{s:polymorphic-methods}{Polymorphic methods} While parameterized classes may be polymorphic in their contents, they are not enough to allow polymorphism of method use. @@ -697,8 +686,8 @@ let sum lst = \end{caml_example} Another use of polymorphic methods is to allow some form of implicit -subtyping in method arguments. We have already seen in section -\ref{ss:inheritance} how some functions may be polymorphic in the +subtyping in method arguments. We have already seen in +section~\ref{s:inheritance} how some functions may be polymorphic in the class of their argument. This can be extended to methods. \begin{caml_example}{toplevel} class type point0 = object method get_x : int end;; @@ -728,8 +717,7 @@ In method "m1", "o" must be an object with at least a method "n1", itself polymorphic. In method "m2", the argument of "n2" and "x" must have the same type, which is quantified at the same level as "'a". -\section{Using coercions} -\label{ss:using-coercions} +\section{s:using-coercions}{Using coercions} Subtyping is never implicit. There are, however, two ways to perform subtyping. The most general construction is fully explicit: both the @@ -827,7 +815,7 @@ unrolled twice to obtain "< m : < m : c1; .. >; .. >" (remember "#c1 = You may also note that the type of "to_c2" is "#c2 -> c2" while the type of "to_c1" is more general than "#c1 -> c1". This is not always true, since there are class types for which some instances of "#c" are not subtypes -of "c", as explained in section~\ref{ss:binary-methods}. Yet, for +of "c", as explained in section~\ref{s:binary-methods}. Yet, for parameterless classes the coercion "(_ :> c)" is always more general than "(_ : #c :> c)". %If a class type exposes the type of self through one of its parameters, this @@ -923,8 +911,7 @@ type 'a c'_class = 'a constraint 'a = < m : int; .. >;; \end{caml_example*} with an extra type variable capturing the open object type. -\section{Functional objects} -\label{ss:functional-objects} +\section{s:functional-objects}{Functional objects} It is possible to write a version of class "point" without assignments on the instance variables. The override construct "{< ... >}" returns a copy of @@ -969,10 +956,9 @@ subclass of "functional_point", the method "move" will return an object of the subclass. Functional update is often used in conjunction with binary methods -as illustrated in section \ref{module:string}. +as illustrated in section~\ref{ss:string-as-class}. -\section{Cloning objects} -\label{ss:cloning-objects} +\section{s:cloning-objects}{Cloning objects} Objects can also be cloned, whether they are functional or imperative. The library function "Oo.copy" makes a shallow copy of an object. That is, @@ -1070,8 +1056,7 @@ p # save; p # set 1; p # save; p # set 2; -\section{Recursive classes} -\label{ss:recursive-classes} +\section{s:recursive-classes}{Recursive classes} Recursive classes can be used to define objects whose types are mutually recursive. @@ -1091,8 +1076,7 @@ Although their types are mutually recursive, the classes "widget" and "window" are themselves independent. -\section{Binary methods} -\label{ss:binary-methods} +\section{s:binary-methods}{Binary methods} A binary method is a method which takes an argument of the same type as self. The class "comparable" below is a template for classes with a @@ -1157,8 +1141,8 @@ or "money2". (min (new money2 5.0) (new money2 3.14))#value;; \end{caml_example} -More examples of binary methods can be found in sections -\ref{module:string} and \ref{module:set}. +More examples of binary methods can be found in +sections~\ref{ss:string-as-class} and~\ref{ss:set-as-class}. Note the use of override for method "times". Writing "new money2 (k *. repr)" instead of "{< repr = k *. repr >}" @@ -1180,8 +1164,7 @@ class money x = end;; \end{caml_example} -\section{Friends} -\label{ss:friends} +\section{s:friends}{Friends} The above class "money" reveals a problem that often occurs with binary methods. In order to interact with other objects of the same class, the @@ -1231,8 +1214,8 @@ module Euro : MONEY = end end;; \end{caml_example*} -Another example of friend functions may be found in section -\ref{module:set}. These examples occur when a group of objects (here +Another example of friend functions may be found in section~\ref{ss:set-as-class}. +These examples occur when a group of objects (here objects of the same class) and functions should see each others internal representation, while their representation should be hidden from the outside. The solution is always to define all friends in the same module, diff --git a/manual/manual/tutorials/polymorphism.etex b/manual/manual/tutorials/polymorphism.etex index 5e62979a..6fbfd494 100644 --- a/manual/manual/tutorials/polymorphism.etex +++ b/manual/manual/tutorials/polymorphism.etex @@ -15,9 +15,8 @@ recursion and higher-rank polymorphism. This chapter details each of these situations and, if it is possible, how to recover genericity. -\section{Weak polymorphism and mutation} -\subsection{Weakly polymorphic types} -\label{ss:weaktypes} +\section{s:weak-polymorphism}{Weak polymorphism and mutation} +\subsection{ss:weak-types}{Weakly polymorphic types} Maybe the most frequent examples of non-genericity derive from the interactions between polymorphic types and mutation. A simple example appears when typing the following expression @@ -101,7 +100,7 @@ Otherwise, they will pick out the type of first use. If there is a mistake at this point, this can result in confusing type errors when later, correct uses are flagged as errors. -\subsection{The value restriction}\label{ss:valuerestriction} +\subsection{ss:valuerestriction}{The value restriction} Identifying the exact context in which polymorphic types should be replaced by weak types in a modular way is a difficult question. Indeed @@ -141,7 +140,7 @@ With this argument, "id_again" is seen as a function definition by the type checker and can therefore be generalized. This kind of manipulation is called eta-expansion in lambda calculus and is sometimes referred under this name. -\subsection{The relaxed value restriction} +\subsection{ss:relaxed-value-restriction}{The relaxed value restriction} There is another partial solution to the problem of unnecessary weak type, which is implemented directly within the type checker. Briefly, it is possible @@ -160,7 +159,7 @@ The value restriction combined with this generalization for covariant type parameters is called the relaxed value restriction. %question: is here the best place for describing variance? -\subsection{Variance and value restriction} +\subsection{ss:variance-and-value-restriction}{Variance and value restriction} Variance describes how type constructors behave with respect to subtyping. Consider for instance a pair of type "x" and "xy" with "x" a subtype of "xy", denoted "x :> xy": @@ -225,7 +224,7 @@ article by Jacques Garrigue on Together, the relaxed value restriction and type parameter covariance help to avoid eta-expansion in many situations. -\subsection{Abstract data types} +\subsection{ss:variance:abstract-data-types}{Abstract data types} Moreover, when the type definitions are exposed, the type checker is able to infer variance information on its own and one can benefit from the relaxed value restriction even unknowingly. However, this is not the case @@ -270,7 +269,7 @@ We then recover polymorphism: List2.empty ();; \end{caml_example} -\section{Polymorphic recursion}\label{s:polymorphic-recursion} +\section{s:polymorphic-recursion}{Polymorphic recursion} The second major class of non-genericity is directly related to the problem of type inference for polymorphic functions. In some circumstances, the type @@ -328,7 +327,7 @@ the type checker had introduced a new type variable "'a" only at the \emph{definition} of the function "depth" whereas, here, we need a different type variable for every \emph{application} of the function "depth". -\subsection{Explicitly polymorphic annotations} +\subsection{ss:explicit-polymorphism}{Explicitly polymorphic annotations} The solution of this conundrum is to use an explicitly polymorphic type annotation for the type "'a": \begin{caml_example}{toplevel} @@ -373,7 +372,7 @@ depth ( Nested(List [ [7]; [8] ]) );; %todo: add a paragraph on the interaction with locally abstract type -\subsection{More examples} +\subsection{ss:recursive-poly-examples}{More examples} With explicit polymorphic annotations, it becomes possible to implement any recursive function that depends only on the structure of the nested lists and not on the type of the elements. For instance, a more complex @@ -413,7 +412,7 @@ let shape n = shape (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));; \end{caml_example} -\section{Higher-rank polymorphic functions} +\section{s:higher-rank-poly}{Higher-rank polymorphic functions} Explicit polymorphic annotations are however not sufficient to cover all the cases where the inferred type of a function is less general than diff --git a/manual/styles/caml-sl.sty b/manual/styles/caml-sl.sty deleted file mode 100644 index 6bcfefe8..00000000 --- a/manual/styles/caml-sl.sty +++ /dev/null @@ -1,61 +0,0 @@ -% CAML style option, for use with the caml-latex filter. - -\typeout{Document Style option `caml-sl' <7 Apr 92>.} -\newcommand{\hash}{\#} -{\catcode`\^^M=\active % - \gdef\@camlinputline#1^^M{\normalsize\tt\hash{} #1\par} % - \gdef\@camloutputline#1^^M{\small\ttfamily\slshape#1\par} } % -\def\@camlblankline{\medskip} -\chardef\@camlbackslash="5C -\def\@bunderline{\setbox0\hbox\bgroup\let\par\@parinunderline} - -\def \@parinunderline {\futurelet \@next \@@parinunderline} -\def \@@parinunderline {\ifx \@next \? \let \@do \@@par@inunderline \else \let \@do \@@@parinunderline \fi \@do} -\def \@@par@inunderline #1{\@eunderline\@oldpar\?\@bunderline} -\def \@@@parinunderline {\@eunderline\@oldpar\@bunderline} -\def\@eunderline{\egroup\underline{\box0}} -\def\@camlnoop{} - -\def\caml{ - \bgroup - \parindent 0pt - \parskip 0pt - \let\do\@makeother\dospecials - \catcode13=\active % 13 = ^M = CR - \catcode92=0 % 92 = \ - \catcode32=\active % 32 = SPC - \frenchspacing - \@vobeyspaces - \let\@oldpar\par - \let\?\@camlinputline - \let\:\@camloutputline - \let\;\@camlblankline - \let\<\@bunderline - \let\>\@eunderline - \let\\\@camlbackslash - \let\-\@camlnoop -} - -\def\endcaml{ - \egroup - \addvspace{\medskipamount} -} - -% Caml-example related command -\def\camlexample#1{ - \ifnum\pdfstrcmp{#1}{toplevel}=0 - \renewcommand{\hash}{\#} - \else - \renewcommand{\hash}{} - \fi - \begin{flushleft} -} -\def\endcamlexample{\end{flushleft}\renewcommand{\hash}{\#}} -\def\camlinput{} -\def\endcamlinput{} -\def\camloutput{} -\def\endcamloutput{} -\def\camlerror{} -\def\endcamlerror{} -\def\camlwarn{} -\def\endcamlwarn{} diff --git a/manual/styles/caml.sty b/manual/styles/caml.sty deleted file mode 100644 index 3f5753ca..00000000 --- a/manual/styles/caml.sty +++ /dev/null @@ -1,31 +0,0 @@ -% CAML style option, for use with the caml-latex filter. - -\typeout{Document Style option `caml' <7 Apr 92>.} - -{\catcode`\^^M=\active % - \gdef\@camlinputline#1^^M{\tt\##1\par} % - \gdef\@camloutputline#1^^M{\tt#1\par} } % -\def\@camlblankline{\medskip} -\chardef\@camlbackslash="5C - -\def\caml{ - \bgroup - \flushleft - \parindent 0pt - \parskip 0pt - \let\do\@makeother\dospecials - \catcode`\^^M=\active - \catcode`\\=0 - \catcode`\ \active - \frenchspacing - \@vobeyspaces - \let\?\@camlinputline - \let\:\@camloutputline - \let\;\@camlblankline - \let\\\@camlbackslash -} - -\def\endcaml{ - \endflushleft - \egroup\noindent -} diff --git a/manual/styles/html.sty b/manual/styles/html.sty index 6a9e9253..137fdf16 100644 --- a/manual/styles/html.sty +++ b/manual/styles/html.sty @@ -111,7 +111,7 @@ % Changed \next to \html@next to prevent clashes with other sty files % (mike@emn.fr) % Changed \html@next to \htmlnext so the \makeatletter and -% \makeatother commands could be removed (they were cuasing other +% \makeatother commands could be removed (they were causing other % style files - changebar.sty - to crash) (nikos@cbl.leeds.ac.uk) diff --git a/manual/tests/Makefile b/manual/tests/Makefile index 80f0c506..d3315fff 100644 --- a/manual/tests/Makefile +++ b/manual/tests/Makefile @@ -1,9 +1,11 @@ TOPDIR=$(abspath ../..) +SRC=$(TOPDIR) include $(TOPDIR)/Makefile.tools +include $(TOPDIR)/ocamldoc/Makefile.docfiles MANUAL=$(TOPDIR)/manual/manual .PHONY: all -all: check-cross-references check-stdlib +all: check-cross-references check-stdlib check-case-collision .PHONY: tools tools: cross-reference-checker @@ -13,6 +15,7 @@ cross-reference-checker: cross_reference_checker.ml -I $(TOPDIR)/parsing -I $(TOPDIR)/driver \ $< -o $@ +# check cross-references between the manual and error messages .PHONY: check-cross-references check-cross-references: cross-reference-checker $(SET_LD_PATH) \ @@ -22,11 +25,32 @@ check-cross-references: cross-reference-checker $(TOPDIR)/driver/main_args.ml \ $(TOPDIR)/lambda/translmod.ml +# check that all standard library modules are referenced by the +# standard library chapter of the manual .PHONY: check-stdlib check-stdlib: ./check-stdlib-modules $(TOPDIR) +# check name collision between latex source file and module documentation +# on case-insensitive file systems +normalize = $(shell echo $(basename $(notdir $(1) )) | tr A-Z a-z) +LOWER_MLIS= $(call normalize,$(DOC_ALL_MLIS)) +LOWER_ETEX= $(call normalize,$(wildcard $(MANUAL)/*/*.etex) $(wildcard *.etex)) +INTER = $(filter $(LOWER_ETEX), $(LOWER_MLIS)) + +.PHONY: check-case-collision +check-case-collision: +ifeq ($(INTER),) +else + @echo "The following names" + @echo " $(INTER)" + @echo "are used by both an OCaml module and a latex source file." + @echo "This creates a conflict on case-insensitive file systems." + @false +endif + + .PHONY: clean clean: rm -f *.cm? *.cmx? cross-reference-checker diff --git a/manual/tools/texquote2.ml b/manual/tools/texquote2.ml index d6e8a8f5..2a996615 100644 --- a/manual/tools/texquote2.ml +++ b/manual/tools/texquote2.ml @@ -81,7 +81,7 @@ let process_line line = function | Normal -> if is_prefix "\\begin{caml_" line || is_prefix "\\begin{rawhtml}" line then (print_string line; Verbatim_like) - else if is_prefix "\\camlexample" line + else if is_prefix "\\begin{camlexample}" line then (print_endline line; Caml) else if is_prefix "\\begin{verbatim}" line then begin @@ -100,7 +100,7 @@ let process_line line = function end | Caml -> print_endline line; - if is_prefix "\\endcamlexample" line then Normal else Caml + if is_prefix "\\end{camlexample}" line then Normal else Caml | Verbatim (verbatim_end_in, verbatim_end_out) as env -> if is_prefix verbatim_end_in line then begin diff --git a/manual/tools/transf.mll b/manual/tools/transf.mll index dcb5f3e2..a9cc2671 100644 --- a/manual/tools/transf.mll +++ b/manual/tools/transf.mll @@ -14,7 +14,7 @@ rule main = parse "\\begin{syntax}" { print_string "\\begin{syntax}"; syntax lexbuf } - | "\\begin{verbatim}" | "\\camlexample" as s { + | "\\begin{verbatim}" | "\\begin{camlexample}" as s { print_string s; verbatim lexbuf } | "\\@" { @@ -99,7 +99,7 @@ and indoublequote = parse indoublequote lexbuf } and verbatim = parse - "\n\\end{verbatim}"|"\\endcamlexample" as s { + "\n\\end{verbatim}"|"\\end{camlexample}" as s { print_string s; main lexbuf } | _ { diff --git a/middle_end/clambda.ml b/middle_end/clambda.ml index 406bfbcc..59402629 100644 --- a/middle_end/clambda.ml +++ b/middle_end/clambda.ml @@ -136,6 +136,9 @@ type preallocated_constant = { provenance : usymbol_provenance option; } +type with_constants = + ulambda * preallocated_block list * preallocated_constant list + (* Comparison functions for constants. We must not use Stdlib.compare because it compares "0.0" and "-0.0" equal. (PR#6442) *) diff --git a/middle_end/clambda.mli b/middle_end/clambda.mli index ddd0956d..9d74eb66 100644 --- a/middle_end/clambda.mli +++ b/middle_end/clambda.mli @@ -151,3 +151,6 @@ type preallocated_constant = { definition : ustructured_constant; provenance : usymbol_provenance option; } + +type with_constants = + ulambda * preallocated_block list * preallocated_constant list diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml index 20767f62..ef657569 100644 --- a/middle_end/closure/closure.ml +++ b/middle_end/closure/closure.ml @@ -184,7 +184,7 @@ let lambda_smaller lam threshold = size := !size+2 ; lambda_size lam) sw ; - Misc.may lambda_size d + Option.iter lambda_size d | Ustaticfail (_,args) -> lambda_list_size args | Ucatch(_, _, body, handler) -> incr size; lambda_size body; lambda_size handler @@ -627,7 +627,7 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam = Ustringswitch (substitute loc st sb rn arg, List.map (fun (s,act) -> s,substitute loc st sb rn act) sw, - Misc.may_map (substitute loc st sb rn) d) + Option.map (substitute loc st sb rn) d) | Ustaticfail (nfail, args) -> let nfail = match rn with @@ -1116,7 +1116,7 @@ let rec close ({ backend; fenv; cenv } as env) lam = s,uact) sw in let ud = - Misc.may_map + Option.map (fun d -> let ud,_ = close env d in ud) d in @@ -1433,7 +1433,7 @@ let collect_exported_structured_constants a = | Ustringswitch (u,sw,d) -> ulam u ; List.iter (fun (_,act) -> ulam act) sw ; - Misc.may ulam d + Option.iter ulam d | Ustaticfail (_, ul) -> List.iter ulam ul | Ucatch (_, _, u1, u2) | Utrywith (u1, _, u2) diff --git a/middle_end/closure/closure_middle_end.ml b/middle_end/closure/closure_middle_end.ml new file mode 100644 index 00000000..cb593eb0 --- /dev/null +++ b/middle_end/closure/closure_middle_end.ml @@ -0,0 +1,58 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +[@@@ocaml.warning "+a-4-30-40-41-42"] + +let raw_clambda_dump_if ppf + ((ulambda, _, structured_constants) : Clambda.with_constants) = + if !Clflags.dump_rawclambda || !Clflags.dump_clambda then + begin + Format.fprintf ppf "@.clambda:@."; + Printclambda.clambda ppf ulambda; + List.iter (fun { Clambda. symbol; definition; _ } -> + Format.fprintf ppf "%s:@ %a@." + symbol + Printclambda.structured_constant definition) + structured_constants + end; + if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@." + +let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump + (lambda : Lambda.program) = + let clambda = + Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code + in + let provenance : Clambda.usymbol_provenance = + { original_idents = []; + module_path = + Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ())); + } + in + let preallocated_block = + Clambda.{ + symbol = Compilenv.make_symbol None; + exported = true; + tag = 0; + fields = List.init lambda.main_module_block_size (fun _ -> None); + provenance = Some provenance; + } + in + let constants = Compilenv.structured_constants () in + Compilenv.clear_structured_constants (); + let clambda_and_constants = + clambda, [preallocated_block], constants + in + raw_clambda_dump_if ppf_dump clambda_and_constants; + clambda_and_constants diff --git a/middle_end/closure/closure_middle_end.mli b/middle_end/closure/closure_middle_end.mli new file mode 100644 index 00000000..e0ebb1de --- /dev/null +++ b/middle_end/closure/closure_middle_end.mli @@ -0,0 +1,22 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +val lambda_to_clambda + : backend:(module Backend_intf.S) + -> filename:string + -> prefixname:string + -> ppf_dump:Format.formatter + -> Lambda.program + -> Clambda.with_constants diff --git a/middle_end/compilenv.ml b/middle_end/compilenv.ml index add4e90e..247b0694 100644 --- a/middle_end/compilenv.ml +++ b/middle_end/compilenv.ml @@ -49,16 +49,18 @@ module CstMap = because it compares "0.0" and "-0.0" equal. *) end) +module SymMap = Misc.Stdlib.String.Map + type structured_constants = { strcst_shared: string CstMap.t; - strcst_all: (string * Clambda.ustructured_constant) list; + strcst_all: Clambda.ustructured_constant SymMap.t; } let structured_constants_empty = { strcst_shared = CstMap.empty; - strcst_all = []; + strcst_all = SymMap.empty; } let structured_constants = ref structured_constants_empty @@ -371,7 +373,7 @@ let new_structured_constant cst ~shared = structured_constants := { strcst_shared = CstMap.add cst lbl strcst_shared; - strcst_all = (lbl, cst) :: strcst_all; + strcst_all = SymMap.add lbl cst strcst_all; }; lbl else @@ -379,7 +381,7 @@ let new_structured_constant cst ~shared = structured_constants := { strcst_shared; - strcst_all = (lbl, cst) :: strcst_all; + strcst_all = SymMap.add lbl cst strcst_all; }; lbl @@ -389,6 +391,9 @@ let add_exported_constant s = let clear_structured_constants () = structured_constants := structured_constants_empty +let structured_constant_of_symbol s = + SymMap.find_opt s (!structured_constants).strcst_all + let structured_constants () = let provenance : Clambda.usymbol_provenance = { original_idents = []; @@ -396,7 +401,8 @@ let structured_constants () = Path.Pident (Ident.create_persistent (current_unit_name ())); } in - List.map + SymMap.bindings (!structured_constants).strcst_all + |> List.map (fun (symbol, definition) -> { Clambda.symbol; @@ -404,7 +410,6 @@ let structured_constants () = definition; provenance = Some provenance; }) - (!structured_constants).strcst_all let closure_symbol fv = let compilation_unit = Closure_id.get_compilation_unit fv in diff --git a/middle_end/compilenv.mli b/middle_end/compilenv.mli index 569d51ea..8f1ef284 100644 --- a/middle_end/compilenv.mli +++ b/middle_end/compilenv.mli @@ -117,6 +117,10 @@ val new_structured_constant: val structured_constants: unit -> Clambda.preallocated_constant list val clear_structured_constants: unit -> unit + +val structured_constant_of_symbol: + string -> Clambda.ustructured_constant option + val add_exported_constant: string -> unit (* clambda-only *) type structured_constants diff --git a/middle_end/flambda/augment_specialised_args.mli b/middle_end/flambda/augment_specialised_args.mli index 5c48a126..910a2d15 100644 --- a/middle_end/flambda/augment_specialised_args.mli +++ b/middle_end/flambda/augment_specialised_args.mli @@ -48,7 +48,7 @@ module type S = sig -> What_to_specialise.t end -module Make (T : S) : sig +module Make (_ : S) : sig (** [duplicate_function] should be [Inline_and_simplify.duplicate_function]. *) val rewrite_set_of_closures diff --git a/middle_end/flambda/base_types/id_types.ml b/middle_end/flambda/base_types/id_types.ml index 6d2e2743..c9a77adc 100644 --- a/middle_end/flambda/base_types/id_types.ml +++ b/middle_end/flambda/base_types/id_types.ml @@ -40,7 +40,7 @@ module type UnitId = sig val unit : t -> Compilation_unit.t end -module Id(E:sig end) : Id = struct +module Id() : Id = struct type t = int * string let empty_string = "" let create = let r = ref 0 in diff --git a/middle_end/flambda/base_types/id_types.mli b/middle_end/flambda/base_types/id_types.mli index 48ca037c..78ca75a8 100644 --- a/middle_end/flambda/base_types/id_types.mli +++ b/middle_end/flambda/base_types/id_types.mli @@ -46,11 +46,9 @@ sig val unit : t -> Compilation_unit.t end -(** If applied generatively, i.e. [Id(struct end)], creates a new type - of identifiers. *) -module Id : functor (E : sig end) -> Id +module Id () : Id module UnitId : - functor (Id : Id) -> + Id -> functor (Compilation_unit : Identifiable.Thing) -> UnitId with module Compilation_unit := Compilation_unit diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml index 9bdd30ea..a89d755e 100644 --- a/middle_end/flambda/closure_conversion.ml +++ b/middle_end/flambda/closure_conversion.ml @@ -502,14 +502,14 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t = consts = List.map aux sw.sw_consts; numblocks = nums sw.sw_numblocks sw.sw_blocks sw.sw_failaction; blocks = List.map aux sw.sw_blocks; - failaction = Misc.may_map (close t env) sw.sw_failaction; + failaction = Option.map (close t env) sw.sw_failaction; })) | Lstringswitch (arg, sw, def, _) -> let scrutinee = Variable.create Names.string_switch in Flambda.create_let scrutinee (Expr (close t env arg)) (String_switch (scrutinee, List.map (fun (s, e) -> s, close t env e) sw, - Misc.may_map (close t env) def)) + Option.map (close t env) def)) | Lstaticraise (i, args) -> Lift_code.lifting_helper (close_list t env args) ~evaluation_order:`Right_to_left diff --git a/middle_end/flambda/effect_analysis.ml b/middle_end/flambda/effect_analysis.ml index d0cbd441..2ddba764 100644 --- a/middle_end/flambda/effect_analysis.ml +++ b/middle_end/flambda/effect_analysis.ml @@ -37,12 +37,10 @@ let rec no_effects (flam : Flambda.t) = let aux (_, flam) = no_effects flam in List.for_all aux sw.blocks && List.for_all aux sw.consts - && Misc.Stdlib.Option.value_default no_effects sw.failaction - ~default:true + && Option.fold ~some:no_effects ~none:true sw.failaction | String_switch (_, sw, def) -> List.for_all (fun (_, lam) -> no_effects lam) sw - && Misc.Stdlib.Option.value_default no_effects def - ~default:true + && Option.fold ~some:no_effects ~none:true def | Static_catch (_, _, body, _) | Try_with (body, _, _) -> (* If there is a [raise] in [body], the whole [Try_with] may have an effect, so there is no need to test the handler. *) diff --git a/middle_end/flambda/export_info_for_pack.ml b/middle_end/flambda/export_info_for_pack.ml index 42a81553..ebed5593 100644 --- a/middle_end/flambda/export_info_for_pack.ml +++ b/middle_end/flambda/export_info_for_pack.ml @@ -89,7 +89,7 @@ let import_set_of_closures units pack Closure_id.Map.map (import_approx_for_pack units pack) set_of_closures.results; aliased_symbol = - Misc.may_map + Option.map (import_symbol_for_pack units pack) set_of_closures.aliased_symbol; } diff --git a/middle_end/flambda/flambda.ml b/middle_end/flambda/flambda.ml index 243e2e3f..70adfcb9 100644 --- a/middle_end/flambda/flambda.ml +++ b/middle_end/flambda/flambda.ml @@ -565,11 +565,11 @@ let rec variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument free_variable scrutinee; List.iter (fun (_, e) -> aux e) switch.consts; List.iter (fun (_, e) -> aux e) switch.blocks; - Misc.may aux switch.failaction + Option.iter aux switch.failaction | String_switch (scrutinee, cases, failaction) -> free_variable scrutinee; List.iter (fun (_, e) -> aux e) cases; - Misc.may aux failaction + Option.iter aux failaction | Static_raise (_, es) -> List.iter free_variable es | Static_catch (_, vars, e1, e2) -> @@ -789,10 +789,10 @@ let iter_general ~toplevel f f_named maybe_named = | Switch (_, sw) -> List.iter (fun (_,l) -> aux l) sw.consts; List.iter (fun (_,l) -> aux l) sw.blocks; - Misc.may aux sw.failaction + Option.iter aux sw.failaction | String_switch (_, sw, def) -> List.iter (fun (_,l) -> aux l) sw; - Misc.may aux def + Option.iter aux def and aux_named (named : named) = f_named named; match named with @@ -1138,7 +1138,7 @@ let create_set_of_closures ~function_decls ~free_vars ~specialised_args This would be true when the function is known never to have been inlined. - Note that something like that may maybe enforcable in + Note that something like that may maybe enforceable in inline_and_simplify, but there is no way to do that on other passes. diff --git a/middle_end/flambda/flambda_invariants.ml b/middle_end/flambda/flambda_invariants.ml index 250a2e9a..6c2b572d 100644 --- a/middle_end/flambda/flambda_invariants.ml +++ b/middle_end/flambda/flambda_invariants.ml @@ -213,14 +213,14 @@ let variable_and_symbol_invariants (program : Flambda.program) = ignore_int n; loop env e) (consts @ blocks); - Misc.may (loop env) failaction + Option.iter (loop env) failaction | String_switch (arg, cases, e_opt) -> check_variable_is_bound env arg; List.iter (fun (label, case) -> ignore_string label; loop env case) cases; - Misc.may (loop env) e_opt + Option.iter (loop env) e_opt | Static_raise (static_exn, es) -> ignore_static_exception static_exn; List.iter (check_variable_is_bound env) es diff --git a/middle_end/flambda/flambda_iterators.ml b/middle_end/flambda/flambda_iterators.ml index a69575da..6edc4bba 100644 --- a/middle_end/flambda/flambda_iterators.ml +++ b/middle_end/flambda/flambda_iterators.ml @@ -32,10 +32,10 @@ let apply_on_subexpressions f f_named (flam : Flambda.t) = | Switch (_, sw) -> List.iter (fun (_,l) -> f l) sw.consts; List.iter (fun (_,l) -> f l) sw.blocks; - Misc.may f sw.failaction + Option.iter f sw.failaction | String_switch (_, sw, def) -> List.iter (fun (_,l) -> f l) sw; - Misc.may f def + Option.iter f def | Static_catch (_,_,f1,f2) -> f f1; f f2; | Try_with (f1,_,f2) -> diff --git a/middle_end/flambda/flambda_middle_end.ml b/middle_end/flambda/flambda_middle_end.ml index e604a328..6330ff12 100644 --- a/middle_end/flambda/flambda_middle_end.ml +++ b/middle_end/flambda/flambda_middle_end.ml @@ -6,7 +6,7 @@ (* Mark Shinwell and Leo White, Jane Street Europe *) (* *) (* Copyright 2013--2016 OCamlPro SAS *) -(* Copyright 2014--2016 Jane Street Group LLC *) +(* Copyright 2014--2019 Jane Street Group LLC *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) @@ -14,7 +14,7 @@ (* *) (**************************************************************************) -[@@@ocaml.warning "+a-4-9-30-40-41-42-66"] +[@@@ocaml.warning "+a-4-30-40-41-42-66"] open! Int_replace_polymorphic_compare let _dump_function_sizes flam ~backend = @@ -31,11 +31,8 @@ let _dump_function_sizes flam ~backend = | None -> assert false) set_of_closures.function_decls.funs) -let middle_end ~ppf_dump ~prefixname ~backend - ~size - ~filename - ~module_ident - ~module_initializer = +let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename + ~module_ident ~module_initializer = Profile.record_call "flambda" (fun () -> let previous_warning_reporter = !Location.warning_reporter in let module WarningSet = @@ -198,3 +195,54 @@ let middle_end ~ppf_dump ~prefixname ~backend (* dump_function_sizes flam ~backend; *) flam)) ) + +let flambda_raw_clambda_dump_if ppf + ({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _; + structured_constants; exported = _; } as input) = + if !Clflags.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 !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."; + input + +let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump + (program : Lambda.program) = + let program = + lambda_to_flambda ~ppf_dump ~prefixname ~backend + ~size:program.main_module_block_size + ~filename + ~module_ident:program.module_ident + ~module_initializer:program.code + in + let export = Build_export_info.build_transient ~backend program in + let clambda, preallocated_blocks, constants = + Profile.record_call "backend" (fun () -> + (program, export) + |> Flambda_to_clambda.convert ~ppf_dump + |> flambda_raw_clambda_dump_if ppf_dump + |> (fun { Flambda_to_clambda. expr; preallocated_blocks; + structured_constants; exported; } -> + Compilenv.set_export_info exported; + let clambda = + Un_anf.apply ~what:(Compilenv.current_unit_symbol ()) + ~ppf_dump expr + in + clambda, preallocated_blocks, structured_constants)) + in + let constants = + List.map (fun (symbol, definition) -> + { Clambda.symbol = Linkage_name.to_string (Symbol.label symbol); + exported = true; + definition; + provenance = None; + }) + (Symbol.Map.bindings constants) + in + clambda, preallocated_blocks, constants diff --git a/middle_end/flambda/flambda_middle_end.mli b/middle_end/flambda/flambda_middle_end.mli index 584cb45a..e7bb7478 100644 --- a/middle_end/flambda/flambda_middle_end.mli +++ b/middle_end/flambda/flambda_middle_end.mli @@ -16,14 +16,12 @@ [@@@ocaml.warning "+a-4-9-30-40-41-42"] -(* Translate Lambda code to Flambda code and then optimize it. *) +(** Translate Lambda code to Flambda code, optimize it, and produce Clambda. *) -val middle_end - : ppf_dump:Format.formatter - -> prefixname:string - -> backend:(module Backend_intf.S) - -> size:int +val lambda_to_clambda + : backend:(module Backend_intf.S) -> filename:string - -> module_ident:Ident.t - -> module_initializer:Lambda.lambda - -> Flambda.program + -> prefixname:string + -> ppf_dump:Format.formatter + -> Lambda.program + -> Clambda.with_constants diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml index 2f60f9fc..d53034c8 100644 --- a/middle_end/flambda/flambda_to_clambda.ml +++ b/middle_end/flambda/flambda_to_clambda.ml @@ -31,6 +31,9 @@ type t = { Set_of_closures_id.t for_one_or_more_units; imported_units : Simple_value_approx.function_declarations for_one_or_more_units; + ppf_dump : Format.formatter; + mutable constants_for_instrumentation : + Clambda.ustructured_constant Symbol.Map.t; } let get_fun_offset t closure_id = @@ -70,7 +73,7 @@ let is_function_constant t closure_id = (* Instrumentation of closure and field accesses to try to catch compiler bugs. *) -let check_closure ulam named : Clambda.ulambda = +let check_closure t ulam named : Clambda.ulambda = if not !Clflags.clambda_checks then ulam else let desc = @@ -78,14 +81,19 @@ let check_closure ulam named : Clambda.ulambda = ~arity:2 ~alloc:false in let str = Format.asprintf "%a" Flambda.print_named named in - let str_const = - Compilenv.new_structured_constant (Uconst_string str) ~shared:true + let sym = Compilenv.new_const_symbol () in + let sym' = + Symbol.of_global_linkage (Compilation_unit.get_current_exn ()) + (Linkage_name.create sym) in + t.constants_for_instrumentation <- + Symbol.Map.add sym' (Clambda.Uconst_string str) + t.constants_for_instrumentation; Uprim (Pccall desc, - [ulam; Clambda.Uconst (Uconst_ref (str_const, None))], + [ulam; Clambda.Uconst (Uconst_ref (sym, None))], Debuginfo.none) -let check_field ulam pos named_opt : Clambda.ulambda = +let check_field t ulam pos named_opt : Clambda.ulambda = if not !Clflags.clambda_checks then ulam else let desc = @@ -97,11 +105,16 @@ let check_field ulam pos named_opt : Clambda.ulambda = | None -> "" | Some named -> Format.asprintf "%a" Flambda.print_named named in - let str_const = - Compilenv.new_structured_constant (Uconst_string str) ~shared:true + let sym = Compilenv.new_const_symbol () in + let sym' = + Symbol.of_global_linkage (Compilation_unit.get_current_exn ()) + (Linkage_name.create sym) in + t.constants_for_instrumentation <- + Symbol.Map.add sym' (Clambda.Uconst_string str) + t.constants_for_instrumentation; Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_int pos); - Clambda.Uconst (Uconst_ref (str_const, None))], + Clambda.Uconst (Uconst_ref (sym, None))], Debuginfo.none) module Env : sig @@ -258,7 +271,7 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda = to_clambda_direct_apply t func args direct_func dbg env | Apply { func; args; kind = Indirect; dbg = dbg } -> let callee = subst_var env func in - Ugeneric_apply (check_closure callee (Flambda.Expr (Var func)), + Ugeneric_apply (check_closure t callee (Flambda.Expr (Var func)), subst_vars env args, dbg) | Switch (arg, sw) -> let aux () : Clambda.ulambda = @@ -300,7 +313,7 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda = | String_switch (arg, sw, def) -> let arg = subst_var env arg in let sw = List.map (fun (s, e) -> s, to_clambda t env e) sw in - let def = Misc.may_map (to_clambda t env) def in + let def = Option.map (to_clambda t env) def in Ustringswitch (arg, sw, def) | Static_raise (static_exn, args) -> Ustaticfail (Static_exception.to_int static_exn, @@ -368,15 +381,15 @@ and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda = a [Uoffset] construction in the event that the offset is zero, otherwise we might break pattern matches in Cmmgen (in particular for the compilation of "let rec"). *) - check_closure ( + check_closure t ( build_uoffset - (check_closure (subst_var env set_of_closures) + (check_closure t (subst_var env set_of_closures) (Flambda.Expr (Var set_of_closures))) (get_fun_offset t closure_id)) named | Move_within_set_of_closures { closure; start_from; move_to } -> - check_closure (build_uoffset - (check_closure (subst_var env closure) + check_closure t (build_uoffset + (check_closure t (subst_var env closure) (Flambda.Expr (Var closure))) ((get_fun_offset t move_to) - (get_fun_offset t start_from))) named @@ -386,13 +399,14 @@ and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda = let var_offset = get_fv_offset t var in let pos = var_offset - fun_offset in Uprim (Pfield pos, - [check_field (check_closure ulam (Expr (Var closure))) pos (Some named)], + [check_field t (check_closure t ulam (Expr (Var closure))) + pos (Some named)], Debuginfo.none) | Prim (Pfield index, [block], dbg) -> - Uprim (Pfield index, [check_field (subst_var env block) index None], dbg) + Uprim (Pfield index, [check_field t (subst_var env block) index None], dbg) | Prim (Psetfield (index, maybe_ptr, init), [block; new_value], dbg) -> Uprim (Psetfield (index, maybe_ptr, init), [ - check_field (subst_var env block) index None; + check_field t (subst_var env block) index None; subst_var env new_value; ], dbg) | Prim (Popaque, args, dbg) -> @@ -569,11 +583,15 @@ and to_clambda_closed_set_of_closures t env symbol env, id :: params) function_decl.params (env, []) in + let body = + Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol + (to_clambda t env_body function_decl.body) + in { label = Compilenv.function_label (Closure_id.wrap id); arity = Flambda_utils.function_arity function_decl; params = List.map (fun var -> VP.create var, Lambda.Pgenval) params; return = Lambda.Pgenval; - body = to_clambda t env_body function_decl.body; + body; dbg = function_decl.dbg; env = None; } @@ -698,7 +716,7 @@ type result = { exported : Export_info.t; } -let convert (program, exported_transient) : result = +let convert ~ppf_dump (program, exported_transient) : result = let current_unit = let closures = Closure_id.Map.keys (Flambda_utils.make_closure_map program) @@ -733,10 +751,20 @@ let convert (program, exported_transient) : result = closures; } in - let t = { current_unit; imported_units; } in + let t = + { current_unit; + imported_units; + constants_for_instrumentation = Symbol.Map.empty; + ppf_dump; + } + in let expr, structured_constants, preallocated_blocks = to_clambda_program t Env.empty Symbol.Map.empty program in + let structured_constants = + Symbol.Map.disjoint_union structured_constants + t.constants_for_instrumentation + in let exported = Export_info.t_of_transient exported_transient ~program diff --git a/middle_end/flambda/flambda_to_clambda.mli b/middle_end/flambda/flambda_to_clambda.mli index 8c493d40..d08af3e2 100644 --- a/middle_end/flambda/flambda_to_clambda.mli +++ b/middle_end/flambda/flambda_to_clambda.mli @@ -35,4 +35,7 @@ type result = { For direct calls, the hidden closure parameter is added. Switch tables are also built. *) -val convert : Flambda.program * Export_info.transient -> result +val convert + : ppf_dump:Format.formatter + -> Flambda.program * Export_info.transient + -> result diff --git a/middle_end/flambda/inconstant_idents.ml b/middle_end/flambda/inconstant_idents.ml index 59f8aa8a..28efb3e9 100644 --- a/middle_end/flambda/inconstant_idents.ml +++ b/middle_end/flambda/inconstant_idents.ml @@ -286,12 +286,12 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct mark_var arg curr; List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.consts; List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.blocks; - Misc.may (fun l -> mark_loop ~toplevel [] l) sw.failaction + Option.iter (fun l -> mark_loop ~toplevel [] l) sw.failaction | String_switch (arg,sw,def) -> mark_curr curr; mark_var arg curr; List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw; - Misc.may (fun l -> mark_loop ~toplevel [] l) def + Option.iter (fun l -> mark_loop ~toplevel [] l) def | Send { kind = _; meth; obj; args; dbg = _; } -> mark_curr curr; mark_var meth curr; diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml index 7d304cd8..b720ae4a 100644 --- a/middle_end/flambda/inline_and_simplify.ml +++ b/middle_end/flambda/inline_and_simplify.ml @@ -1630,7 +1630,6 @@ let rec simplify_program_body env r (program : Flambda.program_body) let approx = A.augment_with_symbol (A.value_block tag (Array.of_list approxs)) symbol in - let module Backend = (val (E.backend env) : Backend_intf.S) in let env = E.add_symbol env symbol approx in let program, r = simplify_program_body env r program in Initialize_symbol (symbol, tag, fields, program), r diff --git a/middle_end/flambda/inlining_cost.ml b/middle_end/flambda/inlining_cost.ml index 33e870f9..3ca1d222 100644 --- a/middle_end/flambda/inlining_cost.ml +++ b/middle_end/flambda/inlining_cost.ml @@ -99,7 +99,7 @@ let lambda_smaller' lam ~than:threshold = size := !size + 2; lambda_size lam) sw; - Misc.may lambda_size def + Option.iter lambda_size def | Static_raise _ -> () | Static_catch (_, _, body, handler) -> incr size; lambda_size body; lambda_size handler diff --git a/middle_end/flambda/lift_code.ml b/middle_end/flambda/lift_code.ml index 02292c46..3474b06b 100644 --- a/middle_end/flambda/lift_code.ml +++ b/middle_end/flambda/lift_code.ml @@ -19,36 +19,50 @@ open! Int_replace_polymorphic_compare type lifter = Flambda.program -> Flambda.program -let rebuild_let - (defs : (Variable.t * Flambda.named Flambda.With_free_variables.t) list) - (body : Flambda.t) = +type def = + | Immutable of Variable.t * Flambda.named Flambda.With_free_variables.t + | Mutable of Mutable_variable.t * Variable.t * Lambda.value_kind + +let rebuild_let (defs : def list) (body : Flambda.t) = let module W = Flambda.With_free_variables in - List.fold_left (fun body (var, def) -> - W.create_let_reusing_defining_expr var def body) + List.fold_left (fun body def -> + match def with + | Immutable(var, def) -> + W.create_let_reusing_defining_expr var def body + | Mutable(var, initial_value, contents_kind) -> + Flambda.Let_mutable {var; initial_value; contents_kind; body}) body defs -let rec extract_lets - (acc:(Variable.t * Flambda.named Flambda.With_free_variables.t) list) - (let_expr:Flambda.let_expr) : - (Variable.t * Flambda.named Flambda.With_free_variables.t) list * - Flambda.t Flambda.With_free_variables.t = +let rec extract_let_expr (acc:def list) (let_expr:Flambda.let_expr) : + def list * Flambda.t Flambda.With_free_variables.t = + let module W = Flambda.With_free_variables in + let acc = + match let_expr with + | { var = v1; defining_expr = Expr (Let let2); _ } -> + let acc, body2 = extract_let_expr acc let2 in + Immutable(v1, W.expr body2) :: acc + | { var = v1; defining_expr = Expr (Let_mutable let_mut); _ } -> + let acc, body2 = extract_let_mutable acc let_mut in + Immutable(v1, W.expr body2) :: acc + | { var = v; _ } -> + Immutable(v, W.of_defining_expr_of_let let_expr) :: acc + in + let body = W.of_body_of_let let_expr in + extract acc body + +and extract_let_mutable acc (let_mut : Flambda.let_mutable) = let module W = Flambda.With_free_variables in - match let_expr with - | { var = v1; defining_expr = Expr (Let let2); _ } -> - let acc, body2 = extract_lets acc let2 in - let acc = (v1, W.expr body2) :: acc in - let body = W.of_body_of_let let_expr in - extract acc body - | { var = v; _ } -> - let acc = (v, W.of_defining_expr_of_let let_expr) :: acc in - let body = W.of_body_of_let let_expr in - extract acc body + let { Flambda.var; initial_value; contents_kind; body } = let_mut in + let acc = Mutable(var, initial_value, contents_kind) :: acc in + extract acc (W.of_expr body) and extract acc (expr : Flambda.t Flambda.With_free_variables.t) = let module W = Flambda.With_free_variables in match W.contents expr with | Let let_expr -> - extract_lets acc let_expr + extract_let_expr acc let_expr + | Let_mutable let_mutable -> + extract_let_mutable acc let_mutable | _ -> acc, expr @@ -56,10 +70,13 @@ let rec lift_lets_expr (expr:Flambda.t) ~toplevel : Flambda.t = let module W = Flambda.With_free_variables in match expr with | Let let_expr -> - let defs, body = extract_lets [] let_expr in - let rev_defs = - List.rev_map (lift_lets_named_with_free_variables ~toplevel) defs - in + let defs, body = extract_let_expr [] let_expr in + let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in + let body = lift_lets_expr (W.contents body) ~toplevel in + rebuild_let (List.rev rev_defs) body + | Let_mutable let_mut -> + let defs, body = extract_let_mutable [] let_mut in + let rev_defs = List.rev_map (lift_lets_def ~toplevel) defs in let body = lift_lets_expr (W.contents body) ~toplevel in rebuild_let (List.rev rev_defs) body | e -> @@ -68,26 +85,28 @@ let rec lift_lets_expr (expr:Flambda.t) ~toplevel : Flambda.t = (lift_lets_named ~toplevel) e -and lift_lets_named_with_free_variables - ((var, named):Variable.t * Flambda.named Flambda.With_free_variables.t) - ~toplevel : Variable.t * Flambda.named Flambda.With_free_variables.t = +and lift_lets_def def ~toplevel = let module W = Flambda.With_free_variables in - match W.contents named with - | Expr e -> - var, W.expr (W.of_expr (lift_lets_expr e ~toplevel)) - | Set_of_closures set when not toplevel -> - var, - W.of_named - (Set_of_closures - (Flambda_iterators.map_function_bodies - ~f:(lift_lets_expr ~toplevel) set)) - | Symbol _ | Const _ | Allocated_const _ | Read_mutable _ - | Read_symbol_field (_, _) | Project_closure _ | Move_within_set_of_closures _ - | Project_var _ | Prim _ | Set_of_closures _ -> - var, named + match def with + | Mutable _ -> def + | Immutable(var, named) -> + let named = + match W.contents named with + | Expr e -> W.expr (W.of_expr (lift_lets_expr e ~toplevel)) + | Set_of_closures set when not toplevel -> + W.of_named + (Set_of_closures + (Flambda_iterators.map_function_bodies + ~f:(lift_lets_expr ~toplevel) set)) + | Symbol _ | Const _ | Allocated_const _ | Read_mutable _ + | Read_symbol_field (_, _) | Project_closure _ + | Move_within_set_of_closures _ | Project_var _ + | Prim _ | Set_of_closures _ -> + named + in + Immutable(var, named) and lift_lets_named _var (named:Flambda.named) ~toplevel : Flambda.named = - let module W = Flambda.With_free_variables in match named with | Expr e -> Expr (lift_lets_expr e ~toplevel) diff --git a/middle_end/flambda/ref_to_variables.ml b/middle_end/flambda/ref_to_variables.ml index f93948f9..aa2a73c6 100644 --- a/middle_end/flambda/ref_to_variables.ml +++ b/middle_end/flambda/ref_to_variables.ml @@ -60,11 +60,11 @@ let variables_not_used_as_local_reference (tree:Flambda.t) = set := Variable.Set.add cond !set; List.iter (fun (_, branch) -> loop branch) consts; List.iter (fun (_, branch) -> loop branch) blocks; - Misc.may loop failaction + Option.iter loop failaction | String_switch (cond, branches, default) -> set := Variable.Set.add cond !set; List.iter (fun (_, branch) -> loop branch) branches; - Misc.may loop default + Option.iter loop default | Static_catch (_, _, body, handler) -> loop body; loop handler diff --git a/middle_end/flambda/simple_value_approx.ml b/middle_end/flambda/simple_value_approx.ml index 34fc5ce0..fcd8e4d7 100644 --- a/middle_end/flambda/simple_value_approx.ml +++ b/middle_end/flambda/simple_value_approx.ml @@ -290,7 +290,7 @@ let value_closure ?closure_var ?set_of_closures_var ?set_of_closures_symbol let approx_set_of_closures = { descr = Value_set_of_closures value_set_of_closures; var = set_of_closures_var; - symbol = Misc.may_map (fun s -> s, None) set_of_closures_symbol; + symbol = Option.map (fun s -> s, None) set_of_closures_symbol; } in let value_closure = diff --git a/middle_end/flambda/un_anf.ml b/middle_end/flambda/un_anf.ml index 50f9e7b1..c9a095b5 100644 --- a/middle_end/flambda/un_anf.ml +++ b/middle_end/flambda/un_anf.ml @@ -152,7 +152,7 @@ let make_var_info (clam : Clambda.ulambda) : var_info = ignore_string str; loop branch) branches; - Misc.may loop default + Option.iter loop default | Ustaticfail (static_exn, args) -> ignore_int static_exn; List.iter loop args @@ -354,7 +354,7 @@ let let_bound_vars_that_can_be_moved var_info (clam : Clambda.ulambda) = loop branch) branches; let_stack := []; - Misc.may loop default; + Option.iter loop default; let_stack := [] | Ustaticfail (static_exn, args) -> ignore_int static_exn; @@ -516,7 +516,7 @@ let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda) branches in let default = - Misc.may_map (substitute_let_moveable is_let_moveable env) default + Option.map (substitute_let_moveable is_let_moveable env) default in Ustringswitch (cond, branches, default) | Ustaticfail (n, args) -> @@ -735,7 +735,7 @@ let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda) List.map (fun (s, branch) -> s, un_anf var_info env branch) branches in - let default = Misc.may_map (un_anf var_info env) default in + let default = Option.map (un_anf var_info env) default in Ustringswitch (cond, branches, default), Fixed | Ustaticfail (n, args) -> let args = un_anf_list var_info env args in @@ -799,7 +799,7 @@ and un_anf_list var_info env clams : Clambda.ulambda list = and un_anf_array var_info env clams : Clambda.ulambda array = Array.map (un_anf var_info env) clams -let apply ~ppf_dump clam ~what = +let apply ~what ~ppf_dump clam = let var_info = make_var_info clam in let let_bound_vars_that_can_be_moved = let_bound_vars_that_can_be_moved var_info clam @@ -812,6 +812,8 @@ let apply ~ppf_dump clam ~what = let clam = un_anf var_info V.Map.empty clam in if !Clflags.dump_clambda then begin Format.fprintf ppf_dump - "@.un-anf (%s):@ %a@." what Printclambda.clambda clam + "@.un-anf (%a):@ %a@." + Symbol.print what + Printclambda.clambda clam end; clam diff --git a/middle_end/flambda/un_anf.mli b/middle_end/flambda/un_anf.mli index 92ea06cd..a7d5e94e 100644 --- a/middle_end/flambda/un_anf.mli +++ b/middle_end/flambda/un_anf.mli @@ -17,7 +17,7 @@ (** Expand ANF-like constructs so that pattern matches in [Cmmgen] will work correctly. *) val apply - : ppf_dump:Format.formatter + : what:Symbol.t + -> ppf_dump:Format.formatter -> Clambda.ulambda - -> what:string -> Clambda.ulambda diff --git a/ocaml-variants.opam b/ocaml-variants.opam index eabd2645..2af999ea 100644 --- a/ocaml-variants.opam +++ b/ocaml-variants.opam @@ -1,8 +1,8 @@ opam-version: "2.0" -version: "4.09.1" +version: "4.10.0" synopsis: "OCaml development version" depends: [ - "ocaml" {= "4.09.1" & post} + "ocaml" {= "4.10.0" & post} "base-unix" {post} "base-bigarray" {post} "base-threads" {post} @@ -12,8 +12,7 @@ flags: compiler setenv: CAML_LD_LIBRARY_PATH = "%{lib}%/stublibs" build: [ ["./configure" "--prefix=%{prefix}%"] - [make "-j%{jobs}%" "world"] - [make "-j%{jobs}%" "world.opt"] + [make "-j%{jobs}%"] ] install: [make "install"] maintainer: "caml-list@inria.fr" diff --git a/ocamldoc/.depend b/ocamldoc/.depend index 3b33fb26..4bc98ad3 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -74,7 +74,6 @@ odoc_analyse.cmi : \ odoc_module.cmo \ odoc_global.cmi odoc_args.cmo : \ - ../utils/warnings.cmi \ odoc_types.cmi \ odoc_texi.cmo \ odoc_messages.cmo \ @@ -87,11 +86,8 @@ odoc_args.cmo : \ odoc_config.cmi \ ../driver/main_args.cmi \ ../utils/config.cmi \ - ../driver/compenv.cmi \ - ../utils/clflags.cmi \ odoc_args.cmi odoc_args.cmx : \ - ../utils/warnings.cmx \ odoc_types.cmx \ odoc_texi.cmx \ odoc_messages.cmx \ @@ -104,8 +100,6 @@ odoc_args.cmx : \ odoc_config.cmx \ ../driver/main_args.cmx \ ../utils/config.cmx \ - ../driver/compenv.cmx \ - ../utils/clflags.cmx \ odoc_args.cmi odoc_args.cmi : \ odoc_gen.cmi @@ -127,7 +121,6 @@ odoc_ast.cmo : \ odoc_exception.cmo \ odoc_env.cmi \ odoc_class.cmo \ - ../utils/misc.cmi \ ../parsing/location.cmi \ ../typing/ident.cmi \ ../parsing/asttypes.cmi \ @@ -150,7 +143,6 @@ odoc_ast.cmx : \ odoc_exception.cmx \ odoc_env.cmx \ odoc_class.cmx \ - ../utils/misc.cmx \ ../parsing/location.cmx \ ../typing/ident.cmx \ ../parsing/asttypes.cmi \ @@ -288,7 +280,6 @@ odoc_env.cmo : \ ../typing/predef.cmi \ ../typing/path.cmi \ odoc_name.cmi \ - ../utils/misc.cmi \ ../typing/btype.cmi \ odoc_env.cmi odoc_env.cmx : \ @@ -297,7 +288,6 @@ odoc_env.cmx : \ ../typing/predef.cmx \ ../typing/path.cmx \ odoc_name.cmx \ - ../utils/misc.cmx \ ../typing/btype.cmx \ odoc_env.cmi odoc_env.cmi : \ @@ -474,7 +464,6 @@ odoc_man.cmo : \ odoc_misc.cmi \ odoc_messages.cmo \ odoc_info.cmi \ - ../utils/misc.cmi \ ../parsing/asttypes.cmi odoc_man.cmx : \ odoc_str.cmx \ @@ -482,7 +471,6 @@ odoc_man.cmx : \ odoc_misc.cmx \ odoc_messages.cmx \ odoc_info.cmx \ - ../utils/misc.cmx \ ../parsing/asttypes.cmi odoc_merge.cmo : \ odoc_value.cmo \ @@ -595,13 +583,11 @@ odoc_parser.cmi : \ odoc_print.cmo : \ ../typing/types.cmi \ ../typing/printtyp.cmi \ - ../utils/misc.cmi \ ../typing/btype.cmi \ odoc_print.cmi odoc_print.cmx : \ ../typing/types.cmx \ ../typing/printtyp.cmx \ - ../utils/misc.cmx \ ../typing/btype.cmx \ odoc_print.cmi odoc_print.cmi : \ @@ -627,6 +613,7 @@ odoc_search.cmo : \ odoc_types.cmi \ odoc_type.cmo \ odoc_module.cmo \ + odoc_misc.cmi \ odoc_extension.cmo \ odoc_exception.cmo \ odoc_class.cmo \ @@ -636,6 +623,7 @@ odoc_search.cmx : \ odoc_types.cmx \ odoc_type.cmx \ odoc_module.cmx \ + odoc_misc.cmx \ odoc_extension.cmx \ odoc_exception.cmx \ odoc_class.cmx \ @@ -669,7 +657,6 @@ odoc_sig.cmo : \ odoc_exception.cmo \ odoc_env.cmi \ odoc_class.cmo \ - ../utils/misc.cmi \ ../parsing/longident.cmi \ ../parsing/location.cmi \ ../typing/ident.cmi \ @@ -694,7 +681,6 @@ odoc_sig.cmx : \ odoc_exception.cmx \ odoc_env.cmx \ odoc_class.cmx \ - ../utils/misc.cmx \ ../parsing/longident.cmx \ ../parsing/location.cmx \ ../typing/ident.cmx \ diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 6710176b..4a6e0fc6 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -17,16 +17,18 @@ ROOTDIR = .. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc $(STDLIBFLAGS) -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt $(STDLIBFLAGS) -OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend +OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS) +OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS) +OCAMLDEP = $(BEST_OCAMLDEP) DEPFLAGS = -slash -OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex +OCAMLLEX = $(BEST_OCAMLLEX) + # TODO: figure out whether the DEBUG lines the following preprocessor removes # are actually useful. # If they are not, then the preprocessor logic (including the @@ -44,24 +46,37 @@ OCAMLPP=-pp 'sh ./remove_DEBUG' MKDIR=mkdir -p CP=cp OCAMLDOC=ocamldoc +OCAMLDOC_OPT=$(OCAMLDOC).opt # TODO: clarify whether the following really needs to be that complicated ifeq "$(UNIX_OR_WIN32)" "unix" ifeq "$(TARGET)" "$(HOST)" ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true" - OCAMLDOC_RUN=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC) + OCAMLDOC_RUN_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC) else - OCAMLDOC_RUN=./$(OCAMLDOC) +# if shared-libraries are not supported, unix.cma and str.cma +# are compiled with -custom, so ocamldoc also uses -custom, +# and (ocamlrun ocamldoc) does not work. + OCAMLDOC_RUN_BYTE=./$(OCAMLDOC) endif else - OCAMLDOC_RUN=$(OCAMLRUN) ./$(OCAMLDOC) + OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(OCAMLDOC) endif else # Windows - OCAMLDOC_RUN = \ + OCAMLDOC_RUN_BYTE = \ CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC) endif -OCAMLDOC_OPT=$(OCAMLDOC).opt +OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT) + +OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE) + +ifeq "$(wildcard $(OCAMLDOC_OPT))" "" + OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE) +else + OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT) +endif + OCAMLDOC_LIBCMA=odoc_info.cma OCAMLDOC_LIBCMI=odoc_info.cmi OCAMLDOC_LIBCMXA=odoc_info.cmxa @@ -103,7 +118,9 @@ INCLUDES_NODEP=\ DEPINCLUDES=$(INCLUDES_DEP) INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) -COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A -safe-string -strict-sequence -strict-formats -bin-annot +COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \ + -safe-string -strict-sequence -strict-formats -bin-annot -principal + LINKFLAGS=$(INCLUDES) -nostdlib CMOFILES=\ @@ -168,11 +185,14 @@ LIBCMOFILES = $(CMOFILES) LIBCMXFILES = $(LIBCMOFILES:.cmo=.cmx) LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi) +ifeq "$(STDLIB_MANPAGES)" "true" +DOCS_TARGET = manpages +else +DOCS_TARGET = +endif .PHONY: all -all: lib exe generators manpages - -manpages: generators +all: lib exe generators $(DOCS_TARGET) .PHONY: exe exe: $(OCAMLDOC) @@ -271,7 +291,7 @@ odoc_see_lexer.ml: odoc_see_lexer.mll $(OCAMLOPT_CMD) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< .mll.ml: - $(OCAMLLEX) $< + $(OCAMLLEX) $(OCAMLLEX_FLAGS) $< .mly.ml: $(OCAMLYACC) --strict -v $< @@ -343,7 +363,7 @@ test: $(MKDIR) $@ $(OCAMLDOC_RUN) -html -colorize-code -sort -d $@ $(INCLUDES) -dump $@/ocamldoc.odoc odoc*.ml odoc*.mli -v $(MKDIR) $@-custom - $(OCAMLDOC_RUN) -colorize-code -sort -d $@-custom $(INCLUDES) \ + $(OCAMLDOC_RUN_PLUGINS) -colorize-code -sort -d $@-custom $(INCLUDES) \ -g generators/odoc_literate.cmo -g generators/odoc_todo.cmo \ -load $@/ocamldoc.odoc -v @@ -363,11 +383,6 @@ test_stdlib_code: $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.ml \ $(ROOTDIR)/otherlibs/str/str.ml -.PHONY: test_framed -test_framed: - $(MKDIR) $@ - $(OCAMLDOC_RUN) -g odoc_fhtml.cmo -sort -colorize-code -d $@ $(INCLUDES) odoc*.ml odoc*.mli - .PHONY: test_latex test_latex: $(MKDIR) $@ @@ -446,7 +461,7 @@ stdlib_latex/stdlib.pdf: stdlib_latex/stdlib.tex .PHONY: autotest_stdlib autotest_stdlib: $(MKDIR) $@ - $(OCAMLDOC_RUN) -g autotest/odoc_test.cmo\ + $(OCAMLDOC_RUN_PLUGINS) -g autotest/odoc_test.cmo\ $(INCLUDES) -keep-code \ $(ROOTDIR)/stdlib/*.mli \ $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \ @@ -507,10 +522,10 @@ clean: depend: $(OCAMLYACC) odoc_text_parser.mly $(OCAMLYACC) odoc_parser.mly - $(OCAMLLEX) odoc_text_lexer.mll - $(OCAMLLEX) odoc_lexer.mll - $(OCAMLLEX) odoc_ocamlhtml.mll - $(OCAMLLEX) odoc_see_lexer.mll + $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_text_lexer.mll + $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_lexer.mll + $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_ocamlhtml.mll + $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_see_lexer.mll $(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mll *.mly *.ml *.mli > .depend $(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) -shared generators/*.ml >> .depend diff --git a/ocamldoc/odoc_args.ml b/ocamldoc/odoc_args.ml index dd1c448f..46fcb58b 100644 --- a/ocamldoc/odoc_args.ml +++ b/ocamldoc/odoc_args.ml @@ -197,61 +197,10 @@ let anonymous f = Odoc_global.files := !Odoc_global.files @ [sf] module Options = Main_args.Make_ocamldoc_options(struct - let set r () = r := true - let unset r () = r := false - let _absname = set Clflags.absname - let _alert = Warnings.parse_alert_option - let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs - let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s] - let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s] - let _intf_suffix s = Config.interface_suffix := s - let _labels = unset Clflags.classic - let _alias_deps = unset Clflags.transparent_modules - let _no_alias_deps = set Clflags.transparent_modules - let _app_funct = set Clflags.applicative_functors - let _no_app_funct = unset Clflags.applicative_functors - let _noassert = set Clflags.noassert - let _nolabels = set Clflags.classic - let _nostdlib = set Clflags.no_std_include - let _open s = Clflags.open_modules := s :: !Clflags.open_modules - let _pp s = Clflags.preprocessor := Some s - let _ppx s = Clflags.all_ppx := s :: !Clflags.all_ppx - let _principal = set Clflags.principal - let _no_principal = unset Clflags.principal - let _rectypes = set Clflags.recursive_types - let _no_rectypes = unset Clflags.recursive_types - let _safe_string = unset Clflags.unsafe_string - let _short_paths = unset Clflags.real_paths - let _strict_sequence = set Clflags.strict_sequence - let _no_strict_sequence = unset Clflags.strict_sequence - let _strict_formats = set Clflags.strict_formats - let _no_strict_formats = unset Clflags.strict_formats - let _thread = set Clflags.use_threads - let _vmthread = ignore - let _unboxed_types = set Clflags.unboxed_types - let _no_unboxed_types = unset Clflags.unboxed_types - let _unsafe () = assert false - let _unsafe_string = set Clflags.unsafe_string - let _v () = Compenv.print_version_and_library "documentation generator" - let _version = Compenv.print_version_string - let _vnum = Compenv.print_version_string - let _w = (Warnings.parse_options false) - let _warn_error _ = assert false - let _warn_help _ = assert false - let _where = Compenv.print_standard_library - let _verbose = set Clflags.verbose - let _nopervasives = set Clflags.nopervasives - let _dno_unique_ids = unset Clflags.unique_ids - let _dunique_ids = set Clflags.unique_ids - let _dsource = set Clflags.dump_source - let _dparsetree = set Clflags.dump_parsetree - 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 _dcamlprimc = set Clflags.keep_camlprimc_file - let anonymous = anonymous + include Main_args.Default.Odoc_args + let _I s = Odoc_global.include_dirs := s :: !Odoc_global.include_dirs + let _impl s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Impl_file s] + let _intf s = Odoc_global.files := !Odoc_global.files @ [Odoc_global.Intf_file s] end) (** The default option list *) diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index ac9a5dbe..0203752d 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -14,7 +14,6 @@ (**************************************************************************) (** Analysis of implementation files. *) -open Misc open Asttypes open Types open Typedtree @@ -61,12 +60,15 @@ module Typedtree_search = let add_to_hashes table table_values tt = match tt with | Typedtree.Tstr_module mb -> - Hashtbl.add table (M (Name.from_ident mb.mb_id)) tt + Option.iter (fun id -> + Hashtbl.add table (M (Name.from_ident id)) tt) mb.mb_id | Typedtree.Tstr_recmodule mods -> List.iter (fun mb -> - Hashtbl.add table (M (Name.from_ident mb.mb_id)) - (Typedtree.Tstr_module mb) + Option.iter (fun id -> + Hashtbl.add table (M (Name.from_ident id)) + (Typedtree.Tstr_module mb) + ) mb.mb_id ) mods | Typedtree.Tstr_modtype mtd -> @@ -1307,7 +1309,7 @@ module Analyser = xt_name = complete_name; xt_args; xt_ret = - may_map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type; + Option.map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type; xt_type_extension = new_te; xt_alias = None; xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ; @@ -1366,7 +1368,7 @@ module Analyser = ex_info = comment_opt ; ex_args; ex_ret = - Misc.may_map + Option.map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) tt_ret_type; ex_alias = None ; @@ -1396,15 +1398,18 @@ module Analyser = in (0, new_env, [ Element_exception new_ext ]) - | Parsetree.Pstr_module {Parsetree.pmb_name=name; pmb_expr=module_expr} -> + | Parsetree.Pstr_module {Parsetree.pmb_name={txt=None}} -> + (0, env, []) + + | Parsetree.Pstr_module {Parsetree.pmb_name={txt=Some name}; pmb_expr=module_expr} -> ( (* of string * module_expr *) try - let tt_module_expr = Typedtree_search.search_module table name.txt in + let tt_module_expr = Typedtree_search.search_module table name in let new_module_pre = analyse_module env current_module_name - name.txt + name comment_opt module_expr tt_module_expr @@ -1434,7 +1439,7 @@ module Analyser = (0, new_env2, [ Element_module new_module ]) with Not_found -> - let complete_name = Name.concat current_module_name name.txt in + let complete_name = Name.concat current_module_name name in raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) ) @@ -1444,26 +1449,29 @@ module Analyser = let new_env = List.fold_left (fun acc_env {Parsetree.pmb_name=name;pmb_expr=mod_exp} -> - let complete_name = Name.concat current_module_name name.txt in - let e = Odoc_env.add_module acc_env complete_name in - let tt_mod_exp = - try Typedtree_search.search_module table name.txt - with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) - in - let new_module = analyse_module - e - current_module_name - name.txt - None - mod_exp - tt_mod_exp - in - match new_module.m_type with - Types.Mty_signature s -> - Odoc_env.add_signature e new_module.m_name - ~rel: (Name.simple new_module.m_name) s - | _ -> - e + match name.txt with + | None -> acc_env + | Some name -> + let complete_name = Name.concat current_module_name name in + let e = Odoc_env.add_module acc_env complete_name in + let tt_mod_exp = + try Typedtree_search.search_module table name + with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) + in + let new_module = analyse_module + e + current_module_name + name + None + mod_exp + tt_mod_exp + in + match new_module.m_type with + Types.Mty_signature s -> + Odoc_env.add_signature e new_module.m_name + ~rel: (Name.simple new_module.m_name) s + | _ -> + e ) env mods @@ -1471,12 +1479,23 @@ module Analyser = let rec f ?(first=false) last_pos name_mod_exp_list = match name_mod_exp_list with [] -> [] - | {Parsetree.pmb_name=name;pmb_expr=mod_exp} :: q -> - let complete_name = Name.concat current_module_name name.txt in + | {Parsetree.pmb_name={txt=None};pmb_expr=mod_exp} :: q -> + let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in + let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in + let (_, ele_comments) = (* the comment for the first type was already retrieved *) + if first then + (None, []) + else + get_comments_in_module last_pos loc_start + in + let eles = f loc_end q in + ele_comments @ eles + | {Parsetree.pmb_name={txt=Some name};pmb_expr=mod_exp} :: q -> + let complete_name = Name.concat current_module_name name in let loc_start = mod_exp.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = mod_exp.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in let tt_mod_exp = - try Typedtree_search.search_module table name.txt + try Typedtree_search.search_module table name with Not_found -> raise (Failure (Odoc_messages.module_not_found_in_typedtree complete_name)) in let (com_opt, ele_comments) = (* the comment for the first type was already retrieved *) @@ -1488,7 +1507,7 @@ module Analyser = let new_module = analyse_module new_env current_module_name - name.txt + name com_opt mod_exp tt_mod_exp @@ -1710,29 +1729,33 @@ module Analyser = let elements2 = replace_dummy_included_modules elements included_modules_from_tt in { m_base with m_kind = Module_struct elements2 } - | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2), - Typedtree.Tmod_functor (ident, _, mtyp, tt_module_expr2)) -> - let loc = match pmodule_type with None -> Location.none - | Some pmty -> pmty.Parsetree.pmty_loc in + | (Parsetree.Pmod_functor (param2, p_module_expr2), + Typedtree.Tmod_functor (param, tt_module_expr2)) -> + let loc, mp_name, mp_kind, mp_type = + match param2, param with + | Parsetree.Unit, Typedtree.Unit -> + Location.none, "*", Module_type_struct [], None + | Parsetree.Named (_, pmty), Typedtree.Named (ident, _, mty) -> + let loc = pmty.Parsetree.pmty_loc in + let mp_name = Option.fold ~none:"*" ~some:Name.from_ident ident in + let mp_kind = + Sig.analyse_module_type_kind env current_module_name pmty + mty.mty_type + in + let mp_type = Odoc_env.subst_module_type env mty.mty_type in + loc, mp_name, mp_kind, Some mp_type + | _, _ -> assert false + in let loc_start = loc.Location.loc_start.Lexing.pos_cnum in let loc_end = loc.Location.loc_end.Lexing.pos_cnum in let mp_type_code = get_string_of_file loc_start loc_end in print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); - let mp_name = Name.from_ident ident in - let mp_kind = - match pmodule_type, mtyp with - Some pmty, Some mty -> - Sig.analyse_module_type_kind env current_module_name pmty - mty.mty_type - | _ -> Module_type_struct [] - in let param = { - mp_name = mp_name ; - mp_type = Misc.may_map - (fun m -> Odoc_env.subst_module_type env m.mty_type) mtyp ; + mp_name ; + mp_type ; mp_type_code = mp_type_code ; - mp_kind = mp_kind ; + mp_kind ; } in let dummy_complete_name = (*Name.concat "__"*) param.mp_name in diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli index fc1c0eb7..754800d9 100644 --- a/ocamldoc/odoc_ast.mli +++ b/ocamldoc/odoc_ast.mli @@ -90,7 +90,7 @@ module Typedtree_search : The module uses the module {!Odoc_sig.Analyser}. @param My_ir The module used to retrieve comments and special comments.*) module Analyser : - functor (My_ir : Odoc_sig.Info_retriever) -> + Odoc_sig.Info_retriever -> sig (** This function takes a file name, a file containing the code and the typed tree obtained from the compiler. diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index 446ad121..79928f26 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -216,15 +216,17 @@ let subst_type env t = let subst_module_type env t = let rec iter t = + let open Types in match t with - Types.Mty_ident p -> + Mty_ident p -> let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in - Types.Mty_ident new_p - | Types.Mty_alias _ - | Types.Mty_signature _ -> + Mty_ident new_p + | Mty_alias _ + | Mty_signature _ -> t - | Types.Mty_functor (id, mt1, mt2) -> - Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2) + | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt) + | Mty_functor (Named (name, mt1), mt2) -> + Mty_functor (Named (name, iter mt1), iter mt2) in iter t diff --git a/ocamldoc/odoc_gen.ml b/ocamldoc/odoc_gen.ml index 8ea2c947..152c2414 100644 --- a/ocamldoc/odoc_gen.ml +++ b/ocamldoc/odoc_gen.ml @@ -26,12 +26,12 @@ module Base_generator : Base = struct class generator : doc_generator = object method generate _ = () end end;; -module type Base_functor = functor (G: Base) -> Base -module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator -module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator -module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator -module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator -module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator +module type Base_functor = Base -> Base +module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator +module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator +module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator +module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator +module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator type generator = | Html of (module Odoc_html.Html_generator) diff --git a/ocamldoc/odoc_gen.mli b/ocamldoc/odoc_gen.mli index ba74da89..0bc723cc 100644 --- a/ocamldoc/odoc_gen.mli +++ b/ocamldoc/odoc_gen.mli @@ -26,12 +26,12 @@ module type Base = sig module Base_generator : Base -module type Base_functor = functor (P: Base) -> Base -module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator -module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator -module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator -module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator -module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator +module type Base_functor = Base -> Base +module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator +module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator +module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator +module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator +module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator (** Various ways to create a generator. *) type generator = diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index e9b98fd1..8f1fe600 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -1712,7 +1712,7 @@ class html = bs b "\n" in print_concat b "\n" print_one l; - bs b "\n}\n" + bs b "\n}\n" (** Print html code for a type. *) diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 5b1d1e53..b2d4cb80 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -287,12 +287,11 @@ class man = method man_of_text_element b txt = match txt with | Odoc_info.Raw s -> bs b (self#escape s) - | Odoc_info.Code s -> - bs b "\n.B "; - bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") + | Odoc_info.Code s -> self#man_of_code b s | Odoc_info.CodePre s -> - bs b "\n.B "; - bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") + bs b "\n.EX"; + self#man_of_code b s; + bs b "\n.EE"; | Odoc_info.Verbatim s -> bs b (self#escape s) | Odoc_info.Bold t @@ -346,7 +345,11 @@ class man = if String.lowercase_ascii target = "man" then bs b code else () (** Print groff string to display code. *) - method man_of_code b s = self#man_of_text b [ Code s ] + method man_of_code b code = + let code = self#escape code in + bs b "\n.ft B\n"; + bs b (Str.global_replace (Str.regexp "\n") "\n.br\n\\&" code); + bs b "\n.ft R\n"; (** Take a string and return the string where fully qualified idents have been replaced by idents relative to the given module name.*) @@ -733,7 +736,7 @@ class man = (fun (p, desc_opt) -> bs b ".sp\n"; bs b ("\""^p.mp_name^"\"\n"); - Misc.may (self#man_of_module_type b m_name) p.mp_type; + Option.iter (self#man_of_module_type b m_name) p.mp_type; bs b "\n"; ( match desc_opt with diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml index 163c154b..77b54a12 100644 --- a/ocamldoc/odoc_misc.ml +++ b/ocamldoc/odoc_misc.ml @@ -72,6 +72,14 @@ let list_concat sep = in iter +let remove_duplicates (type a) compare (li : a list) = + let module S = Set.Make(struct type t = a let compare = compare end) in + let maybe_cons ((set, rev_acc) as acc) x = + if S.mem x set then acc + else (S.add x set, x :: rev_acc) in + let (_, rev_acc) = List.fold_left maybe_cons (S.empty, []) li in + List.rev rev_acc + let rec string_of_longident li = match li with | Longident.Lident s -> s diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli index 8b848158..e468f818 100644 --- a/ocamldoc/odoc_misc.mli +++ b/ocamldoc/odoc_misc.mli @@ -102,6 +102,10 @@ val get_titles_in_text : Odoc_types.text -> (int * string option * Odoc_types.te begin with a letter should be in the first returned list.*) val create_index_lists : 'a list -> ('a -> string) -> 'a list list +(** [remove_duplicates compare li] removes the duplicates in the input list, + keeping the leftmost occurrence of each repeated element. *) +val remove_duplicates : ('a -> 'a -> int) -> 'a list -> 'a list + (** [remove_ending_newline s] returns [s] without the optional ending newline. *) val remove_ending_newline : string -> string diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml index b21dff00..5612e5b7 100644 --- a/ocamldoc/odoc_print.ml +++ b/ocamldoc/odoc_print.ml @@ -52,18 +52,20 @@ exception Use_code of string than the "emptied" type. *) let simpl_module_type ?code t = + let open Types in let rec iter t = match t with - Types.Mty_ident _ - | Types.Mty_alias _ -> t - | Types.Mty_signature _ -> + Mty_ident _ + | Mty_alias _ -> t + | Mty_signature _ -> ( match code with - None -> Types.Mty_signature [] + None -> Mty_signature [] | Some s -> raise (Use_code s) ) - | Types.Mty_functor (id, mt1, mt2) -> - Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2) + | Mty_functor (Unit, mt) -> Mty_functor (Unit, iter mt) + | Mty_functor (Named (name, mt1), mt2) -> + Mty_functor (Named (name, iter mt1), iter mt2) in iter t diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml index 530000bc..810c88e8 100644 --- a/ocamldoc/odoc_search.ml +++ b/ocamldoc/odoc_search.ml @@ -325,17 +325,14 @@ module Search = l and search module_list v = - List.fold_left - (fun acc -> fun m -> - List.fold_left - (fun acc2 -> fun ele -> - if List.mem ele acc2 then acc2 else acc2 @ [ele] - ) - acc - (search_module m v) - ) - [] - module_list + let results_with_duplicates = + List.fold_left + (fun rev_acc m -> + List.rev_append (search_module m v) rev_acc) + [] module_list + |> List.rev + in + Odoc_misc.remove_duplicates Stdlib.compare results_with_duplicates end module P_name = diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index e413c11a..b695338e 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -15,7 +15,6 @@ (** Analysis of interface files. *) -open Misc open Asttypes open Types @@ -395,7 +394,7 @@ module Analyser = { vc_name = constructor_name ; vc_args; - vc_ret = may_map (Odoc_env.subst_type env) ret_type; + vc_ret = Option.map (Odoc_env.subst_type env) ret_type; vc_text = comment_opt } in @@ -492,10 +491,11 @@ module Analyser = | [] -> acc | types -> take_item (Parsetree.Psig_type (rf, types))) | Parsetree.Psig_modsubst _ -> acc - | Parsetree.Psig_module ({Parsetree.pmd_name=name; + | Parsetree.Psig_module {Parsetree.pmd_name={ txt = None }} -> acc + | Parsetree.Psig_module ({Parsetree.pmd_name={txt = Some name }; pmd_type=module_type} as r) as m -> - begin match Name.Map.find name.txt erased with + begin match Name.Map.find name erased with | exception Not_found -> take_item m | `Removed -> acc | `Constrained constraints -> @@ -508,9 +508,15 @@ module Analyser = | Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m -> if is_erased name.txt erased then acc else take_item m | Parsetree.Psig_recmodule mods -> - (match List.filter (fun pmd -> not (is_erased pmd.Parsetree.pmd_name.txt erased)) mods with - | [] -> acc - | mods -> take_item (Parsetree.Psig_recmodule mods))) + (match List.filter + (fun pmd -> + match pmd.Parsetree.pmd_name.txt with + | None -> false + | Some name -> not (is_erased name erased)) + mods + with + | [] -> acc + | mods -> take_item (Parsetree.Psig_recmodule mods))) signature [] (** Analysis of the elements of a class, from the information in the parsetree and in the class @@ -842,7 +848,7 @@ module Analyser = { xt_name = Name.concat current_module_name name ; xt_args; - xt_ret = may_map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ; + xt_ret = Option.map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ; xt_type_extension = new_te; xt_alias = None ; xt_loc = { loc_impl = None ; loc_inter = Some types_ext.Types.ext_loc} ; @@ -887,7 +893,7 @@ module Analyser = ex_name = Name.concat current_module_name name.txt ; ex_info = comment_opt ; ex_args; - ex_ret = may_map (Odoc_env.subst_type env) types_ext.ext_ret_type ; + ex_ret = Option.map (Odoc_env.subst_type env) types_ext.ext_ret_type ; ex_alias = None ; ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ; ex_code = @@ -1142,13 +1148,16 @@ module Analyser = | Parsetree.Psig_modsubst _ -> (* FIXME *) (0, env, []) - | Parsetree.Psig_module {Parsetree.pmd_name=name; pmd_type=module_type} -> - let complete_name = Name.concat current_module_name name.txt in + | Parsetree.Psig_module {Parsetree.pmd_name={txt=None}} -> + (0, env, []) + + | Parsetree.Psig_module {Parsetree.pmd_name={txt=Some name}; pmd_type=module_type} -> + let complete_name = Name.concat current_module_name name in (* get the module type in the signature by the module name *) let sig_module_type = - try Signature_search.search_module table name.txt + try Signature_search.search_module table name with Not_found -> - raise (Failure (Odoc_messages.module_not_found current_module_name name.txt)) + raise (Failure (Odoc_messages.module_not_found current_module_name name)) in let module_kind = analyse_module_kind env complete_name module_type sig_module_type in let code_intf = @@ -1194,31 +1203,60 @@ module Analyser = let new_env = List.fold_left (fun acc_env {Parsetree.pmd_name={txt=name}} -> - let complete_name = Name.concat current_module_name name in - let e = Odoc_env.add_module acc_env complete_name in - (* get the information for the module in the signature *) - let sig_module_type = - try Signature_search.search_module table name - with Not_found -> - raise (Failure (Odoc_messages.module_not_found current_module_name name)) - in - match sig_module_type with - (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *) - Types.Mty_signature s -> - Odoc_env.add_signature e complete_name ~rel: name s - | _ -> - print_DEBUG "not a Tmty_signature"; - e - ) - env - decls + match name with + | None -> acc_env + | Some name -> + let complete_name = Name.concat current_module_name name in + let e = Odoc_env.add_module acc_env complete_name in + (* get the information for the module in the signature *) + let sig_module_type = + try Signature_search.search_module table name + with Not_found -> + raise (Failure (Odoc_messages.module_not_found current_module_name name)) + in + match sig_module_type with + (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *) + Types.Mty_signature s -> + Odoc_env.add_signature e complete_name ~rel: name s + | _ -> + print_DEBUG "not a Tmty_signature"; + e + ) + env + decls in let rec f ?(first=false) acc_maybe_more last_pos name_mtype_list = match name_mtype_list with [] -> (acc_maybe_more, []) - | {Parsetree.pmd_name=name; pmd_type=modtype} :: q -> - let complete_name = Name.concat current_module_name name.txt in + | {Parsetree.pmd_name={txt = None}; pmd_type=modtype} :: q -> + let loc = modtype.Parsetree.pmty_loc in + let loc_start = Loc.start loc in + let loc_end = Loc.end_ loc in + let _, ele_comments = + if first then (None, []) + else get_comments_in_module last_pos loc_start + in + let pos_limit2 = + match q with + [] -> pos_limit + | _ :: _ -> Loc.start loc + in + let (maybe_more, _) = + My_ir.just_after_special + !file_name + (get_string_of_file loc_end pos_limit2) + in + + let (maybe_more2, eles) = f + maybe_more + (loc_end + maybe_more) + q + in + (maybe_more2, ele_comments @ eles) + + | {Parsetree.pmd_name={txt = Some name}; pmd_type=modtype} :: q -> + let complete_name = Name.concat current_module_name name in let loc = modtype.Parsetree.pmty_loc in let loc_start = Loc.start loc in let loc_end = Loc.end_ loc in @@ -1237,9 +1275,9 @@ module Analyser = in (* get the information for the module in the signature *) let sig_module_type = - try Signature_search.search_module table name.txt + try Signature_search.search_module table name with Not_found -> - raise (Failure (Odoc_messages.module_not_found current_module_name name.txt)) + raise (Failure (Odoc_messages.module_not_found current_module_name name)) in (* associate the comments to each constructor and build the [Type.t_type] *) let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in @@ -1544,28 +1582,31 @@ module Analyser = raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat") ) - | Parsetree.Pmty_functor (_, pmodule_type2, module_type2) -> + | Parsetree.Pmty_functor (param2, module_type2) -> ( - let loc = match pmodule_type2 with None -> Location.none - | Some pmty -> pmty.Parsetree.pmty_loc in + let loc = match param2 with Parsetree.Unit -> Location.none + | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in let loc_start = Loc.start loc in let loc_end = Loc.end_ loc in let mp_type_code = get_string_of_file loc_start loc_end in print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); match sig_module_type with - Types.Mty_functor (ident, param_module_type, body_module_type) -> - let mp_kind = - match pmodule_type2, param_module_type with - Some pmty, Some mty -> + Types.Mty_functor (param, body_module_type) -> + let mp_name, mp_kind = + match param2, param with + Parsetree.Named (_, pmty), Types.Named (Some ident, mty) -> + Name.from_ident ident, analyse_module_type_kind env current_module_name pmty mty - | _ -> Module_type_struct [] + | _ -> "*", Module_type_struct [] in let param = { - mp_name = Name.from_ident ident ; + mp_name = mp_name; mp_type = - Misc.may_map (Odoc_env.subst_module_type env) - param_module_type; + (match param with + | Types.Unit -> None + | Types.Named (_, mty) -> + Some (Odoc_env.subst_module_type env mty)); mp_type_code = mp_type_code ; mp_kind = mp_kind ; } @@ -1639,27 +1680,30 @@ module Analyser = (* if we're here something's wrong *) raise (Failure "Parsetree.Pmty_signature signature but not Types.Mty_signature signat") ) - | Parsetree.Pmty_functor (_, pmodule_type2,module_type2) (* of string * module_type * module_type *) -> + | Parsetree.Pmty_functor (param2,module_type2) (* of string * module_type * module_type *) -> ( match sig_module_type with - Types.Mty_functor (ident, param_module_type, body_module_type) -> - let loc = match pmodule_type2 with None -> Location.none - | Some pmty -> pmty.Parsetree.pmty_loc in + Types.Mty_functor (param, body_module_type) -> + let loc = match param2 with Parsetree.Unit -> Location.none + | Parsetree.Named (_, pmty) -> pmty.Parsetree.pmty_loc in let loc_start = Loc.start loc in let loc_end = Loc.end_ loc in let mp_type_code = get_string_of_file loc_start loc_end in print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); - let mp_kind = - match pmodule_type2, param_module_type with - Some pmty, Some mty -> + let mp_name, mp_kind = + match param2, param with + Parsetree.Named (_, pmty), Types.Named (Some ident, mty) -> + Name.from_ident ident, analyse_module_type_kind env current_module_name pmty mty - | _ -> Module_type_struct [] + | _ -> "*", Module_type_struct [] in let param = { - mp_name = Name.from_ident ident ; - mp_type = Misc.may_map - (Odoc_env.subst_module_type env) param_module_type ; + mp_name; + mp_type = + (match param with + | Types.Unit -> None + | Types.Named(_, mty) -> Some (Odoc_env.subst_module_type env mty)); mp_type_code = mp_type_code ; mp_kind = mp_kind ; } diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli index ac26bc8b..78d774de 100644 --- a/ocamldoc/odoc_sig.mli +++ b/ocamldoc/odoc_sig.mli @@ -110,7 +110,7 @@ module type Info_retriever = end module Analyser : - functor (My_ir : Info_retriever) -> + Info_retriever -> sig (** This variable is used to load a file as a string and retrieve characters from it.*) val file : string ref diff --git a/ocamltest/.depend b/ocamltest/.depend index 278e3e86..01a6139e 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -4,35 +4,43 @@ run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \ run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \ ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \ - ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/mlvalues.h \ - ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \ - ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \ + ../runtime/caml/domain_state.h ../runtime/caml/mlvalues.h \ + ../runtime/caml/domain_state.tbl ../runtime/caml/memory.h \ + ../runtime/caml/gc.h ../runtime/caml/major_gc.h \ + ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \ + ../runtime/caml/address_class.h ../runtime/caml/domain.h \ ../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \ ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \ ../runtime/caml/mlvalues.h ../runtime/caml/config.h \ - ../runtime/caml/misc.h ../runtime/caml/memory.h ../runtime/caml/gc.h \ - ../runtime/caml/mlvalues.h ../runtime/caml/major_gc.h \ + ../runtime/caml/misc.h ../runtime/caml/domain_state.h \ + ../runtime/caml/mlvalues.h ../runtime/caml/domain_state.tbl \ + ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/major_gc.h \ ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \ - ../runtime/caml/address_class.h ../runtime/caml/alloc.h \ - ../runtime/caml/signals.h ../runtime/caml/osdeps.h \ - ../runtime/caml/memory.h + ../runtime/caml/address_class.h ../runtime/caml/domain.h \ + ../runtime/caml/alloc.h ../runtime/caml/signals.h \ + ../runtime/caml/osdeps.h ../runtime/caml/memory.h actions.cmo : \ + variables.cmi \ result.cmi \ environments.cmi \ actions.cmi actions.cmx : \ + variables.cmx \ result.cmx \ environments.cmx \ actions.cmi actions.cmi : \ + variables.cmi \ result.cmi \ environments.cmi actions_helpers.cmo : \ variables.cmi \ + strace.cmi \ run_command.cmi \ result.cmi \ ocamltest_stdlib.cmi \ + modifier_parser.cmi \ filecompare.cmi \ environments.cmi \ builtin_variables.cmi \ @@ -40,9 +48,11 @@ actions_helpers.cmo : \ actions_helpers.cmi actions_helpers.cmx : \ variables.cmx \ + strace.cmx \ run_command.cmx \ result.cmx \ ocamltest_stdlib.cmx \ + modifier_parser.cmx \ filecompare.cmx \ environments.cmx \ builtin_variables.cmx \ @@ -83,12 +93,10 @@ builtin_variables.cmi : \ variables.cmi environments.cmo : \ variables.cmi \ - tsl_lexer.cmi \ ocamltest_stdlib.cmi \ environments.cmi environments.cmx : \ variables.cmx \ - tsl_lexer.cmx \ ocamltest_stdlib.cmx \ environments.cmi environments.cmi : \ @@ -129,6 +137,20 @@ main.cmx : \ actions.cmx \ main.cmi main.cmi : +modifier_parser.cmo : \ + variables.cmi \ + tsl_lexer.cmi \ + ocamltest_stdlib.cmi \ + environments.cmi \ + modifier_parser.cmi +modifier_parser.cmx : \ + variables.cmx \ + tsl_lexer.cmx \ + ocamltest_stdlib.cmx \ + environments.cmx \ + modifier_parser.cmi +modifier_parser.cmi : \ + environments.cmi ocaml_actions.cmo : \ result.cmi \ ocamltest_stdlib.cmi \ @@ -371,6 +393,14 @@ run_command.cmx : \ ocamltest_stdlib.cmx \ run_command.cmi run_command.cmi : +strace.cmo : \ + variables.cmi \ + strace.cmi +strace.cmx : \ + variables.cmx \ + strace.cmi +strace.cmi : \ + variables.cmi tests.cmo : \ result.cmi \ actions.cmi \ diff --git a/ocamltest/Makefile b/ocamltest/Makefile index 1c0067aa..4218e6a9 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -19,6 +19,7 @@ ROOTDIR = .. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries ifeq "$(filter str,$(OTHERLIBRARIES))" "" str := false @@ -96,13 +97,15 @@ core := \ run_command.mli run_command.ml \ filecompare.mli filecompare.ml \ variables.mli variables.ml \ + environments.mli environments.ml \ result.mli result.ml \ actions.mli actions.ml \ tests.mli tests.ml \ + strace.mli strace.ml \ tsl_ast.mli tsl_ast.ml \ tsl_parser.mly \ tsl_lexer.mli tsl_lexer.mll \ - environments.mli environments.ml \ + modifier_parser.mli modifier_parser.ml \ tsl_semantics.mli tsl_semantics.ml \ builtin_variables.mli builtin_variables.ml \ actions_helpers.mli actions_helpers.ml \ @@ -176,15 +179,15 @@ flags := -g -nostdlib $(include_directories) \ -strict-sequence -safe-string -strict-formats \ -w +a-4-9-41-42-44-45-48 -warn-error A -ocamlc := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlc $(flags) +ocamlc := $(BEST_OCAMLC) $(flags) -ocamlopt := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/ocamlopt $(flags) +ocamlopt := $(BEST_OCAMLOPT) $(flags) -ocamldep := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/boot/ocamlc -depend +ocamldep := $(BEST_OCAMLDEP) depflags := -slash depincludes := -ocamllex := $(ROOTDIR)/runtime/ocamlrun $(ROOTDIR)/lex/ocamllex +ocamllex := $(BEST_OCAMLLEX) ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc @@ -218,10 +221,7 @@ ocamltest.opt$(EXE): $(native_modules) $(ocamlyacc) $< %.ml: %.mll - $(ocamllex) -q $< - -%.$(O): %.c - $(CC) $(OC_CFLAGS) $(OC_CPPFLAGS) -c $< + $(ocamllex) $(OCAMLLEX_FLAGS) $< ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config sed \ @@ -257,6 +257,7 @@ ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config -e 's|@@CFLAGS@@|$(OC_CFLAGS)|' \ -e 's|@@CCOMPTYPE@@|$(CCOMPTYPE)|' \ -e 's|@@WINDOWS_UNICODE@@|$(WINDOWS_UNICODE)|' \ + -e 's|@@FUNCTION_SECTIONS@@|$(FUNCTION_SECTIONS)|' \ $< > $@ .PHONY: clean diff --git a/ocamltest/actions.ml b/ocamltest/actions.ml index e9614371..cb436a60 100644 --- a/ocamltest/actions.ml +++ b/ocamltest/actions.ml @@ -23,7 +23,9 @@ type t = { mutable hook : code option } -let action_name a = a.name +let name a = a.name + +let action_name = Variables.make ("action_name", "Name of the current action") let make n c = { name = n; body = c; hook = None } @@ -61,6 +63,7 @@ let run log env action = let code = match action.hook with | None -> action.body | Some code -> code in + let env = Environments.add action_name action.name env in code log env module ActionSet = Set.Make @@ -68,3 +71,5 @@ module ActionSet = Set.Make type nonrec t = t let compare = compare end) + +let _ = Variables.register_variable action_name diff --git a/ocamltest/actions.mli b/ocamltest/actions.mli index 941fc477..bdcf4258 100644 --- a/ocamltest/actions.mli +++ b/ocamltest/actions.mli @@ -19,7 +19,9 @@ type code = out_channel -> Environments.t -> Result.t * Environments.t type t -val action_name : t -> string +val name : t -> string + +val action_name : Variables.t val update : t -> code -> t diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml index 210b2f25..6dae89fd 100644 --- a/ocamltest/actions_helpers.ml +++ b/ocamltest/actions_helpers.ml @@ -97,13 +97,29 @@ let run_cmd ?(stderr_variable=Builtin_variables.stderr) ?(append=false) ?(timeout=0) - log env cmd + log env original_cmd = let log_redirection std filename = if filename<>"" then begin Printf.fprintf log " Redirecting %s to %s \n%!" std filename end in + let cmd = + if (Environments.lookup_as_bool Strace.strace env) = Some true then + begin + let action_name = Environments.safe_lookup Actions.action_name env in + let test_build_directory = test_build_directory env in + let strace_logfile_name = Strace.get_logfile_name action_name in + let strace_logfile = + Filename.make_path [test_build_directory; strace_logfile_name] + in + let strace_flags = Environments.safe_lookup Strace.strace_flags env in + let strace_cmd = + ["strace"; "-f"; "-o"; strace_logfile; strace_flags] + in + strace_cmd @ original_cmd + end else original_cmd + in let lst = List.concat (List.map String.words cmd) in let quoted_lst = if Sys.os_type="Win32" @@ -205,7 +221,7 @@ let run_script log env = log scriptenv in let final_value = if Result.is_pass result then begin - match Environments.modifiers_of_file response_file with + match Modifier_parser.modifiers_of_file response_file with | modifiers -> let modified_env = Environments.apply_modifiers newenv modifiers in (result, modified_env) @@ -248,7 +264,7 @@ let run_hook hook_name log input_env = } in let exit_status = run settings in let final_value = match exit_status with | 0 -> - begin match Environments.modifiers_of_file response_file with + begin match Modifier_parser.modifiers_of_file response_file with | modifiers -> let modified_env = Environments.apply_modifiers hookenv modifiers in (Result.pass, modified_env) @@ -287,8 +303,12 @@ let check_output kind_of_output output_variable reference_variable log Filecompare.reference_filename = reference_filename; Filecompare.output_filename = output_filename } in + let ignore_header_conf = { + Filecompare.lines = skip_lines; + Filecompare.bytes = skip_bytes; + } in let tool = - Filecompare.(make_cmp_tool ~ignore:{lines=skip_lines;bytes=skip_bytes}) in + Filecompare.make_cmp_tool ~ignore:ignore_header_conf in match Filecompare.check_file ~tool files with | Filecompare.Same -> (Result.pass, env) | Filecompare.Different -> @@ -303,7 +323,7 @@ let check_output kind_of_output output_variable reference_variable log then begin Printf.fprintf log "Promoting %s output %s to reference %s\n%!" kind_of_output output_filename reference_filename; - Sys.copy_file output_filename reference_filename; + Filecompare.promote files ignore_header_conf; end; (Result.fail_with_reason reason, env) | Filecompare.Unexpected_output -> diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index 64af2eec..0cb4d925 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -145,12 +145,42 @@ let arch64 = make "64-bit architecture" "non-64-bit architecture") +let arch_arm = make + "arch_arm" + (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm") + "Target is ARM architecture" + "Target is not ARM architecture") + +let arch_arm64 = make + "arch_arm64" + (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "arm64") + "Target is ARM64 architecture" + "Target is not ARM64 architecture") + + let arch_amd64 = make + "arch_amd64" + (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "amd64") + "Target is AMD64 architecture" + "Target is not AMD64 architecture") + + let arch_i386 = make + "arch_i386" + (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "i386") + "Target is i386 architecture" + "Target is not i386 architecture") + let arch_power = make "arch_power" (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "power") "Target is POWER architecture" "Target is not POWER architecture") +let function_sections = make + "function_sections" + (Actions_helpers.pass_or_skip (Ocamltest_config.function_sections) + "Target supports function sections" + "Target does not support function sections") + let has_symlink = make "has_symlink" (Actions_helpers.pass_or_skip (Sys.has_symlink () ) @@ -214,5 +244,10 @@ let _ = run; script; check_program_output; + arch_arm; + arch_arm64; + arch_amd64; + arch_i386; arch_power; + function_sections; ] diff --git a/ocamltest/dune b/ocamltest/dune index 9d3361a2..ff6cb830 100644 --- a/ocamltest/dune +++ b/ocamltest/dune @@ -22,7 +22,7 @@ (rule (targets ocamltest_config.ml) - (deps ../Makefile.config ../Makefile.common Makefile + (deps ../Makefile.config ../Makefile.common ../Makefile.best_binaries Makefile ./ocamltest_config.ml.in ./getocamloptdefaultflags) (action (run make %{targets}))) diff --git a/ocamltest/environments.ml b/ocamltest/environments.ml index cac5e21f..43dd1173 100644 --- a/ocamltest/environments.ml +++ b/ocamltest/environments.ml @@ -142,26 +142,3 @@ let rec apply_modifier environment = function | Remove variable -> remove variable environment and apply_modifiers environment modifiers = List.fold_left apply_modifier environment modifiers - -let modifier_of_string str = - let lexbuf = Lexing.from_string str in - let variable_name, result = Tsl_lexer.modifier lexbuf in - let variable = - match Variables.find_variable variable_name with - | None -> raise (Variables.No_such_variable variable_name) - | Some variable -> variable - in - match result with - | `Remove -> Remove variable - | `Add value -> Add (variable, value) - | `Append value -> Append (variable, value) - -let modifiers_of_file filename = - let ic = open_in filename in - let rec modifiers_of_lines acc = match input_line_opt ic with - | None -> acc - | Some line -> - modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in - let modifiers = modifiers_of_lines [] in - close_in ic; - List.rev modifiers diff --git a/ocamltest/environments.mli b/ocamltest/environments.mli index 94d794bb..f288a6f1 100644 --- a/ocamltest/environments.mli +++ b/ocamltest/environments.mli @@ -67,7 +67,3 @@ exception Modifiers_name_already_registered of string exception Modifiers_name_not_found of string val register_modifiers : string -> modifiers -> unit - -val modifier_of_string : string -> modifier - -val modifiers_of_file : string -> modifiers diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index f9a59609..d2e8c310 100644 --- a/ocamltest/filecompare.ml +++ b/ocamltest/filecompare.ml @@ -179,3 +179,22 @@ let diff files = in Sys.force_remove temporary_file; result + +let promote files ignore_conf = + match files.filetype, ignore_conf with + | Text, {lines = skip_lines; _} -> + let reference = open_out files.reference_filename in + let output = open_in files.output_filename in + for _ = 1 to skip_lines do + try ignore (input_line output) with End_of_file -> () + done; + Sys.copy_chan output reference; + close_out reference; + close_in output + | Binary, {bytes = skip_bytes; _} -> + let reference = open_out_bin files.reference_filename in + let output = open_in_bin files.output_filename in + seek_in output skip_bytes; + Sys.copy_chan output reference; + close_out reference; + close_in output diff --git a/ocamltest/filecompare.mli b/ocamltest/filecompare.mli index 42b493ae..6a071dc6 100644 --- a/ocamltest/filecompare.mli +++ b/ocamltest/filecompare.mli @@ -46,3 +46,5 @@ val check_file : ?tool:tool -> files -> result val cmp_result_of_exitcode : string -> int -> result val diff : files -> (string, string) Stdlib.result + +val promote : files -> ignore -> unit diff --git a/ocamltest/main.ml b/ocamltest/main.ml index cfe38d07..2d75b0e4 100644 --- a/ocamltest/main.ml +++ b/ocamltest/main.ml @@ -121,7 +121,7 @@ let test_file test_filename = let used_tests = tests_in_trees test_trees in let used_actions = actions_in_tests used_tests in let action_names = - let f act names = String.Set.add (Actions.action_name act) names in + let f act names = String.Set.add (Actions.name act) names in Actions.ActionSet.fold f used_actions String.Set.empty in let test_dirname = Filename.dirname test_filename in let test_basename = Filename.basename test_filename in @@ -181,12 +181,62 @@ let test_file test_filename = (* Restore current working directory *) Sys.chdir cwd -let main () = - if !Options.files_to_test = [] then begin - print_usage(); - exit 1 +let is_test s = + match tsl_block_of_file s with + | _ -> true + | exception _ -> false + +let ignored s = + s = "" || s.[0] = '_' || s.[0] = '.' + +let find_test_dirs dir = + let res = ref [] in + let rec loop dir = + let contains_tests = ref false in + Array.iter (fun s -> + if ignored s then () + else begin + let s = dir ^ "/" ^ s in + if Sys.is_directory s then loop s + else if not !contains_tests && is_test s then contains_tests := true + end + ) (Sys.readdir dir); + if !contains_tests then res := dir :: !res + in + loop dir; + List.rev !res + +let list_tests dir = + let res = ref [] in + if Sys.is_directory dir then begin + Array.iter (fun s -> + if ignored s then () + else begin + let s' = dir ^ "/" ^ s in + if Sys.is_directory s' || not (is_test s') then () + else res := s :: !res + end + ) (Sys.readdir dir) end; - init_tests_to_skip(); - List.iter test_file !Options.files_to_test + List.rev !res + +let () = + init_tests_to_skip() + +let main () = + let failed = ref false in + let work_done = ref false in + let list_tests dir = + match list_tests dir with + | [] -> failed := true + | res -> List.iter print_endline res + in + let find_test_dirs dir = List.iter print_endline (find_test_dirs dir) in + let doit f x = work_done := true; f x in + List.iter (doit find_test_dirs) !Options.find_test_dirs; + List.iter (doit list_tests) !Options.list_tests; + List.iter (doit test_file) !Options.files_to_test; + if not !work_done then print_usage(); + if !failed || not !work_done then exit 1 let _ = main() diff --git a/ocamltest/modifier_parser.ml b/ocamltest/modifier_parser.ml new file mode 100644 index 00000000..65af1284 --- /dev/null +++ b/ocamltest/modifier_parser.ml @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Parsing of modifier (response) files created by hooks and scripts *) + +open Ocamltest_stdlib + +let modifier_of_string str = + let lexbuf = Lexing.from_string str in + let variable_name, result = Tsl_lexer.modifier lexbuf in + let variable = + match Variables.find_variable variable_name with + | None -> raise (Variables.No_such_variable variable_name) + | Some variable -> variable + in + match result with + | `Remove -> Environments.Remove variable + | `Add value -> Environments.Add (variable, value) + | `Append value -> Environments.Append (variable, value) + +let modifiers_of_file filename = + let ic = open_in filename in + let rec modifiers_of_lines acc = match input_line_opt ic with + | None -> acc + | Some line -> + modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in + let modifiers = modifiers_of_lines [] in + close_in ic; + List.rev modifiers diff --git a/ocamltest/modifier_parser.mli b/ocamltest/modifier_parser.mli new file mode 100644 index 00000000..f34e3a39 --- /dev/null +++ b/ocamltest/modifier_parser.mli @@ -0,0 +1,20 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Parsing of modifier (response) files created by hooks and scripts *) + +val modifier_of_string : string -> Environments.modifier + +val modifiers_of_file : string -> Environments.modifiers diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml index 02c17aa7..4586ccee 100644 --- a/ocamltest/ocaml_actions.ml +++ b/ocamltest/ocaml_actions.ml @@ -686,6 +686,7 @@ let finalise_codegen_msvc ocamlsrcdir test_basename log env = let run_codegen log env = let ocamlsrcdir = Ocaml_directories.srcdir () in let testfile = Actions_helpers.testfile env in + let testfile_basename = Filename.chop_extension testfile in let what = Printf.sprintf "Running codegen on %s" testfile in Printf.fprintf log "%s\n%!" what; let test_build_directory = @@ -699,9 +700,13 @@ let run_codegen log env = compiler_output env in + let output_file = Filename.make_filename testfile_basename "output" in + let output = Filename.make_path [test_build_directory; output_file] in + let env = Environments.add Builtin_variables.output output env in let commandline = [ Ocaml_commands.ocamlrun_codegen ocamlsrcdir; + flags env; "-S " ^ testfile ] in let expected_exit_status = 0 in @@ -714,7 +719,6 @@ let run_codegen log env = log env commandline in if exit_status=expected_exit_status then begin - let testfile_basename = Filename.chop_extension testfile in let finalise = if Ocamltest_config.ccomptype="msvc" then finalise_codegen_msvc diff --git a/ocamltest/ocamltest_config.ml.in b/ocamltest/ocamltest_config.ml.in index 90bf0d3c..2f7fb6d4 100644 --- a/ocamltest/ocamltest_config.ml.in +++ b/ocamltest/ocamltest_config.ml.in @@ -76,3 +76,5 @@ let bytecc_libs = "@@BYTECCLIBS@@" let nativecc_libs = "@@NATIVECCLIBS@@" let windows_unicode = @@WINDOWS_UNICODE@@ != 0 + +let function_sections = @@FUNCTION_SECTIONS@@ diff --git a/ocamltest/ocamltest_config.mli b/ocamltest/ocamltest_config.mli index 933d1ae3..91977929 100644 --- a/ocamltest/ocamltest_config.mli +++ b/ocamltest/ocamltest_config.mli @@ -105,3 +105,7 @@ val bytecc_libs : string val nativecc_libs : string val windows_unicode : bool + +val function_sections : bool +(** Whether the compiler was configured to generate + each function in a separate section *) diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli index 2200b3d5..d74fc2c2 100644 --- a/ocamltest/ocamltest_stdlib.mli +++ b/ocamltest/ocamltest_stdlib.mli @@ -49,6 +49,7 @@ module Sys : sig val run_system_command : string -> unit val make_directory : string -> unit val string_of_file : string -> string + val copy_chan : in_channel -> out_channel -> unit val copy_file : string -> string -> unit val force_remove : string -> unit val has_symlink : unit -> bool diff --git a/ocamltest/options.ml b/ocamltest/options.ml index 1547735c..24989c02 100644 --- a/ocamltest/options.ml +++ b/ocamltest/options.ml @@ -21,7 +21,7 @@ let show_objects title string_of_object objects = List.iter print_object objects; exit 0 -let string_of_action = Actions.action_name +let string_of_action = Actions.name let string_of_test test = if test.Tests.test_run_by_default @@ -49,21 +49,30 @@ let log_to_stderr = ref false let promote = ref false +let find_test_dirs = ref [] + +let list_tests = ref [] + +let add_to_list r x = + r := !r @ [x] + let commandline_options = [ - ("-e", Arg.Set log_to_stderr, "Log to stderr instead of a file."); + ("-e", Arg.Set log_to_stderr, " Log to stderr instead of a file."); ("-promote", Arg.Set promote, - "Overwrite reference files with the test output (experimental, unstable)"); - ("-show-actions", Arg.Unit show_actions, "Show available actions."); - ("-show-tests", Arg.Unit show_tests, "Show available tests."); - ("-show-variables", Arg.Unit show_variables, "Show available variables."); + " Overwrite reference files with the test output (experimental, unstable)"); + ("-show-actions", Arg.Unit show_actions, " Show available actions."); + ("-show-tests", Arg.Unit show_tests, " Show available tests."); + ("-show-variables", Arg.Unit show_variables, " Show available variables."); + ("-find-test-dirs", Arg.String (add_to_list find_test_dirs), + " Find directories that contain tests (recursive)."); + ("-list-tests", Arg.String (add_to_list list_tests), + " List tests in given directory."); ] let files_to_test = ref [] -let add_testfile name = files_to_test := !files_to_test @ [name] - let usage = "Usage: " ^ Sys.argv.(0) ^ " options files to test" let _ = - Arg.parse commandline_options add_testfile usage + Arg.parse (Arg.align commandline_options) (add_to_list files_to_test) usage diff --git a/ocamltest/options.mli b/ocamltest/options.mli index 26d3796f..4d64fdbd 100644 --- a/ocamltest/options.mli +++ b/ocamltest/options.mli @@ -22,3 +22,7 @@ val files_to_test : string list ref val promote : bool ref val usage : string + +val find_test_dirs : string list ref + +val list_tests : string list ref diff --git a/ocamltest/strace.ml b/ocamltest/strace.ml new file mode 100644 index 00000000..f289adba --- /dev/null +++ b/ocamltest/strace.ml @@ -0,0 +1,32 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Implementation of the strace feature *) + +let strace = Variables.make ("strace", "Whether to use strace") +let strace_flags = + Variables.make ("strace_flags", "Which flags to pass to strace") + +let (counters : (string, int) Hashtbl.t) = Hashtbl.create 10 + +let get_logfile_name base = + let n = try Hashtbl.find counters base with Not_found -> 1 in + let filename = Printf.sprintf "strace-%s_%d.log" base n in + Hashtbl.replace counters base (n+1); + filename + +let _ = + Variables.register_variable strace; + Variables.register_variable strace_flags diff --git a/ocamltest/strace.mli b/ocamltest/strace.mli new file mode 100644 index 00000000..ac21db36 --- /dev/null +++ b/ocamltest/strace.mli @@ -0,0 +1,22 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Interface to the strace feature *) + +val strace : Variables.t + +val strace_flags : Variables.t + +val get_logfile_name : string -> string diff --git a/ocamltest/tests.ml b/ocamltest/tests.ml index f360600e..7e86bbf7 100644 --- a/ocamltest/tests.ml +++ b/ocamltest/tests.ml @@ -43,7 +43,7 @@ let lookup name = let test_of_action action = { - test_name = Actions.action_name action; + test_name = Actions.name action; test_run_by_default = false; test_actions = [action] } @@ -55,10 +55,10 @@ let run_actions log testenv actions = | action::remaining_actions -> begin Printf.fprintf log "Running action %d/%d (%s)\n%!" - action_number total (Actions.action_name action); + action_number total (Actions.name action); let (result, env') = Actions.run log env action in Printf.fprintf log "Action %d/%d (%s) %s\n%!" - action_number total (Actions.action_name action) + action_number total (Actions.name action) (Result.string_of_result result); if Result.is_pass result then run_actions_aux (action_number+1) env' remaining_actions diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll index 90a30836..19ef10ee 100644 --- a/ocamltest/tsl_lexer.mll +++ b/ocamltest/tsl_lexer.mll @@ -22,9 +22,7 @@ open Tsl_parser let comment_start_pos = ref [] let lexer_error message = - Printf.eprintf "%s\n%!" message; - exit 2 - + failwith (Printf.sprintf "Tsl lexer: %s" message) } let newline = ('\013'* '\010') @@ -67,6 +65,8 @@ rule token = parse file line column (Lexing.lexeme lexbuf) in lexer_error message } + | eof + { lexer_error "unexpected eof" } (* Backslashes are ignored in strings except at the end of lines where they cause the newline to be ignored. After an escaped newline, any blank characters at the start of the line are ignored and optionally one blank diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common index b121b0cd..b800ca91 100644 --- a/otherlibs/Makefile.otherlibs.common +++ b/otherlibs/Makefile.otherlibs.common @@ -18,12 +18,13 @@ ROOTDIR=../.. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun -CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \ - -I $(ROOTDIR)/stdlib +CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib +CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib + OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS) OC_CPPFLAGS += -I$(ROOTDIR)/runtime @@ -35,20 +36,23 @@ OPTCOMPFLAGS=-O3 else OPTCOMPFLAGS= endif +ifeq "$(FUNCTION_SECTIONS)" "true" +OPTCOMPFLAGS += -function-sections +endif MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib -# Variables to be defined by individual libraries: -#LIBNAME= -#CLIBNAME= -#CMIFILES= -#CAMLOBJS= -#COBJS= -#EXTRACFLAGS= -#EXTRACAMLFLAGS= -#LINKOPTS= -#LDOPTS= -#HEADERS= - +# Variables that must be defined by individual libraries: +# LIBNAME +# CAMLOBJS + +# Variables that can be defined by individual libraries, +# but have sensible default values: +COBJS ?= +EXTRACFLAGS ?= +EXTRACAMLFLAGS ?= +LINKOPTS ?= +LDOPTS ?= +HEADERS ?= CMIFILES ?= $(CAMLOBJS:.cmo=.cmi) CAMLOBJS_NAT ?= $(CAMLOBJS:.cmo=.cmx) CLIBNAME ?= $(LIBNAME) diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index 2a59ad5b..41cfb485 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -23,11 +23,12 @@ ROOTDIR = ../.. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLC=$(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT=$(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib # COMPFLAGS should be in sync with the toplevel Makefile's COMPFLAGS. COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \ @@ -98,6 +99,7 @@ COMPILERLIBS_SOURCES=\ typing/ident.ml \ typing/path.ml \ typing/primitive.ml \ + typing/type_immediacy.ml \ typing/types.ml \ typing/btype.ml \ typing/subst.ml \ @@ -119,7 +121,7 @@ COMPILERLIBS_SOURCES=\ # provide .ml files for .mli-only modules---without this, such modules do # not seem to be located by the type checker inside bytecode packs. -$(LOCAL_SRC)/Makefile: $(LOCAL_SRC)/Makefile.copy-sources +$(LOCAL_SRC)/Makefile: $(LOCAL_SRC)/Makefile.copy-sources Makefile cp -f $< $@ for ml in $(COMPILERLIBS_SOURCES); do \ echo "$(LOCAL_SRC)/$$(basename $$ml): $(ROOTDIR)/$$ml" \ @@ -260,6 +262,9 @@ clean: partialclean $(LOCAL_SRC)/*.ml $(LOCAL_SRC)/*.mli $(LOCAL_SRC)/Makefile \ $(LOCAL_SRC)/.depend byte/dynlink.mli native/dynlink.mli +.PHONY: beforedepend +beforedepend: dynlink_platform_intf.mli + .PHONY: depend ifeq "$(TOOLCHAIN)" "msvc" depend: @@ -269,15 +274,14 @@ DEPEND_DUMMY_FILES=\ native/dynlink_compilerlibs.ml \ byte/dynlink_compilerlibs.mli \ byte/dynlink.mli \ - native/dynlink.mli \ - dynlink_platform_intf.mli + native/dynlink.mli -depend: +depend: beforedepend touch $(DEPEND_DUMMY_FILES) $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \ - -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend + -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \ - -I native -native *.ml native/dynlink.ml >> .depend + -I native -native *.ml native/dynlink.ml >> .depend rm -f $(DEPEND_DUMMY_FILES) endif diff --git a/otherlibs/dynlink/dynlink_common.mli b/otherlibs/dynlink/dynlink_common.mli index a9201249..c6f92d05 100644 --- a/otherlibs/dynlink/dynlink_common.mli +++ b/otherlibs/dynlink/dynlink_common.mli @@ -19,7 +19,7 @@ (** Construction of dynlink functionality given the platform-specific code. *) -module Make (P : Dynlink_platform_intf.S) : sig +module Make (_ : Dynlink_platform_intf.S) : sig val is_native : bool val loadfile : string -> unit val loadfile_private : string -> unit diff --git a/otherlibs/raw_spacetime_lib/.depend b/otherlibs/raw_spacetime_lib/.depend index d725a309..7f6e6e7a 100644 --- a/otherlibs/raw_spacetime_lib/.depend +++ b/otherlibs/raw_spacetime_lib/.depend @@ -1,18 +1,20 @@ spacetime_offline.$(O): spacetime_offline.c ../../runtime/caml/alloc.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/config.h \ ../../runtime/caml/fail.h ../../runtime/caml/gc.h \ ../../runtime/caml/intext.h ../../runtime/caml/io.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/misc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/roots.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h ../../runtime/caml/stack.h \ - ../../runtime/caml/sys.h ../../runtime/caml/spacetime.h \ - ../../runtime/caml/stack.h ../../runtime/caml/s.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/minor_gc.h ../../runtime/caml/misc.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/roots.h \ + ../../runtime/caml/memory.h ../../runtime/caml/signals.h \ + ../../runtime/caml/stack.h ../../runtime/caml/sys.h \ + ../../runtime/caml/spacetime.h ../../runtime/caml/stack.h \ + ../../runtime/caml/s.h raw_spacetime_lib.cmo : \ raw_spacetime_lib.cmi raw_spacetime_lib.cmx : \ diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend index 9a611166..e9bdc28a 100644 --- a/otherlibs/str/.depend +++ b/otherlibs/str/.depend @@ -1,8 +1,10 @@ strstubs.$(O): strstubs.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/fail.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h str.cmo : \ str.cmi str.cmx : \ diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend index 2c64f077..8647bddf 100644 --- a/otherlibs/systhreads/.depend +++ b/otherlibs/systhreads/.depend @@ -1,31 +1,37 @@ st_stubs_b.$(O): st_stubs.c ../../runtime/caml/alloc.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/backtrace.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \ ../../runtime/caml/exec.h ../../runtime/caml/callback.h \ - ../../runtime/caml/custom.h ../../runtime/caml/fail.h \ - ../../runtime/caml/io.h ../../runtime/caml/memory.h \ - ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ - ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/misc.h \ + ../../runtime/caml/custom.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h ../../runtime/caml/io.h \ + ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ + ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ + ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ + ../../runtime/caml/domain.h ../../runtime/caml/misc.h \ ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \ ../../runtime/caml/roots.h ../../runtime/caml/memory.h \ ../../runtime/caml/signals.h ../../runtime/caml/stacks.h \ - ../../runtime/caml/sys.h threads.h + ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \ + ../../runtime/caml/roots.h threads.h st_stubs_n.$(O): st_stubs.c ../../runtime/caml/alloc.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/backtrace.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/backtrace.h \ ../../runtime/caml/exec.h ../../runtime/caml/callback.h \ - ../../runtime/caml/custom.h ../../runtime/caml/fail.h \ - ../../runtime/caml/io.h ../../runtime/caml/memory.h \ - ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ - ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/misc.h \ + ../../runtime/caml/custom.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h ../../runtime/caml/io.h \ + ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ + ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ + ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ + ../../runtime/caml/domain.h ../../runtime/caml/misc.h \ ../../runtime/caml/mlvalues.h ../../runtime/caml/printexc.h \ ../../runtime/caml/roots.h ../../runtime/caml/memory.h \ ../../runtime/caml/signals.h ../../runtime/caml/stack.h \ - ../../runtime/caml/sys.h threads.h + ../../runtime/caml/sys.h ../../runtime/caml/memprof.h \ + ../../runtime/caml/roots.h threads.h condition.cmo : \ mutex.cmi \ condition.cmi diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index d0b59a8d..668fb4d1 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -17,13 +17,22 @@ ROOTDIR=../.. include $(ROOTDIR)/Makefile.config include $(ROOTDIR)/Makefile.common +include $(ROOTDIR)/Makefile.best_binaries + +OC_CFLAGS += $(SHAREDLIB_CFLAGS) + +OC_CPPFLAGS += -I$(ROOTDIR)/runtime + +NATIVE_CPPFLAGS = \ + -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun LIBS = -nostdlib -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc $(LIBS) -CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt $(LIBS) +CAMLC=$(BEST_OCAMLC) $(LIBS) +CAMLOPT=$(BEST_OCAMLOPT) $(LIBS) + MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string ifeq "$(FLAMBDA)" "true" @@ -92,15 +101,13 @@ $(LIBNAME).cmxa: $(THREADS_NCOBJS) # st_stubs_n.$(O) from the same source file st_stubs.c (it is compiled # twice, each time with different options). +st_stubs_n.$(O): OC_CPPFLAGS += $(NATIVE_CPPFLAGS) + st_stubs_b.$(O): st_stubs.c $(HEADER) - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime \ - $(SHAREDLIB_CFLAGS) $(OUTPUTOBJ)$@ $< + $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $< st_stubs_n.$(O): st_stubs.c $(HEADER) - $(CC) $(OC_CFLAGS) $(OC_CPPFLAGS) \ - -I$(ROOTDIR)/runtime $(SHAREDLIB_CFLAGS) -DNATIVE_CODE \ - -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) \ - $(OUTPUTOBJ)$@ -c $< + $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $< partialclean: rm -f *.cm* @@ -154,11 +161,10 @@ depend: $(error Dependencies cannot be regenerated using the MSVC ports) else depend: - $(CC) -MM $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime st_stubs.c \ + $(CC) -MM $(OC_CPPFLAGS) st_stubs.c \ | sed -e 's/st_stubs\.o/st_stubs_b.$$(O)/' \ -e 's/ st_\(posix\|win32\)\.h//g' > .depend - $(CC) -MM $(OC_CPPFLAGS) -I$(ROOTDIR)/runtime \ - -DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) \ + $(CC) -MM $(OC_CPPFLAGS) $(NATIVE_CPPFLAGS) \ st_stubs.c | sed -e 's/st_stubs\.o/st_stubs_n.$$(O)/' \ -e 's/ st_\(posix\|win32\)\.h//g' >> .depend $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml >> .depend diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h index 5e42cdd4..e7f618a4 100644 --- a/otherlibs/systhreads/st_posix.h +++ b/otherlibs/systhreads/st_posix.h @@ -152,6 +152,7 @@ static void st_masterlock_release(st_masterlock * m) pthread_cond_signal(&m->is_free); } +CAMLno_tsan /* This can be called for reading [waiters] without locking. */ static INLINE int st_masterlock_waiters(st_masterlock * m) { return m->waiters; diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index bfe57514..e46a67be 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -19,6 +19,7 @@ #include "caml/backtrace.h" #include "caml/callback.h" #include "caml/custom.h" +#include "caml/domain.h" #include "caml/fail.h" #include "caml/io.h" #include "caml/memory.h" @@ -33,6 +34,7 @@ #include "caml/stacks.h" #endif #include "caml/sys.h" +#include "caml/memprof.h" #include "threads.h" #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) @@ -69,15 +71,15 @@ struct caml_thread_descr { /* The infos on threads (allocated via caml_stat_alloc()) */ struct caml_thread_struct { - value descr; /* The heap-allocated descriptor (root) */ + value descr; /* The heap-allocated descriptor (root) */ struct caml_thread_struct * next; /* Double linking of running threads */ struct caml_thread_struct * prev; #ifdef NATIVE_CODE - char * top_of_stack; /* Top of stack for this thread (approx.) */ - char * bottom_of_stack; /* Saved value of caml_bottom_of_stack */ - uintnat last_retaddr; /* Saved value of caml_last_return_address */ - value * gc_regs; /* Saved value of caml_gc_regs */ - char * exception_pointer; /* Saved value of caml_exception_pointer */ + char * top_of_stack; /* Top of stack for this thread (approx.) */ + char * bottom_of_stack; /* Saved value of Caml_state->bottom_of_stack */ + uintnat last_retaddr; /* Saved value of Caml_state->last_return_address */ + value * gc_regs; /* Saved value of Caml_state->gc_regs */ + char * exception_pointer; /* Saved value of Caml_state->exception_pointer */ struct caml__roots_block * local_roots; /* Saved value of local_roots */ struct longjmp_buffer * exit_buf; /* For thread exit */ #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) @@ -87,17 +89,19 @@ struct caml_thread_struct { value* spacetime_finaliser_trie_root; #endif #else - value * stack_low; /* The execution stack for this thread */ + value * stack_low; /* The execution stack for this thread */ value * stack_high; value * stack_threshold; - value * sp; /* Saved value of caml_extern_sp for this thread */ - value * trapsp; /* Saved value of caml_trapsp for this thread */ - struct caml__roots_block * local_roots; /* Saved value of caml_local_roots */ - struct longjmp_buffer * external_raise; /* Saved caml_external_raise */ + value * sp; /* Saved value of Caml_state->extern_sp for this thread */ + value * trapsp; /* Saved value of Caml_state->trapsp for this thread */ + /* Saved value of Caml_state->local_roots */ + struct caml__roots_block * local_roots; + struct longjmp_buffer * external_raise; /* Saved Caml_state->external_raise */ #endif - int backtrace_pos; /* Saved caml_backtrace_pos */ - backtrace_slot * backtrace_buffer; /* Saved caml_backtrace_buffer */ - value backtrace_last_exn; /* Saved caml_backtrace_last_exn (root) */ + int backtrace_pos; /* Saved Caml_state->backtrace_pos */ + backtrace_slot * backtrace_buffer; /* Saved Caml_state->backtrace_buffer */ + value backtrace_last_exn; /* Saved Caml_state->backtrace_last_exn (root) */ + int memprof_suspended; /* Saved caml_memprof_suspended */ }; typedef struct caml_thread_struct * caml_thread_t; @@ -171,12 +175,11 @@ static void caml_thread_scan_roots(scanning_action action) static inline void caml_thread_save_runtime_state(void) { #ifdef NATIVE_CODE - curr_thread->top_of_stack = caml_top_of_stack; - curr_thread->bottom_of_stack = caml_bottom_of_stack; - curr_thread->last_retaddr = caml_last_return_address; - curr_thread->gc_regs = caml_gc_regs; - curr_thread->exception_pointer = caml_exception_pointer; - curr_thread->local_roots = caml_local_roots; + curr_thread->top_of_stack = Caml_state->top_of_stack; + curr_thread->bottom_of_stack = Caml_state->bottom_of_stack; + curr_thread->last_retaddr = Caml_state->last_return_address; + curr_thread->gc_regs = Caml_state->gc_regs; + curr_thread->exception_pointer = Caml_state->exception_pointer; #ifdef WITH_SPACETIME curr_thread->spacetime_trie_node_ptr = caml_spacetime_trie_node_ptr; @@ -184,28 +187,28 @@ static inline void caml_thread_save_runtime_state(void) = caml_spacetime_finaliser_trie_root; #endif #else - curr_thread->stack_low = caml_stack_low; - curr_thread->stack_high = caml_stack_high; - curr_thread->stack_threshold = caml_stack_threshold; - curr_thread->sp = caml_extern_sp; - curr_thread->trapsp = caml_trapsp; - curr_thread->local_roots = caml_local_roots; - curr_thread->external_raise = caml_external_raise; + curr_thread->stack_low = Caml_state->stack_low; + curr_thread->stack_high = Caml_state->stack_high; + curr_thread->stack_threshold = Caml_state->stack_threshold; + curr_thread->sp = Caml_state->extern_sp; + curr_thread->trapsp = Caml_state->trapsp; + curr_thread->external_raise = Caml_state->external_raise; #endif - curr_thread->backtrace_pos = caml_backtrace_pos; - curr_thread->backtrace_buffer = caml_backtrace_buffer; - curr_thread->backtrace_last_exn = caml_backtrace_last_exn; + curr_thread->local_roots = Caml_state->local_roots; + curr_thread->backtrace_pos = Caml_state->backtrace_pos; + curr_thread->backtrace_buffer = Caml_state->backtrace_buffer; + curr_thread->backtrace_last_exn = Caml_state->backtrace_last_exn; + curr_thread->memprof_suspended = caml_memprof_suspended; } static inline void caml_thread_restore_runtime_state(void) { #ifdef NATIVE_CODE - caml_top_of_stack = curr_thread->top_of_stack; - caml_bottom_of_stack= curr_thread->bottom_of_stack; - caml_last_return_address = curr_thread->last_retaddr; - caml_gc_regs = curr_thread->gc_regs; - caml_exception_pointer = curr_thread->exception_pointer; - caml_local_roots = curr_thread->local_roots; + Caml_state->top_of_stack = curr_thread->top_of_stack; + Caml_state->bottom_of_stack= curr_thread->bottom_of_stack; + Caml_state->last_return_address = curr_thread->last_retaddr; + Caml_state->gc_regs = curr_thread->gc_regs; + Caml_state->exception_pointer = curr_thread->exception_pointer; #ifdef WITH_SPACETIME caml_spacetime_trie_node_ptr = curr_thread->spacetime_trie_node_ptr; @@ -213,17 +216,18 @@ static inline void caml_thread_restore_runtime_state(void) = curr_thread->spacetime_finaliser_trie_root; #endif #else - caml_stack_low = curr_thread->stack_low; - caml_stack_high = curr_thread->stack_high; - caml_stack_threshold = curr_thread->stack_threshold; - caml_extern_sp = curr_thread->sp; - caml_trapsp = curr_thread->trapsp; - caml_local_roots = curr_thread->local_roots; - caml_external_raise = curr_thread->external_raise; + Caml_state->stack_low = curr_thread->stack_low; + Caml_state->stack_high = curr_thread->stack_high; + Caml_state->stack_threshold = curr_thread->stack_threshold; + Caml_state->extern_sp = curr_thread->sp; + Caml_state->trapsp = curr_thread->trapsp; + Caml_state->external_raise = curr_thread->external_raise; #endif - caml_backtrace_pos = curr_thread->backtrace_pos; - caml_backtrace_buffer = curr_thread->backtrace_buffer; - caml_backtrace_last_exn = curr_thread->backtrace_last_exn; + Caml_state->local_roots = curr_thread->local_roots; + Caml_state->backtrace_pos = curr_thread->backtrace_pos; + Caml_state->backtrace_buffer = curr_thread->backtrace_buffer; + Caml_state->backtrace_last_exn = curr_thread->backtrace_last_exn; + caml_memprof_suspended = curr_thread->memprof_suspended; } /* Hooks for caml_enter_blocking_section and caml_leave_blocking_section */ @@ -376,6 +380,7 @@ static caml_thread_t caml_thread_new_info(void) th->backtrace_pos = 0; th->backtrace_buffer = NULL; th->backtrace_last_exn = Val_unit; + th->memprof_suspended = 0; return th; } @@ -558,6 +563,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg) st_tls_set(thread_descriptor_key, (void *) th); /* Acquire the global mutex */ caml_leave_blocking_section(); + caml_setup_stack_overflow_detection(); #ifdef NATIVE_CODE /* Setup termination handler (for caml_thread_exit) */ if (sigsetjmp(termination_buf.buf, 0) == 0) { @@ -696,7 +702,7 @@ CAMLprim value caml_thread_uncaught_exception(value exn) /* ML */ fprintf(stderr, "Thread %d killed on uncaught exception %s\n", Int_val(Ident(curr_thread->descr)), msg); caml_stat_free(msg); - if (caml_backtrace_active) caml_print_exception_backtrace(); + if (Caml_state->backtrace_active) caml_print_exception_backtrace(); fflush(stderr); return Val_unit; } @@ -743,12 +749,12 @@ CAMLprim value caml_thread_yield(value unit) /* ML */ our blocking section doesn't contain anything interesting, don't bother with saving errno.) */ - caml_process_pending_signals(); + caml_raise_if_exception(caml_process_pending_signals_exn()); caml_thread_save_runtime_state(); st_thread_yield(&caml_master_lock); curr_thread = st_tls_get(thread_descriptor_key); caml_thread_restore_runtime_state(); - caml_process_pending_signals(); + caml_raise_if_exception(caml_process_pending_signals_exn()); return Val_unit; } diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index 1030d945..6068960f 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -1,511 +1,647 @@ accept.o: accept.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h access.o: access.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h addrofstr.o: addrofstr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h alarm.o: alarm.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h bind.o: bind.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h unixsupport.h socketaddr.h \ ../../runtime/caml/misc.h channels.o: channels.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h ../../runtime/caml/io.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/io.h \ + ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h chdir.o: chdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h chmod.o: chmod.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h chown.o: chown.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h chroot.o: chroot.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h close.o: close.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h closedir.o: closedir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h connect.o: connect.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h \ socketaddr.h ../../runtime/caml/misc.h cst2constr.o: cst2constr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h cst2constr.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ + cst2constr.h cstringv.o: cstringv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h dup.o: dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h dup2.o: dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h envir.o: envir.c ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h errmsg.o: errmsg.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h execv.o: execv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h execve.o: execve.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h execvp.o: execvp.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h exit.o: exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h fchmod.o: fchmod.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h fchown.o: fchown.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h fcntl.o: fcntl.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h unixsupport.h fork.o: fork.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/debugger.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/debugger.h \ unixsupport.h fsync.o: fsync.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h ftruncate.o: ftruncate.c ../../runtime/caml/fail.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \ ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h getaddrinfo.o: getaddrinfo.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h \ - cst2constr.h socketaddr.h + ../../runtime/caml/domain.h ../../runtime/caml/misc.h \ + ../../runtime/caml/signals.h unixsupport.h cst2constr.h socketaddr.h getcwd.o: getcwd.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - unixsupport.h + ../../runtime/caml/domain.h unixsupport.h getegid.o: getegid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h geteuid.o: geteuid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getgid.o: getgid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getgr.o: getgr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h getgroups.o: getgroups.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h gethost.o: gethost.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h gethostname.o: gethostname.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h getlogin.o: getlogin.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h getnameinfo.o: getnameinfo.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h getpeername.o: getpeername.c ../../runtime/caml/fail.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \ unixsupport.h socketaddr.h ../../runtime/caml/misc.h getpid.o: getpid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getppid.o: getppid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getproto.o: getproto.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h getpw.o: getpw.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/fail.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h unixsupport.h getserv.o: getserv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h getsockname.o: getsockname.c ../../runtime/caml/fail.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \ unixsupport.h socketaddr.h ../../runtime/caml/misc.h gettimeofday.o: gettimeofday.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h getuid.o: getuid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h gmtime.o: gmtime.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h initgroups.o: initgroups.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h isatty.o: isatty.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h itimer.o: itimer.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h kill.o: kill.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h unixsupport.h \ - ../../runtime/caml/signals.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ + unixsupport.h ../../runtime/caml/signals.h link.o: link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h listen.o: listen.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h unixsupport.h lockf.o: lockf.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h lseek.o: lseek.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/io.h ../../runtime/caml/signals.h unixsupport.h mkdir.o: mkdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h mkfifo.o: mkfifo.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h mmap.o: mmap.c ../../runtime/caml/bigarray.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ ../../runtime/caml/mlvalues.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/fail.h ../../runtime/caml/io.h \ ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h \ ../../runtime/caml/sys.h unixsupport.h mmap_ba.o: mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/misc.h nice.o: nice.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h open.o: open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h opendir.o: opendir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \ + ../../runtime/caml/signals.h unixsupport.h pipe.o: pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h putenv.o: putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h read.o: read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h readdir.o: readdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ ../../runtime/caml/alloc.h ../../runtime/caml/signals.h unixsupport.h readlink.o: readlink.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/signals.h unixsupport.h rename.o: rename.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h rewinddir.o: rewinddir.c ../../runtime/caml/fail.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \ unixsupport.h rmdir.o: rmdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h select.o: select.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h sendrecv.o: sendrecv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h setgid.o: setgid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h setgroups.o: setgroups.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h setsid.o: setsid.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h unixsupport.h setuid.o: setuid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h shutdown.o: shutdown.c ../../runtime/caml/fail.h \ ../../runtime/caml/misc.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/domain_state.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/mlvalues.h \ unixsupport.h signals.o: signals.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/mlvalues.h ../../runtime/caml/signals.h unixsupport.h sleep.o: sleep.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h socket.o: socket.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h unixsupport.h socketaddr.o: socketaddr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h socketpair.o: socketpair.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h sockopt.o: sockopt.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/fail.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h stat.o: stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/io.h unixsupport.h \ - cst2constr.h nanosecond_stat.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \ + ../../runtime/caml/io.h unixsupport.h cst2constr.h nanosecond_stat.h strofaddr.o: strofaddr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ ../../runtime/caml/misc.h symlink.o: symlink.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h termios.o: termios.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h time.o: time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h times.o: times.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h truncate.o: truncate.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/fail.h \ - ../../runtime/caml/signals.h ../../runtime/caml/io.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h ../../runtime/caml/signals.h \ + ../../runtime/caml/io.h unixsupport.h umask.o: umask.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h unixsupport.o: unixsupport.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/callback.h ../../runtime/caml/memory.h \ - ../../runtime/caml/fail.h unixsupport.h cst2constr.h + ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \ + cst2constr.h unlink.o: unlink.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h utimes.o: utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h wait.o: wait.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h unixsupport.h write.o: write.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h unix.cmo : \ unix.cmi unix.cmx : \ diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c index 4a72c098..97e85f26 100644 --- a/otherlibs/unix/gethost.c +++ b/otherlibs/unix/gethost.c @@ -69,14 +69,8 @@ static value alloc_host_entry(struct hostent *entry) else aliases = Atom(0); entry_h_length = entry->h_length; -#ifdef h_addr addr_list = caml_alloc_array(alloc_one_addr, (const char**)entry->h_addr_list); -#else - adr = alloc_one_addr(entry->h_addr); - addr_list = caml_alloc_small(1, 0); - Field(addr_list, 0) = adr; -#endif res = caml_alloc_small(4, 0); Field(res, 0) = name; Field(res, 1) = aliases; diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 84a55eac..8ec4beab 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -234,8 +234,11 @@ val system : string -> process_status (** Execute the given command, wait until it terminates, and return its termination status. The string is interpreted by the shell [/bin/sh] (or the command interpreter [cmd.exe] on Windows) and - therefore can contain redirections, quotes, variables, etc. The - result [WEXITED 127] indicates that the shell couldn't be + therefore can contain redirections, quotes, variables, etc. + To properly quote whitespace and shell special characters occuring + in file names or command arguments, the use of + {!Filename.quote_command} is recommended. + The result [WEXITED 127] indicates that the shell couldn't be executed. *) val getpid : unit -> int @@ -398,15 +401,11 @@ val lseek : file_descr -> int -> seek_command -> int offset (from the beginning of the file). *) val truncate : string -> int -> unit -(** Truncates the named file to the given size. - - On Windows: not implemented. *) +(** Truncates the named file to the given size. *) val ftruncate : file_descr -> int -> unit (** Truncates the file corresponding to the given descriptor - to the given size. - - On Windows: not implemented. *) + to the given size. *) (** {1 File status} *) @@ -784,7 +783,12 @@ val open_process_in : string -> in_channel The standard output of the command is redirected to a pipe, which can be read via the returned input channel. The command is interpreted by the shell [/bin/sh] - (or [cmd.exe] on Windows), cf. [system]. *) + (or [cmd.exe] on Windows), cf. {!Unix.system}. + The {!Filename.quote_command} function can be used to + quote the command and its arguments as appropriate for the shell being + used. If the command does not need to be run through the shell, + {!Unix.open_process_args_in} can be used as a more robust and + more efficient alternative to {!Unix.open_process_in}. *) val open_process_out : string -> out_channel (** Same as {!Unix.open_process_in}, but redirect the standard input of @@ -792,20 +796,29 @@ val open_process_out : string -> out_channel is sent to the standard input of the command. Warning: writes on output channels are buffered, hence be careful to call {!Stdlib.flush} at the right times to ensure - correct synchronization. *) + correct synchronization. + If the command does not need to be run through the shell, + {!Unix.open_process_args_out} can be used instead of + {!Unix.open_process_out}. *) val open_process : string -> in_channel * out_channel (** Same as {!Unix.open_process_out}, but redirects both the standard input and standard output of the command to pipes connected to the two returned channels. The input channel is connected to the output - of the command, and the output channel to the input of the command. *) + of the command, and the output channel to the input of the command. + If the command does not need to be run through the shell, + {!Unix.open_process_args} can be used instead of + {!Unix.open_process}. *) val open_process_full : string -> string array -> in_channel * out_channel * in_channel (** Similar to {!Unix.open_process}, but the second argument specifies the environment passed to the command. The result is a triple of channels connected respectively to the standard output, standard input, - and standard error of the command. *) + and standard error of the command. + If the command does not need to be run through the shell, + {!Unix.open_process_args_full} can be used instead of + {!Unix.open_process_full}. *) val open_process_args_in : string -> string array -> in_channel (** High-level pipe and process management. The first argument specifies the diff --git a/otherlibs/win32unix/.depend b/otherlibs/win32unix/.depend index 92f2a0e8..68b0f1b2 100644 --- a/otherlibs/win32unix/.depend +++ b/otherlibs/win32unix/.depend @@ -1,430 +1,553 @@ accept.$(O): accept.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h bind.$(O): bind.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h channels.$(O): channels.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/io.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + unixsupport.h close.$(O): close.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \ + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h \ ../../runtime/caml/io.h close_on.$(O): close_on.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h connect.$(O): connect.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h socketaddr.h ../../runtime/caml/misc.h createprocess.$(O): createprocess.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h unixsupport.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + unixsupport.h ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h dup.$(O): dup.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h dup2.$(O): dup2.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h errmsg.$(O): errmsg.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + unixsupport.h envir.$(O): envir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h + ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h getpeername.$(O): getpeername.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h getpid.$(O): getpid.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getsockname.$(O): getsockname.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h gettimeofday.$(O): gettimeofday.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h isatty.$(O): isatty.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ - ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - unixsupport.h + ../../runtime/caml/domain.h unixsupport.h link.$(O): link.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h listen.$(O): listen.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h lockf.$(O): lockf.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h unixsupport.h ../../runtime/caml/signals.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \ + ../../runtime/caml/signals.h lseek.$(O): lseek.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h nonblock.$(O): nonblock.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h mkdir.$(O): mkdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ - ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h mmap.$(O): mmap.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/bigarray.h ../../runtime/caml/fail.h \ ../../runtime/caml/io.h ../../runtime/caml/mlvalues.h \ ../../runtime/caml/signals.h ../../runtime/caml/sys.h \ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + unixsupport.h open.$(O): open.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/memory.h \ - unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/memory.h unixsupport.h pipe.$(O): pipe.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/alloc.h unixsupport.h read.$(O): read.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h readlink.$(O): readlink.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h rename.$(O): rename.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h \ - ../../runtime/caml/gc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/memory.h unixsupport.h select.$(O): select.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/fail.h \ - ../../runtime/caml/signals.h winworker.h unixsupport.h windbug.h \ - winlist.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h ../../runtime/caml/signals.h winworker.h \ + unixsupport.h windbug.h winlist.h sendrecv.$(O): sendrecv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h shutdown.$(O): shutdown.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h sleep.$(O): sleep.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h socket.$(O): socket.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h unixsupport.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h sockopt.$(O): sockopt.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/fail.h unixsupport.h \ - socketaddr.h ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ + ../../runtime/caml/misc.h startup.$(O): startup.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ - ../../runtime/caml/s.h ../../runtime/caml/misc.h winworker.h \ - unixsupport.h windbug.h + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl winworker.h unixsupport.h windbug.h stat.$(O): stat.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h ../unix/cst2constr.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h \ + ../unix/cst2constr.h symlink.$(O): symlink.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h system.$(O): system.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/signals.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h times.$(O): times.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h +truncate.$(O): truncate.c ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/config.h ../../runtime/caml/m.h \ + ../../runtime/caml/s.h ../../runtime/caml/misc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/fail.h ../../runtime/caml/signals.h \ + ../../runtime/caml/io.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h unixsupport.$(O): unixsupport.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/callback.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/callback.h \ ../../runtime/caml/alloc.h ../../runtime/caml/memory.h \ - ../../runtime/caml/fail.h ../../runtime/caml/custom.h unixsupport.h \ - ../unix/cst2constr.h + ../../runtime/caml/domain.h ../../runtime/caml/fail.h \ + ../../runtime/caml/custom.h unixsupport.h ../unix/cst2constr.h windir.$(O): windir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/alloc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/alloc.h ../../runtime/caml/fail.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h winwait.$(O): winwait.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h unixsupport.h write.$(O): write.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/signals.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h winlist.$(O): winlist.c winlist.h winworker.$(O): winworker.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h winworker.h \ - unixsupport.h winlist.h windbug.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h winworker.h unixsupport.h winlist.h \ + windbug.h windbug.$(O): windbug.c windbug.h utimes.$(O): utimes.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/mlvalues.h ../../runtime/caml/memory.h \ ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h access.$(O): access.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h addrofstr.$(O): addrofstr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/fail.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h chdir.$(O): chdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h chmod.$(O): chmod.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h cst2constr.$(O): cst2constr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/fail.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/fail.h \ ../unix/cst2constr.h cstringv.$(O): cstringv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h execv.$(O): execv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h execve.$(O): execve.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h execvp.$(O): execvp.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h exit.$(O): exit.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl unixsupport.h getaddrinfo.$(O): getaddrinfo.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/misc.h ../../runtime/caml/signals.h unixsupport.h \ - ../unix/cst2constr.h socketaddr.h + ../../runtime/caml/domain.h ../../runtime/caml/misc.h \ + ../../runtime/caml/signals.h unixsupport.h ../unix/cst2constr.h \ + socketaddr.h getcwd.$(O): getcwd.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/osdeps.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - unixsupport.h + ../../runtime/caml/domain.h unixsupport.h gethost.$(O): gethost.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h gethostname.$(O): gethostname.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h getnameinfo.$(O): getnameinfo.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ - ../../runtime/caml/signals.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/signals.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h getproto.$(O): getproto.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h getserv.$(O): getserv.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h gmtime.$(O): gmtime.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/fail.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/fail.h ../../runtime/caml/memory.h \ + ../../runtime/caml/domain.h unixsupport.h mmap_ba.$(O): mmap_ba.c ../../runtime/caml/alloc.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/bigarray.h ../../runtime/caml/custom.h \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain.h ../../runtime/caml/misc.h putenv.$(O): putenv.c ../../runtime/caml/fail.h ../../runtime/caml/misc.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/domain_state.tbl \ ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ ../../runtime/caml/major_gc.h ../../runtime/caml/freelist.h \ ../../runtime/caml/minor_gc.h ../../runtime/caml/address_class.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/osdeps.h \ - ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/domain.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h rmdir.$(O): rmdir.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h socketaddr.$(O): socketaddr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ - ../../runtime/caml/memory.h unixsupport.h socketaddr.h \ - ../../runtime/caml/misc.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + ../../runtime/caml/memory.h ../../runtime/caml/domain.h unixsupport.h \ + socketaddr.h ../../runtime/caml/misc.h strofaddr.$(O): strofaddr.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ ../../runtime/caml/fail.h unixsupport.h socketaddr.h \ ../../runtime/caml/misc.h time.$(O): time.c ../../runtime/caml/mlvalues.h ../../runtime/caml/config.h \ ../../runtime/caml/m.h ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/alloc.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/alloc.h \ + unixsupport.h unlink.$(O): unlink.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/memory.h ../../runtime/caml/gc.h \ - ../../runtime/caml/mlvalues.h ../../runtime/caml/major_gc.h \ + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/memory.h \ + ../../runtime/caml/gc.h ../../runtime/caml/major_gc.h \ ../../runtime/caml/freelist.h ../../runtime/caml/minor_gc.h \ - ../../runtime/caml/address_class.h ../../runtime/caml/signals.h \ - ../../runtime/caml/osdeps.h ../../runtime/caml/memory.h unixsupport.h + ../../runtime/caml/address_class.h ../../runtime/caml/domain.h \ + ../../runtime/caml/signals.h ../../runtime/caml/osdeps.h \ + ../../runtime/caml/memory.h unixsupport.h fsync.$(O): fsync.c ../../runtime/caml/mlvalues.h \ ../../runtime/caml/config.h ../../runtime/caml/m.h \ ../../runtime/caml/s.h ../../runtime/caml/misc.h \ - ../../runtime/caml/signals.h ../../runtime/caml/mlvalues.h unixsupport.h + ../../runtime/caml/domain_state.h ../../runtime/caml/mlvalues.h \ + ../../runtime/caml/domain_state.tbl ../../runtime/caml/signals.h \ + unixsupport.h unix.cmo : \ unix.cmi unix.cmx : \ diff --git a/otherlibs/win32unix/Makefile b/otherlibs/win32unix/Makefile index ffcb1afc..7d5ec984 100644 --- a/otherlibs/win32unix/Makefile +++ b/otherlibs/win32unix/Makefile @@ -25,8 +25,8 @@ WIN_FILES = accept.c bind.c channels.c close.c \ mkdir.c mmap.c open.c pipe.c read.c readlink.c rename.c \ select.c sendrecv.c \ shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \ - symlink.c system.c times.c unixsupport.c windir.c winwait.c write.c \ - winlist.c winworker.c windbug.c utimes.c + symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \ + write.c winlist.c winworker.c windbug.c utimes.c # Files from the ../unix directory UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \ diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c index d238e53e..758a98f9 100644 --- a/otherlibs/win32unix/createprocess.c +++ b/otherlibs/win32unix/createprocess.c @@ -53,7 +53,7 @@ static DWORD do_create_process_native(wchar_t * exefile, wchar_t * cmdline, err = GetLastError(); goto ret3; } /* If we do not have a console window, then we must create one - before running the process (keep it hidden for apparence). + before running the process (keep it hidden for appearance). If we are starting a GUI application, the newly created console should not matter. */ if (win_has_console()) diff --git a/otherlibs/win32unix/readlink.c b/otherlibs/win32unix/readlink.c index 381ec868..b428db84 100644 --- a/otherlibs/win32unix/readlink.c +++ b/otherlibs/win32unix/readlink.c @@ -83,7 +83,7 @@ CAMLprim value unix_readlink(value opath) win_wide_char_to_multi_byte( point->SymbolicLinkReparseBuffer.PathBuffer + point->SymbolicLinkReparseBuffer.SubstituteNameOffset / sizeof(WCHAR), cbLen, - String_val(result), + (char *)String_val(result), len); CloseHandle(h); } diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c index 203c18ae..b5b83278 100644 --- a/otherlibs/win32unix/select.c +++ b/otherlibs/win32unix/select.c @@ -960,19 +960,19 @@ static int fdlist_to_fdset(value fdlist, fd_set *fdset) static value fdset_to_fdlist(value fdlist, fd_set *fdset) { - value res = Val_int(0); - Begin_roots2(fdlist, res) - for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) { - value s = Field(fdlist, 0); - if (FD_ISSET(Socket_val(s), fdset)) { - value newres = caml_alloc_small(2, 0); - Field(newres, 0) = s; - Field(newres, 1) = res; - res = newres; - } + CAMLparam1(fdlist); + CAMLlocal2(res, s); + res = Val_int(0); + for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) { + s = Field(fdlist, 0); + if (FD_ISSET(Socket_val(s), fdset)) { + value newres = caml_alloc_small(2, 0); + Field(newres, 0) = s; + Field(newres, 1) = res; + res = newres; } - End_roots(); - return res; + } + CAMLreturn(res); } CAMLprim value unix_select(value readfds, value writefds, value exceptfds, @@ -1264,20 +1264,20 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, { iterResult = &(iterSelectData->aResults[i]); l = caml_alloc_small(2, 0); - Store_field(l, 0, find_handle(iterResult, readfds, writefds, - exceptfds)); + Field(l, 0) = find_handle(iterResult, readfds, writefds, + exceptfds); switch (iterResult->EMode) { case SELECT_MODE_READ: - Store_field(l, 1, read_list); + Field(l, 1) = read_list; read_list = l; break; case SELECT_MODE_WRITE: - Store_field(l, 1, write_list); + Field(l, 1) = write_list; write_list = l; break; case SELECT_MODE_EXCEPT: - Store_field(l, 1, except_list); + Field(l, 1) = except_list; except_list = l; break; case SELECT_MODE_NONE: @@ -1320,9 +1320,9 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, DEBUG_PRINT("Build final result"); res = caml_alloc_small(3, 0); - Store_field(res, 0, read_list); - Store_field(res, 1, write_list); - Store_field(res, 2, except_list); + Field(res, 0) = read_list; + Field(res, 1) = write_list; + Field(res, 2) = except_list; DEBUG_PRINT("out select"); diff --git a/otherlibs/win32unix/stat.c b/otherlibs/win32unix/stat.c index bb0381de..78e0d7a1 100644 --- a/otherlibs/win32unix/stat.c +++ b/otherlibs/win32unix/stat.c @@ -297,7 +297,7 @@ static int safe_do_stat(int do_lstat, int use_64, wchar_t* path, HANDLE fstat, _ return 1; } -static int do_stat(int do_lstat, int use_64, char* opath, HANDLE fstat, __int64* st_ino, struct _stat64* res) +static int do_stat(int do_lstat, int use_64, const char* opath, HANDLE fstat, __int64* st_ino, struct _stat64* res) { wchar_t* wpath; int ret; diff --git a/otherlibs/win32unix/truncate.c b/otherlibs/win32unix/truncate.c new file mode 100644 index 00000000..b9ce92c0 --- /dev/null +++ b/otherlibs/win32unix/truncate.c @@ -0,0 +1,125 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Florent Monnier */ +/* Nicolas Ojeda Bar, LexiFi */ +/* */ +/* Copyright 2019 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS + +#include +#include +#include +#include +#include +#include +#include +#include "unixsupport.h" +#include + +static int win_truncate_handle(HANDLE fh, __int64 len) +{ + LARGE_INTEGER fp; + fp.QuadPart = len; + if (SetFilePointerEx(fh, fp, NULL, FILE_BEGIN) == 0 || + SetEndOfFile(fh) == 0) { + return -1; + } + return 0; +} + +static int win_ftruncate(HANDLE fh, __int64 len) +{ + HANDLE dupfh, currproc; + int ret; + currproc = GetCurrentProcess(); + /* Duplicate the handle, so we are free to modify its file position. */ + if (DuplicateHandle(currproc, fh, currproc, &dupfh, 0, FALSE, + DUPLICATE_SAME_ACCESS) == 0) { + return -1; + } + ret = win_truncate_handle(dupfh, len); + CloseHandle(dupfh); + return ret; +} + +static int win_truncate(WCHAR * path, __int64 len) +{ + HANDLE fh; + int ret; + fh = CreateFile(path, GENERIC_WRITE, 0, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (fh == INVALID_HANDLE_VALUE) { + return -1; + } + ret = win_truncate_handle(fh, len); + CloseHandle(fh); + return ret; +} + +CAMLprim value unix_truncate(value path, value len) +{ + CAMLparam2(path, len); + WCHAR * p; + int ret; + caml_unix_check_path(path, "truncate"); + p = caml_stat_strdup_to_utf16(String_val(path)); + caml_enter_blocking_section(); + ret = win_truncate(p, Long_val(len)); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) + uerror("truncate", path); + CAMLreturn(Val_unit); +} + +CAMLprim value unix_truncate_64(value path, value vlen) +{ + CAMLparam2(path, vlen); + WCHAR * p; + int ret; + __int64 len = Int64_val(vlen); + caml_unix_check_path(path, "truncate"); + p = caml_stat_strdup_to_utf16(String_val(path)); + caml_enter_blocking_section(); + ret = win_truncate(p, len); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) + uerror("truncate", path); + CAMLreturn(Val_unit); +} + +CAMLprim value unix_ftruncate(value fd, value len) +{ + int ret; + HANDLE h = Handle_val(fd); + caml_enter_blocking_section(); + ret = win_ftruncate(h, Long_val(len)); + caml_leave_blocking_section(); + if (ret == -1) + uerror("ftruncate", Nothing); + return Val_unit; +} + +CAMLprim value unix_ftruncate_64(value fd, value vlen) +{ + int ret; + HANDLE h = Handle_val(fd); + __int64 len = Int64_val(vlen); + caml_enter_blocking_section(); + ret = win_ftruncate(h, len); + caml_leave_blocking_section(); + if (ret == -1) + uerror("ftruncate", Nothing); + return Val_unit; +} diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 315ca8e6..a8329264 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -229,8 +229,8 @@ type seek_command = external lseek : file_descr -> int -> seek_command -> int = "unix_lseek" -let truncate _name _len = invalid_arg "Unix.truncate not implemented" -let ftruncate _fd _len = invalid_arg "Unix.ftruncate not implemented" +external truncate : string -> int -> unit = "unix_truncate" +external ftruncate : file_descr -> int -> unit = "unix_ftruncate" (* File statistics *) @@ -274,10 +274,8 @@ module LargeFile = struct external lseek : file_descr -> int64 -> seek_command -> int64 = "unix_lseek_64" - let truncate _name _len = - invalid_arg "Unix.LargeFile.truncate not implemented" - let ftruncate _name _len = - invalid_arg "Unix.LargeFile.ftruncate not implemented" + external truncate : string -> int64 -> unit = "unix_truncate_64" + external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64" type stats = { st_dev : int; st_ino : int; diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index 9aa40bca..e9e8dee0 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -24,6 +24,7 @@ type loc = Location.t type lid = Longident.t with_loc type str = string with_loc +type str_opt = string option with_loc type attrs = attribute list let default_loc = ref Location.none @@ -236,7 +237,7 @@ module Mty = struct let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) - let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) @@ -249,8 +250,8 @@ let mk ?(loc = !default_loc) ?(attrs = []) d = let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) - let functor_ ?loc ?attrs arg arg_ty body = - mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let functor_ ?loc ?attrs arg body = + mk ?loc ?attrs (Pmod_functor (arg, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 9bb0aad0..8bae9547 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -29,6 +29,7 @@ type loc = Location.t type lid = Longident.t with_loc type str = string with_loc +type str_opt = string option with_loc type attrs = attribute list (** {1 Default locations} *) @@ -116,7 +117,7 @@ module Pat: val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern - val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern @@ -168,8 +169,8 @@ module Exp: val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression - val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression - -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr + -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression @@ -246,7 +247,7 @@ module Mty: val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> - str -> module_type option -> module_type -> module_type + functor_parameter -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type @@ -262,7 +263,7 @@ module Mod: val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> - str -> module_type option -> module_expr -> module_expr + functor_parameter -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> @@ -321,7 +322,7 @@ module Str: module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> - str -> module_type -> module_declaration + str_opt -> module_type -> module_declaration end (** Module substitutions *) @@ -342,7 +343,7 @@ module Mtd: module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> - str -> module_expr -> module_binding + str_opt -> module_expr -> module_binding end (** Opens *) diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml index c6806a9b..5f016c00 100644 --- a/parsing/ast_iterator.ml +++ b/parsing/ast_iterator.ml @@ -233,6 +233,12 @@ module CT = struct List.iter (sub.class_type_field sub) pcsig_fields end +let iter_functor_param sub = function + | Unit -> () + | Named (name, mty) -> + iter_loc sub name; + sub.module_type sub mty + module MT = struct (* Type expressions for the module language *) @@ -243,9 +249,8 @@ module MT = struct | 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; + | Pmty_functor (param, mt2) -> + iter_functor_param sub param; sub.module_type sub mt2 | Pmty_with (mt, l) -> sub.module_type sub mt; @@ -298,9 +303,8 @@ module M = struct 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; + | Pmod_functor (param, body) -> + iter_functor_param sub param; sub.module_expr sub body | Pmod_apply (m1, m2) -> sub.module_expr sub m1; sub.module_expr sub m2 diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 8488f153..174fe08f 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -249,6 +249,10 @@ module CT = struct (List.map (sub.class_type_field sub) pcsig_fields) end +let map_functor_param sub = function + | Unit -> Unit + | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt) + module MT = struct (* Type expressions for the module language *) @@ -260,10 +264,10 @@ module MT = struct | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) - | Pmty_functor (s, mt1, mt2) -> - functor_ ~loc ~attrs (map_loc sub s) - (Misc.may_map (sub.module_type sub) mt1) - (sub.module_type sub mt2) + | Pmty_functor (param, mt) -> + functor_ ~loc ~attrs + (map_functor_param sub param) + (sub.module_type sub mt) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) @@ -318,9 +322,9 @@ module M = struct match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) - | Pmod_functor (arg, arg_ty, body) -> - functor_ ~loc ~attrs (map_loc sub arg) - (Misc.may_map (sub.module_type sub) arg_ty) + | Pmod_functor (param, body) -> + functor_ ~loc ~attrs + (map_functor_param sub param) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml index dbebed80..e270d5a4 100644 --- a/parsing/builtin_attributes.ml +++ b/parsing/builtin_attributes.ml @@ -262,6 +262,13 @@ let immediate = | _ -> false ) +let immediate64 = + List.exists + (fun a -> match a.attr_name.txt with + | "ocaml.immediate64"|"immediate64" -> true + | _ -> false + ) + (* The "ocaml.boxed (default)" and "ocaml.unboxed (default)" attributes cannot be input by the user, they are added by the compiler when applying the default setting. This is done to record diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli index 03949eea..6200fd74 100644 --- a/parsing/builtin_attributes.mli +++ b/parsing/builtin_attributes.mli @@ -25,6 +25,7 @@ - ocaml.warn_on_literal_pattern - ocaml.deprecated_mutable - ocaml.immediate + - ocaml.immediate64 - ocaml.boxed / ocaml.unboxed {b Warning:} this module is unstable and part of @@ -77,6 +78,7 @@ val explicit_arity: Parsetree.attributes -> bool val immediate: Parsetree.attributes -> bool +val immediate64: Parsetree.attributes -> bool val has_unboxed: Parsetree.attributes -> bool val has_boxed: Parsetree.attributes -> bool diff --git a/parsing/depend.ml b/parsing/depend.ml index ddaf182d..f513144b 100644 --- a/parsing/depend.ml +++ b/parsing/depend.ml @@ -133,7 +133,7 @@ let add_constructor_arguments bv = function let add_constructor_decl bv pcd = add_constructor_arguments bv pcd.pcd_args; - Misc.may (add_type bv) pcd.pcd_res + Option.iter (add_type bv) pcd.pcd_res let add_type_declaration bv td = List.iter @@ -153,7 +153,7 @@ let add_extension_constructor bv ext = match ext.pext_kind with Pext_decl(args, rty) -> add_constructor_arguments bv args; - Misc.may (add_type bv) rty + Option.iter (add_type bv) rty | Pext_rebind lid -> add bv lid let add_type_extension bv te = @@ -182,7 +182,9 @@ let rec add_pattern bv pat = | Ppat_variant(_, op) -> add_opt add_pattern bv op | Ppat_type li -> add bv li | Ppat_lazy p -> add_pattern bv p - | Ppat_unpack id -> pattern_bv := String.Map.add id.txt bound !pattern_bv + | Ppat_unpack id -> + Option.iter + (fun name -> pattern_bv := String.Map.add name bound !pattern_bv) id.txt | Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p | Ppat_exception p -> add_pattern bv p | Ppat_extension e -> handle_extension e @@ -234,7 +236,12 @@ let rec add_expr bv exp = | Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel | Pexp_letmodule(id, m, e) -> let b = add_module_binding bv m in - add_expr (String.Map.add id.txt b bv) e + let bv = + match id.txt with + | None -> bv + | Some id -> String.Map.add id b bv + in + add_expr bv e | Pexp_letexception(_, e) -> add_expr bv e | Pexp_assert (e) -> add_expr bv e | Pexp_lazy (e) -> add_expr bv e @@ -283,9 +290,17 @@ and add_modtype bv mty = Pmty_ident l -> add bv l | Pmty_alias l -> add_module_path bv l | Pmty_signature s -> add_signature bv s - | Pmty_functor(id, mty1, mty2) -> - Misc.may (add_modtype bv) mty1; - add_modtype (String.Map.add id.txt bound bv) mty2 + | Pmty_functor(param, mty2) -> + let bv = + match param with + | Unit -> bv + | Named (id, mty1) -> + add_modtype bv mty1; + match id.txt with + | None -> bv + | Some name -> String.Map.add name bound bv + in + add_modtype bv mty2 | Pmty_with(mty, cstrl) -> add_modtype bv mty; List.iter @@ -340,7 +355,11 @@ and add_sig_item (bv, m) item = add_type_exception bv te; (bv, m) | Psig_module pmd -> let m' = add_modtype_binding bv pmd.pmd_type in - let add = String.Map.add pmd.pmd_name.txt m' in + let add map = + match pmd.pmd_name.txt with + | None -> map + | Some name -> String.Map.add name m' map + in (add bv, add m) | Psig_modsubst pms -> let m' = add_module_alias bv pms.pms_manifest in @@ -348,8 +367,11 @@ and add_sig_item (bv, m) item = (add bv, add m) | Psig_recmodule decls -> let add = - List.fold_right (fun pmd -> String.Map.add pmd.pmd_name.txt bound) - decls + List.fold_right (fun pmd map -> + match pmd.pmd_name.txt with + | None -> map + | Some name -> String.Map.add name bound map + ) decls in let bv' = add bv and m' = add m in List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls; @@ -397,9 +419,17 @@ and add_module_expr bv modl = match modl.pmod_desc with Pmod_ident l -> add_module_path bv l | Pmod_structure s -> ignore (add_structure bv s) - | Pmod_functor(id, mty, modl) -> - Misc.may (add_modtype bv) mty; - add_module_expr (String.Map.add id.txt bound bv) modl + | Pmod_functor(param, modl) -> + let bv = + match param with + | Unit -> bv + | Named (id, mty) -> + add_modtype bv mty; + match id.txt with + | None -> bv + | Some name -> String.Map.add name bound bv + in + add_module_expr bv modl | Pmod_apply(mod1, mod2) -> add_module_expr bv mod1; add_module_expr bv mod2 | Pmod_constraint(modl, mty) -> @@ -463,11 +493,19 @@ and add_struct_item (bv, m) item : _ String.Map.t * _ String.Map.t = (bv, m) | Pstr_module x -> let b = add_module_binding bv x.pmb_expr in - let add = String.Map.add x.pmb_name.txt b in + let add map = + match x.pmb_name.txt with + | None -> map + | Some name -> String.Map.add name b map + in (add bv, add m) | Pstr_recmodule bindings -> let add = - List.fold_right (fun x -> String.Map.add x.pmb_name.txt bound) bindings + List.fold_right (fun x map -> + match x.pmb_name.txt with + | None -> map + | Some name -> String.Map.add name bound map + ) bindings in let bv' = add bv and m = add m in List.iter diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 64547e2d..8d6411dc 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -620,6 +620,8 @@ and comment = parse { store_lexeme lexbuf; comment lexbuf } | "\'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "\'" { store_lexeme lexbuf; comment lexbuf } + | "\'\\" 'o' ['0'-'3'] ['0'-'7'] ['0'-'7'] "\'" + { store_lexeme lexbuf; comment lexbuf } | "\'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "\'" { store_lexeme lexbuf; comment lexbuf } | eof @@ -635,6 +637,8 @@ and comment = parse store_lexeme lexbuf; comment lexbuf } + | (lowercase | uppercase) identchar * + { store_lexeme lexbuf; comment lexbuf } | _ { store_lexeme lexbuf; comment lexbuf } diff --git a/parsing/location.ml b/parsing/location.ml index ab823d36..c2d46dd6 100644 --- a/parsing/location.ml +++ b/parsing/location.ml @@ -82,6 +82,7 @@ let mknoloc txt = mkloc txt none let input_name = ref "_none_" let input_lexbuf = ref (None : lexbuf option) +let input_phrase_buffer = ref (None : Buffer.t option) (******************************************************************************) (* Terminal info *) @@ -452,7 +453,7 @@ let highlight_quote ppf |> infer_line_numbers |> List.map (fun (lnum, { text; start_pos }) -> (text, - Misc.Stdlib.Option.value_default Int.to_string ~default:"" lnum, + Option.fold ~some:Int.to_string ~none:"" lnum, start_pos)) in Format.fprintf ppf "@["; @@ -546,6 +547,23 @@ let lines_around_from_lexbuf lines_around ~start_pos ~end_pos ~seek ~read_char end +(* Attempt to get lines from the phrase buffer *) +let lines_around_from_phrasebuf + ~(start_pos: position) ~(end_pos: position) + (pb: Buffer.t): + input_line list + = + let pos = ref 0 in + let seek n = pos := n in + let read_char () = + if !pos >= Buffer.length pb then None + else begin + let c = Buffer.nth pb !pos in + incr pos; Some c + end + in + lines_around ~start_pos ~end_pos ~seek ~read_char + (* Get lines from a file *) let lines_around_from_file ~(start_pos: position) ~(end_pos: position) @@ -583,15 +601,23 @@ let lines_around_from_current_input ~start_pos ~end_pos = else [] in - match !input_lexbuf with - | Some lb -> + match !input_lexbuf, !input_phrase_buffer, !input_name with + | _, Some pb, "//toplevel//" -> + begin match lines_around_from_phrasebuf pb ~start_pos ~end_pos with + | [] -> (* Could not read the input from the phrase buffer. This is likely + a sign that we were given a buggy location. *) + [] + | lines -> + lines + end + | Some lb, _, _ -> begin match lines_around_from_lexbuf lb ~start_pos ~end_pos with | [] -> (* The input is likely not in the lexbuf anymore *) from_file () | lines -> lines end - | None -> + | None, _, _ -> from_file () (******************************************************************************) diff --git a/parsing/location.mli b/parsing/location.mli index b1c3e013..784c9694 100644 --- a/parsing/location.mli +++ b/parsing/location.mli @@ -74,6 +74,13 @@ val mkloc : 'a -> t -> 'a loc val input_name: string ref val input_lexbuf: Lexing.lexbuf option ref +(* This is used for reporting errors coming from the toplevel. + + When running a toplevel session (i.e. when [!input_name] is "//toplevel//"), + [!input_phrase_buffer] should be [Some buf] where [buf] contains the last + toplevel phrase. *) +val input_phrase_buffer: Buffer.t option ref + (** {1 Toplevel-specific functions} *) diff --git a/parsing/parser.mly b/parsing/parser.mly index 6bfe8d23..f6206179 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -226,6 +226,15 @@ let expecting loc nonterm = let not_expecting loc nonterm = raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm))) +let dotop ~left ~right ~assign ~ext ~multi = + let assign = if assign then "<-" else "" in + let mid = if multi then ";.." else "" in + String.concat "" ["."; ext; left; mid; right; assign] +let paren = "(",")" +let brace = "{", "}" +let bracket = "[", "]" +let lident x = Lident x +let ldot x y = Ldot(x,y) let dotop_fun ~loc dotop = (* We could use ghexp here, but sticking to mkexp for parser.mly compatibility. TODO improve parser.mly *) @@ -245,6 +254,10 @@ let array_set_fun ~loc = let string_set_fun ~loc = ghexp ~loc (Pexp_ident(array_function ~loc "String" "set")) +let multi_indices ~loc = function + | [a] -> false, a + | l -> true, mkexp ~loc (Pexp_array l) + let index_get ~loc get_fun array index = let args = [Nolabel, array; Nolabel, index] in mkexp ~loc (Pexp_apply(get_fun, args)) @@ -255,11 +268,20 @@ let index_set ~loc set_fun array index value = let array_get ~loc = index_get ~loc (array_get_fun ~loc) let string_get ~loc = index_get ~loc (string_get_fun ~loc) -let dotop_get ~loc dotop = index_get ~loc (dotop_fun ~loc dotop) +let dotop_get ~loc path (left,right) ext array index = + let multi, index = multi_indices ~loc index in + index_get ~loc + (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false)) + array index let array_set ~loc = index_set ~loc (array_set_fun ~loc) let string_set ~loc = index_set ~loc (string_set_fun ~loc) -let dotop_set ~loc dotop = index_set ~loc (dotop_fun ~loc dotop) +let dotop_set ~loc path (left,right) ext array index value= + let multi, index = multi_indices ~loc index in + index_set ~loc + (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true)) + array index value + let bigarray_function ~loc str name = ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name)) @@ -1110,20 +1132,20 @@ parse_pattern: functor_arg: (* An anonymous and untyped argument. *) - x = mkrhs(LPAREN RPAREN {"*"}) - { x, None } + LPAREN RPAREN + { Unit } | (* An argument accompanied with an explicit type. *) - LPAREN x = mkrhs(functor_arg_name) COLON mty = module_type RPAREN - { x, Some mty } + LPAREN x = mkrhs(module_name) COLON mty = module_type RPAREN + { Named (x, mty) } ; -functor_arg_name: +module_name: (* A named argument. *) x = UIDENT - { x } + { Some x } | (* An anonymous argument. *) UNDERSCORE - { "_" } + { None } ; (* -------------------------------------------------------------------------- *) @@ -1142,8 +1164,8 @@ module_expr: { unclosed "struct" $loc($1) "end" $loc($4) } | FUNCTOR attrs = attributes args = functor_args MINUSGREATER me = module_expr { wrap_mod_attrs ~loc:$sloc attrs ( - List.fold_left (fun acc (x, mty) -> - mkmod ~loc:$sloc (Pmod_functor (x, mty, acc)) + List.fold_left (fun acc arg -> + mkmod ~loc:$sloc (Pmod_functor (arg, acc)) ) me args ) } | me = paren_module_expr @@ -1285,13 +1307,13 @@ structure_item: %inline module_binding: MODULE ext = ext attrs1 = attributes - uid = mkrhs(UIDENT) + name = mkrhs(module_name) body = module_binding_body attrs2 = post_item_attributes { let docs = symbol_docs $sloc in let loc = make_loc $sloc in let attrs = attrs1 @ attrs2 in - let body = Mb.mk uid body ~attrs ~loc ~docs in + let body = Mb.mk name body ~attrs ~loc ~docs in Pstr_module body, ext } ; @@ -1303,8 +1325,7 @@ module_binding_body: COLON mty = module_type EQUAL me = module_expr { Pmod_constraint(me, mty) } | arg = functor_arg body = module_binding_body - { let (x, mty) = arg in - Pmod_functor(x, mty, body) } + { Pmod_functor(arg, body) } ) { $1 } ; @@ -1320,7 +1341,7 @@ module_binding_body: ext = ext attrs1 = attributes REC - uid = mkrhs(UIDENT) + name = mkrhs(module_name) body = module_binding_body attrs2 = post_item_attributes { @@ -1328,7 +1349,7 @@ module_binding_body: let attrs = attrs1 @ attrs2 in let docs = symbol_docs $sloc in ext, - Mb.mk uid body ~attrs ~loc ~docs + Mb.mk name body ~attrs ~loc ~docs } ; @@ -1336,7 +1357,7 @@ module_binding_body: %inline and_module_binding: AND attrs1 = attributes - uid = mkrhs(UIDENT) + name = mkrhs(module_name) body = module_binding_body attrs2 = post_item_attributes { @@ -1344,7 +1365,7 @@ module_binding_body: let attrs = attrs1 @ attrs2 in let docs = symbol_docs $sloc in let text = symbol_text $symbolstartpos in - Mb.mk uid body ~attrs ~loc ~text ~docs + Mb.mk name body ~attrs ~loc ~text ~docs } ; @@ -1437,8 +1458,8 @@ module_type: MINUSGREATER mty = module_type %prec below_WITH { wrap_mty_attrs ~loc:$sloc attrs ( - List.fold_left (fun acc (x, mty) -> - mkmty ~loc:$sloc (Pmty_functor (x, mty, acc)) + List.fold_left (fun acc arg -> + mkmty ~loc:$sloc (Pmty_functor (arg, acc)) ) mty args ) } | MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT @@ -1454,7 +1475,7 @@ module_type: { Pmty_ident $1 } | module_type MINUSGREATER module_type %prec below_WITH - { Pmty_functor(mknoloc "_", Some $1, $3) } + { Pmty_functor(Named (mknoloc None, $1), $3) } | module_type WITH separated_nonempty_llist(AND, with_constraint) { Pmty_with($1, $3) } /* | LPAREN MODULE mkrhs(mod_longident) RPAREN @@ -1528,14 +1549,14 @@ signature_item: %inline module_declaration: MODULE ext = ext attrs1 = attributes - uid = mkrhs(UIDENT) + name = mkrhs(module_name) body = module_declaration_body attrs2 = post_item_attributes { let attrs = attrs1 @ attrs2 in let loc = make_loc $sloc in let docs = symbol_docs $sloc in - Md.mk uid body ~attrs ~loc ~docs, ext + Md.mk name body ~attrs ~loc ~docs, ext } ; @@ -1545,8 +1566,7 @@ module_declaration_body: { mty } | mkmty( arg = functor_arg body = module_declaration_body - { let (x, mty) = arg in - Pmty_functor(x, mty, body) } + { Pmty_functor(arg, body) } ) { $1 } ; @@ -1555,7 +1575,7 @@ module_declaration_body: %inline module_alias: MODULE ext = ext attrs1 = attributes - uid = mkrhs(UIDENT) + name = mkrhs(module_name) EQUAL body = module_expr_alias attrs2 = post_item_attributes @@ -1563,7 +1583,7 @@ module_declaration_body: let attrs = attrs1 @ attrs2 in let loc = make_loc $sloc in let docs = symbol_docs $sloc in - Md.mk uid body ~attrs ~loc ~docs, ext + Md.mk name body ~attrs ~loc ~docs, ext } ; %inline module_expr_alias: @@ -1598,7 +1618,7 @@ module_subst: ext = ext attrs1 = attributes REC - uid = mkrhs(UIDENT) + name = mkrhs(module_name) COLON mty = module_type attrs2 = post_item_attributes @@ -1606,13 +1626,13 @@ module_subst: let attrs = attrs1 @ attrs2 in let loc = make_loc $sloc in let docs = symbol_docs $sloc in - ext, Md.mk uid mty ~attrs ~loc ~docs + ext, Md.mk name mty ~attrs ~loc ~docs } ; %inline and_module_declaration: AND attrs1 = attributes - uid = mkrhs(UIDENT) + name = mkrhs(module_name) COLON mty = module_type attrs2 = post_item_attributes @@ -1621,7 +1641,7 @@ module_subst: let docs = symbol_docs $sloc in let loc = make_loc $sloc in let text = symbol_text $symbolstartpos in - Md.mk uid mty ~attrs ~loc ~text ~docs + Md.mk name mty ~attrs ~loc ~text ~docs } ; @@ -2088,25 +2108,28 @@ expr: { string_set ~loc:$sloc $1 $4 $7 } | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr { bigarray_set ~loc:$sloc $1 $4 $7 } - | simple_expr DOTOP LBRACKET expr RBRACKET LESSMINUS expr - { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "[]<-")) $1 $4 $7 } - | simple_expr DOTOP LPAREN expr RPAREN LESSMINUS expr - { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "()<-")) $1 $4 $7 } - | simple_expr DOTOP LBRACE expr RBRACE LESSMINUS expr - { dotop_set ~loc:$sloc (Lident ("." ^ $2 ^ "{}<-")) $1 $4 $7 } - | simple_expr DOT mod_longident DOTOP LBRACKET expr RBRACKET LESSMINUS expr - { dotop_set ~loc:$sloc (Ldot($3,"." ^ $4 ^ "[]<-")) $1 $6 $9 } - | simple_expr DOT mod_longident DOTOP LPAREN expr RPAREN LESSMINUS expr - { dotop_set ~loc:$sloc (Ldot($3, "." ^ $4 ^ "()<-")) $1 $6 $9 } - | simple_expr DOT mod_longident DOTOP LBRACE expr RBRACE LESSMINUS expr - { dotop_set ~loc:$sloc (Ldot($3, "." ^ $4 ^ "{}<-")) $1 $6 $9 } + | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET LESSMINUS expr + { dotop_set ~loc:$sloc lident bracket $2 $1 $4 $7 } + | simple_expr DOTOP LPAREN expr_semi_list RPAREN LESSMINUS expr + { dotop_set ~loc:$sloc lident paren $2 $1 $4 $7 } + | simple_expr DOTOP LBRACE expr_semi_list RBRACE LESSMINUS expr + { dotop_set ~loc:$sloc lident brace $2 $1 $4 $7 } + | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET + LESSMINUS expr + { dotop_set ~loc:$sloc (ldot $3) bracket $4 $1 $6 $9 } + | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN + LESSMINUS expr + { dotop_set ~loc:$sloc (ldot $3) paren $4 $1 $6 $9 } + | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE + LESSMINUS expr + { dotop_set ~loc:$sloc (ldot $3) brace $4 $1 $6 $9 } | expr attribute { Exp.attr $1 $2 } | UNDERSCORE { not_expecting $loc($1) "wildcard \"_\"" } ; %inline expr_attrs: - | LET MODULE ext_attributes mkrhs(UIDENT) module_binding_body IN seq_expr + | LET MODULE ext_attributes mkrhs(module_name) module_binding_body IN seq_expr { Pexp_letmodule($4, $5, $7), $3 } | LET EXCEPTION ext_attributes let_exception_declaration IN seq_expr { Pexp_letexception($4, $6), $3 } @@ -2177,32 +2200,32 @@ simple_expr: { string_get ~loc:$sloc $1 $4 } | simple_expr DOT LBRACKET seq_expr error { unclosed "[" $loc($3) "]" $loc($5) } - | simple_expr DOTOP LBRACKET expr RBRACKET - { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "[]")) $1 $4 } - | simple_expr DOTOP LBRACKET expr error + | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET + { dotop_get ~loc:$sloc lident bracket $2 $1 $4 } + | simple_expr DOTOP LBRACKET expr_semi_list error { unclosed "[" $loc($3) "]" $loc($5) } - | simple_expr DOTOP LPAREN expr RPAREN - { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "()")) $1 $4 } - | simple_expr DOTOP LPAREN expr error + | simple_expr DOTOP LPAREN expr_semi_list RPAREN + { dotop_get ~loc:$sloc lident paren $2 $1 $4 } + | simple_expr DOTOP LPAREN expr_semi_list error { unclosed "(" $loc($3) ")" $loc($5) } - | simple_expr DOTOP LBRACE expr RBRACE - { dotop_get ~loc:$sloc (Lident ("." ^ $2 ^ "{}")) $1 $4 } + | simple_expr DOTOP LBRACE expr_semi_list RBRACE + { dotop_get ~loc:$sloc lident brace $2 $1 $4 } | simple_expr DOTOP LBRACE expr error { unclosed "{" $loc($3) "}" $loc($5) } - | simple_expr DOT mod_longident DOTOP LBRACKET expr RBRACKET - { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "[]")) $1 $6 } + | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET + { dotop_get ~loc:$sloc (ldot $3) bracket $4 $1 $6 } | simple_expr DOT - mod_longident DOTOP LBRACKET expr error + mod_longident DOTOP LBRACKET expr_semi_list error { unclosed "[" $loc($5) "]" $loc($7) } - | simple_expr DOT mod_longident DOTOP LPAREN expr RPAREN - { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "()")) $1 $6 } + | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN + { dotop_get ~loc:$sloc (ldot $3) paren $4 $1 $6 } | simple_expr DOT - mod_longident DOTOP LPAREN expr error + mod_longident DOTOP LPAREN expr_semi_list error { unclosed "(" $loc($5) ")" $loc($7) } - | simple_expr DOT mod_longident DOTOP LBRACE expr RBRACE - { dotop_get ~loc:$sloc (Ldot($3, "." ^ $4 ^ "{}")) $1 $6 } + | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE + { dotop_get ~loc:$sloc (ldot $3) brace $4 $1 $6 } | simple_expr DOT - mod_longident DOTOP LBRACE expr error + mod_longident DOTOP LBRACE expr_semi_list error { unclosed "{" $loc($5) "}" $loc($7) } | simple_expr DOT LBRACE expr RBRACE { bigarray_get ~loc:$sloc $1 $4 } @@ -2600,9 +2623,9 @@ simple_pattern_not_ident: { reloc_pat ~loc:$sloc $2 } | simple_delimited_pattern { $1 } - | LPAREN MODULE ext_attributes mkrhs(UIDENT) RPAREN + | LPAREN MODULE ext_attributes mkrhs(module_name) RPAREN { mkpat_attrs ~loc:$sloc (Ppat_unpack $4) $3 } - | LPAREN MODULE ext_attributes mkrhs(UIDENT) COLON package_type RPAREN + | LPAREN MODULE ext_attributes mkrhs(module_name) COLON package_type RPAREN { mkpat_attrs ~loc:$sloc (Ppat_constraint(mkpat ~loc:$sloc (Ppat_unpack $4), $6)) $3 } @@ -2642,7 +2665,7 @@ simple_pattern_not_ident: { unclosed "(" $loc($1) ")" $loc($5) } | LPAREN pattern COLON error { expecting $loc($4) "type" } - | LPAREN MODULE ext_attributes UIDENT COLON package_type + | LPAREN MODULE ext_attributes module_name COLON package_type error { unclosed "(" $loc($1) ")" $loc($7) } | extension @@ -3353,12 +3376,12 @@ operator: PREFIXOP { $1 } | LETOP { $1 } | ANDOP { $1 } - | DOTOP LPAREN RPAREN { "."^ $1 ^"()" } - | DOTOP LPAREN RPAREN LESSMINUS { "."^ $1 ^ "()<-" } - | DOTOP LBRACKET RBRACKET { "."^ $1 ^"[]" } - | DOTOP LBRACKET RBRACKET LESSMINUS { "."^ $1 ^ "[]<-" } - | DOTOP LBRACE RBRACE { "."^ $1 ^"{}" } - | DOTOP LBRACE RBRACE LESSMINUS { "."^ $1 ^ "{}<-" } + | DOTOP LPAREN index_mod RPAREN { "."^ $1 ^"(" ^ $3 ^ ")" } + | DOTOP LPAREN index_mod RPAREN LESSMINUS { "."^ $1 ^ "(" ^ $3 ^ ")<-" } + | DOTOP LBRACKET index_mod RBRACKET { "."^ $1 ^"[" ^ $3 ^ "]" } + | DOTOP LBRACKET index_mod RBRACKET LESSMINUS { "."^ $1 ^ "[" ^ $3 ^ "]<-" } + | DOTOP LBRACE index_mod RBRACE { "."^ $1 ^"{" ^ $3 ^ "}" } + | DOTOP LBRACE index_mod RBRACE LESSMINUS { "."^ $1 ^ "{" ^ $3 ^ "}<-" } | HASHOP { $1 } | BANG { "!" } | infix_operator { $1 } @@ -3385,6 +3408,10 @@ operator: | AMPERAMPER {"&&"} | COLONEQUAL {":="} ; +index_mod: +| { "" } +| SEMI DOTDOT { ";.." } +; constr_ident: UIDENT { $1 } | LBRACKET RBRACKET { "[]" } diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index ac5a3f2b..3f943210 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -42,6 +42,8 @@ type constant = Suffixes are rejected by the typechecker. *) +type location_stack = Location.t list + (** {1 Extension points} *) type attribute = { @@ -79,7 +81,7 @@ and core_type = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; - ptyp_loc_stack: Location.t list; + ptyp_loc_stack: location_stack; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -188,7 +190,7 @@ and pattern = { ppat_desc: pattern_desc; ppat_loc: Location.t; - ppat_loc_stack: Location.t list; + ppat_loc_stack: location_stack; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -236,8 +238,10 @@ and pattern_desc = (* #tconst *) | Ppat_lazy of pattern (* lazy P *) - | Ppat_unpack of string loc - (* (module P) + | Ppat_unpack of string option loc + (* (module P) Some "P" + (module _) None + Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) @@ -254,7 +258,7 @@ and expression = { pexp_desc: expression_desc; pexp_loc: Location.t; - pexp_loc_stack: Location.t list; + pexp_loc_stack: location_stack; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } @@ -344,7 +348,7 @@ and expression_desc = (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) - | Pexp_letmodule of string loc * module_expr * expression + | Pexp_letmodule of string option loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) @@ -711,7 +715,7 @@ and module_type_desc = (* S *) | Pmty_signature of signature (* sig ... end *) - | Pmty_functor of string loc * module_type option * module_type + | Pmty_functor of functor_parameter * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) @@ -722,6 +726,13 @@ and module_type_desc = | Pmty_alias of Longident.t loc (* (module M) *) +and functor_parameter = + | Unit + (* () *) + | Named of string option loc * module_type + (* (X : MT) Some X, MT + (_ : MT) None, MT *) + and signature = signature_item list and signature_item = @@ -769,7 +780,7 @@ and signature_item_desc = and module_declaration = { - pmd_name: string loc; + pmd_name: string option loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; @@ -856,7 +867,7 @@ and module_expr_desc = (* X *) | Pmod_structure of structure (* struct ... end *) - | Pmod_functor of string loc * module_type option * module_expr + | Pmod_functor of functor_parameter * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) @@ -921,7 +932,7 @@ and value_binding = and module_binding = { - pmb_name: string loc; + pmb_name: string option loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 318ece49..2555059f 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -442,8 +442,10 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit = | Ppat_var ({txt = txt;_}) -> protect_ident f txt | Ppat_array l -> pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l - | Ppat_unpack (s) -> - pp f "(module@ %s)@ " s.txt + | Ppat_unpack { txt = None } -> + pp f "(module@ _)@ " + | Ppat_unpack { txt = Some s } -> + pp f "(module@ %s)@ " s | Ppat_type li -> pp f "#%a" longident_loc li | Ppat_record (l, closed) -> @@ -516,7 +518,7 @@ and sugar_expr ctxt f e = | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _}; pexp_attributes=[]; _}, args) when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin - let print_indexop a path_prefix assign left right print_index indices + let print_indexop a path_prefix assign left sep right print_index indices rem_args = let print_path ppf = function | None -> () @@ -525,11 +527,11 @@ and sugar_expr ctxt f e = | false, [] -> pp f "@[%a%a%s%a%s@]" (simple_expr ctxt) a print_path path_prefix - left (list ~sep:"," print_index) indices right; true + left (list ~sep print_index) indices right; true | true, [v] -> pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]" (simple_expr ctxt) a print_path path_prefix - left (list ~sep:"," print_index) indices right + left (list ~sep print_index) indices right (simple_expr ctxt) v; true | _ -> false in match id, List.map snd args with @@ -540,18 +542,18 @@ and sugar_expr ctxt f e = let print = print_indexop a None assign in match path, other_args with | Lident "Array", i :: rest -> - print ".(" ")" (expression ctxt) [i] rest + print ".(" "" ")" (expression ctxt) [i] rest | Lident "String", i :: rest -> - print ".[" "]" (expression ctxt) [i] rest + print ".[" "" "]" (expression ctxt) [i] rest | Ldot (Lident "Bigarray", "Array1"), i1 :: rest -> - print ".{" "}" (simple_expr ctxt) [i1] rest + print ".{" "," "}" (simple_expr ctxt) [i1] rest | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest -> - print ".{" "}" (simple_expr ctxt) [i1; i2] rest + print ".{" "," "}" (simple_expr ctxt) [i1; i2] rest | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest -> - print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest + print ".{" "," "}" (simple_expr ctxt) [i1; i2; i3] rest | Ldot (Lident "Bigarray", "Genarray"), {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest -> - print ".{" "}" (simple_expr ctxt) indexes rest + print ".{" "," "}" (simple_expr ctxt) indexes rest | _ -> false end | (Lident s | Ldot(_,s)) , a :: i :: rest @@ -560,6 +562,11 @@ and sugar_expr ctxt f e = assignment operators end with [right_bracket ^ "<-"], access operators end with [right_bracket] directly *) + let multi_indices = String.contains s ';' in + let i = + match i.pexp_desc with + | Pexp_array l when multi_indices -> l + | _ -> [ i ] in let assign = last_is '-' s in let kind = (* extract the right end bracket *) @@ -574,8 +581,9 @@ and sugar_expr ctxt f e = | Ldot(m,_) -> Some m | _ -> None in let left = String.sub s 0 (1+String.index s left) in - print_indexop a path_prefix assign left right - (expression ctxt) [i] rest + print_indexop a path_prefix assign left ";" right + (if multi_indices then expression ctxt else simple_expr ctxt) + i rest | _ -> false end | _ -> false @@ -698,7 +706,8 @@ and expression ctxt f x = pp f "@[{<%a>}@]" (list string_x_expression ~sep:";" ) l; | Pexp_letmodule (s, me, e) -> - pp f "@[let@ module@ %s@ =@ %a@ in@ %a@]" s.txt + pp f "@[let@ module@ %s@ =@ %a@ in@ %a@]" + (Option.value s.txt ~default:"_") (module_expr reset_ctxt) me (expression ctxt) e | Pexp_letexception (cd, e) -> pp f "@[let@ exception@ %a@ in@ %a@]" @@ -1019,15 +1028,17 @@ and module_type ctxt f x = (attributes ctxt) x.pmty_attributes end else match x.pmty_desc with - | Pmty_functor (_, None, mt2) -> + | Pmty_functor (Unit, mt2) -> pp f "@[functor () ->@ %a@]" (module_type ctxt) mt2 - | Pmty_functor (s, Some mt1, mt2) -> - if s.txt = "_" then - pp f "@[%a@ ->@ %a@]" - (module_type1 ctxt) mt1 (module_type ctxt) mt2 - else - pp f "@[functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt - (module_type ctxt) mt1 (module_type ctxt) mt2 + | Pmty_functor (Named (s, mt1), mt2) -> + begin match s.txt with + | None -> + pp f "@[%a@ ->@ %a@]" + (module_type1 ctxt) mt1 (module_type ctxt) mt2 + | Some name -> + pp f "@[functor@ (%s@ :@ %a)@ ->@ %a@]" name + (module_type ctxt) mt1 (module_type ctxt) mt2 + end | Pmty_with (mt, []) -> module_type ctxt f mt | Pmty_with (mt, l) -> let with_constraint f = function @@ -1101,12 +1112,13 @@ and signature_item ctxt f x : unit = end | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias; pmty_attributes=[]; _};_} as pmd) -> - pp f "@[module@ %s@ =@ %a@]%a" pmd.pmd_name.txt + pp f "@[module@ %s@ =@ %a@]%a" + (Option.value pmd.pmd_name.txt ~default:"_") longident_loc alias (item_attributes ctxt) pmd.pmd_attributes | Psig_module pmd -> pp f "@[module@ %s@ :@ %a@]%a" - pmd.pmd_name.txt + (Option.value pmd.pmd_name.txt ~default:"_") (module_type ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes | Psig_modsubst pms -> @@ -1139,11 +1151,13 @@ and signature_item ctxt f x : unit = | [] -> () ; | pmd :: tl -> if not first then - pp f "@ @[and@ %s:@ %a@]%a" pmd.pmd_name.txt + pp f "@ @[and@ %s:@ %a@]%a" + (Option.value pmd.pmd_name.txt ~default:"_") (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes else - pp f "@[module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt + pp f "@[module@ rec@ %s:@ %a@]%a" + (Option.value pmd.pmd_name.txt ~default:"_") (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes; string_x_module_type_list f ~first:false tl @@ -1168,11 +1182,12 @@ and module_expr ctxt f x = (module_type ctxt) mt | Pmod_ident (li) -> pp f "%a" longident_loc li; - | Pmod_functor (_, None, me) -> + | Pmod_functor (Unit, me) -> pp f "functor ()@;->@;%a" (module_expr ctxt) me - | Pmod_functor (s, Some mt, me) -> + | Pmod_functor (Named (s, mt), me) -> pp f "functor@ (%s@ :@ %a)@;->@;%a" - s.txt (module_type ctxt) mt (module_expr ctxt) me + (Option.value s.txt ~default:"_") + (module_type ctxt) mt (module_expr ctxt) me | Pmod_apply (me1, me2) -> pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2 (* Cf: #7200 *) @@ -1297,14 +1312,18 @@ and structure_item ctxt f x = | Pstr_exception ed -> exception_declaration ctxt f ed | Pstr_module x -> let rec module_helper = function - | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} -> - if mt = None then pp f "()" - else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt; + | {pmod_desc=Pmod_functor(arg_opt,me'); pmod_attributes = []} -> + begin match arg_opt with + | Unit -> pp f "()" + | Named (s, mt) -> + pp f "(%s:%a)" (Option.value s.txt ~default:"_") + (module_type ctxt) mt + end; module_helper me' | me -> me in pp f "@[module %s%a@]%a" - x.pmb_name.txt + (Option.value x.pmb_name.txt ~default:"_") (fun f me -> let me = module_helper me in match me with @@ -1383,20 +1402,31 @@ and structure_item ctxt f x = | Pstr_recmodule decls -> (* 3.07 *) let aux f = function | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) -> - pp f "@[@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt + pp f "@[@ and@ %s:%a@ =@ %a@]%a" + (Option.value pmb.pmb_name.txt ~default:"_") (module_type ctxt) typ (module_expr ctxt) expr (item_attributes ctxt) pmb.pmb_attributes - | _ -> assert false + | pmb -> + pp f "@[@ and@ %s@ =@ %a@]%a" + (Option.value pmb.pmb_name.txt ~default:"_") + (module_expr ctxt) pmb.pmb_expr + (item_attributes ctxt) pmb.pmb_attributes in begin match decls with | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 -> pp f "@[@[module@ rec@ %s:%a@ =@ %a@]%a@ %a@]" - pmb.pmb_name.txt + (Option.value pmb.pmb_name.txt ~default:"_") (module_type ctxt) typ (module_expr ctxt) expr (item_attributes ctxt) pmb.pmb_attributes (fun f l2 -> List.iter (aux f) l2) l2 + | pmb :: l2 -> + pp f "@[@[module@ rec@ %s@ =@ %a@]%a@ %a@]" + (Option.value pmb.pmb_name.txt ~default:"_") + (module_expr ctxt) pmb.pmb_expr + (item_attributes ctxt) pmb.pmb_attributes + (fun f l2 -> List.iter (aux f) l2) l2 | _ -> assert false end | Pstr_attribute a -> floating_attribute ctxt f a diff --git a/parsing/printast.ml b/parsing/printast.ml index fbc0e1ad..30a0eeb3 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -52,6 +52,10 @@ let fmt_string_loc f (x : string loc) = fprintf f "\"%s\" %a" x.txt fmt_location x.loc; ;; +let fmt_str_opt_loc f (x : string option loc) = + fprintf f "\"%s\" %a" (Option.value x.txt ~default:"_") fmt_location x.loc; +;; + let fmt_char_option f = function | None -> fprintf f "None" | Some c -> fprintf f "Some %c" c @@ -132,6 +136,7 @@ let option i f ppf x = let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li;; let string i ppf s = line i ppf "\"%s\"\n" s;; let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;; +let str_opt_loc i ppf s = line i ppf "%a\n" fmt_str_opt_loc s;; let arg_label i ppf = function | Nolabel -> line i ppf "Nolabel\n" | Optional s -> line i ppf "Optional \"%s\"\n" s @@ -240,7 +245,7 @@ and pattern i ppf x = line i ppf "Ppat_type\n"; longident_loc i ppf li | Ppat_unpack s -> - line i ppf "Ppat_unpack %a\n" fmt_string_loc s; + line i ppf "Ppat_unpack %a\n" fmt_str_opt_loc s; | Ppat_exception p -> line i ppf "Ppat_exception\n"; pattern i ppf p @@ -347,7 +352,7 @@ and expression i ppf x = line i ppf "Pexp_override\n"; list i string_x_expression ppf l; | Pexp_letmodule (s, me, e) -> - line i ppf "Pexp_letmodule %a\n" fmt_string_loc s; + line i ppf "Pexp_letmodule %a\n" fmt_str_opt_loc s; module_expr i ppf me; expression i ppf e; | Pexp_letexception (cd, e) -> @@ -662,9 +667,12 @@ and module_type i ppf x = | Pmty_signature (s) -> line i ppf "Pmty_signature\n"; signature i ppf s; - | Pmty_functor (s, mt1, mt2) -> - line i ppf "Pmty_functor %a\n" fmt_string_loc s; - Misc.may (module_type i ppf) mt1; + | Pmty_functor (Unit, mt2) -> + line i ppf "Pmty_functor ()\n"; + module_type i ppf mt2; + | Pmty_functor (Named (s, mt1), mt2) -> + line i ppf "Pmty_functor %a\n" fmt_str_opt_loc s; + module_type i ppf mt1; module_type i ppf mt2; | Pmty_with (mt, l) -> line i ppf "Pmty_with\n"; @@ -699,7 +707,7 @@ and signature_item i ppf x = line i ppf "Psig_exception\n"; type_exception i ppf te | Psig_module pmd -> - line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name; + line i ppf "Psig_module %a\n" fmt_str_opt_loc pmd.pmd_name; attributes i ppf pmd.pmd_attributes; module_type i ppf pmd.pmd_type | Psig_modsubst pms -> @@ -765,9 +773,12 @@ and module_expr i ppf x = | Pmod_structure (s) -> line i ppf "Pmod_structure\n"; structure i ppf s; - | Pmod_functor (s, mt, me) -> - line i ppf "Pmod_functor %a\n" fmt_string_loc s; - Misc.may (module_type i ppf) mt; + | Pmod_functor (Unit, me) -> + line i ppf "Pmod_functor ()\n"; + module_expr i ppf me; + | Pmod_functor (Named (s, mt), me) -> + line i ppf "Pmod_functor %a\n" fmt_str_opt_loc s; + module_type i ppf mt; module_expr i ppf me; | Pmod_apply (me1, me2) -> line i ppf "Pmod_apply\n"; @@ -841,12 +852,12 @@ and structure_item i ppf x = attribute i ppf "Pstr_attribute" a and module_declaration i ppf pmd = - string_loc i ppf pmd.pmd_name; + str_opt_loc i ppf pmd.pmd_name; attributes i ppf pmd.pmd_attributes; module_type (i+1) ppf pmd.pmd_type; and module_binding i ppf x = - string_loc i ppf x.pmb_name; + str_opt_loc i ppf x.pmb_name; attributes i ppf x.pmb_attributes; module_expr (i+1) ppf x.pmb_expr diff --git a/runtime/.depend b/runtime/.depend index a89d380d..9f829455 100644 --- a/runtime/.depend +++ b/runtime/.depend @@ -1,2306 +1,2862 @@ afl_b.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_b.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_b.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_b.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_b.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_b.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_b.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_b.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \ caml/stacks.h caml/memory.h clambda_checks_b.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_b.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_b.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_b.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_b.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \ caml/stacks.h caml/sys.h +domain_b.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_b.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_b.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_b.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_b.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_b.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_b.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_b.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_b.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_b.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_b.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \ + caml/startup_aux.h globroots_b.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_b.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_b.$(O): instrtrace.c intern_b.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_b.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_b.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_b.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_b.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_b.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_b.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_b.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_b.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_b.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_b.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_b.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_b.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_b.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_b.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_b.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_b.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_b.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_b.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_b.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_b.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_b.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_b.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_b.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_b.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_b.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_b.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \ caml/osdeps.h caml/memory.h caml/startup_aux.h startup_byt_b.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_b.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_b.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_b.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_b.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_b.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_b.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_bd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_bd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_bd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_bd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_bd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_bd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_bd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_bd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \ caml/stacks.h caml/memory.h clambda_checks_bd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_bd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_bd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_bd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_bd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \ caml/stacks.h caml/sys.h +domain_bd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_bd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_bd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_bd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_bd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_bd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_bd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_bd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_bd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_bd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_bd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \ + caml/startup_aux.h globroots_bd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_bd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_bd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/instruct.h caml/misc.h \ - caml/mlvalues.h caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/startup_aux.h + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \ + caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/startup_aux.h intern_bd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_bd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h ints_bd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_bd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_bd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_bd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_bd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_bd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_bd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_bd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_bd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_bd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_bd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_bd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_bd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_bd.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_bd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_bd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_bd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_bd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_bd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_bd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_bd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_bd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_bd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_bd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_bd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \ caml/osdeps.h caml/memory.h caml/startup_aux.h startup_byt_bd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_bd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_bd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_bd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_bd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_bd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_bd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_bi.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_bi.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_bi.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_bi.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_bi.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_bi.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_bi.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_bi.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \ caml/stacks.h caml/memory.h clambda_checks_bi.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_bi.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_bi.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_bi.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_bi.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \ caml/stacks.h caml/sys.h +domain_bi.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_bi.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_bi.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_bi.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_bi.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_bi.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_bi.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_bi.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_bi.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_bi.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_bi.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \ + caml/startup_aux.h globroots_bi.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_bi.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_bi.$(O): instrtrace.c intern_bi.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_bi.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_bi.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_bi.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_bi.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_bi.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_bi.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_bi.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_bi.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_bi.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_bi.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_bi.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_bi.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_bi.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_bi.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_bi.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_bi.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_bi.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_bi.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_bi.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_bi.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_bi.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_bi.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_bi.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_bi.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_bi.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_bi.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \ caml/osdeps.h caml/memory.h caml/startup_aux.h startup_byt_bi.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_bi.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_bi.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_bi.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_bi.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_bi.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_bi.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_bpic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_bpic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_bpic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_bpic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_bpic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_bpic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_bpic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_bpic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \ caml/stacks.h caml/memory.h clambda_checks_bpic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_bpic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_bpic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_bpic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_bpic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/fail.h caml/fix_code.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/fail.h caml/fix_code.h \ caml/instruct.h caml/intext.h caml/io.h caml/io.h caml/mlvalues.h \ caml/stacks.h caml/sys.h +domain_bpic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_bpic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_bpic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_bpic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_bpic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_bpic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_bpic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_bpic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_bpic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_bpic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_bpic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stacks.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stacks.h \ + caml/startup_aux.h globroots_bpic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_bpic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_bpic.$(O): instrtrace.c intern_bpic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_bpic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_bpic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_bpic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_bpic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_bpic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_bpic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_bpic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_bpic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_bpic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_bpic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_bpic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_bpic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_bpic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_bpic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_bpic.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_bpic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_bpic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_bpic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_bpic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_bpic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_bpic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_bpic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_bpic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_bpic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_bpic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_bpic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/dynlink.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/dynlink.h \ caml/osdeps.h caml/memory.h caml/startup_aux.h startup_byt_bpic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_bpic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_bpic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_bpic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_bpic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_bpic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_bpic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_n.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_n.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_n.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_n.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_n.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_n.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_n.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_n.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h clambda_checks_n.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_n.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_n.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_n.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_n.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h +domain_n.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_n.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_n.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_n.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_n.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_n.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_n.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_n.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_n.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_n.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_n.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \ + caml/startup_aux.h globroots_n.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_n.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_n.$(O): instrtrace.c intern_n.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_n.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_n.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_n.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_n.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_n.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_n.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_n.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_n.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_n.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_n.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_n.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_n.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_n.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_n.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_n.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_n.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_n.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_n.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_n.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_n.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_n.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_n.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_n.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_n.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_n.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_n.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \ caml/memory.h caml/startup_aux.h startup_byt_n.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_n.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_n.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_n.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_n.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_n.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_n.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_nd.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_nd.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_nd.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_nd.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_nd.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_nd.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_nd.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_nd.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h clambda_checks_nd.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_nd.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_nd.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_nd.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_nd.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h +domain_nd.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_nd.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_nd.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_nd.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_nd.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_nd.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_nd.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_nd.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_nd.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_nd.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_nd.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \ + caml/startup_aux.h globroots_nd.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_nd.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_nd.$(O): instrtrace.c caml/instrtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/instruct.h caml/misc.h \ - caml/mlvalues.h caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/startup_aux.h + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/instruct.h caml/misc.h caml/mlvalues.h \ + caml/opnames.h caml/prims.h caml/stacks.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/startup_aux.h intern_nd.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_nd.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h ints_nd.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_nd.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_nd.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_nd.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_nd.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_nd.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_nd.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_nd.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_nd.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_nd.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_nd.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_nd.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_nd.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_nd.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_nd.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_nd.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_nd.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_nd.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_nd.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_nd.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_nd.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_nd.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_nd.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_nd.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_nd.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \ caml/memory.h caml/startup_aux.h startup_byt_nd.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_nd.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_nd.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_nd.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_nd.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_nd.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_nd.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_ni.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_ni.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_ni.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_ni.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_ni.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_ni.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_ni.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_ni.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h clambda_checks_ni.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_ni.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_ni.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_ni.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_ni.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h +domain_ni.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_ni.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_ni.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_ni.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_ni.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_ni.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_ni.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_ni.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_ni.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_ni.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_ni.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \ + caml/startup_aux.h globroots_ni.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_ni.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_ni.$(O): instrtrace.c intern_ni.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_ni.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_ni.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_ni.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_ni.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_ni.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_ni.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_ni.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_ni.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_ni.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_ni.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_ni.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_ni.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_ni.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_ni.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_ni.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_ni.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_ni.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_ni.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_ni.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_ni.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_ni.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_ni.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_ni.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_ni.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_ni.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_ni.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \ caml/memory.h caml/startup_aux.h startup_byt_ni.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_ni.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_ni.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_ni.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_ni.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_ni.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_ni.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h afl_npic.$(O): afl.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/mlvalues.h caml/misc.h caml/osdeps.h caml/memory.h caml/gc.h \ - caml/mlvalues.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h alloc_npic.$(O): alloc.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/stacks.h caml/memory.h caml/signals.h array_npic.$(O): array.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h backtrace_npic.$(O): backtrace.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/backtrace.h \ - caml/exec.h caml/backtrace_prim.h caml/backtrace.h caml/fail.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/backtrace.h caml/exec.h \ + caml/backtrace_prim.h caml/backtrace.h caml/fail.h caml/debugger.h backtrace_byt_npic.$(O): backtrace_byt.c caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/misc.h caml/alloc.h caml/mlvalues.h \ - caml/custom.h caml/io.h caml/instruct.h caml/intext.h caml/io.h \ - caml/exec.h caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/startup.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/mlvalues.h caml/domain_state.tbl caml/alloc.h caml/custom.h \ + caml/io.h caml/instruct.h caml/intext.h caml/io.h caml/exec.h \ + caml/fix_code.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/startup.h \ caml/exec.h caml/stacks.h caml/memory.h caml/sys.h caml/backtrace.h \ - caml/fail.h caml/backtrace_prim.h caml/backtrace.h + caml/fail.h caml/backtrace_prim.h caml/backtrace.h caml/debugger.h backtrace_nat_npic.$(O): backtrace_nat.c caml/alloc.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/backtrace_prim.h caml/backtrace.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/stack.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/backtrace_prim.h \ + caml/backtrace.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/stack.h bigarray_npic.$(O): bigarray.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/bigarray.h caml/custom.h caml/fail.h \ - caml/intext.h caml/io.h caml/hash.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/bigarray.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ + caml/hash.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/signals.h callback_npic.$(O): callback.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h clambda_checks_npic.$(O): clambda_checks.c caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h + caml/s.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl compact_npic.$(O): compact.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/finalise.h caml/roots.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h \ - caml/compact.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/finalise.h caml/roots.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \ + caml/memory.h caml/mlvalues.h caml/roots.h caml/weak.h caml/compact.h compare_npic.$(O): compare.c caml/custom.h caml/mlvalues.h caml/config.h caml/m.h \ - caml/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ + caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ caml/mlvalues.h custom_npic.$(O): custom.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/custom.h caml/fail.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/signals.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/gc_ctrl.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/signals.h debugger_npic.$(O): debugger.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/debugger.h caml/misc.h caml/osdeps.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h +domain_npic.$(O): domain.c caml/domain_state.h caml/misc.h caml/config.h caml/m.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h dynlink_npic.$(O): dynlink.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h \ - caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/dynlink.h caml/fail.h caml/mlvalues.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ caml/memory.h caml/prims.h caml/signals.h dynlink_nat_npic.$(O): dynlink_nat.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/stack.h caml/callback.h caml/alloc.h caml/intext.h caml/io.h \ caml/osdeps.h caml/memory.h caml/fail.h caml/signals.h caml/hooks.h extern_npic.$(O): extern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h fail_byt_npic.$(O): fail_byt.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/signals.h caml/stacks.h caml/memory.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/fail.h caml/gc.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/stacks.h caml/memory.h fail_nat_npic.$(O): fail_nat.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/printexc.h caml/signals.h \ + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/domain.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/mlvalues.h caml/printexc.h caml/signals.h \ caml/stack.h caml/roots.h caml/memory.h caml/callback.h finalise_npic.$(O): finalise.c caml/callback.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/compact.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/mlvalues.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/compact.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/mlvalues.h \ caml/roots.h caml/signals.h fix_code_npic.$(O): fix_code.c caml/config.h caml/m.h caml/s.h caml/debugger.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/fix_code.h \ - caml/instruct.h caml/intext.h caml/io.h caml/md5.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/reverse.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/fix_code.h caml/instruct.h caml/intext.h \ + caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/misc.h caml/mlvalues.h caml/reverse.h floats_npic.$(O): floats.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/mlvalues.h caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h -freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/freelist.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h +freelist_npic.$(O): freelist.c caml/config.h caml/m.h caml/s.h caml/custom.h \ + caml/mlvalues.h caml/config.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/major_gc.h caml/misc.h \ + caml/mlvalues.h gc_ctrl_npic.$(O): gc_ctrl.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/compact.h \ - caml/custom.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ - caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/signals.h caml/stack.h caml/startup_aux.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/compact.h caml/custom.h caml/fail.h \ + caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/freelist.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/memory.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h caml/stack.h \ + caml/startup_aux.h globroots_npic.$(O): globroots.c caml/memory.h caml/config.h caml/m.h caml/s.h \ - caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h \ + caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/mlvalues.h \ caml/roots.h caml/memory.h caml/globroots.h caml/roots.h hash_npic.$(O): hash.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/custom.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/hash.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/custom.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/hash.h instrtrace_npic.$(O): instrtrace.c intern_npic.$(O): intern.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/custom.h \ - caml/fail.h caml/gc.h caml/intext.h caml/io.h caml/io.h caml/md5.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/misc.h caml/reverse.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/custom.h caml/fail.h caml/gc.h \ + caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/memprof.h caml/roots.h caml/memory.h caml/mlvalues.h \ + caml/misc.h caml/reverse.h caml/signals.h interp_npic.$(O): interp.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/backtrace.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/fix_code.h caml/instrtrace.h \ - caml/instruct.h caml/interp.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/prims.h \ - caml/signals.h caml/stacks.h caml/memory.h caml/startup_aux.h \ - caml/jumptbl.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace.h caml/exec.h caml/callback.h caml/debugger.h caml/fail.h \ + caml/fix_code.h caml/instrtrace.h caml/instruct.h caml/interp.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/misc.h \ + caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \ + caml/startup_aux.h caml/jumptbl.h ints_npic.$(O): ints.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/custom.h \ + caml/fail.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h io_npic.$(O): io.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/osdeps.h \ - caml/memory.h caml/signals.h caml/sys.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/signals.h caml/sys.h lexing_npic.$(O): lexing.c caml/fail.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h main_npic.$(O): main.c caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/misc.h caml/sys.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/mlvalues.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/sys.h caml/osdeps.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h major_gc_npic.$(O): major_gc.c caml/compact.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/custom.h caml/config.h caml/fail.h \ - caml/finalise.h caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/signals.h caml/weak.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/custom.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/freelist.h caml/gc.h \ + caml/gc_ctrl.h caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/signals.h caml/weak.h md5_npic.$(O): md5.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/md5.h caml/io.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/mlvalues.h caml/io.h caml/reverse.h memory_npic.$(O): memory.c caml/address_class.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/mlvalues.h caml/config.h caml/fail.h caml/freelist.h \ - caml/gc.h caml/gc_ctrl.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/signals.h + caml/misc.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/minor_gc.h \ + caml/misc.h caml/mlvalues.h caml/signals.h caml/memprof.h caml/roots.h \ + caml/memory.h +memprof_npic.$(O): memprof.c caml/memprof.h caml/config.h caml/m.h caml/s.h \ + caml/mlvalues.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/fail.h \ + caml/alloc.h caml/callback.h caml/signals.h caml/memory.h \ + caml/minor_gc.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/weak.h caml/stack.h caml/misc.h meta_npic.$(O): meta.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ - caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \ - caml/memory.h caml/backtrace_prim.h caml/backtrace.h caml/exec.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/config.h \ + caml/debugger.h caml/fail.h caml/fix_code.h caml/interp.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/signals.h \ + caml/stacks.h caml/memory.h minor_gc_npic.$(O): minor_gc.c caml/custom.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/config.h caml/fail.h caml/finalise.h \ - caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h caml/gc.h caml/gc_ctrl.h \ + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/config.h caml/fail.h caml/finalise.h caml/roots.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/gc.h caml/gc_ctrl.h \ caml/major_gc.h caml/memory.h caml/minor_gc.h caml/misc.h \ - caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h + caml/mlvalues.h caml/roots.h caml/signals.h caml/weak.h caml/memprof.h misc_npic.$(O): misc.c caml/config.h caml/m.h caml/s.h caml/misc.h caml/config.h \ - caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/osdeps.h \ - caml/memory.h caml/version.h + caml/memory.h caml/gc.h caml/mlvalues.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/osdeps.h caml/memory.h \ + caml/version.h obj_npic.$(O): obj.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/gc.h caml/interp.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/prims.h caml/spacetime.h caml/io.h caml/stack.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h \ + caml/signals.h caml/spacetime.h caml/io.h caml/stack.h parsing_npic.$(O): parsing.c caml/config.h caml/m.h caml/s.h caml/mlvalues.h \ - caml/config.h caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/config.h caml/misc.h caml/domain_state.h caml/mlvalues.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/alloc.h prims_npic.$(O): prims.c caml/mlvalues.h caml/config.h caml/m.h caml/s.h \ - caml/misc.h caml/prims.h + caml/misc.h caml/domain_state.h caml/mlvalues.h caml/domain_state.tbl \ + caml/prims.h printexc_npic.$(O): printexc.c caml/backtrace.h caml/mlvalues.h caml/config.h \ - caml/m.h caml/s.h caml/misc.h caml/exec.h caml/callback.h \ - caml/debugger.h caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h + caml/m.h caml/s.h caml/misc.h caml/domain_state.h caml/domain_state.tbl \ + caml/exec.h caml/callback.h caml/debugger.h caml/fail.h caml/misc.h \ + caml/mlvalues.h caml/printexc.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/memprof.h caml/roots.h caml/memory.h roots_byt_npic.$(O): roots_byt.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h + caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h caml/memprof.h roots_nat_npic.$(O): roots_nat.c caml/finalise.h caml/roots.h caml/misc.h \ caml/config.h caml/m.h caml/s.h caml/memory.h caml/gc.h caml/mlvalues.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/globroots.h caml/memory.h caml/major_gc.h caml/minor_gc.h \ - caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h + caml/misc.h caml/mlvalues.h caml/stack.h caml/roots.h caml/memprof.h signals_npic.$(O): signals.c caml/alloc.h caml/misc.h caml/config.h caml/m.h \ - caml/s.h caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \ - caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h + caml/s.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/callback.h caml/config.h caml/fail.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/mlvalues.h caml/roots.h caml/memory.h \ + caml/signals.h caml/signals_machdep.h caml/sys.h caml/memprof.h \ + caml/roots.h caml/finalise.h signals_byt_npic.$(O): signals_byt.c caml/config.h caml/m.h caml/s.h \ caml/memory.h caml/config.h caml/gc.h caml/mlvalues.h caml/misc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h + caml/domain_state.h caml/domain_state.tbl caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/fail.h caml/finalise.h caml/roots.h caml/memory.h caml/osdeps.h \ + caml/signals.h caml/signals_machdep.h signals_nat_npic.$(O): signals_nat.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/memory.h caml/gc.h \ - caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/osdeps.h caml/memory.h caml/signals.h caml/signals_machdep.h \ - signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h + signals_osdep.h caml/stack.h caml/spacetime.h caml/io.h caml/stack.h \ + caml/memprof.h caml/roots.h caml/finalise.h spacetime_byt_npic.$(O): spacetime_byt.c caml/fail.h caml/misc.h caml/config.h \ - caml/m.h caml/s.h caml/mlvalues.h caml/mlvalues.h + caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/mlvalues.h spacetime_nat_npic.$(O): spacetime_nat.c caml/config.h caml/m.h caml/s.h \ caml/alloc.h caml/misc.h caml/config.h caml/mlvalues.h \ - caml/backtrace_prim.h caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h \ - caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain_state.h caml/domain_state.tbl caml/backtrace_prim.h \ + caml/backtrace.h caml/exec.h caml/fail.h caml/gc.h caml/intext.h \ + caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/domain.h \ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ caml/roots.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ caml/stack.h spacetime_snapshot_npic.$(O): spacetime_snapshot.c caml/alloc.h caml/misc.h \ - caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/backtrace_prim.h \ - caml/backtrace.h caml/exec.h caml/config.h caml/custom.h caml/fail.h \ - caml/gc.h caml/gc_ctrl.h caml/intext.h caml/io.h caml/major_gc.h \ - caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/roots.h caml/memory.h caml/signals.h caml/stack.h caml/sys.h \ - caml/spacetime.h caml/stack.h + caml/config.h caml/m.h caml/s.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace_prim.h caml/backtrace.h caml/exec.h \ + caml/config.h caml/custom.h caml/fail.h caml/gc.h caml/gc_ctrl.h \ + caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \ + caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \ + caml/memory.h caml/signals.h caml/stack.h caml/sys.h caml/spacetime.h \ + caml/stack.h stacks_npic.$(O): stacks.c caml/config.h caml/m.h caml/s.h caml/fail.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h \ - caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \ - caml/minor_gc.h caml/address_class.h + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/misc.h caml/mlvalues.h caml/stacks.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h startup_aux_npic.$(O): startup_aux.c caml/backtrace.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/exec.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/callback.h caml/major_gc.h caml/osdeps.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/exec.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/callback.h caml/major_gc.h caml/osdeps.h \ caml/memory.h caml/startup_aux.h startup_byt_npic.$(O): startup_byt.c caml/config.h caml/m.h caml/s.h caml/alloc.h \ - caml/misc.h caml/config.h caml/mlvalues.h caml/backtrace.h caml/exec.h \ - caml/callback.h caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h \ + caml/misc.h caml/config.h caml/mlvalues.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/callback.h \ + caml/custom.h caml/debugger.h caml/domain.h caml/dynlink.h caml/exec.h \ caml/fail.h caml/fix_code.h caml/freelist.h caml/gc_ctrl.h \ caml/instrtrace.h caml/interp.h caml/intext.h caml/io.h caml/io.h \ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/minor_gc.h caml/misc.h caml/mlvalues.h \ - caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h caml/reverse.h \ - caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ + caml/address_class.h caml/domain.h caml/minor_gc.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/prims.h caml/printexc.h \ + caml/reverse.h caml/signals.h caml/stacks.h caml/sys.h caml/startup.h \ caml/startup_aux.h caml/version.h startup_nat_npic.$(O): startup_nat.c caml/callback.h caml/mlvalues.h \ - caml/config.h caml/m.h caml/s.h caml/misc.h caml/backtrace.h caml/exec.h \ - caml/custom.h caml/debugger.h caml/fail.h caml/freelist.h caml/gc.h \ + caml/config.h caml/m.h caml/s.h caml/misc.h caml/domain_state.h \ + caml/domain_state.tbl caml/backtrace.h caml/exec.h caml/custom.h \ + caml/debugger.h caml/domain.h caml/fail.h caml/freelist.h caml/gc.h \ caml/gc_ctrl.h caml/intext.h caml/io.h caml/memory.h caml/gc.h \ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ - caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h caml/printexc.h \ - caml/stack.h caml/startup_aux.h caml/sys.h + caml/domain.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ + caml/printexc.h caml/stack.h caml/startup_aux.h caml/sys.h str_npic.$(O): str.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \ - caml/misc.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/mlvalues.h caml/misc.h sys_npic.$(O): sys.c caml/config.h caml/m.h caml/s.h caml/alloc.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/debugger.h caml/fail.h caml/gc_ctrl.h \ - caml/io.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/signals.h caml/stacks.h caml/sys.h \ - caml/version.h caml/callback.h caml/startup_aux.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/debugger.h caml/fail.h caml/gc_ctrl.h caml/io.h caml/misc.h \ + caml/mlvalues.h caml/osdeps.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/freelist.h caml/minor_gc.h caml/address_class.h caml/domain.h \ + caml/signals.h caml/stacks.h caml/sys.h caml/version.h caml/callback.h \ + caml/startup_aux.h unix_npic.$(O): unix.c caml/config.h caml/m.h caml/s.h caml/fail.h caml/misc.h \ - caml/config.h caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h \ - caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \ - caml/osdeps.h caml/memory.h caml/signals.h caml/sys.h caml/io.h \ - caml/alloc.h + caml/config.h caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ + caml/address_class.h caml/domain.h caml/misc.h caml/osdeps.h \ + caml/memory.h caml/signals.h caml/sys.h caml/io.h caml/alloc.h weak_npic.$(O): weak.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \ - caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \ - caml/address_class.h caml/mlvalues.h caml/weak.h caml/minor_gc.h \ - caml/signals.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl caml/fail.h \ + caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \ + caml/minor_gc.h caml/address_class.h caml/domain.h caml/mlvalues.h \ + caml/weak.h caml/memory.h caml/minor_gc.h caml/signals.h win32_npic.$(O): win32.c caml/alloc.h caml/misc.h caml/config.h caml/m.h caml/s.h \ - caml/mlvalues.h caml/address_class.h caml/fail.h caml/io.h caml/memory.h \ - caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \ - caml/address_class.h caml/misc.h caml/osdeps.h caml/memory.h \ - caml/signals.h caml/sys.h caml/config.h + caml/mlvalues.h caml/domain_state.h caml/domain_state.tbl \ + caml/address_class.h caml/fail.h caml/io.h caml/memory.h caml/gc.h \ + caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \ + caml/domain.h caml/misc.h caml/osdeps.h caml/memory.h caml/signals.h \ + caml/sys.h caml/config.h diff --git a/runtime/Makefile b/runtime/Makefile index 7c94d621..963c6dd8 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -20,18 +20,13 @@ include $(ROOTDIR)/Makefile.common # Lists of source files -PRIMS := $(addsuffix .c, \ - alloc array compare extern floats gc_ctrl hash intern interp ints io \ - lexing md5 meta obj parsing signals str sys callback weak finalise \ - stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray) - BYTECODE_C_SOURCES := $(addsuffix .c, \ interp misc stacks fix_code startup_aux startup_byt freelist major_gc \ minor_gc memory alloc roots_byt globroots fail_byt signals \ signals_byt printexc backtrace_byt backtrace compare ints \ floats str array io extern intern hash sys meta parsing gc_ctrl md5 obj \ lexing callback debugger weak compact finalise custom dynlink \ - spacetime_byt afl $(UNIX_OR_WIN32) bigarray main) + spacetime_byt afl $(UNIX_OR_WIN32) bigarray main memprof domain) NATIVE_C_SOURCES := $(addsuffix .c, \ startup_aux startup_nat main fail_nat roots_nat signals \ @@ -39,7 +34,8 @@ NATIVE_C_SOURCES := $(addsuffix .c, \ floats str array io extern intern hash sys parsing gc_ctrl md5 obj \ lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \ globroots backtrace_nat backtrace dynlink_nat debugger meta \ - dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray) + dynlink clambda_checks spacetime_nat spacetime_snapshot afl bigarray \ + memprof domain) # The other_files variable stores the list of files whose dependencies # should be computed by `make depend` although they do not need to be @@ -128,10 +124,10 @@ ifeq "$(UNIX_OR_WIN32)" "win32" # than \UXXXXXXXX). The \u is then translated to \x in order to accommodate # pre-Visual Studio 2013 compilers where \x is a non-standard alias for \u. OCAML_STDLIB_DIR = $(shell echo $(LIBDIR)| iconv -t JAVA | sed -e 's/\\u/\\x/g') -OC_CPPFLAGS += -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"' +STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"' else # Unix OCAML_STDLIB_DIR = $(LIBDIR) -OC_CPPFLAGS += -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"' +STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"' endif OC_CPPFLAGS += $(IFLEXDIR) @@ -194,7 +190,7 @@ ifneq "$(BYTECODE_SHARED_LIBRARIES)" "" $(INSTALL_PROG) $(BYTECODE_SHARED_LIBRARIES) "$(INSTALL_LIBDIR)" endif mkdir -p "$(INSTALL_INCDIR)" - $(INSTALL_DATA) caml/*.h "$(INSTALL_INCDIR)" + $(INSTALL_DATA) caml/domain_state.tbl caml/*.h "$(INSTALL_INCDIR)" .PHONY: installopt installopt: @@ -207,7 +203,7 @@ endif clean: rm -f $(PROGRAMS) *.$(O) *.$(A) *.$(SO) ld.conf rm -f primitives prims.c caml/opnames.h caml/jumptbl.h - rm -f caml/version.h + rm -f caml/version.h domain_state*.inc .PHONY: distclean distclean: clean @@ -237,9 +233,11 @@ ld.conf: $(ROOTDIR)/Makefile.config # see http://pubs.opengroup.org/onlinepubs/9699919799/utilities/sort.html: # "using sort to process pathnames, it is recommended that LC_ALL .. set to C" - -primitives : $(PRIMS) - ./gen_primitives.sh >$@ +# To speed up builds, we avoid changing "primitives" when files +# containing primitives change but the primitives table does not +primitives: $(shell ./gen_primitives.sh > primitives.new; \ + cmp -s primitives primitives.new || echo primitives.new) + cp $^ $@ prims.c : primitives (echo '#define CAML_INTERNALS'; \ @@ -343,6 +341,11 @@ object_types := % %_b %_bd %_bi %_bpic %_n %_nd %_ni %_np %_npic $(foreach object_type, $(object_types), \ $(eval $(call COMPILE_C_FILE,$(object_type)))) +dynlink_%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG) + +$(foreach object_type,$(subst %,,$(object_types)), \ + $(eval dynlink$(object_type).$(O): $(ROOTDIR)/Makefile.config)) + # Compilation of assembly files %.o: %.S @@ -355,7 +358,16 @@ $(foreach object_type, $(object_types), \ %_libasmrunpic.o: %.S $(ASPP) $(ASPPFLAGS) $(SHAREDLIB_CFLAGS) -o $@ $< -%.obj: %.asm +domain_state64.inc: caml/domain_state.tbl gen_domain_state64_inc.awk + awk -f gen_domain_state64_inc.awk $< > $@ + +domain_state32.inc: caml/domain_state.tbl gen_domain_state32_inc.awk + awk -f gen_domain_state32_inc.awk $< > $@ + +amd64nt.obj: amd64nt.asm domain_state64.inc + $(ASM)$@ $(ASMFLAGS) $< + +i386nt.obj: i386nt.asm domain_state32.inc $(ASM)$@ $(ASMFLAGS) $< %_libasmrunpic.obj: %.asm diff --git a/runtime/alloc.c b/runtime/alloc.c index 3112065e..7ae6b62c 100644 --- a/runtime/alloc.c +++ b/runtime/alloc.c @@ -27,6 +27,7 @@ #include "caml/memory.h" #include "caml/mlvalues.h" #include "caml/stacks.h" +#include "caml/signals.h" #define Setup_for_gc #define Restore_after_gc diff --git a/runtime/amd64.S b/runtime/amd64.S index ab54633c..77a4f85a 100644 --- a/runtime/amd64.S +++ b/runtime/amd64.S @@ -26,6 +26,7 @@ #define G(r) _##r #define GREL(r) _##r@GOTPCREL #define GCALL(r) _##r +#define TEXT_SECTION(name) .text #define FUNCTION_ALIGN 2 #define EIGHT_ALIGN 3 #define SIXTEEN_ALIGN 4 @@ -40,10 +41,12 @@ #define G(r) r #undef GREL #define GCALL(r) r +#define TEXT_SECTION(name) #define FUNCTION_ALIGN 4 #define EIGHT_ALIGN 8 #define SIXTEEN_ALIGN 16 #define FUNCTION(name) \ + TEXT_SECTION(name); \ .globl name; \ .align FUNCTION_ALIGN; \ name: @@ -54,10 +57,16 @@ #define G(r) r #define GREL(r) r@GOTPCREL #define GCALL(r) r@PLT +#if defined(FUNCTION_SECTIONS) +#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits +#else +#define TEXT_SECTION(name) +#endif #define FUNCTION_ALIGN 4 #define EIGHT_ALIGN 8 #define SIXTEEN_ALIGN 16 #define FUNCTION(name) \ + TEXT_SECTION(caml.##name); \ .globl name; \ .type name,@function; \ .align FUNCTION_ALIGN; \ @@ -103,6 +112,15 @@ #endif + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE + +#define Caml_state(var) (8*domain_field_caml_##var)(%r14) + #if defined(__PIC__) && !defined(SYS_mingw64) && !defined(SYS_cygwin) /* Position-independent operations on global variables. */ @@ -145,9 +163,9 @@ #define RECORD_STACK_FRAME(OFFSET) \ pushq %r11 ; CFI_ADJUST(8); \ movq 8+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_last_return_address) ; \ + movq %rax, Caml_state(last_return_address) ; \ leaq 16+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_bottom_of_stack) ; \ + movq %rax, Caml_state(bottom_of_stack) ; \ popq %r11; CFI_ADJUST(-8) /* Load address of global [label] in register [dst]. */ @@ -181,9 +199,9 @@ #define RECORD_STACK_FRAME(OFFSET) \ movq OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_last_return_address) ; \ + movq %rax, Caml_state(last_return_address) ; \ leaq 8+OFFSET(%rsp), %rax ; \ - STORE_VAR(%rax,caml_bottom_of_stack) + movq %rax, Caml_state(bottom_of_stack) #define LEA_VAR(label,dst) \ leaq G(label)(%rip), dst @@ -272,7 +290,7 @@ #else # define PREPARE_FOR_C_CALL # define CLEANUP_AFTER_C_CALL -# define STACK_PROBE_SIZE 32768 +# define STACK_PROBE_SIZE 4096 #endif /* Registers holding arguments of C functions. */ @@ -287,6 +305,16 @@ #define C_ARG_2 %rsi #define C_ARG_3 %rdx #define C_ARG_4 %rcx +#endif + +#if defined(FUNCTION_SECTIONS) + TEXT_SECTION(caml_hot__code_begin) + .globl G(caml_hot__code_begin) +G(caml_hot__code_begin): + + TEXT_SECTION(caml_hot__code_end) + .globl G(caml_hot__code_end) +G(caml_hot__code_end): #endif .text @@ -307,7 +335,7 @@ LBL(caml_call_gc): subq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE); movq %rax, 0(%rsp) addq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE); - /* Build array of registers, save it into caml_gc_regs */ + /* Build array of registers, save it into Caml_state->gc_regs */ #ifdef WITH_FRAME_POINTERS ENTER_FUNCTION ; #else @@ -325,10 +353,9 @@ LBL(caml_call_gc): pushq %rdi; CFI_ADJUST (8); pushq %rbx; CFI_ADJUST (8); pushq %rax; CFI_ADJUST (8); - STORE_VAR(%rsp, caml_gc_regs) - /* Save caml_young_ptr, caml_exception_pointer */ - STORE_VAR(%r15, caml_young_ptr) - STORE_VAR(%r14, caml_exception_pointer) + movq %rsp, Caml_state(gc_regs) + /* Save young_ptr */ + movq %r15, Caml_state(young_ptr) #ifdef WITH_SPACETIME STORE_VAR(%r13, caml_spacetime_trie_node_ptr) #endif @@ -354,9 +381,8 @@ LBL(caml_call_gc): PREPARE_FOR_C_CALL call GCALL(caml_garbage_collection) CLEANUP_AFTER_C_CALL - /* Restore caml_young_ptr, caml_exception_pointer */ - LOAD_VAR(caml_young_ptr, %r15) - LOAD_VAR(caml_exception_pointer, %r14) + /* Restore young_ptr */ + movq Caml_state(young_ptr), %r15 /* Restore all regs used by the code generator */ movsd 0*8(%rsp), %xmm0 movsd 1*8(%rsp), %xmm1 @@ -401,10 +427,11 @@ FUNCTION(G(caml_alloc1)) CFI_STARTPROC LBL(caml_alloc1): subq $16, %r15 - CMP_VAR(caml_young_limit, %r15) + cmpq Caml_state(young_limit), %r15 jb LBL(100) ret LBL(100): + addq $16, %r15 RECORD_STACK_FRAME(0) ENTER_FUNCTION /* subq $8, %rsp; CFI_ADJUST (8); */ @@ -419,10 +446,11 @@ FUNCTION(G(caml_alloc2)) CFI_STARTPROC LBL(caml_alloc2): subq $24, %r15 - CMP_VAR(caml_young_limit, %r15) + cmpq Caml_state(young_limit), %r15 jb LBL(101) ret LBL(101): + addq $24, %r15 RECORD_STACK_FRAME(0) ENTER_FUNCTION /* subq $8, %rsp; CFI_ADJUST (8); */ @@ -437,10 +465,11 @@ FUNCTION(G(caml_alloc3)) CFI_STARTPROC LBL(caml_alloc3): subq $32, %r15 - CMP_VAR(caml_young_limit, %r15) + cmpq Caml_state(young_limit), %r15 jb LBL(102) ret LBL(102): + addq $32, %r15 RECORD_STACK_FRAME(0) ENTER_FUNCTION /* subq $8, %rsp; CFI_ADJUST (8) */ @@ -456,11 +485,12 @@ CFI_STARTPROC LBL(caml_allocN): pushq %rax; CFI_ADJUST(8) /* save desired size */ subq %rax, %r15 - CMP_VAR(caml_young_limit, %r15) + cmpq Caml_state(young_limit), %r15 jb LBL(103) addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */ ret LBL(103): + addq 0(%rsp), %r15 CFI_ADJUST(8) RECORD_STACK_FRAME(8) #ifdef WITH_FRAME_POINTERS @@ -479,29 +509,49 @@ LBL(103): CFI_ENDPROC ENDFUNCTION(G(caml_allocN)) +/* Reset the allocation pointer and invoke the GC */ + +FUNCTION(G(caml_call_gc1)) +CFI_STARTPROC + addq $16, %r15 + jmp GCALL(caml_call_gc) +CFI_ENDPROC + +FUNCTION(G(caml_call_gc2)) +CFI_STARTPROC + addq $24, %r15 + jmp GCALL(caml_call_gc) +CFI_ENDPROC + +FUNCTION(G(caml_call_gc3)) +CFI_STARTPROC + addq $32, %r15 + jmp GCALL(caml_call_gc) +CFI_ENDPROC + + /* Call a C function from OCaml */ FUNCTION(G(caml_c_call)) CFI_STARTPROC LBL(caml_c_call): /* Record lowest stack address and return address */ - popq %r12; CFI_ADJUST(-8) - STORE_VAR(%r12, caml_last_return_address) - STORE_VAR(%rsp, caml_bottom_of_stack) + popq Caml_state(last_return_address); CFI_ADJUST(-8) + movq %rsp, Caml_state(bottom_of_stack) + /* equivalent to pushing last return address */ + subq $8, %rsp; CFI_ADJUST(8) #ifdef WITH_SPACETIME /* Record the trie node hole pointer that corresponds to - [caml_last_return_address] */ + [Caml_state->last_return_address] */ STORE_VAR(%r13, caml_spacetime_trie_node_ptr) #endif - subq $8, %rsp; CFI_ADJUST(8) /* equivalent to pushq %r12 */ /* Touch the stack to trigger a recoverable segfault if insufficient space remains */ subq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(STACK_PROBE_SIZE); movq %rax, 0(%rsp) addq $(STACK_PROBE_SIZE), %rsp; CFI_ADJUST(-STACK_PROBE_SIZE); - /* Make the exception handler and alloc ptr available to the C code */ - STORE_VAR(%r15, caml_young_ptr) - STORE_VAR(%r14, caml_exception_pointer) + /* Make the alloc ptr available to the C code */ + movq %r15, Caml_state(young_ptr) /* Call the function (address in %rax) */ /* No need to PREPARE_FOR_C_CALL since the caller already reserved the stack space if needed (cf. amd64/proc.ml) */ @@ -515,6 +565,8 @@ FUNCTION(G(caml_start_program)) CFI_STARTPROC /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS + /* Load Caml_state into r14 (was passed as an argument from C) */ + movq C_ARG_1, %r14 /* Initial entry point is G(caml_program) */ LEA_VAR(caml_program, %r12) /* Common code for caml_start_program and caml_callback* */ @@ -525,9 +577,9 @@ LBL(caml_start_program): #else subq $8, %rsp; CFI_ADJUST (8) /* stack 16-aligned */ #endif - PUSH_VAR(caml_gc_regs) - PUSH_VAR(caml_last_return_address) - PUSH_VAR(caml_bottom_of_stack) + pushq Caml_state(gc_regs); CFI_ADJUST(8) + pushq Caml_state(last_return_address); CFI_ADJUST(8) + pushq Caml_state(bottom_of_stack); CFI_ADJUST(8) #ifdef WITH_SPACETIME /* Save arguments to caml_callback* */ pushq %rax; CFI_ADJUST (8) @@ -543,14 +595,13 @@ LBL(caml_start_program): popq %rbx; CFI_ADJUST (-8) popq %rax; CFI_ADJUST (-8) #endif - /* Setup alloc ptr and exception ptr */ - LOAD_VAR(caml_young_ptr, %r15) - LOAD_VAR(caml_exception_pointer, %r14) + /* Setup alloc ptr */ + movq Caml_state(young_ptr), %r15 /* Build an exception handler */ lea LBL(108)(%rip), %r13 pushq %r13; CFI_ADJUST(8) - pushq %r14; CFI_ADJUST(8) - movq %rsp, %r14 + pushq Caml_state(exception_pointer); CFI_ADJUST(8) + movq %rsp, Caml_state(exception_pointer) #ifdef WITH_SPACETIME LOAD_VAR(caml_spacetime_trie_node_ptr, %r13) #endif @@ -558,16 +609,15 @@ LBL(caml_start_program): call *%r12 LBL(107): /* Pop the exception handler */ - popq %r14; CFI_ADJUST(-8) + popq Caml_state(exception_pointer); CFI_ADJUST(-8) popq %r12; CFI_ADJUST(-8) /* dummy register */ LBL(109): - /* Update alloc ptr and exception ptr */ - STORE_VAR(%r15,caml_young_ptr) - STORE_VAR(%r14,caml_exception_pointer) + /* Update alloc ptr */ + movq %r15, Caml_state(young_ptr) /* Pop the callback link, restoring the global variables */ - POP_VAR(caml_bottom_of_stack) - POP_VAR(caml_last_return_address) - POP_VAR(caml_gc_regs) + popq Caml_state(bottom_of_stack); CFI_ADJUST(-8) + popq Caml_state(last_return_address); CFI_ADJUST(-8) + popq Caml_state(gc_regs); CFI_ADJUST(-8) #ifdef WITH_SPACETIME POP_VAR(caml_spacetime_trie_node_ptr) #else @@ -589,10 +639,10 @@ ENDFUNCTION(G(caml_start_program)) FUNCTION(G(caml_raise_exn)) CFI_STARTPROC - TESTL_VAR($1, caml_backtrace_active) + testq $1, Caml_state(backtrace_active) jne LBL(110) - movq %r14, %rsp - popq %r14 + movq Caml_state(exception_pointer), %rsp + popq Caml_state(exception_pointer); CFI_ADJUST(-8) ret LBL(110): movq %rax, %r12 /* Save exception bucket */ @@ -605,14 +655,15 @@ LBL(110): popq C_ARG_2 /* arg 2: pc of raise */ movq %rsp, C_ARG_3 /* arg 3: sp at raise */ #endif - movq %r14, C_ARG_4 /* arg 4: sp of handler */ + /* arg 4: sp of handler */ + movq Caml_state(exception_pointer), C_ARG_4 /* PR#5700: thanks to popq above, stack is now 16-aligned */ /* Thanks to ENTER_FUNCTION, stack is now 16-aligned */ PREPARE_FOR_C_CALL /* no need to cleanup after */ call GCALL(caml_stash_backtrace) movq %r12, %rax /* Recover exception bucket */ - movq %r14, %rsp - popq %r14 + movq Caml_state(exception_pointer), %rsp + popq Caml_state(exception_pointer); CFI_ADJUST(-8) ret CFI_ENDPROC ENDFUNCTION(G(caml_raise_exn)) @@ -621,31 +672,39 @@ ENDFUNCTION(G(caml_raise_exn)) FUNCTION(G(caml_raise_exception)) CFI_STARTPROC - TESTL_VAR($1, caml_backtrace_active) + movq C_ARG_1, %r14 /* Caml_state */ + testq $1, Caml_state(backtrace_active) jne LBL(112) - movq C_ARG_1, %rax - LOAD_VAR(caml_exception_pointer, %rsp) /* Cut stack */ - popq %r14 /* Recover previous exception handler */ - LOAD_VAR(caml_young_ptr, %r15) /* Reload alloc ptr */ + movq C_ARG_2, %rax + movq Caml_state(exception_pointer), %rsp /* Cut stack */ + /* Recover previous exception handler */ + popq Caml_state(exception_pointer); CFI_ADJUST(-8) + movq Caml_state(young_ptr), %r15 /* Reload alloc ptr */ ret LBL(112): #ifdef WITH_FRAME_POINTERS ENTER_FUNCTION ; #endif - movq C_ARG_1, %r12 /* Save exception bucket */ - /* arg 1: exception bucket */ - LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */ - LOAD_VAR(caml_bottom_of_stack,C_ARG_3) /* arg 3: sp of raise */ - LOAD_VAR(caml_exception_pointer,C_ARG_4) /* arg 4: sp of handler */ + /* Save exception bucket. Caml_state in r14 saved across C calls. */ + movq C_ARG_2, %r12 + /* arg 1: exception bucket */ + movq C_ARG_2, C_ARG_1 + /* arg 2: pc of raise */ + movq Caml_state(last_return_address), C_ARG_2 + /* arg 3: sp of raise */ + movq Caml_state(bottom_of_stack), C_ARG_3 + /* arg 4: sp of handler */ + movq Caml_state(exception_pointer), C_ARG_4 #ifndef WITH_FRAME_POINTERS subq $8, %rsp /* PR#5700: maintain stack alignment */ #endif PREPARE_FOR_C_CALL /* no need to cleanup after */ call GCALL(caml_stash_backtrace) movq %r12, %rax /* Recover exception bucket */ - LOAD_VAR(caml_exception_pointer,%rsp) - popq %r14 /* Recover previous exception handler */ - LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */ + movq Caml_state(exception_pointer), %rsp + /* Recover previous exception handler */ + popq Caml_state(exception_pointer); CFI_ADJUST(-8) + movq Caml_state(young_ptr), %r15 /* Reload alloc ptr */ ret CFI_ENDPROC ENDFUNCTION(G(caml_raise_exception)) @@ -657,52 +716,57 @@ ENDFUNCTION(G(caml_raise_exception)) backtrace anyway. */ FUNCTION(G(caml_stack_overflow)) + movq C_ARG_1, %r14 /* Caml_state */ LEA_VAR(caml_exn_Stack_overflow, %rax) - movq %r14, %rsp /* cut the stack */ - popq %r14 /* recover previous exn handler */ - ret /* jump to handler's code */ + movq Caml_state(exception_pointer), %rsp /* cut the stack */ + /* Recover previous exn handler */ + popq Caml_state(exception_pointer) + ret /* jump to handler's code */ ENDFUNCTION(G(caml_stack_overflow)) /* Callback from C to OCaml */ -FUNCTION(G(caml_callback_exn)) +FUNCTION(G(caml_callback_asm)) CFI_STARTPROC /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - movq C_ARG_1, %rbx /* closure */ - movq C_ARG_2, %rax /* argument */ + movq C_ARG_1, %r14 /* Caml_state */ + movq C_ARG_2, %rbx /* closure */ + movq 0(C_ARG_3), %rax /* argument */ movq 0(%rbx), %r12 /* code pointer */ jmp LBL(caml_start_program) CFI_ENDPROC -ENDFUNCTION(G(caml_callback_exn)) +ENDFUNCTION(G(caml_callback_asm)) -FUNCTION(G(caml_callback2_exn)) +FUNCTION(G(caml_callback2_asm)) CFI_STARTPROC /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - movq C_ARG_1, %rdi /* closure -- no op with Unix conventions */ - movq C_ARG_2, %rax /* first argument */ - movq C_ARG_3, %rbx /* second argument */ + movq C_ARG_1, %r14 /* Caml_state */ + movq C_ARG_2, %rdi /* closure */ + movq 0(C_ARG_3), %rax /* first argument */ + movq 8(C_ARG_3), %rbx /* second argument */ LEA_VAR(caml_apply2, %r12) /* code pointer */ jmp LBL(caml_start_program) CFI_ENDPROC -ENDFUNCTION(G(caml_callback2_exn)) +ENDFUNCTION(G(caml_callback2_asm)) -FUNCTION(G(caml_callback3_exn)) +FUNCTION(G(caml_callback3_asm)) CFI_STARTPROC /* Save callee-save registers */ PUSH_CALLEE_SAVE_REGS /* Initial loading of arguments */ - movq C_ARG_2, %rax /* first argument */ - movq C_ARG_3, %rbx /* second argument */ - movq C_ARG_1, %rsi /* closure */ - movq C_ARG_4, %rdi /* third argument */ + movq C_ARG_1, %r14 /* Caml_state */ + movq 0(C_ARG_3), %rax /* first argument */ + movq 8(C_ARG_3), %rbx /* second argument */ + movq C_ARG_2, %rsi /* closure */ + movq 16(C_ARG_3), %rdi /* third argument */ LEA_VAR(caml_apply3, %r12) /* code pointer */ jmp LBL(caml_start_program) CFI_ENDPROC -ENDFUNCTION(G(caml_callback3_exn)) +ENDFUNCTION(G(caml_callback3_asm)) FUNCTION(G(caml_ml_array_bound_error)) CFI_STARTPROC diff --git a/runtime/amd64nt.asm b/runtime/amd64nt.asm index f7509ce1..10e75ca0 100644 --- a/runtime/amd64nt.asm +++ b/runtime/amd64nt.asm @@ -25,20 +25,14 @@ EXTRN caml_apply3: NEAR EXTRN caml_program: NEAR EXTRN caml_array_bound_error: NEAR - EXTRN caml_young_limit: QWORD - EXTRN caml_young_ptr: QWORD - EXTRN caml_bottom_of_stack: QWORD - EXTRN caml_last_return_address: QWORD - EXTRN caml_gc_regs: QWORD - EXTRN caml_exception_pointer: QWORD - EXTRN caml_backtrace_pos: DWORD - EXTRN caml_backtrace_active: DWORD - EXTRN caml_stash_backtrace: NEAR + EXTRN caml_stash_backtrace: NEAR IFDEF WITH_SPACETIME EXTRN caml_spacetime_trie_node_ptr: QWORD EXTRN caml_spacetime_c_to_ocaml: NEAR ENDIF +INCLUDE domain_state64.inc + .CODE PUBLIC caml_system__code_begin @@ -53,22 +47,21 @@ caml_system__code_begin: caml_call_gc: ; Record lowest stack address and return address mov rax, [rsp] - mov caml_last_return_address, rax + Store_last_return_address rax lea rax, [rsp+8] - mov caml_bottom_of_stack, rax + Store_bottom_of_stack rax L105: ; Touch the stack to trigger a recoverable segfault ; if insufficient space remains sub rsp, 01000h mov [rsp], rax add rsp, 01000h - ; Save caml_young_ptr, caml_exception_pointer - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + ; Save young_ptr + Store_young_ptr r15 IFDEF WITH_SPACETIME mov caml_spacetime_trie_node_ptr, r13 ENDIF - ; Build array of registers, save it into caml_gc_regs + ; Build array of registers, save it into Caml_state(gc_regs) push rbp push r11 push r10 @@ -82,7 +75,7 @@ ENDIF push rdi push rbx push rax - mov caml_gc_regs, rsp + Store_gc_regs rsp ; Save floating-point registers sub rsp, 16*8 movsd QWORD PTR [rsp + 0*8], xmm0 @@ -136,9 +129,8 @@ ENDIF pop r10 pop r11 pop rbp - ; Restore caml_young_ptr, caml_exception_pointer - mov r15, caml_young_ptr - mov r14, caml_exception_pointer + ; Restore Caml_state(young_ptr) + Load_young_ptr r15 ; Return to caller ret @@ -146,14 +138,15 @@ ENDIF ALIGN 16 caml_alloc1: sub r15, 16 - cmp r15, caml_young_limit + Cmp_young_limit r15 jb L100 ret L100: + add r15, 16 mov rax, [rsp + 0] - mov caml_last_return_address, rax + Store_last_return_address rax lea rax, [rsp + 8] - mov caml_bottom_of_stack, rax + Store_bottom_of_stack rax sub rsp, 8 call L105 add rsp, 8 @@ -163,14 +156,15 @@ L100: ALIGN 16 caml_alloc2: sub r15, 24 - cmp r15, caml_young_limit + Cmp_young_limit r15 jb L101 ret L101: + add r15, 24 mov rax, [rsp + 0] - mov caml_last_return_address, rax + Store_last_return_address rax lea rax, [rsp + 8] - mov caml_bottom_of_stack, rax + Store_bottom_of_stack rax sub rsp, 8 call L105 add rsp, 8 @@ -180,14 +174,15 @@ L101: ALIGN 16 caml_alloc3: sub r15, 32 - cmp r15, caml_young_limit + Cmp_young_limit r15 jb L102 ret L102: + add r15, 32 mov rax, [rsp + 0] - mov caml_last_return_address, rax + Store_last_return_address rax lea rax, [rsp + 8] - mov caml_bottom_of_stack, rax + Store_bottom_of_stack rax sub rsp, 8 call L105 add rsp, 8 @@ -197,19 +192,40 @@ L102: ALIGN 16 caml_allocN: sub r15, rax - cmp r15, caml_young_limit + Cmp_young_limit r15 jb L103 ret L103: + add r15, rax push rax ; save desired size mov rax, [rsp + 8] - mov caml_last_return_address, rax + Store_last_return_address rax lea rax, [rsp + 16] - mov caml_bottom_of_stack, rax + Store_bottom_of_stack rax call L105 pop rax ; recover desired size jmp caml_allocN +; Reset the allocation pointer and invoke the GC + + PUBLIC caml_call_gc1 + ALIGN 16 +caml_call_gc1: + add r15, 16 + jmp caml_call_gc + + PUBLIC caml_call_gc2 + ALIGN 16 +caml_call_gc2: + add r15, 24 + jmp caml_call_gc + + PUBLIC caml_call_gc3 + ALIGN 16 +caml_call_gc3: + add r15, 32 + jmp caml_call_gc + ; Call a C function from OCaml PUBLIC caml_c_call @@ -217,11 +233,11 @@ L103: caml_c_call: ; Record lowest stack address and return address pop r12 - mov caml_last_return_address, r12 - mov caml_bottom_of_stack, rsp + Store_last_return_address r12 + Store_bottom_of_stack rsp IFDEF WITH_SPACETIME ; Record the trie node hole pointer that corresponds to - ; [caml_last_return_address] + ; [Caml_state(last_return_address)] mov caml_spacetime_trie_node_ptr, r13 ENDIF ; Touch the stack to trigger a recoverable segfault @@ -229,13 +245,12 @@ ENDIF sub rsp, 01000h mov [rsp], rax add rsp, 01000h - ; Make the exception handler and alloc ptr available to the C code - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + ; Make the alloc ptr available to the C code + Store_young_ptr r15 ; Call the function (address in rax) call rax ; Reload alloc ptr - mov r15, caml_young_ptr + Load_young_ptr r15 ; Return to caller push r12 ret @@ -265,6 +280,8 @@ caml_start_program: movapd OWORD PTR [rsp + 7*16], xmm13 movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 + ; First argument (rcx) is Caml_state. Load it in r14 + mov r14, rcx ; Initial entry point is caml_program lea r12, caml_program ; Common code for caml_start_program and caml_callback* @@ -275,9 +292,9 @@ IFDEF WITH_SPACETIME ELSE sub rsp, 8 ; stack 16-aligned ENDIF - push caml_gc_regs - push caml_last_return_address - push caml_bottom_of_stack + Push_gc_regs + Push_last_return_address + Push_bottom_of_stack IFDEF WITH_SPACETIME ; Save arguments to caml_callback push rax @@ -293,14 +310,13 @@ IFDEF WITH_SPACETIME pop rbx pop rax ENDIF - ; Setup alloc ptr and exception ptr - mov r15, caml_young_ptr - mov r14, caml_exception_pointer + ; Setup alloc ptr + Load_young_ptr r15 ; Build an exception handler lea r13, L108 push r13 - push r14 - mov r14, rsp + Push_exception_pointer + Store_exception_pointer rsp IFDEF WITH_SPACETIME mov r13, caml_spacetime_trie_node_ptr ENDIF @@ -308,16 +324,15 @@ ENDIF call r12 L107: ; Pop the exception handler - pop r14 + Pop_exception_pointer pop r12 ; dummy register L109: - ; Update alloc ptr and exception ptr - mov caml_young_ptr, r15 - mov caml_exception_pointer, r14 + ; Update alloc ptr + Store_young_ptr r15 ; Pop the callback restoring, link the global variables - pop caml_bottom_of_stack - pop caml_last_return_address - pop caml_gc_regs + Pop_bottom_of_stack + Pop_last_return_address + Pop_gc_regs IFDEF WITH_SPACETIME pop caml_spacetime_trie_node_ptr ELSE @@ -356,22 +371,25 @@ L108: PUBLIC caml_raise_exn ALIGN 16 caml_raise_exn: - test caml_backtrace_active, 1 + Load_backtrace_active r11 + test r11, 1 jne L110 - mov rsp, r14 ; Cut stack - pop r14 ; Recover previous exception handler - ret ; Branch to handler + Load_exception_pointer rsp ; Cut stack + ; Recover previous exception handler + Pop_exception_pointer + ret ; Branch to handler L110: mov r12, rax ; Save exception bucket in r12 mov rcx, rax ; Arg 1: exception bucket mov rdx, [rsp] ; Arg 2: PC of raise lea r8, [rsp+8] ; Arg 3: SP of raise - mov r9, r14 ; Arg 4: SP of handler + Load_exception_pointer r9 ; Arg 4: SP of handler sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace mov rax, r12 ; Recover exception bucket - mov rsp, r14 ; Cut stack - pop r14 ; Recover previous exception handler + Load_exception_pointer rsp ; Cut stack + ; Recover previous exception handler + Pop_exception_pointer ret ; Branch to handler ; Raise an exception from C @@ -379,32 +397,36 @@ L110: PUBLIC caml_raise_exception ALIGN 16 caml_raise_exception: - test caml_backtrace_active, 1 + mov r14, rcx ; First argument is Caml_state + Load_backtrace_active r11 + test r11, 1 jne L112 - mov rax, rcx ; First argument is exn bucket - mov rsp, caml_exception_pointer - pop r14 ; Recover previous exception handler - mov r15, caml_young_ptr ; Reload alloc ptr + mov rax, rdx ; Second argument is exn bucket + Load_exception_pointer rsp + ; Recover previous exception handler + Pop_exception_pointer + Load_young_ptr r15 ; Reload alloc ptr ret L112: - mov r12, rcx ; Save exception bucket in r12 - ; Arg 1: exception bucket - mov rdx, caml_last_return_address ; Arg 2: PC of raise - mov r8, caml_bottom_of_stack ; Arg 3: SP of raise - mov r9, caml_exception_pointer ; Arg 4: SP of handler + mov r12, rdx ; Save exception bucket in r12 + mov rcx, rdx ; Arg 1: exception bucket + Load_last_return_address rdx ; Arg 2: PC of raise + Load_bottom_of_stack r8 ; Arg 3: SP of raise + Load_exception_pointer r9 ; Arg 4: SP of handler sub rsp, 32 ; Reserve 32 bytes on stack call caml_stash_backtrace mov rax, r12 ; Recover exception bucket - mov rsp, caml_exception_pointer - pop r14 ; Recover previous exception handler - mov r15, caml_young_ptr ; Reload alloc ptr + Load_exception_pointer rsp + ; Recover previous exception handler + Pop_exception_pointer + Load_young_ptr r15; Reload alloc ptr ret ; Callback from C to OCaml - PUBLIC caml_callback_exn + PUBLIC caml_callback_asm ALIGN 16 -caml_callback_exn: +caml_callback_asm: ; Save callee-save registers push rbx push rbp @@ -426,14 +448,15 @@ caml_callback_exn: movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments - mov rbx, rcx ; closure - mov rax, rdx ; argument + mov r14, rcx ; Caml_state + mov rbx, rdx ; closure + mov rax, [r8] ; argument mov r12, [rbx] ; code pointer jmp L106 - PUBLIC caml_callback2_exn + PUBLIC caml_callback2_asm ALIGN 16 -caml_callback2_exn: +caml_callback2_asm: ; Save callee-save registers push rbx push rbp @@ -455,15 +478,16 @@ caml_callback2_exn: movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments - mov rdi, rcx ; closure - mov rax, rdx ; first argument - mov rbx, r8 ; second argument + mov r14, rcx ; Caml_state + mov rdi, rdx ; closure + mov rax, [r8] ; first argument + mov rbx, [r8 + 8] ; second argument lea r12, caml_apply2 ; code pointer jmp L106 - PUBLIC caml_callback3_exn + PUBLIC caml_callback3_asm ALIGN 16 -caml_callback3_exn: +caml_callback3_asm: ; Save callee-save registers push rbx push rbp @@ -485,10 +509,11 @@ caml_callback3_exn: movapd OWORD PTR [rsp + 8*16], xmm14 movapd OWORD PTR [rsp + 9*16], xmm15 ; Initial loading of arguments - mov rsi, rcx ; closure - mov rax, rdx ; first argument - mov rbx, r8 ; second argument - mov rdi, r9 ; third argument + mov r14, rcx ; Caml_state + mov rsi, rdx ; closure + mov rax, [r8] ; first argument + mov rbx, [r8 + 8] ; second argument + mov rdi, [r8 + 16] ; third argument lea r12, caml_apply3 ; code pointer jmp L106 diff --git a/runtime/arm.S b/runtime/arm.S index fd43b214..0f61a524 100644 --- a/runtime/arm.S +++ b/runtime/arm.S @@ -79,9 +79,9 @@ .endm #endif -trap_ptr .req r8 -alloc_ptr .req r10 -alloc_limit .req r11 +trap_ptr .req r8 +alloc_ptr .req r10 +domain_state_ptr .req r11 /* Support for CFI directives */ @@ -99,22 +99,49 @@ alloc_limit .req r11 #define CFI_OFFSET(r,n) #endif -/* Allocation functions and GC interface */ +#if defined(FUNCTION_SECTIONS) +#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits +#else +#define TEXT_SECTION(name) +#endif + +#define FUNCTION(name) \ + TEXT_SECTION(caml.##name); \ + .align 2; \ + .globl name; \ + .type name, %function; \ +name: + +#if defined(FUNCTION_SECTIONS) + TEXT_SECTION(caml_hot__code_begin) + .globl caml_hot__code_begin +caml_hot__code_begin: + + TEXT_SECTION(caml_hot__code_end) + .globl caml_hot__code_end +caml_hot__code_end: +#endif + + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE +#define Caml_state(var) [domain_state_ptr, 8*domain_field_caml_##var] + +/* Allocation functions and GC interface */ .globl caml_system__code_begin caml_system__code_begin: - .align 2 - .globl caml_call_gc -caml_call_gc: +FUNCTION(caml_call_gc) CFI_STARTPROC /* Record return address */ - ldr r12, =caml_last_return_address - str lr, [r12] + str lr, Caml_state(last_return_address) .Lcaml_call_gc: /* Record lowest stack address */ - ldr r12, =caml_bottom_of_stack - str sp, [r12] + str sp, Caml_state(bottom_of_stack) #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) /* Save caller floating-point registers on the stack */ vpush {d0-d7}; CFI_ADJUST(64) @@ -126,15 +153,12 @@ caml_call_gc: #else CFI_OFFSET(lr, -4) #endif - /* Store pointer to saved integer registers in caml_gc_regs */ - ldr r12, =caml_gc_regs - str sp, [r12] + /* Store pointer to saved integer registers in Caml_state->gc_regs */ + str sp, Caml_state(gc_regs) /* Save current allocation pointer for debugging purposes */ - ldr alloc_limit, =caml_young_ptr - str alloc_ptr, [alloc_limit] + str alloc_ptr, Caml_state(young_ptr) /* Save trap pointer in case an exception is raised during GC */ - ldr r12, =caml_exception_pointer - str trap_ptr, [r12] + str trap_ptr, Caml_state(exception_pointer) /* Call the garbage collector */ bl caml_garbage_collection /* Restore integer registers and return address from the stack */ @@ -143,144 +167,119 @@ caml_call_gc: /* Restore floating-point registers from the stack */ vpop {d0-d7}; CFI_ADJUST(-64) #endif - /* Reload new allocation pointer and limit */ - /* alloc_limit still points to caml_young_ptr */ - ldr r12, =caml_young_limit - ldr alloc_ptr, [alloc_limit] - ldr alloc_limit, [r12] + /* Reload new allocation pointer */ + ldr alloc_ptr, Caml_state(young_ptr) /* Return to caller */ bx lr CFI_ENDPROC - .type caml_call_gc, %function .size caml_call_gc, .-caml_call_gc - .align 2 - .globl caml_alloc1 -caml_alloc1: +FUNCTION(caml_alloc1) CFI_STARTPROC .Lcaml_alloc1: sub alloc_ptr, alloc_ptr, 8 - cmp alloc_ptr, alloc_limit + ldr r7, Caml_state(young_limit) + cmp alloc_ptr, r7 bcc 1f bx lr -1: /* Record return address */ - ldr r7, =caml_last_return_address - str lr, [r7] - /* Call GC (preserves r7) */ +1: add alloc_ptr, alloc_ptr, 8 + /* Record return address */ + str lr, Caml_state(last_return_address) + /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ - ldr lr, [r7] + ldr lr, Caml_state(last_return_address) /* Try again */ b .Lcaml_alloc1 CFI_ENDPROC - .type caml_alloc1, %function .size caml_alloc1, .-caml_alloc1 - .align 2 - .globl caml_alloc2 -caml_alloc2: +FUNCTION(caml_alloc2) CFI_STARTPROC .Lcaml_alloc2: sub alloc_ptr, alloc_ptr, 12 - cmp alloc_ptr, alloc_limit + ldr r7, Caml_state(young_limit) + cmp alloc_ptr, r7 bcc 1f bx lr -1: /* Record return address */ - ldr r7, =caml_last_return_address - str lr, [r7] - /* Call GC (preserves r7) */ +1: add alloc_ptr, alloc_ptr, 12 + /* Record return address */ + str lr, Caml_state(last_return_address) + /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ - ldr lr, [r7] + ldr lr, Caml_state(last_return_address) /* Try again */ b .Lcaml_alloc2 CFI_ENDPROC - .type caml_alloc2, %function .size caml_alloc2, .-caml_alloc2 - .align 2 - .globl caml_alloc3 - .type caml_alloc3, %function -caml_alloc3: +FUNCTION(caml_alloc3) CFI_STARTPROC .Lcaml_alloc3: sub alloc_ptr, alloc_ptr, 16 - cmp alloc_ptr, alloc_limit + ldr r7, Caml_state(young_limit) + cmp alloc_ptr, r7 bcc 1f bx lr -1: /* Record return address */ - ldr r7, =caml_last_return_address - str lr, [r7] - /* Call GC (preserves r7) */ +1: add alloc_ptr, alloc_ptr, 16 + /* Record return address */ + str lr, Caml_state(last_return_address) + /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ - ldr lr, [r7] + ldr lr, Caml_state(last_return_address) /* Try again */ b .Lcaml_alloc3 CFI_ENDPROC - .type caml_alloc3, %function .size caml_alloc3, .-caml_alloc3 - .align 2 - .globl caml_allocN -caml_allocN: +FUNCTION(caml_allocN) CFI_STARTPROC .Lcaml_allocN: sub alloc_ptr, alloc_ptr, r7 - cmp alloc_ptr, alloc_limit + ldr r12, Caml_state(young_limit) + cmp alloc_ptr, r12 bcc 1f bx lr -1: /* Record return address */ - ldr r12, =caml_last_return_address - str lr, [r12] +1: add alloc_ptr, alloc_ptr, r7 + /* Record return address */ + str lr, Caml_state(last_return_address) /* Call GC (preserves r7) */ bl .Lcaml_call_gc /* Restore return address */ - ldr r12, =caml_last_return_address - ldr lr, [r12] + ldr lr, Caml_state(last_return_address) /* Try again */ b .Lcaml_allocN CFI_ENDPROC - .type caml_allocN, %function .size caml_allocN, .-caml_allocN /* Call a C function from OCaml */ /* Function to call is in r7 */ - .align 2 - .globl caml_c_call -caml_c_call: +FUNCTION(caml_c_call) CFI_STARTPROC /* Record lowest stack address and return address */ - ldr r5, =caml_last_return_address - ldr r6, =caml_bottom_of_stack - str lr, [r5] - str sp, [r6] + str lr, Caml_state(last_return_address) + str sp, Caml_state(bottom_of_stack) /* Preserve return address in callee-save register r4 */ mov r4, lr CFI_REGISTER(lr, r4) /* Make the exception handler alloc ptr available to the C code */ - ldr r5, =caml_young_ptr - ldr r6, =caml_exception_pointer - str alloc_ptr, [r5] - str trap_ptr, [r6] + str alloc_ptr, Caml_state(young_ptr) + str trap_ptr, Caml_state(exception_pointer) /* Call the function */ blx r7 - /* Reload alloc ptr and alloc limit */ - ldr r6, =caml_young_limit - ldr alloc_ptr, [r5] /* r5 still points to caml_young_ptr */ - ldr alloc_limit, [r6] + /* Reload alloc ptr */ + ldr alloc_ptr, Caml_state(young_ptr) /* Return */ bx r4 CFI_ENDPROC - .type caml_c_call, %function .size caml_c_call, .-caml_c_call /* Start the OCaml program */ - .align 2 - .globl caml_start_program -caml_start_program: +FUNCTION(caml_start_program) CFI_STARTPROC ldr r12, =caml_program @@ -300,53 +299,43 @@ caml_start_program: #else CFI_OFFSET(lr, -4) #endif + ldr domain_state_ptr, =Caml_state + ldr domain_state_ptr, [domain_state_ptr] /* Setup a callback link on the stack */ sub sp, sp, 16; CFI_ADJUST(16) /* 8-byte alignment */ - ldr r4, =caml_bottom_of_stack - ldr r5, =caml_last_return_address - ldr r6, =caml_gc_regs - ldr r4, [r4] - ldr r5, [r5] - ldr r6, [r6] + ldr r4, Caml_state(bottom_of_stack) + ldr r5, Caml_state(last_return_address) + ldr r6, Caml_state(gc_regs) str r4, [sp, 0] str r5, [sp, 4] str r6, [sp, 8] /* Setup a trap frame to catch exceptions escaping the OCaml code */ sub sp, sp, 8; CFI_ADJUST(8) - ldr r6, =caml_exception_pointer ldr r5, =.Ltrap_handler - ldr r4, [r6] + ldr r4, Caml_state(exception_pointer) str r4, [sp, 0] str r5, [sp, 4] mov trap_ptr, sp - /* Reload allocation pointers */ - ldr r4, =caml_young_ptr - ldr alloc_ptr, [r4] - ldr r4, =caml_young_limit - ldr alloc_limit, [r4] + /* Reload allocation pointer */ + ldr alloc_ptr, Caml_state(young_ptr) /* Call the OCaml code */ blx r12 .Lcaml_retaddr: /* Pop the trap frame, restoring caml_exception_pointer */ - ldr r4, =caml_exception_pointer ldr r5, [sp, 0] - str r5, [r4] + str r5, Caml_state(exception_pointer) add sp, sp, 8; CFI_ADJUST(-8) /* Pop the callback link, restoring the global variables */ .Lreturn_result: - ldr r4, =caml_bottom_of_stack ldr r5, [sp, 0] - str r5, [r4] - ldr r4, =caml_last_return_address + str r5, Caml_state(bottom_of_stack) ldr r5, [sp, 4] - str r5, [r4] - ldr r4, =caml_gc_regs + str r5, Caml_state(last_return_address) ldr r5, [sp, 8] - str r5, [r4] + str r5, Caml_state(gc_regs) add sp, sp, 16; CFI_ADJUST(-16) /* Update allocation pointer */ - ldr r4, =caml_young_ptr - str alloc_ptr, [r4] + str alloc_ptr, Caml_state(young_ptr) /* Reload callee-save registers and return address */ pop {r4-r8,r10,r11,lr}; CFI_ADJUST(-32) #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) @@ -357,7 +346,6 @@ caml_start_program: CFI_ENDPROC .type .Lcaml_retaddr, %function .size .Lcaml_retaddr, .-.Lcaml_retaddr - .type caml_start_program, %function .size caml_start_program, .-caml_start_program /* The trap handler */ @@ -366,8 +354,7 @@ caml_start_program: .Ltrap_handler: CFI_STARTPROC /* Save exception pointer */ - ldr r12, =caml_exception_pointer - str trap_ptr, [r12] + str trap_ptr, Caml_state(exception_pointer) /* Encode exception bucket as an exception result */ orr r0, r0, 2 /* Return it */ @@ -378,13 +365,10 @@ caml_start_program: /* Raise an exception from OCaml */ - .align 2 - .globl caml_raise_exn -caml_raise_exn: +FUNCTION(caml_raise_exn) CFI_STARTPROC /* Test if backtrace is active */ - ldr r1, =caml_backtrace_active - ldr r1, [r1] + ldr r1, Caml_state(backtrace_active) cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ mov r4, r0 @@ -400,33 +384,27 @@ caml_raise_exn: /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} CFI_ENDPROC - .type caml_raise_exn, %function .size caml_raise_exn, .-caml_raise_exn /* Raise an exception from C */ - .align 2 - .globl caml_raise_exception -caml_raise_exception: +FUNCTION(caml_raise_exception) CFI_STARTPROC - /* Reload trap ptr, alloc ptr and alloc limit */ - ldr trap_ptr, =caml_exception_pointer - ldr alloc_ptr, =caml_young_ptr - ldr alloc_limit, =caml_young_limit - ldr trap_ptr, [trap_ptr] - ldr alloc_ptr, [alloc_ptr] - ldr alloc_limit, [alloc_limit] + /* Load the domain state ptr */ + mov domain_state_ptr, r0 + /* Load exception bucket */ + mov r0, r1 + /* Reload trap ptr and alloc ptr */ + ldr trap_ptr, Caml_state(exception_pointer) + ldr alloc_ptr, Caml_state(young_ptr) /* Test if backtrace is active */ - ldr r1, =caml_backtrace_active - ldr r1, [r1] + ldr r1, Caml_state(backtrace_active) cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ mov r4, r0 - ldr r1, =caml_last_return_address /* arg2: pc of raise */ - ldr r1, [r1] - ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ - ldr r2, [r2] - mov r3, trap_ptr /* arg4: sp of handler */ + ldr r1, Caml_state(last_return_address) /* arg2: pc of raise */ + ldr r2, Caml_state(bottom_of_stack) /* arg3: sp of raise */ + mov r3, trap_ptr /* arg4: sp of handler */ bl caml_stash_backtrace /* Restore exception bucket */ mov r0, r4 @@ -435,67 +413,55 @@ caml_raise_exception: /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} CFI_ENDPROC - .type caml_raise_exception, %function .size caml_raise_exception, .-caml_raise_exception /* Callback from C to OCaml */ - .align 2 - .globl caml_callback_exn -caml_callback_exn: +FUNCTION(caml_callback_asm) CFI_STARTPROC - /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ - mov r12, r0 - mov r0, r1 /* r0 = first arg */ - mov r1, r12 /* r1 = closure environment */ - ldr r12, [r12] /* code pointer */ + /* Initial shuffling of arguments */ + /* (r0 = Caml_state, r1 = closure, [r2] = first arg) */ + ldr r0, [r2] /* r0 = first arg */ + /* r1 = closure environment */ + ldr r12, [r1] /* code pointer */ b .Ljump_to_caml CFI_ENDPROC - .type caml_callback_exn, %function - .size caml_callback_exn, .-caml_callback_exn + .size caml_callback_asm, .-caml_callback_asm - .align 2 - .globl caml_callback2_exn -caml_callback2_exn: +FUNCTION(caml_callback2_asm) CFI_STARTPROC - /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ - mov r12, r0 - mov r0, r1 /* r0 = first arg */ - mov r1, r2 /* r1 = second arg */ - mov r2, r12 /* r2 = closure environment */ + /* Initial shuffling of arguments */ + /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2) */ + mov r12, r1 + ldr r0, [r2] /* r0 = first arg */ + ldr r1, [r2,4] /* r1 = second arg */ + mov r2, r12 /* r2 = closure environment */ ldr r12, =caml_apply2 b .Ljump_to_caml CFI_ENDPROC - .type caml_callback2_exn, %function - .size caml_callback2_exn, .-caml_callback2_exn + .size caml_callback2_asm, .-caml_callback2_asm - .align 2 - .globl caml_callback3_exn -caml_callback3_exn: +FUNCTION(caml_callback3_asm) CFI_STARTPROC /* Initial shuffling of arguments */ - /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ - mov r12, r0 - mov r0, r1 /* r0 = first arg */ - mov r1, r2 /* r1 = second arg */ - mov r2, r3 /* r2 = third arg */ - mov r3, r12 /* r3 = closure environment */ + /* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2, + [r2,8] = arg3) */ + mov r3, r1 /* r3 = closure environment */ + ldr r0, [r2] /* r0 = first arg */ + ldr r1, [r2,4] /* r1 = second arg */ + ldr r2, [r2,8] /* r2 = third arg */ ldr r12, =caml_apply3 b .Ljump_to_caml CFI_ENDPROC - .type caml_callback3_exn, %function - .size caml_callback3_exn, .-caml_callback3_exn + .size caml_callback3_asm, .-caml_callback3_asm - .align 2 - .globl caml_ml_array_bound_error -caml_ml_array_bound_error: +FUNCTION(caml_ml_array_bound_error) CFI_STARTPROC /* Load address of [caml_array_bound_error] in r7 */ ldr r7, =caml_array_bound_error /* Call that function */ b caml_c_call CFI_ENDPROC - .type caml_ml_array_bound_error, %function .size caml_ml_array_bound_error, .-caml_ml_array_bound_error .globl caml_system__code_end diff --git a/runtime/arm64.S b/runtime/arm64.S index f7857263..afcb3797 100644 --- a/runtime/arm64.S +++ b/runtime/arm64.S @@ -20,12 +20,19 @@ /* Special registers */ +#define DOMAIN_STATE_PTR x25 #define TRAP_PTR x26 #define ALLOC_PTR x27 #define ALLOC_LIMIT x28 #define ARG x15 #define TMP x16 #define TMP2 x17 +#define ARG_DOMAIN_STATE_PTR x18 + +#define C_ARG_1 x0 +#define C_ARG_2 x1 +#define C_ARG_3 x2 +#define C_ARG_4 x3 /* Support for CFI directives */ @@ -43,60 +50,62 @@ #define CFI_OFFSET(r,n) #endif -/* Macros to load and store global variables. Destroy TMP2 */ + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE + +#define Caml_state(var) [x25, 8*domain_field_caml_##var] #if defined(__PIC__) #define ADDRGLOBAL(reg,symb) \ adrp TMP2, :got:symb; \ ldr reg, [TMP2, #:got_lo12:symb] - -#define LOADGLOBAL(reg,symb) \ - ADDRGLOBAL(TMP2,symb); \ - ldr reg, [TMP2] - -#define STOREGLOBAL(reg,symb) \ - ADDRGLOBAL(TMP2,symb); \ - str reg, [TMP2] - -#define LOADGLOBAL32(reg,symb) \ - ADDRGLOBAL(TMP2,symb); \ - ldrsw reg, [TMP2] - #else #define ADDRGLOBAL(reg,symb) \ adrp reg, symb; \ add reg, reg, #:lo12:symb -#define LOADGLOBAL(reg,symb) \ - adrp TMP2, symb; \ - ldr reg, [TMP2, #:lo12:symb] +#endif -#define STOREGLOBAL(reg,symb) \ - adrp TMP2, symb; \ - str reg, [TMP2, #:lo12:symb] +#if defined(FUNCTION_SECTIONS) +#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits +#else +#define TEXT_SECTION(name) +#endif -#define LOADGLOBAL32(reg,symb) \ - adrp TMP2, symb; \ - ldrsw reg, [TMP2, #:lo12:symb] +#if defined(FUNCTION_SECTIONS) + TEXT_SECTION(caml_hot__code_begin) + .globl caml_hot__code_begin +caml_hot__code_begin: + TEXT_SECTION(caml_hot__code_end) + .globl caml_hot__code_end +caml_hot__code_end: #endif -/* Allocation functions and GC interface */ +#define FUNCTION(name) \ + TEXT_SECTION(caml.##name); \ + .align 2; \ + .globl name; \ + .type name, %function; \ +name: +/* Allocation functions and GC interface */ .globl caml_system__code_begin caml_system__code_begin: - .align 2 - .globl caml_call_gc -caml_call_gc: +FUNCTION(caml_call_gc) CFI_STARTPROC /* Record return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) /* Record lowest stack address */ mov TMP, sp - STOREGLOBAL(TMP, caml_bottom_of_stack) + str TMP, Caml_state(bottom_of_stack) .Lcaml_call_gc: /* Set up stack space, saving return address and frame pointer */ /* (2 regs RA/GP, 24 allocatable int regs, 24 caller-save float regs) * 8 */ @@ -133,13 +142,13 @@ caml_call_gc: stp d26, d27, [sp, 352] stp d28, d29, [sp, 368] stp d30, d31, [sp, 384] - /* Store pointer to saved integer registers in caml_gc_regs */ + /* Store pointer to saved integer registers in Caml_state->gc_regs */ add TMP, sp, #16 - STOREGLOBAL(TMP, caml_gc_regs) + str TMP, Caml_state(gc_regs) /* Save current allocation pointer for debugging purposes */ - STOREGLOBAL(ALLOC_PTR, caml_young_ptr) + str ALLOC_PTR, Caml_state(young_ptr) /* Save trap pointer in case an exception is raised during GC */ - STOREGLOBAL(TRAP_PTR, caml_exception_pointer) + str TRAP_PTR, Caml_state(exception_pointer) /* Call the garbage collector */ bl caml_garbage_collection /* Restore registers */ @@ -168,36 +177,34 @@ caml_call_gc: ldp d28, d29, [sp, 368] ldp d30, d31, [sp, 384] /* Reload new allocation pointer and allocation limit */ - LOADGLOBAL(ALLOC_PTR, caml_young_ptr) - LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) + ldr ALLOC_PTR, Caml_state(young_ptr) + ldr ALLOC_LIMIT, Caml_state(young_limit) /* Free stack space and return to caller */ ldp x29, x30, [sp], 400 ret CFI_ENDPROC - .type caml_call_gc, %function .size caml_call_gc, .-caml_call_gc - .align 2 - .globl caml_alloc1 -caml_alloc1: +FUNCTION(caml_alloc1) CFI_STARTPROC 1: sub ALLOC_PTR, ALLOC_PTR, #16 cmp ALLOC_PTR, ALLOC_LIMIT b.lo 2f ret -2: stp x29, x30, [sp, -16]! +2: add ALLOC_PTR, ALLOC_PTR, #16 + stp x29, x30, [sp, -16]! CFI_ADJUST(16) /* Record the lowest address of the caller's stack frame. This is the address immediately above the pair of words (x29 and x30) we just pushed. Those must not be included since otherwise the distance from - [caml_bottom_of_stack] to the highest address in the caller's stack - frame won't match the frame size contained in the relevant frame - descriptor. */ + [Caml_state->bottom_of_stack] to the highest address in the caller's + stack frame won't match the frame size contained in the relevant + frame descriptor. */ add x29, sp, #16 - STOREGLOBAL(x29, caml_bottom_of_stack) + str x29, Caml_state(bottom_of_stack) add x29, sp, #0 /* Record return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ @@ -217,15 +224,16 @@ caml_alloc2: cmp ALLOC_PTR, ALLOC_LIMIT b.lo 2f ret -2: stp x29, x30, [sp, -16]! +2: add ALLOC_PTR, ALLOC_PTR, #24 + stp x29, x30, [sp, -16]! CFI_ADJUST(16) /* Record the lowest address of the caller's stack frame. See comment above. */ add x29, sp, #16 - STOREGLOBAL(x29, caml_bottom_of_stack) + str x29, Caml_state(bottom_of_stack) add x29, sp, #0 /* Record return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ @@ -237,23 +245,22 @@ caml_alloc2: .type caml_alloc2, %function .size caml_alloc2, .-caml_alloc2 - .align 2 - .globl caml_alloc3 -caml_alloc3: +FUNCTION(caml_alloc3) CFI_STARTPROC 1: sub ALLOC_PTR, ALLOC_PTR, #32 cmp ALLOC_PTR, ALLOC_LIMIT b.lo 2f ret -2: stp x29, x30, [sp, -16]! +2: add ALLOC_PTR, ALLOC_PTR, #32 + stp x29, x30, [sp, -16]! CFI_ADJUST(16) /* Record the lowest address of the caller's stack frame. See comment above. */ add x29, sp, #16 - STOREGLOBAL(x29, caml_bottom_of_stack) + str x29, Caml_state(bottom_of_stack) add x29, sp, #0 /* Record return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) /* Call GC */ bl .Lcaml_call_gc /* Restore return address */ @@ -265,6 +272,7 @@ caml_alloc3: .type caml_alloc3, %function .size caml_alloc3, .-caml_alloc3 + TEXT_SECTION(caml_allocN) .align 2 .globl caml_allocN caml_allocN: @@ -273,15 +281,16 @@ caml_allocN: cmp ALLOC_PTR, ALLOC_LIMIT b.lo 2f ret -2: stp x29, x30, [sp, -16]! +2: add ALLOC_PTR, ALLOC_PTR, ARG + stp x29, x30, [sp, -16]! CFI_ADJUST(16) /* Record the lowest address of the caller's stack frame. See comment above. */ add x29, sp, #16 - STOREGLOBAL(x29, caml_bottom_of_stack) + str x29, Caml_state(bottom_of_stack) add x29, sp, #0 /* Record return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) /* Call GC. This preserves ARG */ bl .Lcaml_call_gc /* Restore return address */ @@ -290,43 +299,38 @@ caml_allocN: /* Try again */ b 1b CFI_ENDPROC - .type caml_allocN, %function .size caml_allocN, .-caml_allocN /* Call a C function from OCaml */ /* Function to call is in ARG */ - .align 2 - .globl caml_c_call -caml_c_call: +FUNCTION(caml_c_call) CFI_STARTPROC /* Preserve return address in callee-save register x19 */ mov x19, x30 CFI_REGISTER(30, 19) /* Record lowest stack address and return address */ - STOREGLOBAL(x30, caml_last_return_address) + str x30, Caml_state(last_return_address) add TMP, sp, #0 - STOREGLOBAL(TMP, caml_bottom_of_stack) + str TMP, Caml_state(bottom_of_stack) /* Make the exception handler alloc ptr available to the C code */ - STOREGLOBAL(ALLOC_PTR, caml_young_ptr) - STOREGLOBAL(TRAP_PTR, caml_exception_pointer) + str ALLOC_PTR, Caml_state(young_ptr) + str TRAP_PTR, Caml_state(exception_pointer) /* Call the function */ blr ARG /* Reload alloc ptr and alloc limit */ - LOADGLOBAL(ALLOC_PTR, caml_young_ptr) - LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) + ldr ALLOC_PTR, Caml_state(young_ptr) + ldr ALLOC_LIMIT, Caml_state(young_limit) /* Return */ ret x19 CFI_ENDPROC - .type caml_c_call, %function .size caml_c_call, .-caml_c_call /* Start the OCaml program */ - .align 2 - .globl caml_start_program -caml_start_program: +FUNCTION(caml_start_program) CFI_STARTPROC + mov ARG_DOMAIN_STATE_PTR, C_ARG_1 ADDRGLOBAL(ARG, caml_program) /* Code shared with caml_callback* */ @@ -349,39 +353,41 @@ caml_start_program: stp d10, d11, [sp, 112] stp d12, d13, [sp, 128] stp d14, d15, [sp, 144] + /* Load domain state pointer from argument */ + mov DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR /* Setup a callback link on the stack */ - LOADGLOBAL(x8, caml_bottom_of_stack) - LOADGLOBAL(x9, caml_last_return_address) - LOADGLOBAL(x10, caml_gc_regs) + ldr x8, Caml_state(bottom_of_stack) + ldr x9, Caml_state(last_return_address) + ldr x10, Caml_state(gc_regs) stp x8, x9, [sp, -32]! /* 16-byte alignment */ CFI_ADJUST(32) str x10, [sp, 16] /* Setup a trap frame to catch exceptions escaping the OCaml code */ - LOADGLOBAL(x8, caml_exception_pointer) + ldr x8, Caml_state(exception_pointer) adr x9, .Ltrap_handler stp x8, x9, [sp, -16]! CFI_ADJUST(16) add TRAP_PTR, sp, #0 /* Reload allocation pointers */ - LOADGLOBAL(ALLOC_PTR, caml_young_ptr) - LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) + ldr ALLOC_PTR, Caml_state(young_ptr) + ldr ALLOC_LIMIT, Caml_state(young_limit) /* Call the OCaml code */ blr ARG .Lcaml_retaddr: /* Pop the trap frame, restoring caml_exception_pointer */ ldr x8, [sp], 16 CFI_ADJUST(-16) - STOREGLOBAL(x8, caml_exception_pointer) + str x8, Caml_state(exception_pointer) /* Pop the callback link, restoring the global variables */ .Lreturn_result: ldr x10, [sp, 16] ldp x8, x9, [sp], 32 CFI_ADJUST(-32) - STOREGLOBAL(x8, caml_bottom_of_stack) - STOREGLOBAL(x9, caml_last_return_address) - STOREGLOBAL(x10, caml_gc_regs) + str x8, Caml_state(bottom_of_stack) + str x9, Caml_state(last_return_address) + str x10, Caml_state(gc_regs) /* Update allocation pointer */ - STOREGLOBAL(ALLOC_PTR, caml_young_ptr) + str ALLOC_PTR, Caml_state(young_ptr) /* Reload callee-save registers and return address */ ldp x19, x20, [sp, 16] ldp x21, x22, [sp, 32] @@ -399,7 +405,6 @@ caml_start_program: CFI_ENDPROC .type .Lcaml_retaddr, %function .size .Lcaml_retaddr, .-.Lcaml_retaddr - .type caml_start_program, %function .size caml_start_program, .-caml_start_program /* The trap handler */ @@ -408,7 +413,7 @@ caml_start_program: .Ltrap_handler: CFI_STARTPROC /* Save exception pointer */ - STOREGLOBAL(TRAP_PTR, caml_exception_pointer) + str TRAP_PTR, Caml_state(exception_pointer) /* Encode exception bucket as an exception result */ orr x0, x0, #2 /* Return it */ @@ -419,13 +424,11 @@ caml_start_program: /* Raise an exception from OCaml */ - .align 2 - .globl caml_raise_exn -caml_raise_exn: +FUNCTION(caml_raise_exn) CFI_STARTPROC /* Test if backtrace is active */ - LOADGLOBAL32(TMP, caml_backtrace_active) - cbnz TMP, 2f + ldr TMP, Caml_state(backtrace_active) + cbnz TMP, 2f 1: /* Cut stack at current trap handler */ mov sp, TRAP_PTR /* Pop previous handler and jump to it */ @@ -444,21 +447,22 @@ caml_raise_exn: mov x0, x19 b 1b CFI_ENDPROC - .type caml_raise_exn, %function .size caml_raise_exn, .-caml_raise_exn /* Raise an exception from C */ - .align 2 - .globl caml_raise_exception -caml_raise_exception: +FUNCTION(caml_raise_exception) CFI_STARTPROC + /* Load the domain state ptr */ + mov DOMAIN_STATE_PTR, C_ARG_1 + /* Load the exception bucket */ + mov x0, C_ARG_2 /* Reload trap ptr, alloc ptr and alloc limit */ - LOADGLOBAL(TRAP_PTR, caml_exception_pointer) - LOADGLOBAL(ALLOC_PTR, caml_young_ptr) - LOADGLOBAL(ALLOC_LIMIT, caml_young_limit) + ldr TRAP_PTR, Caml_state(exception_pointer) + ldr ALLOC_PTR, Caml_state(young_ptr) + ldr ALLOC_LIMIT, Caml_state(young_limit) /* Test if backtrace is active */ - LOADGLOBAL32(TMP, caml_backtrace_active) + ldr TMP, Caml_state(backtrace_active) cbnz TMP, 2f 1: /* Cut stack at current trap handler */ mov sp, TRAP_PTR @@ -469,76 +473,73 @@ caml_raise_exception: 2: /* Preserve exception bucket in callee-save register x19 */ mov x19, x0 /* Stash the backtrace */ - /* arg1: exn bucket, already in x0 */ - LOADGLOBAL(x1, caml_last_return_address) /* arg2: pc of raise */ - LOADGLOBAL(x2, caml_bottom_of_stack) /* arg3: sp of raise */ + /* arg1: exn bucket */ + ldr x1, Caml_state(last_return_address) /* arg2: pc of raise */ + ldr x2, Caml_state(bottom_of_stack) /* arg3: sp of raise */ mov x3, TRAP_PTR /* arg4: sp of handler */ bl caml_stash_backtrace /* Restore exception bucket and raise */ mov x0, x19 b 1b CFI_ENDPROC - .type caml_raise_exception, %function .size caml_raise_exception, .-caml_raise_exception /* Callback from C to OCaml */ - .align 2 - .globl caml_callback_exn -caml_callback_exn: +FUNCTION(caml_callback_asm) CFI_STARTPROC - /* Initial shuffling of arguments (x0 = closure, x1 = first arg) */ - mov TMP, x0 - mov x0, x1 /* x0 = first arg */ - mov x1, TMP /* x1 = closure environment */ - ldr ARG, [TMP] /* code pointer */ + /* Initial shuffling of arguments */ + /* (x0 = Caml_state, x1 = closure, [x2] = first arg) */ + mov ARG_DOMAIN_STATE_PTR, x0 + ldr x0, [x2] /* x0 = first arg */ + /* x1 = closure environment */ + ldr ARG, [x1] /* code pointer */ b .Ljump_to_caml CFI_ENDPROC - .type caml_callback_exn, %function - .size caml_callback_exn, .-caml_callback_exn + .type caml_callback_asm, %function + .size caml_callback_asm, .-caml_callback_asm + TEXT_SECTION(caml_callback2_asm) .align 2 - .globl caml_callback2_exn -caml_callback2_exn: + .globl caml_callback2_asm +caml_callback2_asm: CFI_STARTPROC - /* Initial shuffling of arguments (x0 = closure, x1 = arg1, x2 = arg2) */ - mov TMP, x0 - mov x0, x1 /* x0 = first arg */ - mov x1, x2 /* x1 = second arg */ + /* Initial shuffling of arguments */ + /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */ + mov ARG_DOMAIN_STATE_PTR, x0 + mov TMP, x1 + ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */ mov x2, TMP /* x2 = closure environment */ ADDRGLOBAL(ARG, caml_apply2) b .Ljump_to_caml CFI_ENDPROC - .type caml_callback2_exn, %function - .size caml_callback2_exn, .-caml_callback2_exn + .type caml_callback2_asm, %function + .size caml_callback2_asm, .-caml_callback2_asm + TEXT_SECTION(caml_callback3_asm) .align 2 - .globl caml_callback3_exn -caml_callback3_exn: + .globl caml_callback3_asm +caml_callback3_asm: CFI_STARTPROC /* Initial shuffling of arguments */ - /* (x0 = closure, x1 = arg1, x2 = arg2, x3 = arg3) */ - mov TMP, x0 - mov x0, x1 /* x0 = first arg */ - mov x1, x2 /* x1 = second arg */ - mov x2, x3 /* x2 = third arg */ - mov x3, TMP /* x3 = closure environment */ + /* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2, + [x2,16] = arg3) */ + mov ARG_DOMAIN_STATE_PTR, x0 + mov x3, x1 /* x3 = closure environment */ + ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */ + ldr x2, [x2, 16] /* x2 = third arg */ ADDRGLOBAL(ARG, caml_apply3) b .Ljump_to_caml CFI_ENDPROC - .type caml_callback3_exn, %function - .size caml_callback3_exn, .-caml_callback3_exn + .size caml_callback3_asm, .-caml_callback3_asm - .align 2 - .globl caml_ml_array_bound_error -caml_ml_array_bound_error: +FUNCTION(caml_ml_array_bound_error) CFI_STARTPROC /* Load address of [caml_array_bound_error] in ARG */ ADDRGLOBAL(ARG, caml_array_bound_error) /* Call that function */ b caml_c_call CFI_ENDPROC - .type caml_ml_array_bound_error, %function .size caml_ml_array_bound_error, .-caml_ml_array_bound_error .globl caml_system__code_end diff --git a/runtime/array.c b/runtime/array.c index e4da1db8..64790423 100644 --- a/runtime/array.c +++ b/runtime/array.c @@ -278,9 +278,9 @@ CAMLprim value caml_floatarray_create(value len) caml_invalid_argument("Float.Array.create"); else { result = caml_alloc_shr (wosize, Double_array_tag); - result = caml_check_urgent_gc (result); } - return result; + // Give the GC a chance to run, and run memprof callbacks + return caml_process_pending_actions_with_root (result); } /* [len] is a [value] representing number of words or floats */ @@ -316,22 +316,22 @@ CAMLprim value caml_make_vect(value len, value init) for (i = 0; i < size; i++) Field(res, i) = init; } else if (size > Max_wosize) caml_invalid_argument("Array.make"); - else if (Is_block(init) && Is_young(init)) { - /* We don't want to create so many major-to-minor references, - so [init] is moved to the major heap by doing a minor GC. */ - CAML_INSTR_INT ("force_minor/make_vect@", 1); - caml_request_minor_gc (); - caml_gc_dispatch (); - res = caml_alloc_shr(size, 0); - for (i = 0; i < size; i++) Field(res, i) = init; - res = caml_check_urgent_gc (res); - } else { + if (Is_block(init) && Is_young(init)) { + /* We don't want to create so many major-to-minor references, + so [init] is moved to the major heap by doing a minor GC. */ + CAML_INSTR_INT ("force_minor/make_vect@", 1); + caml_minor_collection (); + } + CAMLassert(!(Is_block(init) && Is_young(init))); res = caml_alloc_shr(size, 0); - for (i = 0; i < size; i++) caml_initialize(&Field(res, i), init); - res = caml_check_urgent_gc (res); + /* We now know that [init] is not in the minor heap, so there is + no need to call [caml_initialize]. */ + for (i = 0; i < size; i++) Field(res, i) = init; } } + // Give the GC a chance to run, and run memprof callbacks + caml_process_pending_actions (); CAMLreturn (res); } @@ -379,12 +379,13 @@ CAMLprim value caml_make_array(value init) res = caml_alloc_small(wsize, Double_array_tag); } else { res = caml_alloc_shr(wsize, Double_array_tag); - res = caml_check_urgent_gc(res); } for (i = 0; i < size; i++) { double d = Double_val(Field(init, i)); Store_double_flat_field(res, i, d); } + // run memprof callbacks + caml_process_pending_actions(); CAMLreturn (res); } } @@ -521,8 +522,9 @@ static value caml_array_gather(intnat num_arrays, CAMLassert(pos == size); /* Many caml_initialize in a row can create a lot of old-to-young - refs. Give the minor GC a chance to run if it needs to. */ - res = caml_check_urgent_gc(res); + refs. Give the minor GC a chance to run if it needs to. + Run memprof callbacks for the major allocation. */ + res = caml_process_pending_actions_with_root (res); } CAMLreturn (res); } @@ -589,3 +591,46 @@ CAMLprim value caml_array_concat(value al) } return res; } + +CAMLprim value caml_array_fill(value array, + value v_ofs, + value v_len, + value val) +{ + intnat ofs = Long_val(v_ofs); + intnat len = Long_val(v_len); + value* fp; + + /* This duplicates the logic of caml_modify. Please refer to the + implementation of that function for a description of GC + invariants we need to enforce.*/ + +#ifdef FLAT_FLOAT_ARRAY + if (Tag_val(array) == Double_array_tag) { + double d = Double_val (val); + for (; len > 0; len--, ofs++) + Store_double_flat_field(array, ofs, d); + return Val_unit; + } +#endif + fp = &Field(array, ofs); + if (Is_young(array)) { + for (; len > 0; len--, fp++) *fp = val; + } else { + int is_val_young_block = Is_block(val) && Is_young(val); + CAMLassert(Is_in_heap(fp)); + for (; len > 0; len--, fp++) { + value old = *fp; + if (old == val) continue; + *fp = val; + if (Is_block(old)) { + if (Is_young(old)) continue; + if (caml_gc_phase == Phase_mark) caml_darken(old, NULL); + } + if (is_val_young_block) + add_to_ref_table (Caml_state->ref_table, fp); + } + if (is_val_young_block) caml_check_urgent_gc (Val_unit); + } + return Val_unit; +} diff --git a/runtime/backtrace.c b/runtime/backtrace.c index ddf7af14..1967ef55 100644 --- a/runtime/backtrace.c +++ b/runtime/backtrace.c @@ -26,15 +26,11 @@ #include "caml/backtrace.h" #include "caml/backtrace_prim.h" #include "caml/fail.h" - -CAMLexport int32_t caml_backtrace_active = 0; -CAMLexport int32_t caml_backtrace_pos = 0; -CAMLexport backtrace_slot * caml_backtrace_buffer = NULL; -CAMLexport value caml_backtrace_last_exn = Val_unit; +#include "caml/debugger.h" void caml_init_backtrace(void) { - caml_register_global_root(&caml_backtrace_last_exn); + caml_register_global_root(&Caml_state->backtrace_last_exn); } /* Start or stop the backtrace machinery */ @@ -42,14 +38,14 @@ CAMLprim value caml_record_backtrace(value vflag) { int flag = Int_val(vflag); - if (flag != caml_backtrace_active) { - caml_backtrace_active = flag; - caml_backtrace_pos = 0; - caml_backtrace_last_exn = Val_unit; - /* Note: We do lazy initialization of caml_backtrace_buffer when + if (flag != Caml_state->backtrace_active) { + Caml_state->backtrace_active = flag; + Caml_state->backtrace_pos = 0; + Caml_state->backtrace_last_exn = Val_unit; + /* Note: We do lazy initialization of Caml_state->backtrace_buffer when needed in order to simplify the interface with the thread library (thread creation doesn't need to allocate - caml_backtrace_buffer). So we don't have to allocate it here. + Caml_state->backtrace_buffer). So we don't have to allocate it here. */ } return Val_unit; @@ -58,7 +54,7 @@ CAMLprim value caml_record_backtrace(value vflag) /* Return the status of the backtrace machinery */ CAMLprim value caml_backtrace_status(value vunit) { - return Val_bool(caml_backtrace_active); + return Val_bool(Caml_state->backtrace_active); } /* Print location information -- same behavior as in Printexc @@ -116,8 +112,8 @@ CAMLexport void caml_print_exception_backtrace(void) return; } - for (i = 0; i < caml_backtrace_pos; i++) { - for (dbg = caml_debuginfo_extract(caml_backtrace_buffer[i]); + for (i = 0; i < Caml_state->backtrace_pos; i++) { + for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]); dbg != NULL; dbg = caml_debuginfo_next(dbg)) { @@ -133,34 +129,17 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit) CAMLparam0(); CAMLlocal1(res); - /* Beware: the allocations below may cause finalizers to be run, and another - backtrace---possibly of a different length---to be stashed (for example - if the finalizer raises then catches an exception). We choose to ignore - any such finalizer backtraces and return the original one. */ - - if (!caml_backtrace_active || - caml_backtrace_buffer == NULL || - caml_backtrace_pos == 0) { + if (!Caml_state->backtrace_active || + Caml_state->backtrace_buffer == NULL || + Caml_state->backtrace_pos == 0) { res = caml_alloc(0, 0); } else { - backtrace_slot saved_caml_backtrace_buffer[BACKTRACE_BUFFER_SIZE]; - int saved_caml_backtrace_pos; - intnat i; + intnat i, len = Caml_state->backtrace_pos; - saved_caml_backtrace_pos = caml_backtrace_pos; - - if (saved_caml_backtrace_pos > BACKTRACE_BUFFER_SIZE) { - saved_caml_backtrace_pos = BACKTRACE_BUFFER_SIZE; - } - - memcpy(saved_caml_backtrace_buffer, caml_backtrace_buffer, - saved_caml_backtrace_pos * sizeof(backtrace_slot)); - - res = caml_alloc(saved_caml_backtrace_pos, 0); - for (i = 0; i < saved_caml_backtrace_pos; i++) { - Field(res, i) = Val_backtrace_slot(saved_caml_backtrace_buffer[i]); - } + res = caml_alloc(len, 0); + for (i = 0; i < len; i++) + Field(res, i) = Val_backtrace_slot(Caml_state->backtrace_buffer[i]); } CAMLreturn(res); @@ -174,7 +153,7 @@ CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace) intnat i; mlsize_t bt_size; - caml_backtrace_last_exn = exn; + Caml_state->backtrace_last_exn = exn; bt_size = Wosize_val(backtrace); if(bt_size > BACKTRACE_BUFFER_SIZE){ @@ -184,18 +163,19 @@ CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace) /* We don't allocate if the backtrace is empty (no -g or backtrace not activated) */ if(bt_size == 0){ - caml_backtrace_pos = 0; + Caml_state->backtrace_pos = 0; return Val_unit; } /* Allocate if needed and copy the backtrace buffer */ - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1){ + if (Caml_state->backtrace_buffer == NULL && + caml_alloc_backtrace_buffer() == -1) { return Val_unit; } - caml_backtrace_pos = bt_size; - for(i=0; i < caml_backtrace_pos; i++){ - caml_backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i)); + Caml_state->backtrace_pos = bt_size; + for(i=0; i < Caml_state->backtrace_pos; i++){ + Caml_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i)); } return Val_unit; @@ -344,3 +324,13 @@ CAMLprim value caml_get_exception_backtrace(value unit) CAMLreturn(res); } + +CAMLprim value caml_get_current_callstack(value max_frames_value) { + CAMLparam1(max_frames_value); + CAMLlocal1(res); + + res = caml_alloc(caml_current_callstack_size(Long_val(max_frames_value)), 0); + caml_current_callstack_write(res); + + CAMLreturn(res); +} diff --git a/runtime/backtrace_byt.c b/runtime/backtrace_byt.c index b913dacd..428e7589 100644 --- a/runtime/backtrace_byt.c +++ b/runtime/backtrace_byt.c @@ -42,6 +42,7 @@ #include "caml/backtrace.h" #include "caml/fail.h" #include "caml/backtrace_prim.h" +#include "caml/debugger.h" /* The table of debug information fragments */ struct ext_table caml_debug_info; @@ -178,6 +179,9 @@ CAMLprim value caml_add_debug_info(code_t code_start, value code_size, CAMLparam1(events_heap); struct debug_info *debug_info; + if (events_heap != Val_unit) + caml_debugger(DEBUG_INFO_ADDED, events_heap); + /* build the OCaml-side debug_info value */ debug_info = caml_stat_alloc(sizeof(struct debug_info)); @@ -219,39 +223,36 @@ CAMLprim value caml_remove_debug_info(code_t start) } int caml_alloc_backtrace_buffer(void){ - CAMLassert(caml_backtrace_pos == 0); - caml_backtrace_buffer = + CAMLassert(Caml_state->backtrace_pos == 0); + Caml_state->backtrace_buffer = caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(code_t)); - if (caml_backtrace_buffer == NULL) return -1; + if (Caml_state->backtrace_buffer == NULL) return -1; return 0; } /* Store the return addresses contained in the given stack fragment into the backtrace array */ -void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise) +void caml_stash_backtrace(value exn, value * sp, int reraise) { - if (pc != NULL) pc = pc - 1; - if (exn != caml_backtrace_last_exn || !reraise) { - caml_backtrace_pos = 0; - caml_backtrace_last_exn = exn; + if (exn != Caml_state->backtrace_last_exn || !reraise) { + Caml_state->backtrace_pos = 0; + Caml_state->backtrace_last_exn = exn; } - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1) + if (Caml_state->backtrace_buffer == NULL && + caml_alloc_backtrace_buffer() == -1) return; - if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; - /* testing the code region is needed: PR#8026 */ - if (find_debug_info(pc) != NULL) - caml_backtrace_buffer[caml_backtrace_pos++] = pc; - /* Traverse the stack and put all values pointing into bytecode into the backtrace buffer. */ - for (/*nothing*/; sp < caml_trapsp; sp++) { - code_t p = (code_t) *sp; - if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) break; + for (/*nothing*/; sp < Caml_state->trapsp; sp++) { + code_t p; + if (Is_long(*sp)) continue; + p = (code_t) *sp; + if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) break; if (find_debug_info(p) != NULL) - caml_backtrace_buffer[caml_backtrace_pos++] = p; + Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = p; } } @@ -261,8 +262,11 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise) code_t caml_next_frame_pointer(value ** sp, value ** trsp) { - while (*sp < caml_stack_high) { - code_t *p = (code_t*) (*sp)++; + while (*sp < Caml_state->stack_high) { + value *spv = (*sp)++; + code_t *p; + if (Is_long(*spv)) continue; + p = (code_t*) spv; if(&Trap_pc(*trsp) == p) { *trsp = Trap_link(*trsp); continue; @@ -274,50 +278,32 @@ code_t caml_next_frame_pointer(value ** sp, value ** trsp) return NULL; } -/* Stores upto [max_frames_value] frames of the current call stack to - return to the user. This is used not in an exception-raising - context, but only when the user requests to save the trace - (hopefully less often). Instead of using a bounded buffer as - [caml_stash_backtrace], we first traverse the stack to compute the - right size, then allocate space for the trace. */ - -CAMLprim value caml_get_current_callstack(value max_frames_value) +intnat caml_current_callstack_size(intnat max_frames) { - CAMLparam1(max_frames_value); - CAMLlocal1(trace); - - /* we use `intnat` here because, were it only `int`, passing `max_int` - from the OCaml side would overflow on 64bits machines. */ - intnat max_frames = Long_val(max_frames_value); intnat trace_size; + value * sp = Caml_state->extern_sp; + value * trsp = Caml_state->trapsp; - /* first compute the size of the trace */ - { - value * sp = caml_extern_sp; - value * trsp = caml_trapsp; - - for (trace_size = 0; trace_size < max_frames; trace_size++) { - code_t p = caml_next_frame_pointer(&sp, &trsp); - if (p == NULL) break; - } + for (trace_size = 0; trace_size < max_frames; trace_size++) { + code_t p = caml_next_frame_pointer(&sp, &trsp); + if (p == NULL) break; } - trace = caml_alloc(trace_size, 0); - - /* then collect the trace */ - { - value * sp = caml_extern_sp; - value * trsp = caml_trapsp; - uintnat trace_pos; + return trace_size; +} - for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { - code_t p = caml_next_frame_pointer(&sp, &trsp); - CAMLassert(p != NULL); - Field(trace, trace_pos) = Val_backtrace_slot(p); - } +void caml_current_callstack_write(value trace) { + value * sp = Caml_state->extern_sp; + value * trsp = Caml_state->trapsp; + uintnat trace_pos, trace_size = Wosize_val(trace); + + for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { + code_t p = caml_next_frame_pointer(&sp, &trsp); + CAMLassert(p != NULL); + /* [Val_backtrace_slot(...)] is always a long, no need to call + [caml_modify]. */ + Field(trace, trace_pos) = Val_backtrace_slot(p); } - - CAMLreturn(trace); } /* Read the debugging info contained in the current bytecode executable. */ diff --git a/runtime/backtrace_nat.c b/runtime/backtrace_nat.c index 0d1a3e58..81cb6d8e 100644 --- a/runtime/backtrace_nat.c +++ b/runtime/backtrace_nat.c @@ -66,10 +66,10 @@ frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp) } int caml_alloc_backtrace_buffer(void){ - CAMLassert(caml_backtrace_pos == 0); - caml_backtrace_buffer = + CAMLassert(Caml_state->backtrace_pos == 0); + Caml_state->backtrace_buffer = caml_stat_alloc_noexc(BACKTRACE_BUFFER_SIZE * sizeof(backtrace_slot)); - if (caml_backtrace_buffer == NULL) return -1; + if (Caml_state->backtrace_buffer == NULL) return -1; return 0; } @@ -81,12 +81,13 @@ int caml_alloc_backtrace_buffer(void){ [caml_get_current_callstack] was implemented. */ void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp) { - if (exn != caml_backtrace_last_exn) { - caml_backtrace_pos = 0; - caml_backtrace_last_exn = exn; + if (exn != Caml_state->backtrace_last_exn) { + Caml_state->backtrace_pos = 0; + Caml_state->backtrace_last_exn = exn; } - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1) + if (Caml_state->backtrace_buffer == NULL && + caml_alloc_backtrace_buffer() == -1) return; /* iterate on each frame */ @@ -94,66 +95,46 @@ void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp) frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); if (descr == NULL) return; /* store its descriptor in the backtrace buffer */ - if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; - caml_backtrace_buffer[caml_backtrace_pos++] = (backtrace_slot) descr; + if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; + Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = + (backtrace_slot) descr; /* Stop when we reach the current exception handler */ if (sp > trapsp) return; } } -/* Stores upto [max_frames_value] frames of the current call stack to - return to the user. This is used not in an exception-raising - context, but only when the user requests to save the trace - (hopefully less often). Instead of using a bounded buffer as - [caml_stash_backtrace], we first traverse the stack to compute the - right size, then allocate space for the trace. */ -CAMLprim value caml_get_current_callstack(value max_frames_value) -{ - CAMLparam1(max_frames_value); - CAMLlocal1(trace); - - /* we use `intnat` here because, were it only `int`, passing `max_int` - from the OCaml side would overflow on 64bits machines. */ - intnat max_frames = Long_val(max_frames_value); - intnat trace_size; - - /* first compute the size of the trace */ - { - uintnat pc = caml_last_return_address; - char * sp = caml_bottom_of_stack; - char * limitsp = caml_top_of_stack; +intnat caml_current_callstack_size(intnat max_frames) { + intnat trace_size = 0; + uintnat pc = Caml_state->last_return_address; + char * sp = Caml_state->bottom_of_stack; - trace_size = 0; - while (1) { - frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); - if (descr == NULL) break; - if (trace_size >= max_frames) break; - ++trace_size; + while (1) { + frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); + if (descr == NULL) break; + if (trace_size >= max_frames) break; + ++trace_size; - if (sp > limitsp) break; - } + if (sp > Caml_state->top_of_stack) break; } - trace = caml_alloc((mlsize_t) trace_size, 0); + return trace_size; +} - /* then collect the trace */ - { - uintnat pc = caml_last_return_address; - char * sp = caml_bottom_of_stack; - intnat trace_pos; +void caml_current_callstack_write(value trace) { + uintnat pc = Caml_state->last_return_address; + char * sp = Caml_state->bottom_of_stack; + intnat trace_pos, trace_size = Wosize_val(trace); - for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { - frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); - CAMLassert(descr != NULL); - Field(trace, trace_pos) = Val_backtrace_slot((backtrace_slot) descr); - } + for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { + frame_descr * descr = caml_next_frame_descriptor(&pc, &sp); + CAMLassert(descr != NULL); + /* [Val_backtrace_slot(...)] is always a long, no need to call + [caml_modify]. */ + Field(trace, trace_pos) = Val_backtrace_slot((backtrace_slot) descr); } - - CAMLreturn(trace); } - debuginfo caml_debuginfo_extract(backtrace_slot slot) { uintnat infoptr; diff --git a/runtime/bigarray.c b/runtime/bigarray.c index 62d3d3de..60733909 100644 --- a/runtime/bigarray.c +++ b/runtime/bigarray.c @@ -209,7 +209,7 @@ CAMLexport int caml_ba_compare(value v1, value v2) if (e1 < e2) return -1; \ if (e1 > e2) return 1; \ if (e1 != e2) { \ - caml_compare_unordered = 1; \ + Caml_state->compare_unordered = 1; \ if (e1 == e1) return 1; \ if (e2 == e2) return -1; \ } \ diff --git a/runtime/callback.c b/runtime/callback.c index 03a89b30..71936374 100644 --- a/runtime/callback.c +++ b/runtime/callback.c @@ -19,6 +19,7 @@ #include #include "caml/callback.h" +#include "caml/domain.h" #include "caml/fail.h" #include "caml/memory.h" #include "caml/mlvalues.h" @@ -71,22 +72,23 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) CAMLassert(narg + 4 <= 256); - caml_extern_sp -= narg + 4; - for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */ + Caml_state->extern_sp -= narg + 4; + for (i = 0; i < narg; i++) Caml_state->extern_sp[i] = args[i]; /* arguments */ #ifndef LOCAL_CALLBACK_BYTECODE - caml_extern_sp[narg] = (value) (callback_code + 4); /* return address */ - caml_extern_sp[narg + 1] = Val_unit; /* environment */ - caml_extern_sp[narg + 2] = Val_long(0); /* extra args */ - caml_extern_sp[narg + 3] = closure; + Caml_state->extern_sp[narg] = (value)(callback_code + 4); /* return address */ + Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */ + Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */ + Caml_state->extern_sp[narg + 3] = closure; Init_callback(); callback_code[1] = narg + 3; callback_code[3] = narg; res = caml_interprete(callback_code, sizeof(callback_code)); #else /*have LOCAL_CALLBACK_BYTECODE*/ - caml_extern_sp[narg] = (value) (local_callback_code + 4); /* return address */ - caml_extern_sp[narg + 1] = Val_unit; /* environment */ - caml_extern_sp[narg + 2] = Val_long(0); /* extra args */ - caml_extern_sp[narg + 3] = closure; + /* return address */ + Caml_state->extern_sp[narg] = (value) (local_callback_code + 4); + Caml_state->extern_sp[narg + 1] = Val_unit; /* environment */ + Caml_state->extern_sp[narg + 2] = Val_long(0); /* extra args */ + Caml_state->extern_sp[narg + 3] = closure; local_callback_code[0] = ACC; local_callback_code[1] = narg + 3; local_callback_code[2] = APPLY; @@ -100,7 +102,7 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) res = caml_interprete(local_callback_code, sizeof(local_callback_code)); caml_release_bytecode(local_callback_code, sizeof(local_callback_code)); #endif /*LOCAL_CALLBACK_BYTECODE*/ - if (Is_exception_result(res)) caml_extern_sp += narg + 4; /* PR#3419 */ + if (Is_exception_result(res)) Caml_state->extern_sp += narg + 4; /* PR#3419 */ return res; } @@ -131,7 +133,31 @@ CAMLexport value caml_callback3_exn(value closure, #else -/* Native-code callbacks. caml_callback[123]_exn are implemented in asm. */ +/* Native-code callbacks. */ + +typedef value (callback_stub)(caml_domain_state* state, value closure, + value* args); + +callback_stub caml_callback_asm, caml_callback2_asm, caml_callback3_asm; + +CAMLexport value caml_callback_exn(value closure, value arg) +{ + return caml_callback_asm(Caml_state, closure, &arg); +} + +CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2) +{ + value args[] = {arg1, arg2}; + return caml_callback2_asm(Caml_state, closure, args); +} + +CAMLexport value caml_callback3_exn(value closure, + value arg1, value arg2, value arg3) +{ + value args[] = {arg1, arg2, arg3}; + return caml_callback3_asm(Caml_state, closure, args); +} + CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) { @@ -170,31 +196,23 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) CAMLexport value caml_callback (value closure, value arg) { - value res = caml_callback_exn(closure, arg); - if (Is_exception_result(res)) caml_raise(Extract_exception(res)); - return res; + return caml_raise_if_exception(caml_callback_exn(closure, arg)); } CAMLexport value caml_callback2 (value closure, value arg1, value arg2) { - value res = caml_callback2_exn(closure, arg1, arg2); - if (Is_exception_result(res)) caml_raise(Extract_exception(res)); - return res; + return caml_raise_if_exception(caml_callback2_exn(closure, arg1, arg2)); } CAMLexport value caml_callback3 (value closure, value arg1, value arg2, value arg3) { - value res = caml_callback3_exn(closure, arg1, arg2, arg3); - if (Is_exception_result(res)) caml_raise(Extract_exception(res)); - return res; + return caml_raise_if_exception(caml_callback3_exn(closure, arg1, arg2, arg3)); } CAMLexport value caml_callbackN (value closure, int narg, value args[]) { - value res = caml_callbackN_exn(closure, narg, args); - if (Is_exception_result(res)) caml_raise(Extract_exception(res)); - return res; + return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args)); } /* Naming of OCaml values */ diff --git a/runtime/caml/address_class.h b/runtime/caml/address_class.h index 85e22d32..45e5410e 100644 --- a/runtime/caml/address_class.h +++ b/runtime/caml/address_class.h @@ -27,7 +27,8 @@ #define Is_young(val) \ (CAMLassert (Is_block (val)), \ - (addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start) + (char *)(val) < (char *)Caml_state_field(young_end) && \ + (char *)(val) > (char *)Caml_state_field(young_start)) #define Is_in_heap(a) (Classify_addr(a) & In_heap) @@ -46,7 +47,6 @@ /***********************************************************************/ /* The rest of this file is private and may change without notice. */ -extern value *caml_young_start, *caml_young_end; extern char * caml_code_area_start, * caml_code_area_end; #define Not_in_heap 0 diff --git a/runtime/caml/alloc.h b/runtime/caml/alloc.h index 81fff858..f3f490af 100644 --- a/runtime/caml/alloc.h +++ b/runtime/caml/alloc.h @@ -27,6 +27,9 @@ extern "C" { #endif +/* It is guaranteed that these allocation functions will not trigger + any OCaml callback such as finalizers or signal handlers. */ + CAMLextern value caml_alloc (mlsize_t wosize, tag_t); CAMLextern value caml_alloc_small (mlsize_t wosize, tag_t); CAMLextern value caml_alloc_tuple (mlsize_t wosize); diff --git a/runtime/caml/backtrace.h b/runtime/caml/backtrace.h index fcc13312..5cf24b85 100644 --- a/runtime/caml/backtrace.h +++ b/runtime/caml/backtrace.h @@ -30,20 +30,20 @@ * * Backtrace generation is split in multiple steps. * The lowest-level one, done by [backtrace_byt.c] and - * [backtrace_nat.c] just fills the [caml_backtrace_buffer] + * [backtrace_nat.c] just fills the [Caml_state->backtrace_buffer] * variable each time a frame is unwinded. * At that point, we don't know whether the backtrace will be useful or not so * this code should be as fast as possible. * * If the backtrace happens to be useful, later passes will read - * [caml_backtrace_buffer] and turn it into a [raw_backtrace] and then a + * [Caml_state->backtrace_buffer] and turn it into a [raw_backtrace] and then a * [backtrace]. * This is done in [backtrace.c] and [stdlib/printexc.ml]. * * Content of buffers * ------------------ * - * [caml_backtrace_buffer] (really cheap) + * [Caml_state->backtrace_buffer] (really cheap) * Backend and process image dependent, abstracted by C-type backtrace_slot. * [raw_backtrace] (cheap) * OCaml values of abstract type [Printexc.raw_backtrace_slot], @@ -51,51 +51,43 @@ * [backtrace] (more expensive) * OCaml values of algebraic data-type [Printexc.backtrace_slot] */ - -/* Non zero iff backtraces are recorded. - * One should use to change this variable [caml_record_backtrace]. - */ -CAMLextern int caml_backtrace_active; - -/* The [backtrace_slot] type represents values stored in the - * [caml_backtrace_buffer]. In bytecode, it is the same as a - * [code_t], in native code it as a [frame_descr *]. The difference - * doesn't matter for code outside [backtrace_{byt,nat}.c], - * so it is just exposed as a [backtrace_slot]. + /* [Caml_state->backtrace_active] is non zero iff backtraces are recorded. + * This variable must be changed with [caml_record_backtrace]. */ -typedef void * backtrace_slot; - -/* The [caml_backtrace_buffer] and [caml_backtrace_last_exn] - * variables are valid only if [caml_backtrace_active != 0]. +#define caml_backtrace_active (Caml_state_field(backtrace_active)) +/* The [Caml_state->backtrace_buffer] and [Caml_state->backtrace_last_exn] + * variables are valid only if [Caml_state->backtrace_active != 0]. * * They are part of the state specific to each thread, and threading libraries * are responsible for copying them on context switch. - * See [otherlibs/systhreads/st_stubs.c] and [otherlibs/threads/scheduler.c]. - */ - -/* [caml_backtrace_buffer] is filled by runtime when unwinding stack. - * It is an array ranging from [0] to [caml_backtrace_pos - 1]. - * [caml_backtrace_pos] is always zero if [!caml_backtrace_active]. + * See [otherlibs/systhreads/st_stubs.c]. + * + * + * [Caml_state->backtrace_buffer] is filled by runtime when unwinding stack. It + * is an array ranging from [0] to [Caml_state->backtrace_pos - 1]. + * [Caml_state->backtrace_pos] is always zero if + * [!Caml_state->backtrace_active]. * * Its maximum size is determined by [BACKTRACE_BUFFER_SIZE] from * [backtrace_prim.h], but this shouldn't affect users. */ -CAMLextern backtrace_slot * caml_backtrace_buffer; -CAMLextern int caml_backtrace_pos; +#define caml_backtrace_buffer (Caml_state_field(backtrace_buffer)) +#define caml_backtrace_pos (Caml_state_field(backtrace_pos)) -/* [caml_backtrace_last_exn] stores the last exception value that was raised, - * iff [caml_backtrace_active != 0]. - * It is tested for equality to determine whether a raise is a re-raise of the - * same exception. - * - * FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized +/* [Caml_state->backtrace_last_exn] stores the last exception value that was + * raised, iff [Caml_state->backtrace_active != 0]. It is tested for equality + * to determine whether a raise is a re-raise of the same exception. + */ +#define caml_backtrace_last_exn (Caml_state_field(backtrace_last_exn)) + +/* FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized * exceptions are constant, so physical equality is no longer appropriate. * raise and re-raise are distinguished by: * - passing reraise = 1 to [caml_stash_backtrace] (see below) in the bytecode * interpreter; - * - directly resetting [caml_backtrace_pos] to 0 in native runtimes for raise. + * - directly resetting [Caml_state->backtrace_pos] to 0 in native + runtimes for raise. */ -CAMLextern value caml_backtrace_last_exn; /* [caml_record_backtrace] toggle backtrace recording on and off. * This function can be called at runtime by user-code, or during @@ -115,7 +107,7 @@ CAMLextern char_os * caml_cds_file; /* Primitive called _only_ by runtime to record unwinded frames to * backtrace. A similar primitive exists for native code, but with a * different prototype. */ -extern void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise); +extern void caml_stash_backtrace(value exn, value * sp, int reraise); #endif diff --git a/runtime/caml/backtrace_prim.h b/runtime/caml/backtrace_prim.h index b6673218..08c23604 100644 --- a/runtime/caml/backtrace_prim.h +++ b/runtime/caml/backtrace_prim.h @@ -71,7 +71,7 @@ void caml_debuginfo_location(debuginfo dbg, /*out*/ struct caml_loc_info * li); #define Val_backtrace_slot(bslot) (Val_long(((uintnat)(bslot))>>1)) #define Backtrace_slot_val(vslot) ((backtrace_slot)(Long_val(vslot) << 1)) -/* Allocate the caml_backtrace_buffer. Returns 0 on success, -1 otherwise */ +/* Allocate Caml_state->backtrace_buffer. Returns 0 on success, -1 otherwise */ int caml_alloc_backtrace_buffer(void); #ifndef NATIVE_CODE @@ -90,10 +90,28 @@ value caml_remove_debug_info(code_t start); * It defines the [caml_stash_backtrace] function, which is called to quickly * fill the backtrace buffer by walking the stack when an exception is raised. * - * It also defines the [caml_get_current_callstack] OCaml primitive, which also - * walks the stack but directly turns it into a [raw_backtrace] and is called - * explicitly. - */ + * It also defines the two following functions, which makes it possible + * to store upto [max_frames_value] frames of the current call + * stack. This is not used in an exception-raising context, but only + * when the user requests to save the trace (hopefully less often), or + * the context of profiling. Instead of using a bounded buffer as + * [caml_stash_backtrace], we first traverse the stack to compute the + * right size, then allocate space for the trace. + * + * The first function, [caml_current_callstack_size] computes the size + * (in words) of the needed buffer, while the second actually writes + * the call stack to the buffer as an object of type + * [raw_backtrace]. It should always be called with a buffer of the + * size predicted by [caml_current_callstack_size]. The reason we use + * two separated functions is to allow using either [caml_alloc] (for + * performance) or [caml_alloc_shr] (when we need to avoid a call to + * the GC, in memprof.c). + * + * We use `intnat` for max_frames because, were it only `int`, passing + * `max_int` from the OCaml side would overflow on 64bits machines. */ + +intnat caml_current_callstack_size(intnat max_frames); +void caml_current_callstack_write(value trace); #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/callback.h b/runtime/caml/callback.h index 82fab82e..eef3342e 100644 --- a/runtime/caml/callback.h +++ b/runtime/caml/callback.h @@ -39,10 +39,6 @@ CAMLextern value caml_callback3_exn (value closure, value arg1, value arg2, value arg3); CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]); -#define Make_exception_result(v) ((v) | 2) -#define Is_exception_result(v) (((v) & 3) == 2) -#define Extract_exception(v) ((v) & ~3) - CAMLextern const value * caml_named_value (char const * name); typedef void (*caml_named_action) (const value*, char *); CAMLextern void caml_iterate_named_values(caml_named_action f); diff --git a/runtime/caml/compact.h b/runtime/caml/compact.h index e29d0e86..5f189507 100644 --- a/runtime/caml/compact.h +++ b/runtime/caml/compact.h @@ -22,7 +22,12 @@ #include "misc.h" #include "mlvalues.h" -void caml_compact_heap (void); +/* [caml_compact_heap] compacts the heap and optionally changes the + allocation policy. + if [new_allocation_policy] is -1, the policy is not changed. +*/ +void caml_compact_heap (intnat new_allocation_policy); + void caml_compact_heap_maybe (void); void caml_invert_root (value v, value *p); diff --git a/runtime/caml/compatibility.h b/runtime/caml/compatibility.h index c2e1881c..1ec4df3f 100644 --- a/runtime/caml/compatibility.h +++ b/runtime/caml/compatibility.h @@ -265,7 +265,6 @@ #define enter_blocking_section_hook caml_enter_blocking_section_hook #define leave_blocking_section_hook caml_leave_blocking_section_hook #define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook -#define async_action_hook caml_async_action_hook #define enter_blocking_section caml_enter_blocking_section #define leave_blocking_section caml_leave_blocking_section #define convert_signal_number caml_convert_signal_number diff --git a/runtime/caml/config.h b/runtime/caml/config.h index 4d5b99db..d1f93bb9 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -47,6 +47,8 @@ #include "compatibility.h" #endif +#ifndef CAML_CONFIG_H_NO_TYPEDEFS + #include #if defined(HAS_LOCALE_H) || defined(HAS_XLOCALE_H) @@ -139,6 +141,8 @@ typedef uint64_t uintnat; #error "No integer type available to represent pointers" #endif +#endif /* CAML_CONFIG_H_NO_TYPEDEFS */ + /* Endianness of floats */ /* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows: diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h index 56a9a604..2713867b 100644 --- a/runtime/caml/custom.h +++ b/runtime/caml/custom.h @@ -66,8 +66,8 @@ CAMLextern value caml_alloc_custom_mem(struct custom_operations * ops, CAMLextern void caml_register_custom_operations(struct custom_operations * ops); -CAMLextern int caml_compare_unordered; - /* Used by custom comparison to report unordered NaN-like cases. */ +/* Global variable moved to Caml_state in 4.10 */ +#define caml_compare_unordered (Caml_state_field(compare_unordered)) #ifdef CAML_INTERNALS extern struct custom_operations * caml_find_custom_operations(char * ident); diff --git a/runtime/caml/debugger.h b/runtime/caml/debugger.h index c98f35a8..f5b27f61 100644 --- a/runtime/caml/debugger.h +++ b/runtime/caml/debugger.h @@ -29,13 +29,16 @@ extern uintnat caml_event_count; enum event_kind { EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT, - TRAP_BARRIER, UNCAUGHT_EXC + TRAP_BARRIER, UNCAUGHT_EXC, DEBUG_INFO_ADDED, + CODE_LOADED, CODE_UNLOADED }; void caml_debugger_init (void); -void caml_debugger (enum event_kind event); +void caml_debugger (enum event_kind event, value param); void caml_debugger_cleanup_fork (void); +opcode_t caml_debugger_saved_instruction(code_t pc); + /* Communication protocol */ /* Requests from the debugger to the runtime system */ @@ -97,7 +100,11 @@ enum debugger_request { /* Replies to a REQ_GO request. All replies are followed by three uint32_t: - the value of the event counter - the position of the stack - - the current pc. */ + - the current pc. + The REP_CODE_DEBUG_INFO reply is also followed by: + - the newly added debug information. + The REP_CODE_{UN,}LOADED reply is also followed by: + - the code fragment index. */ enum debugger_reply { REP_EVENT = 'e', @@ -108,8 +115,14 @@ enum debugger_reply { /* Program exited by calling exit or reaching the end of the source. */ REP_TRAP = 's', /* Trap barrier crossed. */ - REP_UNCAUGHT_EXC = 'u' + REP_UNCAUGHT_EXC = 'u', /* Program exited due to a stray exception. */ + REP_CODE_DEBUG_INFO = 'D', + /* Additional debug info loaded. */ + REP_CODE_LOADED = 'L', + /* Additional code loaded. */ + REP_CODE_UNLOADED = 'U', + /* Additional code unloaded. */ }; #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h new file mode 100644 index 00000000..23833d24 --- /dev/null +++ b/runtime/caml/domain.h @@ -0,0 +1,36 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_DOMAIN_H +#define CAML_DOMAIN_H + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef CAML_INTERNALS + +#include "domain_state.h" + +void caml_init_domain(void); + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_DOMAIN_H */ diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h new file mode 100644 index 00000000..798a461b --- /dev/null +++ b/runtime/caml/domain_state.h @@ -0,0 +1,58 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_STATE_H +#define CAML_STATE_H + +#include +#include "misc.h" +#include "mlvalues.h" + +/* This structure sits in the TLS area and is also accessed efficiently + * via native code, which is why the indices are important */ + +typedef struct { +#ifdef CAML_NAME_SPACE +#define DOMAIN_STATE(type, name) CAMLalign(8) type name; +#else +#define DOMAIN_STATE(type, name) CAMLalign(8) type _##name; +#endif +#include "domain_state.tbl" +#undef DOMAIN_STATE +} caml_domain_state; + +enum { + Domain_state_num_fields = +#define DOMAIN_STATE(type, name) + 1 +#include "domain_state.tbl" +#undef DOMAIN_STATE +}; + +/* Check that the structure was laid out without padding, + since the runtime assumes this in computing offsets */ +CAML_STATIC_ASSERT( + sizeof(caml_domain_state) == + (Domain_state_num_fields + ) * 8); + +CAMLextern caml_domain_state* Caml_state; +#ifdef CAML_NAME_SPACE +#define Caml_state_field(field) Caml_state->field +#else +#define Caml_state_field(field) Caml_state->_##field +#endif + +#endif /* CAML_STATE_H */ diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl new file mode 100644 index 00000000..80ac7875 --- /dev/null +++ b/runtime/caml/domain_state.tbl @@ -0,0 +1,75 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +DOMAIN_STATE(value*, young_ptr) +DOMAIN_STATE(value*, young_limit) +/* Minor heap limit. See minor_gc.c. */ + +DOMAIN_STATE(char*, exception_pointer) +/* Exception pointer that points into the current stack */ + +DOMAIN_STATE(void*, young_base) +DOMAIN_STATE(value*, young_start) +DOMAIN_STATE(value*, young_end) +DOMAIN_STATE(value*, young_alloc_start) +DOMAIN_STATE(value*, young_alloc_end) +DOMAIN_STATE(value*, young_alloc_mid) +DOMAIN_STATE(value*, young_trigger) +DOMAIN_STATE(asize_t, minor_heap_wsz) +DOMAIN_STATE(intnat, in_minor_collection) +DOMAIN_STATE(double, extra_heap_resources_minor) +DOMAIN_STATE(struct caml_ref_table*, ref_table) +DOMAIN_STATE(struct caml_ephe_ref_table*, ephe_ref_table) +DOMAIN_STATE(struct caml_custom_table*, custom_table) +/* See minor_gc.c */ + +DOMAIN_STATE(value*, stack_low) +DOMAIN_STATE(value*, stack_high) +DOMAIN_STATE(value*, stack_threshold) +DOMAIN_STATE(value*, extern_sp) +DOMAIN_STATE(value*, trapsp) +DOMAIN_STATE(value*, trap_barrier) +DOMAIN_STATE(struct longjmp_buffer*, external_raise) +DOMAIN_STATE(value, exn_bucket) +/* See interp.c */ + +DOMAIN_STATE(char*, top_of_stack) +DOMAIN_STATE(char*, bottom_of_stack) +DOMAIN_STATE(uintnat, last_return_address) +DOMAIN_STATE(value*, gc_regs) +/* See roots_nat.c */ + +DOMAIN_STATE(intnat, backtrace_active) +DOMAIN_STATE(intnat, backtrace_pos) +DOMAIN_STATE(backtrace_slot*, backtrace_buffer) +DOMAIN_STATE(value, backtrace_last_exn) +/* See backtrace.c */ + +DOMAIN_STATE(intnat, compare_unordered) +DOMAIN_STATE(intnat, requested_major_slice) +DOMAIN_STATE(intnat, requested_minor_gc) +DOMAIN_STATE(struct caml__roots_block *, local_roots) + +DOMAIN_STATE(double, stat_minor_words) +DOMAIN_STATE(double, stat_promoted_words) +DOMAIN_STATE(double, stat_major_words) +DOMAIN_STATE(intnat, stat_minor_collections) +DOMAIN_STATE(intnat, stat_major_collections) +DOMAIN_STATE(intnat, stat_heap_wsz) +DOMAIN_STATE(intnat, stat_top_heap_wsz) +DOMAIN_STATE(intnat, stat_compactions) +DOMAIN_STATE(intnat, stat_heap_chunks) +/* See gc_ctrl.c */ diff --git a/runtime/caml/exec.h b/runtime/caml/exec.h index 9aa65371..51627f79 100644 --- a/runtime/caml/exec.h +++ b/runtime/caml/exec.h @@ -60,7 +60,7 @@ struct exec_trailer { /* Magic number for this release */ -#define EXEC_MAGIC "Caml1999X026" +#define EXEC_MAGIC "Caml1999X027" #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/fail.h b/runtime/caml/fail.h index 54907e42..ca4d8fd4 100644 --- a/runtime/caml/fail.h +++ b/runtime/caml/fail.h @@ -59,10 +59,14 @@ struct longjmp_buffer { #define siglongjmp(buf,val) longjmp(buf,val) #endif -CAMLextern struct longjmp_buffer * caml_external_raise; -extern value caml_exn_bucket; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_external_raise (Caml_state_field(external_raise)) +#define caml_exn_bucket (Caml_state_field(exn_bucket)) + int caml_is_special_exception(value exn); +value caml_raise_if_exception(value res); + #endif /* CAML_INTERNALS */ #ifdef __cplusplus diff --git a/runtime/caml/finalise.h b/runtime/caml/finalise.h index 5c8ea24c..fbde3619 100644 --- a/runtime/caml/finalise.h +++ b/runtime/caml/finalise.h @@ -22,7 +22,7 @@ void caml_final_update_mark_phase (void); void caml_final_update_clean_phase (void); -void caml_final_do_calls (void); +value caml_final_do_calls_exn (void); void caml_final_do_roots (scanning_action f); void caml_final_invert_finalisable_values (void); void caml_final_oldify_young_roots (void); diff --git a/runtime/caml/fix_code.h b/runtime/caml/fix_code.h index 7e5633d6..83c393a1 100644 --- a/runtime/caml/fix_code.h +++ b/runtime/caml/fix_code.h @@ -26,7 +26,6 @@ extern code_t caml_start_code; extern asize_t caml_code_size; -extern unsigned char * caml_saved_code; void caml_init_code_fragments(void); void caml_load_code (int fd, asize_t len); diff --git a/runtime/caml/freelist.h b/runtime/caml/freelist.h index 54e0e822..657e6883 100644 --- a/runtime/caml/freelist.h +++ b/runtime/caml/freelist.h @@ -25,13 +25,43 @@ extern asize_t caml_fl_cur_wsz; -header_t *caml_fl_allocate (mlsize_t wo_sz); -void caml_fl_init_merge (void); -void caml_fl_reset (void); -header_t *caml_fl_merge_block (value); -void caml_fl_add_blocks (value); -void caml_make_free_blocks (value *, mlsize_t wsz, int, int); -void caml_set_allocation_policy (uintnat); +/* See [freelist.c] for usage info on these functions. */ +extern header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz); +extern void (*caml_fl_p_init_merge) (void); +extern void (*caml_fl_p_reset) (void); +extern header_t *(*caml_fl_p_merge_block) (value bp, char *limit); +extern void (*caml_fl_p_add_blocks) (value bp); +extern void (*caml_fl_p_make_free_blocks) + (value *p, mlsize_t size, int do_merge, int color); +#ifdef DEBUG +extern void (*caml_fl_p_check) (void); +#endif + +static inline header_t *caml_fl_allocate (mlsize_t wo_sz) + { return (*caml_fl_p_allocate) (wo_sz); } + +static inline void caml_fl_init_merge (void) + { (*caml_fl_p_init_merge) (); } + +static inline void caml_fl_reset (void) + { (*caml_fl_p_reset) (); } + +static inline header_t *caml_fl_merge_block (value bp, char *limit) + { return (*caml_fl_p_merge_block) (bp, limit); } + +static inline void caml_fl_add_blocks (value bp) + { (*caml_fl_p_add_blocks) (bp); } + +static inline void caml_make_free_blocks + (value *p, mlsize_t size, int do_merge, int color) + { (*caml_fl_p_make_free_blocks) (p, size, do_merge, color); } + +extern void caml_set_allocation_policy (intnat); + +#ifdef DEBUG +static inline void caml_fl_check (void) + { (*caml_fl_p_check) (); } +#endif #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/gc_ctrl.h b/runtime/caml/gc_ctrl.h index 3f1578f9..dd3be4e5 100644 --- a/runtime/caml/gc_ctrl.h +++ b/runtime/caml/gc_ctrl.h @@ -20,18 +20,16 @@ #include "misc.h" -extern double - caml_stat_minor_words, - caml_stat_promoted_words, - caml_stat_major_words; - -extern intnat - caml_stat_minor_collections, - caml_stat_major_collections, - caml_stat_heap_wsz, - caml_stat_top_heap_wsz, - caml_stat_compactions, - caml_stat_heap_chunks; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_stat_minor_words (Caml_state_field(stat_minor_words)) +#define caml_stat_promoted_words (Caml_state_field(stat_promoted_words)) +#define caml_stat_major_words (Caml_state_field(stat_major_words)) +#define caml_stat_minor_collections (Caml_state_field(stat_minor_collections)) +#define caml_stat_major_collections (Caml_state_field(stat_major_collections)) +#define caml_stat_heap_wsz (Caml_state_field(stat_heap_wsz)) +#define caml_stat_top_heap_wsz (Caml_state_field(stat_top_heap_wsz)) +#define caml_stat_compactions (Caml_state_field(stat_compactions)) +#define caml_stat_heap_chunks (Caml_state_field(stat_heap_chunks)) /* minor_size: cf. minor_heap_size in gc.mli diff --git a/runtime/caml/intext.h b/runtime/caml/intext.h index 927e2497..be4b9467 100644 --- a/runtime/caml/intext.h +++ b/runtime/caml/intext.h @@ -188,24 +188,6 @@ CAMLnoreturn_start CAMLextern void caml_deserialize_error(char * msg) CAMLnoreturn_end; - -#ifdef CAML_INTERNALS - -/* Auxiliary stuff for sending code pointers */ - -struct code_fragment { - char * code_start; - char * code_end; - unsigned char digest[16]; - char digest_computed; -}; - -CAMLextern struct code_fragment * caml_extern_find_code(char *addr); - -extern struct ext_table caml_code_fragments_table; - -#endif /* CAML_INTERNALS */ - #ifdef __cplusplus } #endif diff --git a/runtime/caml/m.h.in b/runtime/caml/m.h.in index d8e535e0..4299643a 100644 --- a/runtime/caml/m.h.in +++ b/runtime/caml/m.h.in @@ -102,3 +102,7 @@ #undef CAML_SAFE_STRING #undef FLAT_FLOAT_ARRAY + +#undef FUNCTION_SECTIONS + +#undef SUPPORTS_ALIGNED_ATTRIBUTE diff --git a/runtime/caml/major_gc.h b/runtime/caml/major_gc.h index 813f8a78..87339757 100644 --- a/runtime/caml/major_gc.h +++ b/runtime/caml/major_gc.h @@ -70,7 +70,10 @@ extern double caml_major_work_credit; extern double caml_gc_clock; /* [caml_major_gc_hook] is called just between the end of the mark - phase and the beginning of the sweep phase of the major GC */ + phase and the beginning of the sweep phase of the major GC. + + This hook must not allocate, change any heap value, nor + call OCaml code. */ CAMLextern void (*caml_major_gc_hook)(void); void caml_init_major_heap (asize_t); /* size in bytes */ diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h index 5075cd0a..ad35a0b7 100644 --- a/runtime/caml/memory.h +++ b/runtime/caml/memory.h @@ -29,31 +29,34 @@ #endif /* CAML_INTERNALS */ #include "misc.h" #include "mlvalues.h" +#include "domain.h" #ifdef __cplusplus extern "C" { #endif - CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t); #ifdef WITH_PROFINFO CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat); -CAMLextern value caml_alloc_shr_preserving_profinfo (mlsize_t, tag_t, - header_t); #else #define caml_alloc_shr_with_profinfo(size, tag, profinfo) \ caml_alloc_shr(size, tag) -#define caml_alloc_shr_preserving_profinfo(size, tag, header) \ - caml_alloc_shr(size, tag) #endif /* WITH_PROFINFO */ -CAMLextern value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t); + +/* Variant of [caml_alloc_shr] where no memprof sampling is performed. */ +CAMLextern value caml_alloc_shr_no_track_noexc (mlsize_t, tag_t); + +/* Variant of [caml_alloc_shr] where no memprof sampling is performed, + and re-using the profinfo associated with the header given in + parameter. */ +CAMLextern value caml_alloc_shr_for_minor_gc (mlsize_t, tag_t, header_t); + CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t); CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz); CAMLextern void caml_free_dependent_memory (mlsize_t bsz); CAMLextern void caml_modify (value *, value); CAMLextern void caml_initialize (value *, value); CAMLextern value caml_check_urgent_gc (value); -CAMLextern int caml_init_alloc_for_heap (void); CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */ CAMLextern void caml_free_for_heap (char *mem); CAMLextern void caml_disown_for_heap (char *mem); @@ -206,33 +209,52 @@ int caml_page_table_initialize(mlsize_t bytesize); #define DEBUG_clear(result, wosize) #endif -#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) do { \ - CAMLassert ((wosize) >= 1); \ - CAMLassert ((tag_t) (tag) < 256); \ - CAMLassert ((wosize) <= Max_young_wosize); \ - caml_young_ptr -= Whsize_wosize (wosize); \ - if (caml_young_ptr < caml_young_trigger){ \ - caml_young_ptr += Whsize_wosize (wosize); \ - CAML_INSTR_INT ("force_minor/alloc_small@", 1); \ - Setup_for_gc; \ - caml_gc_dispatch (); \ - Restore_after_gc; \ - caml_young_ptr -= Whsize_wosize (wosize); \ - } \ - Hd_hp (caml_young_ptr) = \ +enum caml_alloc_small_flags { + CAML_DONT_TRACK = 0, CAML_DO_TRACK = 1, + CAML_FROM_C = 0, CAML_FROM_CAML = 2 +}; + +extern void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags); +// Do not call asynchronous callbacks from allocation functions +#define Alloc_small_origin CAML_FROM_C +#define Alloc_small_aux(result, wosize, tag, profinfo, track) do { \ + CAMLassert ((wosize) >= 1); \ + CAMLassert ((tag_t) (tag) < 256); \ + CAMLassert ((wosize) <= Max_young_wosize); \ + Caml_state_field(young_ptr) -= Whsize_wosize (wosize); \ + if (Caml_state_field(young_ptr) < Caml_state_field(young_limit)) { \ + Setup_for_gc; \ + caml_alloc_small_dispatch((tag), (wosize), \ + (track) | Alloc_small_origin); \ + Restore_after_gc; \ + } \ + Hd_hp (Caml_state_field(young_ptr)) = \ Make_header_with_profinfo ((wosize), (tag), Caml_black, profinfo); \ - (result) = Val_hp (caml_young_ptr); \ - DEBUG_clear ((result), (wosize)); \ + (result) = Val_hp (Caml_state_field(young_ptr)); \ + DEBUG_clear ((result), (wosize)); \ }while(0) +#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) \ + Alloc_small_aux(result, wosize, tag, profinfo, CAML_DO_TRACK) + #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) + extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat); + #define Alloc_small(result, wosize, tag) \ Alloc_small_with_profinfo(result, wosize, tag, \ caml_spacetime_my_profinfo(NULL, wosize)) +#define Alloc_small_no_track(result, wosize, tag) \ + Alloc_small_aux(result, wosize, tag, \ + caml_spacetime_my_profinfo(NULL, wosize), CAML_DONT_TRACK) + #else + #define Alloc_small(result, wosize, tag) \ Alloc_small_with_profinfo(result, wosize, tag, (uintnat) 0) +#define Alloc_small_no_track(result, wosize, tag) \ + Alloc_small_aux(result, wosize, tag, (uintnat) 0, CAML_DONT_TRACK) + #endif /* Deprecated alias for [caml_modify] */ @@ -248,7 +270,8 @@ struct caml__roots_block { value *tables [5]; }; -CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ +/* Global variable moved to Caml_state in 4.10 */ +#define caml_local_roots (Caml_state_field(local_roots)) /* The following macros are used to declare C local variables and function parameters of type [value]. @@ -282,7 +305,7 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ */ #define CAMLparam0() \ - struct caml__roots_block *caml__frame = caml_local_roots + struct caml__roots_block *caml__frame = Caml_state_field(local_roots) #define CAMLparam1(x) \ CAMLparam0 (); \ @@ -334,8 +357,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = 1), \ (caml__roots_##x.ntables = 1), \ (caml__roots_##x.tables [0] = &x), \ @@ -346,8 +369,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = 1), \ (caml__roots_##x.ntables = 2), \ (caml__roots_##x.tables [0] = &x), \ @@ -359,8 +382,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = 1), \ (caml__roots_##x.ntables = 3), \ (caml__roots_##x.tables [0] = &x), \ @@ -373,8 +396,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = 1), \ (caml__roots_##x.ntables = 4), \ (caml__roots_##x.tables [0] = &x), \ @@ -388,8 +411,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = 1), \ (caml__roots_##x.ntables = 5), \ (caml__roots_##x.tables [0] = &x), \ @@ -404,8 +427,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ struct caml__roots_block caml__roots_##x; \ CAMLunused_start int caml__dummy_##x = ( \ (void) caml__frame, \ - (caml__roots_##x.next = caml_local_roots), \ - (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.next = Caml_state_field(local_roots)), \ + (Caml_state_field(local_roots) = &caml__roots_##x), \ (caml__roots_##x.nitems = (size)), \ (caml__roots_##x.ntables = 1), \ (caml__roots_##x.tables[0] = &(x[0])), \ @@ -441,7 +464,7 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ CAMLxparamN (x, (size)) -#define CAMLdrop caml_local_roots = caml__frame +#define CAMLdrop Caml_state_field(local_roots) = caml__frame #define CAMLreturn0 do{ \ CAMLdrop; \ @@ -490,16 +513,16 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ #define Begin_roots1(r0) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = 1; \ caml__roots_block.ntables = 1; \ caml__roots_block.tables[0] = &(r0); #define Begin_roots2(r0, r1) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = 1; \ caml__roots_block.ntables = 2; \ caml__roots_block.tables[0] = &(r0); \ @@ -507,8 +530,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ #define Begin_roots3(r0, r1, r2) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = 1; \ caml__roots_block.ntables = 3; \ caml__roots_block.tables[0] = &(r0); \ @@ -517,8 +540,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ #define Begin_roots4(r0, r1, r2, r3) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = 1; \ caml__roots_block.ntables = 4; \ caml__roots_block.tables[0] = &(r0); \ @@ -528,8 +551,8 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ #define Begin_roots5(r0, r1, r2, r3, r4) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = 1; \ caml__roots_block.ntables = 5; \ caml__roots_block.tables[0] = &(r0); \ @@ -540,13 +563,13 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ #define Begin_roots_block(table, size) { \ struct caml__roots_block caml__roots_block; \ - caml__roots_block.next = caml_local_roots; \ - caml_local_roots = &caml__roots_block; \ + caml__roots_block.next = Caml_state_field(local_roots); \ + Caml_state_field(local_roots) = &caml__roots_block; \ caml__roots_block.nitems = (size); \ caml__roots_block.ntables = 1; \ caml__roots_block.tables[0] = (table); -#define End_roots() caml_local_roots = caml__roots_block.next; } +#define End_roots() Caml_state_field(local_roots) = caml__roots_block.next; } /* [caml_register_global_root] registers a global C variable as a memory root diff --git a/runtime/caml/memprof.h b/runtime/caml/memprof.h new file mode 100644 index 00000000..c313f277 --- /dev/null +++ b/runtime/caml/memprof.h @@ -0,0 +1,40 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Jacques-Henri Jourdan, projet Gallium, INRIA Paris */ +/* */ +/* Copyright 2016 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_MEMPROF_H +#define CAML_MEMPROF_H + +#ifdef CAML_INTERNALS + +#include "config.h" +#include "mlvalues.h" +#include "roots.h" + +extern int caml_memprof_suspended; + +extern value caml_memprof_handle_postponed_exn(); + +extern void caml_memprof_track_alloc_shr(value block); +extern void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml); +extern void caml_memprof_track_interned(header_t* block, header_t* blockend); + +extern void caml_memprof_renew_minor_sample(void); +extern value* caml_memprof_young_trigger; + +extern void caml_memprof_scan_roots(scanning_action f); + +#endif + +#endif /* CAML_MEMPROF_H */ diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h index 92793e2d..d2d6bcc2 100644 --- a/runtime/caml/minor_gc.h +++ b/runtime/caml/minor_gc.h @@ -16,17 +16,23 @@ #ifndef CAML_MINOR_GC_H #define CAML_MINOR_GC_H - #include "address_class.h" #include "config.h" -CAMLextern value *caml_young_start, *caml_young_end; -CAMLextern value *caml_young_alloc_start, *caml_young_alloc_end; -CAMLextern value *caml_young_ptr, *caml_young_limit; -CAMLextern value *caml_young_trigger; -extern asize_t caml_minor_heap_wsz; -extern int caml_in_minor_collection; -extern double caml_extra_heap_resources_minor; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_young_start (Caml_state_field(young_start)) +#define caml_young_end (Caml_state_field(young_end)) +#define caml_young_ptr (Caml_state_field(young_ptr)) +#define caml_young_limit (Caml_state_field(young_limit)) +#define caml_young_alloc_start (Caml_state_field(young_alloc_start)) +#define caml_young_alloc_end (Caml_state_field(young_alloc_end)) +#define caml_young_alloc_mid (Caml_state_field(young_alloc_mid)) +#define caml_young_trigger (Caml_state_field(young_trigger)) +#define caml_minor_heap_wsz (Caml_state_field(minor_heap_wsz)) +#define caml_in_minor_collection (Caml_state_field(in_minor_collection)) +#define caml_extra_heap_resources_minor \ + (Caml_state_field(extra_heap_resources_minor)) + #define CAML_TABLE_STRUCT(t) { \ t *base; \ @@ -39,7 +45,6 @@ extern double caml_extra_heap_resources_minor; } struct caml_ref_table CAML_TABLE_STRUCT(value *); -CAMLextern struct caml_ref_table caml_ref_table; struct caml_ephe_ref_elt { value ephe; /* an ephemeron in major heap */ @@ -47,7 +52,6 @@ struct caml_ephe_ref_elt { }; struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt); -CAMLextern struct caml_ephe_ref_table caml_ephe_ref_table; struct caml_custom_elt { value block; /* The finalized block in the minor heap. */ @@ -56,12 +60,17 @@ struct caml_custom_elt { }; struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt); -CAMLextern struct caml_custom_table caml_custom_table; +/* Table of custom blocks in the minor heap that contain finalizers + or GC speed parameters. */ extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ extern void caml_empty_minor_heap (void); CAMLextern void caml_gc_dispatch (void); +CAMLextern void caml_minor_collection (void); CAMLextern void garbage_collection (void); /* runtime/signals_nat.c */ +extern void caml_oldify_one (value, value *); +extern void caml_oldify_mopup (void); + 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 *); @@ -70,8 +79,7 @@ extern void caml_alloc_ephe_table (struct caml_ephe_ref_table *, extern void caml_realloc_custom_table (struct caml_custom_table *); extern void caml_alloc_custom_table (struct caml_custom_table *, asize_t, asize_t); -extern void caml_oldify_one (value, value *); -extern void caml_oldify_mopup (void); +void caml_alloc_minor_tables (void); #define Oldify(p) do{ \ value __oldify__v__ = *p; \ diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h index 4466d292..7fea2b14 100644 --- a/runtime/caml/misc.h +++ b/runtime/caml/misc.h @@ -27,6 +27,8 @@ #include #include +#include +#include /* Basic types and constants */ @@ -36,8 +38,20 @@ typedef size_t asize_t; #define NULL 0 #endif +#if defined(__GNUC__) || defined(__clang__) + /* Supported since at least GCC 3.1 */ + #define CAMLdeprecated_typedef(name, type) \ + typedef type name __attribute ((deprecated)) +#elif _MSC_VER >= 1310 + /* NB deprecated("message") only supported from _MSC_VER >= 1400 */ + #define CAMLdeprecated_typedef(name, type) \ + typedef __declspec(deprecated) type name +#else + #define CAMLdeprecated_typedef(name, type) typedef type name +#endif + #ifdef CAML_INTERNALS -typedef char * addr; +CAMLdeprecated_typedef(addr, char *); #endif /* CAML_INTERNALS */ /* Noreturn is preserved for compatibility reasons. @@ -81,19 +95,62 @@ typedef char * addr; #define CAMLweakdef #endif +/* Alignment is necessary for domain_state.h, since the code generated */ +/* by ocamlopt makes direct references into the domain state structure,*/ +/* which is stored in a register on many platforms. For this to work, */ +/* we need to be able to compute the exact offset of each member. */ +#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L +#define CAMLalign(n) _Alignas(n) +#elif defined(SUPPORTS_ALIGNED_ATTRIBUTE) +#define CAMLalign(n) __attribute__((aligned(n))) +#elif _MSC_VER >= 1500 +#define CAMLalign(n) __declspec(align(n)) +#else +#error "How do I align values on this platform?" +#endif + +/* CAMLunused is preserved for compatibility reasons. + Instead of the legacy GCC/Clang-only + CAMLunused foo; + you should prefer + CAMLunused_start foo CAMLunused_end; + which supports both GCC/Clang and MSVC. +*/ +#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7)) + #define CAMLunused_start __attribute__ ((unused)) + #define CAMLunused_end + #define CAMLunused __attribute__ ((unused)) +#elif _MSC_VER >= 1500 + #define CAMLunused_start __pragma( warning (push) ) \ + __pragma( warning (disable:4189 ) ) + #define CAMLunused_end __pragma( warning (pop)) + #define CAMLunused +#else + #define CAMLunused_start + #define CAMLunused_end + #define CAMLunused +#endif + #ifdef __cplusplus extern "C" { #endif -/* GC timing hooks. These can be assigned by the user. - [caml_minor_gc_begin_hook] must not allocate nor change any heap value. - The others can allocate and even call back to OCaml code. +/* GC timing hooks. These can be assigned by the user. These hooks + must not allocate, change any heap value, nor call OCaml code. */ typedef void (*caml_timing_hook) (void); extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook; extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook; extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook; +#define CAML_STATIC_ASSERT_3(b, l) \ + CAMLunused_start \ + CAMLextern char static_assertion_failure_line_##l[(b) ? 1 : -1] \ + CAMLunused_end + +#define CAML_STATIC_ASSERT_2(b, l) CAML_STATIC_ASSERT_3(b, l) +#define CAML_STATIC_ASSERT(b) CAML_STATIC_ASSERT_2(b, __LINE__) + /* Windows Unicode support (rest below - char_os is needed earlier) */ #ifdef _WIN32 @@ -126,6 +183,15 @@ CAMLnoreturn_end; #define CAMLassert(x) ((void) 0) #endif +/* This hook is called when a fatal error occurs in the OCaml + runtime. It is given arguments to be passed to the [vprintf]-like + functions in order to synthetize the error message. + If it returns, the runtime calls [abort()]. + + If it is [NULL], the error message is printed on stderr and then + [abort()] is called. */ +extern void (*caml_fatal_error_hook) (char *msg, va_list args); + CAMLnoreturn_start CAMLextern void caml_fatal_error (char *, ...) #ifdef __GNUC__ @@ -179,6 +245,9 @@ static inline int caml_umul_overflow(uintnat a, uintnat b, uintnat * res) extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); #endif +/* From floats.c */ +extern double caml_log1p(double); + /* Windows Unicode support */ #ifdef _WIN32 @@ -205,6 +274,9 @@ extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); #define strcmp_os wcscmp #define strlen_os wcslen #define sscanf_os swscanf +#define strcpy_os wcscpy +#define mktemp_os _wmktemp +#define fopen_os _wfopen #define caml_stat_strdup_os caml_stat_wcsdup #define caml_stat_strconcat_os caml_stat_wcsconcat @@ -237,6 +309,9 @@ extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); #define strcmp_os strcmp #define strlen_os strlen #define sscanf_os sscanf +#define strcpy_os strcpy +#define mktemp_os mktemp +#define fopen_os fopen #define caml_stat_strdup_os caml_stat_strdup #define caml_stat_strconcat_os caml_stat_strconcat @@ -299,6 +374,7 @@ int caml_runtime_warnings_active(void); 01 -> fields of free list blocks in major heap 03 -> heap chunks deallocated by heap shrinking 04 -> fields deallocated by [caml_obj_truncate] + 05 -> unused child pointers in large free blocks 10 -> uninitialised fields of minor objects 11 -> uninitialised fields of major objects 15 -> uninitialised words of [caml_stat_alloc_aligned] blocks @@ -312,6 +388,7 @@ int caml_runtime_warnings_active(void); #define Debug_free_major Debug_tag (0x01) #define Debug_free_shrink Debug_tag (0x03) #define Debug_free_truncate Debug_tag (0x04) +#define Debug_free_unused Debug_tag (0x05) #define Debug_uninit_minor Debug_tag (0x10) #define Debug_uninit_major Debug_tag (0x11) #define Debug_uninit_align Debug_tag (0x15) @@ -340,7 +417,6 @@ extern int caml_snprintf(char * buf, size_t size, const char * format, ...); #include #include -extern intnat caml_stat_minor_collections; extern intnat caml_instr_starttime, caml_instr_stoptime; struct caml_instr_block { @@ -358,15 +434,15 @@ extern struct caml_instr_block *caml_instr_log; /* Allocate the data block for a given name. [t] must have been declared with [CAML_INSTR_DECLARE]. */ -#define CAML_INSTR_ALLOC(t) do{ \ - if (caml_stat_minor_collections >= caml_instr_starttime \ - && caml_stat_minor_collections < caml_instr_stoptime){ \ - t = caml_stat_alloc_noexc (sizeof (struct caml_instr_block)); \ - t->index = 0; \ - t->tag[0] = ""; \ - t->next = caml_instr_log; \ - caml_instr_log = t; \ - } \ +#define CAML_INSTR_ALLOC(t) do{ \ + if (Caml_state_field(stat_minor_collections) >= caml_instr_starttime \ + && Caml_state_field(stat_minor_collections) < caml_instr_stoptime){ \ + t = caml_stat_alloc_noexc (sizeof (struct caml_instr_block)); \ + t->index = 0; \ + t->tag[0] = ""; \ + t->next = caml_instr_log; \ + caml_instr_log = t; \ + } \ }while(0) /* Allocate the data block and start the timer. @@ -432,8 +508,43 @@ extern void caml_instr_atexit (void); #endif /* CAML_INSTR */ +/* Macro used to deactivate thread and address sanitizers on some + functions. */ +#define CAMLno_tsan +#define CAMLno_asan +#if defined(__has_feature) +# if __has_feature(thread_sanitizer) +# undef CAMLno_tsan +# define CAMLno_tsan __attribute__((no_sanitize("thread"))) +# endif +# if __has_feature(address_sanitizer) +# undef CAMLno_asan +# define CAMLno_asan __attribute__((no_sanitize("address"))) +# endif +#endif + +/* A table of all code fragments (main program and dynlinked modules) */ +struct code_fragment { + char *code_start; + char *code_end; + unsigned char digest[16]; + char digest_computed; +}; + +extern struct ext_table caml_code_fragments_table; + +int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf); + #endif /* CAML_INTERNALS */ +/* The [backtrace_slot] type represents values stored in + * [Caml_state->backtrace_buffer]. In bytecode, it is the same as a + * [code_t], in native code it as a [frame_descr *]. The difference + * doesn't matter for code outside [backtrace_{byt,nat}.c], + * so it is just exposed as a [void *]. + */ +typedef void * backtrace_slot; + #ifdef __cplusplus } #endif diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h index c84c2c4c..780c014e 100644 --- a/runtime/caml/mlvalues.h +++ b/runtime/caml/mlvalues.h @@ -64,6 +64,8 @@ typedef unsigned int tag_t; /* Actually, an unsigned char */ typedef uintnat color_t; typedef uintnat mark_t; +#include "domain_state.h" + /* Longs vs blocks. */ #define Is_long(x) (((x) & 1) != 0) #define Is_block(x) (((x) & 1) == 0) @@ -79,6 +81,13 @@ typedef uintnat mark_t; #define Unsigned_long_val(x) ((uintnat)(x) >> 1) #define Unsigned_int_val(x) ((int) Unsigned_long_val(x)) +/* Encoded exceptional return values, when functions are suffixed with + _exn. Encoded exceptions are invalid values and must not be seen + by the garbage collector. */ +#define Make_exception_result(v) ((v) | 2) +#define Is_exception_result(v) (((v) & 3) == 2) +#define Extract_exception(v) ((v) & ~3) + /* Structure of the header: For 16-bit and 32-bit architectures: diff --git a/runtime/caml/roots.h b/runtime/caml/roots.h index fed345d3..755aa8a7 100644 --- a/runtime/caml/roots.h +++ b/runtime/caml/roots.h @@ -32,9 +32,9 @@ extern uintnat caml_incremental_roots_count; CAMLextern void caml_do_local_roots (scanning_action, value *, value *, struct caml__roots_block *); #else -CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack, - uintnat last_retaddr, value * gc_regs, - struct caml__roots_block * local_roots); +CAMLextern void caml_do_local_roots(scanning_action f, char * c_bottom_of_stack, + uintnat last_retaddr, value * v_gc_regs, + struct caml__roots_block * gc_local_roots); #endif CAMLextern void (*caml_scan_roots_hook) (scanning_action); diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in index 2e7db516..b618309d 100644 --- a/runtime/caml/s.h.in +++ b/runtime/caml/s.h.in @@ -243,6 +243,9 @@ #undef HAS_EXECVPE +#undef HAS_FFS +#undef HAS_BITSCANFORWARD + #undef HAS_STACK_OVERFLOW_DETECTION #undef HAS_SIGWAIT diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h index 46e65dd2..7ec1ad3b 100644 --- a/runtime/caml/signals.h +++ b/runtime/caml/signals.h @@ -30,35 +30,68 @@ extern "C" { #endif +CAMLextern void caml_enter_blocking_section (void); +CAMLextern void caml_leave_blocking_section (void); + +CAMLextern void caml_process_pending_actions (void); +/* Checks for pending actions and executes them. This includes pending + minor and major collections, signal handlers, finalisers, and + Memprof callbacks. Assumes that the runtime lock is held. Can raise + exceptions asynchronously into OCaml code. */ + +CAMLextern value caml_process_pending_actions_exn (void); +/* Same as [caml_process_pending_actions], but returns the exception + if any (otherwise returns [Val_unit]). */ + #ifdef CAML_INTERNALS -CAMLextern intnat volatile caml_signals_are_pending; CAMLextern intnat volatile caml_pending_signals[]; + +/* When an action is pending, either [caml_something_to_do] is 1, or + there is a function currently running which will end by either + executing all actions, or set [caml_something_to_do] back to 1. We + set it to 0 when starting executing all callbacks. + + In the case there are two different callbacks (say, a signal and a + finaliser) arriving at the same time, then the processing of one + awaits the return of the other. In case of long-running callbacks, + we may want to run the second one without waiting the end of the + first one. We do this by provoking an additional polling every + minor collection and every major slice. To guarantee a low latency + for signals, we avoid delaying signal handlers in that case by + calling them first. + + FIXME: We could get into caml_process_pending_actions when + caml_something_to_do is seen as set but not caml_pending_signals, + making us miss the signal. +*/ CAMLextern int volatile caml_something_to_do; -extern int volatile caml_requested_major_slice; -extern int volatile caml_requested_minor_gc; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_requested_major_slice (Caml_state_field(requested_major_slice)) +#define caml_requested_minor_gc (Caml_state_field(requested_minor_gc)) + +void caml_update_young_limit(void); void caml_request_major_slice (void); void caml_request_minor_gc (void); CAMLextern int caml_convert_signal_number (int); CAMLextern int caml_rev_convert_signal_number (int); -void caml_execute_signal(int signal_number, int in_signal_handler); +value caml_execute_signal_exn(int signal_number, int in_signal_handler); void caml_record_signal(int signal_number); -void caml_process_pending_signals(void); -void caml_process_event(void); +value caml_process_pending_signals_exn(void); +void caml_set_action_pending (void); +value caml_do_pending_actions_exn (void); +value caml_process_pending_actions_with_root (value extra_root); // raises int caml_set_signal_action(int signo, int action); +void caml_setup_stack_overflow_detection(void); CAMLextern void (*caml_enter_blocking_section_hook)(void); CAMLextern void (*caml_leave_blocking_section_hook)(void); CAMLextern int (*caml_try_leave_blocking_section_hook)(void); -CAMLextern void (* volatile caml_async_action_hook)(void); #ifdef POSIX_SIGNALS CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *); #endif #endif /* CAML_INTERNALS */ -CAMLextern void caml_enter_blocking_section (void); -CAMLextern void caml_leave_blocking_section (void); - #ifdef __cplusplus } #endif diff --git a/runtime/caml/stack.h b/runtime/caml/stack.h index 0c4aab15..259f97ac 100644 --- a/runtime/caml/stack.h +++ b/runtime/caml/stack.h @@ -107,16 +107,18 @@ extern uintnat caml_stack_usage (void); extern uintnat (*caml_stack_usage_hook)(void); /* Declaration of variables used in the asm code */ -extern char * caml_top_of_stack; -extern char * caml_bottom_of_stack; -extern uintnat caml_last_return_address; -extern value * caml_gc_regs; -extern char * caml_exception_pointer; extern value * caml_globals[]; extern char caml_globals_map[]; extern intnat caml_globals_inited; extern intnat * caml_frametable[]; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_top_of_stack (Caml_state_field(top_of_stack)) +#define caml_bottom_of_stack (Caml_state_field(bottom_of_stack)) +#define caml_last_return_address (Caml_state_field(last_return_address)) +#define caml_gc_regs (Caml_state_field(gc_regs)) +#define caml_exception_pointer (Caml_state_field(exception_pointer)) + CAMLextern frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp); #endif /* CAML_INTERNALS */ diff --git a/runtime/caml/stacks.h b/runtime/caml/stacks.h index 18ec0ac3..8cbb02a8 100644 --- a/runtime/caml/stacks.h +++ b/runtime/caml/stacks.h @@ -24,12 +24,13 @@ #include "mlvalues.h" #include "memory.h" -CAMLextern value * caml_stack_low; -CAMLextern value * caml_stack_high; -CAMLextern value * caml_stack_threshold; -CAMLextern value * caml_extern_sp; -CAMLextern value * caml_trapsp; -CAMLextern value * caml_trap_barrier; +/* Global variables moved to Caml_state in 4.10 */ +#define caml_stack_low (Caml_state_field(stack_low)) +#define caml_stack_high (Caml_state_field(stack_high)) +#define caml_stack_threshold (Caml_state_field(stack_threshold)) +#define caml_extern_sp (Caml_state_field(extern_sp)) +#define caml_trapsp (Caml_state_field(trapsp)) +#define caml_trap_barrier (Caml_state_field(trap_barrier)) #define Trap_pc(tp) (((code_t *)(tp))[0]) #define Trap_link(tp) (((value **)(tp))[1]) diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h index ab514fdb..a6259764 100644 --- a/runtime/caml/weak.h +++ b/runtime/caml/weak.h @@ -19,6 +19,7 @@ #define CAML_WEAK_H #include "mlvalues.h" +#include "memory.h" #ifdef __cplusplus extern "C" { @@ -183,7 +184,7 @@ static inline void caml_ephe_clean (value v){ }else{ Field (v, i) = child = f; if (Is_block (f) && Is_young (f)) - add_to_ephe_ref_table(&caml_ephe_ref_table, v, i); + add_to_ephe_ref_table(Caml_state_field(ephe_ref_table), v, i); goto ephemeron_again; } } diff --git a/runtime/compact.c b/runtime/compact.c index 0f40035a..75c973fa 100644 --- a/runtime/compact.c +++ b/runtime/compact.c @@ -158,7 +158,7 @@ static char *compact_allocate (mlsize_t size) return adr; } -static void do_compaction (void) +static void do_compaction (intnat new_allocation_policy) { char *ch, *chend; CAMLassert (caml_gc_phase == Phase_idle); @@ -405,9 +405,14 @@ static void do_compaction (void) } } - /* Rebuild the free list. */ + /* Rebuild the free list. This is the right time for a change of + allocation policy, since we are rebuilding the allocator's data + structures from scratch. */ { ch = caml_heap_start; + if (new_allocation_policy != -1){ + caml_set_allocation_policy (new_allocation_policy); + } caml_fl_reset (); while (ch != NULL){ if (Chunk_size (ch) > Chunk_alloc (ch)){ @@ -418,23 +423,26 @@ static void do_compaction (void) ch = Chunk_next (ch); } } - ++ caml_stat_compactions; + ++ Caml_state->stat_compactions; caml_gc_message (0x10, "done.\n"); } uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */ -void caml_compact_heap (void) +void caml_compact_heap (intnat new_allocation_policy) { uintnat target_wsz, live; CAML_INSTR_SETUP(tmr, "compact"); - CAMLassert (caml_young_ptr == caml_young_alloc_end); - CAMLassert (caml_ref_table.ptr == caml_ref_table.base); - CAMLassert (caml_ephe_ref_table.ptr == caml_ephe_ref_table.base); - CAMLassert (caml_custom_table.ptr == caml_custom_table.base); + CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end); + CAMLassert (Caml_state->ref_table->ptr == + Caml_state->ref_table->base); + CAMLassert (Caml_state->ephe_ref_table->ptr == + Caml_state->ephe_ref_table->base); + CAMLassert (Caml_state->custom_table->ptr == + Caml_state->custom_table->base); - do_compaction (); + do_compaction (new_allocation_policy); CAML_INSTR_TIME (tmr, "compact/main"); /* Compaction may fail to shrink the heap to a reasonable size because it deals in complete chunks: if a very large chunk @@ -461,18 +469,18 @@ void caml_compact_heap (void) We recompact if target_wsz < heap_size / 2 */ - live = caml_stat_heap_wsz - caml_fl_cur_wsz; + live = Caml_state->stat_heap_wsz - caml_fl_cur_wsz; target_wsz = live + caml_percent_free * (live / 100 + 1) + Wsize_bsize (Page_size); target_wsz = caml_clip_heap_chunk_wsz (target_wsz); #ifdef HAS_HUGE_PAGES if (caml_use_huge_pages - && Bsize_wsize (caml_stat_heap_wsz) <= HUGE_PAGE_SIZE) + && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE) return; #endif - if (target_wsz < caml_stat_heap_wsz / 2){ + if (target_wsz < Caml_state->stat_heap_wsz / 2){ /* Recompact. */ char *chunk; @@ -492,15 +500,15 @@ void caml_compact_heap (void) } Chunk_next (chunk) = caml_heap_start; caml_heap_start = chunk; - ++ caml_stat_heap_chunks; - caml_stat_heap_wsz += Wsize_bsize (Chunk_size (chunk)); - if (caml_stat_heap_wsz > caml_stat_top_heap_wsz){ - caml_stat_top_heap_wsz = caml_stat_heap_wsz; + ++ Caml_state->stat_heap_chunks; + Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (chunk)); + if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){ + Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz; } - do_compaction (); - CAMLassert (caml_stat_heap_chunks == 1); + do_compaction (-1); + CAMLassert (Caml_state->stat_heap_chunks == 1); CAMLassert (Chunk_next (caml_heap_start) == NULL); - CAMLassert (caml_stat_heap_wsz == Wsize_bsize (Chunk_size (chunk))); + CAMLassert (Caml_state->stat_heap_wsz == Wsize_bsize (Chunk_size (chunk))); CAML_INSTR_TIME (tmr, "compact/recompact"); } } @@ -511,29 +519,29 @@ void caml_compact_heap_maybe (void) FW = fl_size_at_phase_change + 3 * (caml_fl_cur_wsz - caml_fl_wsz_at_phase_change) FW = 3 * caml_fl_cur_wsz - 2 * caml_fl_wsz_at_phase_change - Estimated live words: LW = caml_stat_heap_wsz - FW + Estimated live words: LW = Caml_state->stat_heap_wsz - FW Estimated free percentage: FP = 100 * FW / LW We compact the heap if FP > caml_percent_max */ double fw, fp; CAMLassert (caml_gc_phase == Phase_idle); if (caml_percent_max >= 1000000) return; - if (caml_stat_major_collections < 3) return; - if (caml_stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return; + if (Caml_state->stat_major_collections < 3) return; + if (Caml_state->stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return; #ifdef HAS_HUGE_PAGES if (caml_use_huge_pages - && Bsize_wsize (caml_stat_heap_wsz) <= HUGE_PAGE_SIZE) + && Bsize_wsize (Caml_state->stat_heap_wsz) <= HUGE_PAGE_SIZE) return; #endif fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change; if (fw < 0) fw = caml_fl_cur_wsz; - if (fw >= caml_stat_heap_wsz){ + if (fw >= Caml_state->stat_heap_wsz){ fp = 1000000.0; }else{ - fp = 100.0 * fw / (caml_stat_heap_wsz - fw); + fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw); if (fp > 1000000.0) fp = 1000000.0; } caml_gc_message (0x200, "FL size at phase change = %" @@ -551,12 +559,12 @@ void caml_compact_heap_maybe (void) caml_finish_major_cycle (); fw = caml_fl_cur_wsz; - fp = 100.0 * fw / (caml_stat_heap_wsz - fw); + fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw); caml_gc_message (0x200, "Measured overhead: %" ARCH_INTNAT_PRINTF_FORMAT "u%%\n", (uintnat) fp); if (fp >= caml_percent_max) - caml_compact_heap (); + caml_compact_heap (-1); else caml_gc_message (0x200, "Automatic compaction aborted.\n"); diff --git a/runtime/compare.c b/runtime/compare.c index fd7ed763..974e0c01 100644 --- a/runtime/compare.c +++ b/runtime/compare.c @@ -30,7 +30,6 @@ struct compare_item { value * v1, * v2; mlsize_t count; }; #define COMPARE_STACK_INIT_SIZE 8 #define COMPARE_STACK_MIN_ALLOC_SIZE 32 #define COMPARE_STACK_MAX_SIZE (1024*1024) -CAMLexport int caml_compare_unordered; struct compare_stack { struct compare_item init_stack[COMPARE_STACK_INIT_SIZE]; @@ -140,9 +139,9 @@ static intnat do_compare_val(struct compare_stack* stk, int res; int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext; if (compare == NULL) break; /* for backward compatibility */ - caml_compare_unordered = 0; + Caml_state->compare_unordered = 0; res = compare(v1, v2); - if (caml_compare_unordered && !total) return UNORDERED; + if (Caml_state->compare_unordered && !total) return UNORDERED; if (res != 0) return res; goto next_item; } @@ -163,9 +162,9 @@ static intnat do_compare_val(struct compare_stack* stk, int res; int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext; if (compare == NULL) break; /* for backward compatibility */ - caml_compare_unordered = 0; + Caml_state->compare_unordered = 0; res = compare(v1, v2); - if (caml_compare_unordered && !total) return UNORDERED; + if (Caml_state->compare_unordered && !total) return UNORDERED; if (res != 0) return res; goto next_item; } @@ -261,9 +260,9 @@ static intnat do_compare_val(struct compare_stack* stk, compare_free_stack(stk); caml_invalid_argument("compare: abstract value"); } - caml_compare_unordered = 0; + Caml_state->compare_unordered = 0; res = compare(v1, v2); - if (caml_compare_unordered && !total) return UNORDERED; + if (Caml_state->compare_unordered && !total) return UNORDERED; if (res != 0) return res; break; } diff --git a/runtime/custom.c b/runtime/custom.c index da755b35..8568b587 100644 --- a/runtime/custom.c +++ b/runtime/custom.c @@ -54,24 +54,23 @@ static value alloc_custom_gen (struct custom_operations * ops, } /* The remaining [mem_minor] will be counted if the block survives a minor GC */ - add_to_custom_table (&caml_custom_table, result, mem_minor, max_major); + add_to_custom_table (Caml_state->custom_table, result, + mem_minor, max_major); /* Keep track of extra resources held by custom block in minor heap. */ if (mem_minor != 0) { if (max_minor == 0) max_minor = 1; - caml_extra_heap_resources_minor += + Caml_state->extra_heap_resources_minor += (double) mem_minor / (double) max_minor; - if (caml_extra_heap_resources_minor > 1.0) { - caml_request_minor_gc (); - caml_gc_dispatch (); - } + if (Caml_state->extra_heap_resources_minor > 1.0) + caml_minor_collection (); } } } else { result = caml_alloc_shr(wosize, Custom_tag); Custom_ops_val(result) = ops; caml_adjust_gc_speed(mem, max_major); - result = caml_check_urgent_gc(result); + caml_check_urgent_gc(Val_unit); } CAMLreturn(result); } @@ -100,9 +99,9 @@ CAMLexport value caml_alloc_custom_mem(struct custom_operations * ops, the major GC takes 1.5 cycles (previous cycle + marking phase) before it starts to deallocate dead blocks allocated during the previous cycle. [heap_size / 150] is really [heap_size * (2/3) / 100] (but faster). */ - Bsize_wsize (caml_stat_heap_wsz) / 150 * caml_custom_major_ratio; + Bsize_wsize (Caml_state->stat_heap_wsz) / 150 * caml_custom_major_ratio; mlsize_t max_minor = - Bsize_wsize (caml_minor_heap_wsz) / 100 * caml_custom_minor_ratio; + Bsize_wsize (Caml_state->minor_heap_wsz) / 100 * caml_custom_minor_ratio; return alloc_custom_gen (ops, bsz, mem, max_major, mem_minor, max_minor); } diff --git a/runtime/debugger.c b/runtime/debugger.c index f77cf1eb..6b471c1e 100644 --- a/runtime/debugger.c +++ b/runtime/debugger.c @@ -39,7 +39,7 @@ void caml_debugger_init(void) { } -void caml_debugger(enum event_kind event) +void caml_debugger(enum event_kind event, value param) { } @@ -95,6 +95,8 @@ static struct channel * dbg_out;/* Output channel on the socket */ static char *dbg_addr = NULL; +static struct ext_table breakpoints_table; + static void open_connection(void) { #ifdef _WIN32 @@ -186,6 +188,8 @@ void caml_debugger_init(void) if (dbg_addr != NULL) caml_stat_free(dbg_addr); dbg_addr = address; + caml_ext_table_init(&breakpoints_table, 16); + #ifdef _WIN32 winsock_startup(); (void)atexit(winsock_cleanup); @@ -227,14 +231,15 @@ void caml_debugger_init(void) host = gethostbyname(address); if (host == NULL) caml_fatal_error("unknown debugging host %s", address); - memmove(&sock_addr.s_inet.sin_addr, host->h_addr, host->h_length); + memmove(&sock_addr.s_inet.sin_addr, + host->h_addr_list[0], host->h_length); } sock_addr.s_inet.sin_port = htons(atoi(port)); sock_addr_len = sizeof(sock_addr.s_inet); } open_connection(); caml_debugger_in_use = 1; - caml_trap_barrier = caml_stack_high; + Caml_state->trap_barrier = Caml_state->stack_high; } static value getval(struct channel *chan) @@ -255,15 +260,109 @@ static void safe_output_value(struct channel *chan, value val) struct longjmp_buffer raise_buf, * saved_external_raise; /* Catch exceptions raised by [caml_output_val] */ - saved_external_raise = caml_external_raise; + saved_external_raise = Caml_state->external_raise; if (sigsetjmp(raise_buf.buf, 0) == 0) { - caml_external_raise = &raise_buf; + Caml_state->external_raise = &raise_buf; caml_output_val(chan, val, marshal_flags); } else { /* Send wrong magic number, will cause [caml_input_value] to fail */ caml_really_putblock(chan, "\000\000\000\000", 4); } - caml_external_raise = saved_external_raise; + Caml_state->external_raise = saved_external_raise; +} + +struct breakpoint { + code_t pc; + opcode_t saved; +}; + +static struct breakpoint *find_breakpoint(code_t pc) +{ + struct breakpoint *bpti; + int i; + + for (i = 0; i < breakpoints_table.size; i++) { + bpti = (struct breakpoint *) breakpoints_table.contents[i]; + if (bpti->pc == pc) + return bpti; + } + + return NULL; +} + +static void save_instruction(code_t pc) +{ + struct breakpoint *bpt; + + if (find_breakpoint(pc) != NULL) { + /* Already saved. Nothing to do. */ + return; + } + + bpt = caml_stat_alloc(sizeof(struct breakpoint)); + bpt->pc = pc; + bpt->saved = *pc; + caml_ext_table_add(&breakpoints_table, bpt); +} + +static void set_instruction(code_t pc, opcode_t opcode) +{ + save_instruction(pc); + caml_set_instruction(pc, opcode); +} + +static void restore_instruction(code_t pc) +{ + struct breakpoint *bpt = find_breakpoint(pc); + CAMLassert (bpt != NULL); + + *pc = bpt->saved; + caml_ext_table_remove(&breakpoints_table, bpt); +} + +static code_t pc_from_pos(int frag, intnat pos) +{ + struct code_fragment *cf; + CAMLassert (frag >= 0); + CAMLassert (frag < caml_code_fragments_table.size); + CAMLassert (pos >= 0); + CAMLassert (pos < caml_code_size); + + cf = (struct code_fragment *) caml_code_fragments_table.contents[frag]; + return (code_t) (cf->code_start + pos); +} + +opcode_t caml_debugger_saved_instruction(code_t pc) +{ + struct breakpoint *bpt = find_breakpoint(pc); + CAMLassert (bpt != NULL); + + return bpt->saved; +} + +void caml_debugger_code_unloaded(int index) +{ + struct code_fragment *cf; + struct breakpoint *bpti; + int i; + + if (!caml_debugger_in_use) return; + + caml_putch(dbg_out, REP_CODE_UNLOADED); + caml_putword(dbg_out, index); + + cf = (struct code_fragment *) caml_code_fragments_table.contents[index]; + + for (i = 0; i < breakpoints_table.size; i++) { + bpti = (struct breakpoint *) breakpoints_table.contents[i]; + if ((char*) bpti->pc >= cf->code_start && (char*) bpti->pc < cf->code_end) { + caml_ext_table_remove(&breakpoints_table, bpti); + /* caml_ext_table_remove has shifted the next element in place + of the one we just removed. Decrement i for the next + iteration. */ + i--; + } + } } #define Pc(sp) ((code_t)((sp)[0])) @@ -271,44 +370,69 @@ static void safe_output_value(struct channel *chan, value val) #define Extra_args(sp) (Long_val(((sp)[2]))) #define Locals(sp) ((sp) + 3) -void caml_debugger(enum event_kind event) +void caml_debugger(enum event_kind event, value param) { - value * frame; + value *frame, *newframe; intnat i, pos; value val; + int frag, found = 0; + struct code_fragment *cf; + (void) found; /* Silence unused variable warning. */ if (dbg_socket == -1) return; /* Not connected to a debugger. */ /* Reset current frame */ - frame = caml_extern_sp + 1; + frame = Caml_state->extern_sp + 1; /* Report the event to the debugger */ switch(event) { case PROGRAM_START: /* Nothing to report */ + CAMLassert (param == Val_unit); goto command_loop; case EVENT_COUNT: + CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_EVENT); break; case BREAKPOINT: + CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_BREAKPOINT); break; case PROGRAM_EXIT: + CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_EXITED); break; case TRAP_BARRIER: + CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_TRAP); break; case UNCAUGHT_EXC: + CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_UNCAUGHT_EXC); break; + case DEBUG_INFO_ADDED: + caml_putch(dbg_out, REP_CODE_DEBUG_INFO); + caml_output_val(dbg_out, /* debug_info */ param, Val_emptylist); + break; + case CODE_LOADED: + caml_putch(dbg_out, REP_CODE_LOADED); + caml_putword(dbg_out, /* index */ Long_val(param)); + break; + case CODE_UNLOADED: + caml_putch(dbg_out, REP_CODE_UNLOADED); + caml_putword(dbg_out, /* index */ Long_val(param)); + break; } caml_putword(dbg_out, caml_event_count); if (event == EVENT_COUNT || event == BREAKPOINT) { - caml_putword(dbg_out, caml_stack_high - frame); - caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t)); + caml_putword(dbg_out, Caml_state->stack_high - frame); + found = caml_find_code_fragment((char*) Pc(frame), &frag, &cf); + CAMLassert(found); + caml_putword(dbg_out, frag); + caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); } else { /* No PC and no stack frame associated with other events */ caml_putword(dbg_out, 0); + caml_putword(dbg_out, -1); caml_putword(dbg_out, 0); } caml_flush(dbg_out); @@ -319,23 +443,19 @@ void caml_debugger(enum event_kind event) while(1) { switch(caml_getch(dbg_in)) { case REQ_SET_EVENT: + frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); - CAMLassert (pos >= 0); - CAMLassert (pos < caml_code_size); - caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), EVENT); + set_instruction(pc_from_pos(frag, pos), EVENT); break; case REQ_SET_BREAKPOINT: + frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); - CAMLassert (pos >= 0); - CAMLassert (pos < caml_code_size); - caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), BREAK); + set_instruction(pc_from_pos(frag, pos), BREAK); break; case REQ_RESET_INSTR: + frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); - CAMLassert (pos >= 0); - CAMLassert (pos < caml_code_size); - pos = pos / sizeof(opcode_t); - caml_set_instruction(caml_start_code + pos, caml_saved_code[pos]); + restore_instruction(pc_from_pos(frag, pos)); break; case REQ_CHECKPOINT: #ifndef _WIN32 @@ -349,7 +469,6 @@ void caml_debugger(enum event_kind event) } #else caml_fatal_error("REQ_CHECKPOINT command"); - exit(-1); #endif break; case REQ_GO: @@ -363,39 +482,44 @@ void caml_debugger(enum event_kind event) wait(NULL); #else caml_fatal_error("REQ_WAIT command"); - exit(-1); #endif break; case REQ_INITIAL_FRAME: - frame = caml_extern_sp + 1; + frame = Caml_state->extern_sp + 1; /* Fall through */ case REQ_GET_FRAME: - caml_putword(dbg_out, caml_stack_high - frame); - if (frame < caml_stack_high){ - caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t)); - }else{ - caml_putword (dbg_out, 0); + caml_putword(dbg_out, Caml_state->stack_high - frame); + if (frame < Caml_state->stack_high && + caml_find_code_fragment((char*) Pc(frame), &frag, &cf)) { + caml_putword(dbg_out, frag); + caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); + } else { + caml_putword(dbg_out, 0); + caml_putword(dbg_out, 0); } caml_flush(dbg_out); break; case REQ_SET_FRAME: i = caml_getword(dbg_in); - frame = caml_stack_high - i; + frame = Caml_state->stack_high - i; break; case REQ_UP_FRAME: i = caml_getword(dbg_in); - if (frame + Extra_args(frame) + i + 3 >= caml_stack_high) { + newframe = frame + Extra_args(frame) + i + 3; + if (newframe >= Caml_state->stack_high || + !caml_find_code_fragment((char*) Pc(newframe), &frag, &cf)) { caml_putword(dbg_out, -1); } else { - frame += Extra_args(frame) + i + 3; - caml_putword(dbg_out, caml_stack_high - frame); - caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t)); + frame = newframe; + caml_putword(dbg_out, Caml_state->stack_high - frame); + caml_putword(dbg_out, frag); + caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); } caml_flush(dbg_out); break; case REQ_SET_TRAP_BARRIER: i = caml_getword(dbg_in); - caml_trap_barrier = caml_stack_high - i; + Caml_state->trap_barrier = Caml_state->stack_high - i; break; case REQ_GET_LOCAL: i = caml_getword(dbg_in); @@ -413,7 +537,7 @@ void caml_debugger(enum event_kind event) caml_flush(dbg_out); break; case REQ_GET_ACCU: - putval(dbg_out, *caml_extern_sp); + putval(dbg_out, *Caml_state->extern_sp); caml_flush(dbg_out); break; case REQ_GET_HEADER: @@ -441,7 +565,10 @@ void caml_debugger(enum event_kind event) break; case REQ_GET_CLOSURE_CODE: val = getval(dbg_in); - caml_putword(dbg_out, (Code_val(val)-caml_start_code) * sizeof(opcode_t)); + found = caml_find_code_fragment((char*) Code_val(val), &frag, &cf); + CAMLassert(found); + caml_putword(dbg_out, frag); + caml_putword(dbg_out, (char*) Code_val(val) - cf->code_start); caml_flush(dbg_out); break; case REQ_SET_FORK_MODE: diff --git a/runtime/domain.c b/runtime/domain.c new file mode 100644 index 00000000..f1bc08e3 --- /dev/null +++ b/runtime/domain.c @@ -0,0 +1,83 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS + +#include "caml/domain_state.h" +#include "caml/memory.h" + +CAMLexport caml_domain_state* Caml_state; + +void caml_init_domain () +{ + if (Caml_state != NULL) + return; + + Caml_state = + (caml_domain_state*)caml_stat_alloc_noexc(sizeof(caml_domain_state)); + if (Caml_state == NULL) + caml_fatal_error ("cannot initialize domain state"); + + Caml_state->young_limit = NULL; + Caml_state->exception_pointer = NULL; + + Caml_state->young_ptr = NULL; + Caml_state->young_base = NULL; + Caml_state->young_start = NULL; + Caml_state->young_end = NULL; + Caml_state->young_alloc_start = NULL; + Caml_state->young_alloc_mid = NULL; + Caml_state->young_alloc_end = NULL; + Caml_state->young_trigger = NULL; + Caml_state->minor_heap_wsz = 0; + Caml_state->in_minor_collection = 0; + Caml_state->extra_heap_resources_minor = 0; + caml_alloc_minor_tables(); + + Caml_state->stack_low = NULL; + Caml_state->stack_high = NULL; + Caml_state->stack_threshold = NULL; + Caml_state->extern_sp = NULL; + Caml_state->trapsp = NULL; + Caml_state->trap_barrier = NULL; + Caml_state->external_raise = NULL; + Caml_state->exn_bucket = Val_unit; + + Caml_state->top_of_stack = NULL; + Caml_state->bottom_of_stack = NULL; /* no stack initially */ + Caml_state->last_return_address = 1; /* not in OCaml code initially */ + Caml_state->gc_regs = NULL; + + Caml_state->stat_minor_words = 0.0; + Caml_state->stat_promoted_words = 0.0; + Caml_state->stat_major_words = 0.0; + Caml_state->stat_minor_collections = 0; + Caml_state->stat_major_collections = 0; + Caml_state->stat_heap_wsz = 0; + Caml_state->stat_top_heap_wsz = 0; + Caml_state->stat_compactions = 0; + Caml_state->stat_heap_chunks = 0; + + Caml_state->backtrace_active = 0; + Caml_state->backtrace_pos = 0; + Caml_state->backtrace_buffer = NULL; + Caml_state->backtrace_last_exn = Val_unit; + + Caml_state->compare_unordered = 0; + Caml_state->local_roots = NULL; + Caml_state->requested_major_slice = 0; + Caml_state->requested_minor_gc = 0; +} diff --git a/runtime/dune b/runtime/dune index 8e8a116b..4b9c50af 100644 --- a/runtime/dune +++ b/runtime/dune @@ -33,7 +33,7 @@ io.c extern.c intern.c hash.c sys.c meta.c parsing.c gc_ctrl.c md5.c obj.c lexing.c callback.c debugger.c weak.c compact.c finalise.c custom.c dynlink.c spacetime_byt.c afl.c unix.c win32.c bigarray.c - main.c) + main.c memprof.c domain.c) (action (progn (bash "touch .depend") ; hack. diff --git a/runtime/extern.c b/runtime/extern.c index ac434210..5409d7b1 100644 --- a/runtime/extern.c +++ b/runtime/extern.c @@ -610,9 +610,13 @@ static void extern_rec(value v) } } } - else if ((cf = caml_extern_find_code((char *) v)) != NULL) { + else if (caml_find_code_fragment((char*) v, NULL, &cf)) { if ((extern_flags & CLOSURES) == 0) extern_invalid_argument("output_value: functional value"); + if (! cf->digest_computed) { + caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); + cf->digest_computed = 1; + } writecode32(CODE_CODEPOINTER, (char *) v - cf->code_start); writeblock((const char *)cf->digest, 16); } else { @@ -929,19 +933,3 @@ CAMLexport void caml_serialize_block_float_8(void * data, intnat len) } #endif } - -/* Find where a code pointer comes from */ - -CAMLexport struct code_fragment * caml_extern_find_code(char *addr) -{ - int i; - for (i = caml_code_fragments_table.size - 1; i >= 0; i--) { - struct code_fragment * cf = caml_code_fragments_table.contents[i]; - if (! cf->digest_computed) { - caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start); - cf->digest_computed = 1; - } - if (cf->code_start <= addr && addr < cf->code_end) return cf; - } - return NULL; -} diff --git a/runtime/fail_byt.c b/runtime/fail_byt.c index 9c8d6a45..a8acdf0e 100644 --- a/runtime/fail_byt.c +++ b/runtime/fail_byt.c @@ -20,9 +20,10 @@ #include #include #include "caml/alloc.h" +#include "caml/callback.h" #include "caml/fail.h" -#include "caml/io.h" #include "caml/gc.h" +#include "caml/io.h" #include "caml/memory.h" #include "caml/misc.h" #include "caml/mlvalues.h" @@ -30,15 +31,12 @@ #include "caml/signals.h" #include "caml/stacks.h" -CAMLexport struct longjmp_buffer * caml_external_raise = NULL; -value caml_exn_bucket; - CAMLexport void caml_raise(value v) { Unlock_exn(); - caml_exn_bucket = v; - if (caml_external_raise == NULL) caml_fatal_uncaught_exception(v); - siglongjmp(caml_external_raise->buf, 1); + Caml_state->exn_bucket = v; + if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v); + siglongjmp(Caml_state->external_raise->buf, 1); } CAMLexport void caml_raise_constant(value tag) @@ -192,6 +190,12 @@ CAMLexport void caml_raise_sys_blocked_io(void) caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO)); } +value caml_raise_if_exception(value res) +{ + if (Is_exception_result(res)) caml_raise(Extract_exception(res)); + return res; +} + int caml_is_special_exception(value exn) { /* this function is only used in caml_format_exception to produce a more readable textual representation of some exceptions. It is diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c index e1f687d3..380578ac 100644 --- a/runtime/fail_nat.c +++ b/runtime/fail_nat.c @@ -20,6 +20,7 @@ #include #include #include "caml/alloc.h" +#include "caml/domain.h" #include "caml/fail.h" #include "caml/io.h" #include "caml/gc.h" @@ -52,24 +53,28 @@ extern caml_generated_constant /* Exception raising */ CAMLnoreturn_start - extern void caml_raise_exception (value bucket) + extern void caml_raise_exception (caml_domain_state* state, value bucket) CAMLnoreturn_end; -char * caml_exception_pointer = NULL; - +/* Used by the stack overflow handler -> deactivate ASAN (see + segv_handler in signals_nat.c). */ +CAMLno_asan void caml_raise(value v) { Unlock_exn(); - if (caml_exception_pointer == NULL) caml_fatal_uncaught_exception(v); + if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v); - while (caml_local_roots != NULL && - (char *) caml_local_roots < caml_exception_pointer) { - caml_local_roots = caml_local_roots->next; + while (Caml_state->local_roots != NULL && + (char *) Caml_state->local_roots < Caml_state->exception_pointer) { + Caml_state->local_roots = Caml_state->local_roots->next; } - caml_raise_exception(v); + caml_raise_exception(Caml_state, v); } +/* Used by the stack overflow handler -> deactivate ASAN (see + segv_handler in signals_nat.c). */ +CAMLno_asan void caml_raise_constant(value tag) { caml_raise(tag); @@ -135,6 +140,9 @@ void caml_raise_out_of_memory(void) caml_raise_constant((value) caml_exn_Out_of_memory); } +/* Used by the stack overflow handler -> deactivate ASAN (see + segv_handler in signals_nat.c). */ +CAMLno_asan void caml_raise_stack_overflow(void) { caml_raise_constant((value) caml_exn_Stack_overflow); @@ -165,6 +173,12 @@ void caml_raise_sys_blocked_io(void) caml_raise_constant((value) caml_exn_Sys_blocked_io); } +value caml_raise_if_exception(value res) +{ + if (Is_exception_result(res)) caml_raise(Extract_exception(res)); + return res; +} + /* We use a pre-allocated exception because we can't do a GC before the exception is raised (lack of stack descriptors for the ccall to [caml_array_bound_error]). */ diff --git a/runtime/finalise.c b/runtime/finalise.c index d34913fb..455f91ae 100644 --- a/runtime/finalise.c +++ b/runtime/finalise.c @@ -68,6 +68,7 @@ static struct to_do *to_do_tl = NULL; It is the finalising set. */ +static int running_finalisation_function = 0; /* [size] is a number of elements for the [to_do.item] array */ static void alloc_to_do (int size) @@ -80,6 +81,7 @@ static void alloc_to_do (int size) if (to_do_tl == NULL){ to_do_hd = result; to_do_tl = result; + if(!running_finalisation_function) caml_set_action_pending(); }else{ CAMLassert (to_do_tl->next == NULL); to_do_tl->next = result; @@ -161,13 +163,10 @@ void caml_final_update_clean_phase (){ generic_final_update(&finalisable_last, /* darken_value */ 0); } - -static int running_finalisation_function = 0; - /* Call the finalisation functions for the finalising set. Note that this function must be reentrant. */ -void caml_final_do_calls (void) +value caml_final_do_calls_exn (void) { struct final f; value res; @@ -175,8 +174,7 @@ void caml_final_do_calls (void) void* saved_spacetime_trie_node_ptr; #endif - if (running_finalisation_function) return; - if (to_do_hd != NULL){ + if (!running_finalisation_function && to_do_hd != NULL){ if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) (); caml_gc_message (0x80, "Calling finalisation functions.\n"); while (1){ @@ -203,11 +201,12 @@ void caml_final_do_calls (void) caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr; #endif running_finalisation_function = 0; - if (Is_exception_result (res)) caml_raise (Extract_exception (res)); + if (Is_exception_result (res)) return res; } caml_gc_message (0x80, "Done calling finalisation functions.\n"); if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) (); } + return Val_unit; } /* Call a scanning_action [f] on [x]. */ @@ -420,10 +419,12 @@ CAMLprim value caml_final_register_called_without_value (value f, value v){ return Val_unit; } - CAMLprim value caml_final_release (value unit) { running_finalisation_function = 0; + /* Some finalisers might be waiting. */ + if (to_do_tl != NULL) + caml_set_action_pending(); return Val_unit; } diff --git a/runtime/fix_code.c b/runtime/fix_code.c index e55ac5c5..3cfcac49 100644 --- a/runtime/fix_code.c +++ b/runtime/fix_code.c @@ -37,7 +37,6 @@ code_t caml_start_code; asize_t caml_code_size; -unsigned char * caml_saved_code; struct ext_table caml_code_fragments_table; /* Read the main bytecode block from a file */ @@ -56,8 +55,6 @@ void caml_init_code_fragments(void) { void caml_load_code(int fd, asize_t len) { - int i; - caml_code_size = len; caml_start_code = (code_t) caml_stat_alloc(caml_code_size); if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size) @@ -67,15 +64,7 @@ void caml_load_code(int fd, asize_t len) #ifdef ARCH_BIG_ENDIAN caml_fixup_endianness(caml_start_code, caml_code_size); #endif - if (caml_debugger_in_use) { - len /= sizeof(opcode_t); - caml_saved_code = (unsigned char *) caml_stat_alloc(len); - for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i]; - } #ifdef THREADED_CODE - /* Better to thread now than at the beginning of [caml_interprete], - since the debugger interface needs to perform SET_EVENT requests - on the code. */ caml_thread_code(caml_start_code, caml_code_size); #endif } diff --git a/runtime/freelist.c b/runtime/freelist.c index fbd23324..19c35590 100644 --- a/runtime/freelist.c +++ b/runtime/freelist.c @@ -23,6 +23,7 @@ #include #include "caml/config.h" +#include "caml/custom.h" #include "caml/freelist.h" #include "caml/gc.h" #include "caml/gc_ctrl.h" @@ -31,15 +32,72 @@ #include "caml/misc.h" #include "caml/mlvalues.h" +/*************** declarations common to all policies ******************/ + +/* A block in a small free list is a [value] (integer representing a + pointer to the first word after the block's header). The end of the + list is NULL. +*/ +#define Val_NULL ((value) NULL) + +asize_t caml_fl_cur_wsz = 0; /* Number of words in the free set, + including headers but not fragments. */ + +value caml_fl_merge = Val_NULL; /* Current insertion pointer. Managed + jointly with [sweep_slice]. */ + +/* Next in list */ +#define Next_small(v) Field ((v), 0) + +/* Next in memory order */ +static inline value Next_in_mem (value v) { + return (value) &Field ((v), Whsize_val (v)); +} + +#ifdef CAML_INSTR +static uintnat instr_size [20] = + {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; +static char *instr_name [20] = { + NULL, + "alloc01@", + "alloc02@", + "alloc03@", + "alloc04@", + "alloc05@", + "alloc06@", + "alloc07@", + "alloc08@", + "alloc09@", + "alloc10-19@", + "alloc20-29@", + "alloc30-39@", + "alloc40-49@", + "alloc50-59@", + "alloc60-69@", + "alloc70-79@", + "alloc80-89@", + "alloc90-99@", + "alloc_large@", +}; +uintnat caml_instr_alloc_jump = 0; +/* number of pointers followed to allocate from the free set */ + +#define INSTR_alloc_jump(n) (caml_instr_alloc_jump += (n)) + +#else + +#define INSTR_alloc_jump(n) ((void)0) + +#endif /*CAML_INSTR*/ + + +/********************* next-fit allocation policy *********************/ + /* The free-list is kept sorted by increasing addresses. This makes the merging of adjacent free blocks possible. - (See [caml_fl_merge_block].) + (See [nf_merge_block].) */ -/* A free list block is a [value] (integer representing a pointer to the - first word after the block's header). The end of the list is NULL. */ -#define Val_NULL ((value) NULL) - /* The sentinel can be located anywhere in memory, but it must not be adjacent to any heap object. */ static struct { @@ -47,66 +105,37 @@ static struct { header_t h; value first_field; value filler2; /* Make sure the sentinel is never adjacent to any block. */ -} sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0}; - -#define Fl_head (Val_bp (&(sentinel.first_field))) -static value fl_prev = Fl_head; /* Current allocation pointer. */ -static value fl_last = Val_NULL; /* Last block in the list. Only valid - just after [caml_fl_allocate] returns NULL. */ -value caml_fl_merge = Fl_head; /* Current insertion pointer. Managed - jointly with [sweep_slice]. */ -asize_t caml_fl_cur_wsz = 0; /* Number of words in the free list, - including headers but not fragments. */ - -#define FLP_MAX 1000 -static value flp [FLP_MAX]; -static int flp_size = 0; -static value beyond = Val_NULL; +} nf_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0}; -#define Next(b) (Field (b, 0)) +#define Nf_head (Val_bp (&(nf_sentinel.first_field))) -#define Policy_next_fit 0 -#define Policy_first_fit 1 -uintnat caml_allocation_policy = Policy_next_fit; -#define policy caml_allocation_policy +static value nf_prev = Nf_head; /* Current allocation pointer. */ +static value nf_last = Val_NULL; /* Last block in the list. Only valid + just after [nf_allocate] returns NULL. */ -#ifdef DEBUG -static void fl_check (void) +#if defined (DEBUG) || FREELIST_DEBUG +static void nf_check (void) { - value cur, prev; - int prev_found = 0, flp_found = 0, merge_found = 0; + value cur; + int prev_found = 0, merge_found = 0; uintnat size_found = 0; - int sz = 0; - prev = Fl_head; - cur = Next (prev); + cur = Next_small (Nf_head); while (cur != Val_NULL){ size_found += Whsize_bp (cur); CAMLassert (Is_in_heap (cur)); - if (cur == fl_prev) prev_found = 1; - if (policy == Policy_first_fit && Wosize_bp (cur) > sz){ - sz = Wosize_bp (cur); - if (flp_found < flp_size){ - CAMLassert (Next (flp[flp_found]) == cur); - ++ flp_found; - }else{ - CAMLassert (beyond == Val_NULL - || Bp_val (cur) >= Bp_val (Next (beyond))); - } - } + if (cur == nf_prev) prev_found = 1; if (cur == caml_fl_merge) merge_found = 1; - prev = cur; - cur = Next (prev); + cur = Next_small (cur); } - if (policy == Policy_next_fit) CAMLassert (prev_found || fl_prev == Fl_head); - if (policy == Policy_first_fit) CAMLassert (flp_found == flp_size); - CAMLassert (merge_found || caml_fl_merge == Fl_head); + CAMLassert (prev_found || nf_prev == Nf_head); + CAMLassert (merge_found || caml_fl_merge == Nf_head); CAMLassert (size_found == caml_fl_cur_wsz); } -#endif +#endif /* DEBUG || FREELIST_DEBUG */ -/* [allocate_block] is called by [caml_fl_allocate]. Given a suitable free +/* [nf_allocate_block] is called by [nf_allocate]. Given a suitable free block and the requested size, it allocates a new block from the free block. There are three cases: 0. The free block has the requested size. Detach the block from the @@ -120,78 +149,34 @@ static void fl_check (void) it is located in the high-address words of the free block, so that the linking of the free-list does not change in case 2. */ -static header_t *allocate_block (mlsize_t wh_sz, int flpi, value prev, - value cur) +static header_t *nf_allocate_block (mlsize_t wh_sz, value prev, value cur) { header_t h = Hd_bp (cur); CAMLassert (Whsize_hd (h) >= wh_sz); if (Wosize_hd (h) < wh_sz + 1){ /* Cases 0 and 1. */ caml_fl_cur_wsz -= Whsize_hd (h); - Next (prev) = Next (cur); - CAMLassert (Is_in_heap (Next (prev)) || Next (prev) == Val_NULL); + Next_small (prev) = Next_small (cur); + CAMLassert (Is_in_heap (Next_small (prev)) + || Next_small (prev) == Val_NULL); if (caml_fl_merge == cur) caml_fl_merge = prev; #ifdef DEBUG - fl_last = Val_NULL; + nf_last = Val_NULL; #endif /* In case 1, the following creates the empty block correctly. In case 0, it gives an invalid header to the block. The function - calling [caml_fl_allocate] will overwrite it. */ + calling [nf_allocate] will overwrite it. */ Hd_op (cur) = Make_header (0, 0, Caml_white); - if (policy == Policy_first_fit){ - if (flpi + 1 < flp_size && flp[flpi + 1] == cur){ - flp[flpi + 1] = prev; - }else if (flpi == flp_size - 1){ - beyond = (prev == Fl_head) ? Val_NULL : prev; - -- flp_size; - } - } }else{ /* Case 2. */ caml_fl_cur_wsz -= wh_sz; Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue); } - if (policy == Policy_next_fit) fl_prev = prev; + nf_prev = prev; return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz); } -#ifdef CAML_INSTR -static uintnat instr_size [20] = - {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}; -static char *instr_name [20] = { - NULL, - "alloc01@", - "alloc02@", - "alloc03@", - "alloc04@", - "alloc05@", - "alloc06@", - "alloc07@", - "alloc08@", - "alloc09@", - "alloc10-19@", - "alloc20-29@", - "alloc30-39@", - "alloc40-49@", - "alloc50-59@", - "alloc60-69@", - "alloc70-79@", - "alloc80-89@", - "alloc90-99@", - "alloc_large@", -}; -uintnat caml_instr_alloc_jump = 0; -/* number of pointers followed to allocate from the free list */ -#endif /*CAML_INSTR*/ - -/* [caml_fl_allocate] does not set the header of the newly allocated block. - The calling function must do it before any GC function gets called. - [caml_fl_allocate] returns a head pointer. -*/ -header_t *caml_fl_allocate (mlsize_t wo_sz) +static header_t *nf_allocate (mlsize_t wo_sz) { value cur = Val_NULL, prev; - header_t *result; - int i; - mlsize_t sz, prevsz; CAMLassert (sizeof (char *) == sizeof (value)); CAMLassert (wo_sz >= 1); #ifdef CAML_INSTR @@ -204,188 +189,37 @@ header_t *caml_fl_allocate (mlsize_t wo_sz) } #endif /* CAML_INSTR */ - switch (policy){ - case Policy_next_fit: - CAMLassert (fl_prev != Val_NULL); - /* Search from [fl_prev] to the end of the list. */ - prev = fl_prev; - cur = Next (prev); + CAMLassert (nf_prev != Val_NULL); + /* Search from [nf_prev] to the end of the list. */ + prev = nf_prev; + cur = Next_small (prev); while (cur != Val_NULL){ CAMLassert (Is_in_heap (cur)); if (Wosize_bp (cur) >= wo_sz){ - return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur); + return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur); } prev = cur; - cur = Next (prev); + cur = Next_small (prev); #ifdef CAML_INSTR ++ caml_instr_alloc_jump; #endif } - fl_last = prev; - /* Search from the start of the list to [fl_prev]. */ - prev = Fl_head; - cur = Next (prev); - while (prev != fl_prev){ + nf_last = prev; + /* Search from the start of the list to [nf_prev]. */ + prev = Nf_head; + cur = Next_small (prev); + while (prev != nf_prev){ if (Wosize_bp (cur) >= wo_sz){ - return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur); + return nf_allocate_block (Whsize_wosize (wo_sz), prev, cur); } prev = cur; - cur = Next (prev); + cur = Next_small (prev); #ifdef CAML_INSTR ++ caml_instr_alloc_jump; #endif } /* No suitable block was found. */ return NULL; - break; - - case Policy_first_fit: { - /* Search in the flp array. */ - for (i = 0; i < flp_size; i++){ - sz = Wosize_bp (Next (flp[i])); - if (sz >= wo_sz){ -#if FREELIST_DEBUG - if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz); -#endif - result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], - Next (flp[i])); - goto update_flp; - } - } - /* Extend the flp array. */ - if (flp_size == 0){ - prev = Fl_head; - prevsz = 0; - }else{ - prev = Next (flp[flp_size - 1]); - prevsz = Wosize_bp (prev); - if (beyond != Val_NULL) prev = beyond; - } - while (flp_size < FLP_MAX){ - cur = Next (prev); - if (cur == Val_NULL){ - fl_last = prev; - beyond = (prev == Fl_head) ? Val_NULL : prev; - return NULL; - }else{ - sz = Wosize_bp (cur); - if (sz > prevsz){ - flp[flp_size] = prev; - ++ flp_size; - if (sz >= wo_sz){ - beyond = cur; - i = flp_size - 1; -#if FREELIST_DEBUG - if (flp_size > 5){ - fprintf (stderr, "FLP: extended to %d\n", flp_size); - } -#endif - result = allocate_block (Whsize_wosize (wo_sz), flp_size - 1, prev, - cur); - goto update_flp; - } - prevsz = sz; - } - } - prev = cur; - } - beyond = cur; - - /* The flp table is full. Do a slow first-fit search. */ -#if FREELIST_DEBUG - fprintf (stderr, "FLP: table is full -- slow first-fit\n"); -#endif - if (beyond != Val_NULL){ - prev = beyond; - }else{ - prev = flp[flp_size - 1]; - } - prevsz = Wosize_bp (Next (flp[FLP_MAX-1])); - CAMLassert (prevsz < wo_sz); - cur = Next (prev); - while (cur != Val_NULL){ - CAMLassert (Is_in_heap (cur)); - sz = Wosize_bp (cur); - if (sz < prevsz){ - beyond = cur; - }else if (sz >= wo_sz){ - return allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur); - } - prev = cur; - cur = Next (prev); - } - fl_last = prev; - return NULL; - - update_flp: /* (i, sz) */ - /* The block at [i] was removed or reduced. Update the table. */ - CAMLassert (0 <= i && i < flp_size + 1); - if (i < flp_size){ - if (i > 0){ - prevsz = Wosize_bp (Next (flp[i-1])); - }else{ - prevsz = 0; - } - if (i == flp_size - 1){ - if (Wosize_bp (Next (flp[i])) <= prevsz){ - beyond = Next (flp[i]); - -- flp_size; - }else{ - beyond = Val_NULL; - } - }else{ - value buf [FLP_MAX]; - int j = 0; - mlsize_t oldsz = sz; - - prev = flp[i]; - while (prev != flp[i+1] && j < FLP_MAX - i){ - cur = Next (prev); - sz = Wosize_bp (cur); - if (sz > prevsz){ - buf[j++] = prev; - prevsz = sz; - if (sz >= oldsz){ - CAMLassert (sz == oldsz); - break; - } - } - prev = cur; - } -#if FREELIST_DEBUG - if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j); -#endif - if (FLP_MAX >= flp_size + j - 1){ - if (j != 1){ - memmove (&flp[i+j], &flp[i+1], sizeof (value) * (flp_size-i-1)); - } - if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j); - flp_size += j - 1; - }else{ - if (FLP_MAX > i + j){ - if (j != 1){ - memmove (&flp[i+j], &flp[i+1], sizeof (value) * (FLP_MAX-i-j)); - } - if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j); - }else{ - if (i != FLP_MAX){ - memmove (&flp[i], &buf[0], sizeof (value) * (FLP_MAX - i)); - } - } - flp_size = FLP_MAX - 1; - beyond = Next (flp[FLP_MAX - 1]); - } - } - } - return result; - } - break; - - default: - CAMLassert (0); /* unknown policy */ - break; - } - return NULL; /* NOT REACHED */ } /* Location of the last fragment seen by the sweeping code. @@ -394,9 +228,9 @@ header_t *caml_fl_allocate (mlsize_t wo_sz) Note that [last_fragment] doesn't point to the fragment itself, but to the block after it. */ -static header_t *last_fragment; +static header_t *nf_last_fragment; -void caml_fl_init_merge (void) +static void nf_init_merge (void) { #ifdef CAML_INSTR int i; @@ -405,74 +239,52 @@ void caml_fl_init_merge (void) instr_size[i] = 0; } #endif /* CAML_INSTR */ - last_fragment = NULL; - caml_fl_merge = Fl_head; + nf_last_fragment = NULL; + caml_fl_merge = Nf_head; #ifdef DEBUG - fl_check (); + nf_check (); #endif } -static void truncate_flp (value changed) -{ - if (changed == Fl_head){ - flp_size = 0; - beyond = Val_NULL; - }else{ - while (flp_size > 0 - && Bp_val (Next (flp[flp_size - 1])) >= Bp_val (changed)) - -- flp_size; - if (Bp_val (beyond) >= Bp_val (changed)) beyond = Val_NULL; - } -} - -/* This is called by caml_compact_heap. */ -void caml_fl_reset (void) +static void nf_reset (void) { - Next (Fl_head) = Val_NULL; - switch (policy){ - case Policy_next_fit: - fl_prev = Fl_head; - break; - case Policy_first_fit: - truncate_flp (Fl_head); - break; - default: - CAMLassert (0); - break; - } + Next_small (Nf_head) = Val_NULL; + nf_prev = Nf_head; caml_fl_cur_wsz = 0; - caml_fl_init_merge (); + nf_init_merge (); } -/* [caml_fl_merge_block] returns the head pointer of the next block after [bp], - because merging blocks may change the size of [bp]. */ -header_t *caml_fl_merge_block (value bp) +/* Note: the [limit] parameter is unused because we merge blocks one by one. */ +static header_t *nf_merge_block (value bp, char *limit) { - value prev, cur; - header_t *adj; + value prev, cur, adj; header_t hd = Hd_val (bp); mlsize_t prev_wosz; caml_fl_cur_wsz += Whsize_hd (hd); + /* [merge_block] is now responsible for calling the finalization function. */ + if (Tag_hd (hd) == Custom_tag){ + void (*final_fun)(value) = Custom_ops_val(bp)->finalize; + if (final_fun != NULL) final_fun(bp); + } + #ifdef DEBUG caml_set_fields (bp, 0, Debug_free_major); #endif prev = caml_fl_merge; - cur = Next (prev); + cur = Next_small (prev); /* The sweep code makes sure that this is the right place to insert this block: */ - CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head); + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head); CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL); - if (policy == Policy_first_fit) truncate_flp (prev); - /* If [last_fragment] and [bp] are adjacent, merge them. */ - if (last_fragment == Hp_val (bp)){ + if (nf_last_fragment == Hp_val (bp)){ mlsize_t bp_whsz = Whsize_val (bp); if (bp_whsz <= Max_wosize){ hd = Make_header (bp_whsz, 0, Caml_white); - bp = (value) last_fragment; + bp = (value) nf_last_fragment; Hd_val (bp) = hd; caml_fl_cur_wsz += Whsize_wosize (0); } @@ -480,20 +292,20 @@ header_t *caml_fl_merge_block (value bp) /* If [bp] and [cur] are adjacent, remove [cur] from the free-list and merge them. */ - adj = (header_t *) &Field (bp, Wosize_hd (hd)); - if (adj == Hp_val (cur)){ - value next_cur = Next (cur); + adj = Next_in_mem (bp); + if (adj == cur){ + value next_cur = Next_small (cur); mlsize_t cur_whsz = Whsize_val (cur); if (Wosize_hd (hd) + cur_whsz <= Max_wosize){ - Next (prev) = next_cur; - if (policy == Policy_next_fit && fl_prev == cur) fl_prev = prev; + Next_small (prev) = next_cur; + if (nf_prev == cur) nf_prev = prev; hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue); Hd_val (bp) = hd; - adj = (header_t *) &Field (bp, Wosize_hd (hd)); + adj = Next_in_mem (bp); #ifdef DEBUG - fl_last = Val_NULL; - Next (cur) = (value) Debug_free_major; + nf_last = Val_NULL; + Next_small (cur) = (value) Debug_free_major; Hd_val (cur) = Debug_free_major; #endif cur = next_cur; @@ -502,31 +314,30 @@ header_t *caml_fl_merge_block (value bp) /* If [prev] and [bp] are adjacent merge them, else insert [bp] into the free-list if it is big enough. */ prev_wosz = Wosize_val (prev); - if ((header_t *) &Field (prev, prev_wosz) == Hp_val (bp) - && prev_wosz + Whsize_hd (hd) < Max_wosize){ - Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0,Caml_blue); + if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){ + Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue); #ifdef DEBUG Hd_val (bp) = Debug_free_major; #endif CAMLassert (caml_fl_merge == prev); }else if (Wosize_hd (hd) != 0){ Hd_val (bp) = Bluehd_hd (hd); - Next (bp) = cur; - Next (prev) = bp; + Next_small (bp) = cur; + Next_small (prev) = bp; caml_fl_merge = bp; }else{ /* This is a fragment. Leave it in white but remember it for eventual merging with the next block. */ - last_fragment = (header_t *) bp; + nf_last_fragment = (header_t *) bp; caml_fl_cur_wsz -= Whsize_wosize (0); } - return adj; + return Hp_val (adj); } /* This is a heap extension. We have to insert it in the right place in the free-list. - [caml_fl_add_blocks] can only be called right after a call to - [caml_fl_allocate] that returned Val_NULL. + [nf_add_blocks] can only be called right after a call to + [nf_allocate] that returned Val_NULL. Most of the heap extensions are expected to be at the end of the free list. (This depends on the implementation of [malloc].) @@ -534,60 +345,46 @@ header_t *caml_fl_merge_block (value bp) terminated by Val_NULL, and field 1 of the first block must point to the last block. */ -void caml_fl_add_blocks (value bp) +static void nf_add_blocks (value bp) { value cur = bp; - CAMLassert (fl_last != Val_NULL); - CAMLassert (Next (fl_last) == Val_NULL); + CAMLassert (nf_last != Val_NULL); + CAMLassert (Next_small (nf_last) == Val_NULL); do { caml_fl_cur_wsz += Whsize_bp (cur); cur = Field(cur, 0); } while (cur != Val_NULL); - if (Bp_val (bp) > Bp_val (fl_last)){ - Next (fl_last) = bp; - if (fl_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){ + if (Bp_val (bp) > Bp_val (nf_last)){ + Next_small (nf_last) = bp; + if (nf_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){ caml_fl_merge = Field (bp, 1); } - if (policy == Policy_first_fit && flp_size < FLP_MAX){ - flp [flp_size++] = fl_last; - } }else{ value prev; - prev = Fl_head; - cur = Next (prev); + prev = Nf_head; + cur = Next_small (prev); while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){ - CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head); - /* XXX TODO: extend flp on the fly */ + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head); prev = cur; - cur = Next (prev); + cur = Next_small (prev); } - CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Fl_head); + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Nf_head); CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL); - Next (Field (bp, 1)) = cur; - Next (prev) = bp; + Next_small (Field (bp, 1)) = cur; + Next_small (prev) = bp; /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp], we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge] is always the last free-list block before [caml_gc_sweep_hp]. */ if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){ caml_fl_merge = Field (bp, 1); } - if (policy == Policy_first_fit) truncate_flp (bp); } } -/* Cut a block of memory into Max_wosize pieces, give them headers, - and optionally merge them into the free list. - arguments: - p: pointer to the first word of the block - size: size of the block (in words) - do_merge: 1 -> do merge; 0 -> do not merge - color: which color to give to the pieces; if [do_merge] is 1, this - is overridden by the merge code, but we have historically used - [Caml_white]. -*/ -void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color) +static void nf_make_free_blocks + (value *p, mlsize_t size, int do_merge, int color) { mlsize_t sz; @@ -597,27 +394,1493 @@ void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color) }else{ sz = size; } - *(header_t *)p = - Make_header (Wosize_whsize (sz), 0, color); - if (do_merge) caml_fl_merge_block (Val_hp (p)); + *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color); + if (do_merge) nf_merge_block (Val_hp (p), NULL); size -= sz; p += sz; } } -void caml_set_allocation_policy (uintnat p) -{ +/******************** first-fit allocation policy *********************/ + +#define FLP_MAX 1000 +static value flp [FLP_MAX]; +static int flp_size = 0; +static value beyond = Val_NULL; + +/* The sentinel can be located anywhere in memory, but it must not be + adjacent to any heap object. */ +static struct { + value filler1; /* Make sure the sentinel is never adjacent to any block. */ + header_t h; + value first_field; + value filler2; /* Make sure the sentinel is never adjacent to any block. */ +} ff_sentinel = {0, Make_header (0, 0, Caml_blue), Val_NULL, 0}; + +#define Ff_head (Val_bp (&(ff_sentinel.first_field))) +static value ff_last = Val_NULL; /* Last block in the list. Only valid + just after [ff_allocate] returns NULL. */ + + +#if defined (DEBUG) || FREELIST_DEBUG +static void ff_check (void) +{ + value cur; + int flp_found = 0, merge_found = 0; + uintnat size_found = 0; + int sz = 0; + + cur = Next_small (Ff_head); + while (cur != Val_NULL){ + size_found += Whsize_bp (cur); + CAMLassert (Is_in_heap (cur)); + if (Wosize_bp (cur) > sz){ + sz = Wosize_bp (cur); + if (flp_found < flp_size){ + CAMLassert (Next_small (flp[flp_found]) == cur); + ++ flp_found; + }else{ + CAMLassert (beyond == Val_NULL + || Bp_val (cur) >= Bp_val (Next_small (beyond))); + } + } + if (cur == caml_fl_merge) merge_found = 1; + cur = Next_small (cur); + } + CAMLassert (flp_found == flp_size); + CAMLassert (merge_found || caml_fl_merge == Ff_head); + CAMLassert (size_found == caml_fl_cur_wsz); +} +#endif /* DEBUG || FREELIST_DEBUG */ + +/* [ff_allocate_block] is called by [ff_allocate]. Given a suitable free + block and the requested size, it allocates a new block from the free + block. There are three cases: + 0. The free block has the requested size. Detach the block from the + free-list and return it. + 1. The free block is 1 word longer than the requested size. Detach + the block from the free list. The remaining word cannot be linked: + turn it into an empty block (header only), and return the rest. + 2. The free block is large enough. Split it in two and return the right + block. + In all cases, the allocated block is right-justified in the free block: + it is located in the high-address words of the free block, so that + the linking of the free-list does not change in case 2. +*/ +static header_t *ff_allocate_block (mlsize_t wh_sz, int flpi, value prev, + value cur) +{ + header_t h = Hd_bp (cur); + CAMLassert (Whsize_hd (h) >= wh_sz); + if (Wosize_hd (h) < wh_sz + 1){ /* Cases 0 and 1. */ + caml_fl_cur_wsz -= Whsize_hd (h); + Next_small (prev) = Next_small (cur); + CAMLassert (Is_in_heap (Next_small (prev)) + || Next_small (prev) == Val_NULL); + if (caml_fl_merge == cur) caml_fl_merge = prev; +#ifdef DEBUG + ff_last = Val_NULL; +#endif + /* In case 1, the following creates the empty block correctly. + In case 0, it gives an invalid header to the block. The function + calling [ff_allocate] will overwrite it. */ + Hd_op (cur) = Make_header (0, 0, Caml_white); + if (flpi + 1 < flp_size && flp[flpi + 1] == cur){ + flp[flpi + 1] = prev; + }else if (flpi == flp_size - 1){ + beyond = (prev == Ff_head) ? Val_NULL : prev; + -- flp_size; + } + }else{ /* Case 2. */ + caml_fl_cur_wsz -= wh_sz; + Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue); + } + return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz); +} + +static header_t *ff_allocate (mlsize_t wo_sz) +{ + value cur = Val_NULL, prev; + header_t *result; + int i; + mlsize_t sz, prevsz; + CAMLassert (sizeof (char *) == sizeof (value)); + CAMLassert (wo_sz >= 1); +#ifdef CAML_INSTR + if (wo_sz < 10){ + ++instr_size[wo_sz]; + }else if (wo_sz < 100){ + ++instr_size[wo_sz/10 + 9]; + }else{ + ++instr_size[19]; + } +#endif /* CAML_INSTR */ + + /* Search in the flp array. */ + for (i = 0; i < flp_size; i++){ + sz = Wosize_bp (Next_small (flp[i])); + if (sz >= wo_sz){ +#if FREELIST_DEBUG + if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz); +#endif + result = ff_allocate_block (Whsize_wosize (wo_sz), i, flp[i], + Next_small (flp[i])); + goto update_flp; + } + } + /* Extend the flp array. */ + if (flp_size == 0){ + prev = Ff_head; + prevsz = 0; + }else{ + prev = Next_small (flp[flp_size - 1]); + prevsz = Wosize_bp (prev); + if (beyond != Val_NULL) prev = beyond; + } + while (flp_size < FLP_MAX){ + cur = Next_small (prev); + if (cur == Val_NULL){ + ff_last = prev; + beyond = (prev == Ff_head) ? Val_NULL : prev; + return NULL; + }else{ + sz = Wosize_bp (cur); + if (sz > prevsz){ + flp[flp_size] = prev; + ++ flp_size; + if (sz >= wo_sz){ + beyond = cur; + i = flp_size - 1; +#if FREELIST_DEBUG + if (flp_size > 5){ + fprintf (stderr, "FLP: extended to %d\n", flp_size); + } +#endif + result = ff_allocate_block (Whsize_wosize (wo_sz), flp_size - 1, + prev, cur); + goto update_flp; + } + prevsz = sz; + } + } + prev = cur; + } + beyond = cur; + + /* The flp table is full. Do a slow first-fit search. */ +#if FREELIST_DEBUG + fprintf (stderr, "FLP: table is full -- slow first-fit\n"); +#endif + if (beyond != Val_NULL){ + prev = beyond; + }else{ + prev = flp[flp_size - 1]; + } + prevsz = Wosize_bp (Next_small (flp[FLP_MAX-1])); + CAMLassert (prevsz < wo_sz); + cur = Next_small (prev); + while (cur != Val_NULL){ + CAMLassert (Is_in_heap (cur)); + sz = Wosize_bp (cur); + if (sz < prevsz){ + beyond = cur; + }else if (sz >= wo_sz){ + return ff_allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur); + } + prev = cur; + cur = Next_small (prev); + } + ff_last = prev; + return NULL; + + update_flp: /* (i, sz) */ + /* The block at [i] was removed or reduced. Update the table. */ + CAMLassert (0 <= i && i < flp_size + 1); + if (i < flp_size){ + if (i > 0){ + prevsz = Wosize_bp (Next_small (flp[i-1])); + }else{ + prevsz = 0; + } + if (i == flp_size - 1){ + if (Wosize_bp (Next_small (flp[i])) <= prevsz){ + beyond = Next_small (flp[i]); + -- flp_size; + }else{ + beyond = Val_NULL; + } + }else{ + value buf [FLP_MAX]; + int j = 0; + mlsize_t oldsz = sz; + + prev = flp[i]; + while (prev != flp[i+1] && j < FLP_MAX - i){ + cur = Next_small (prev); + sz = Wosize_bp (cur); + if (sz > prevsz){ + buf[j++] = prev; + prevsz = sz; + if (sz >= oldsz){ + CAMLassert (sz == oldsz); + break; + } + } + prev = cur; + } +#if FREELIST_DEBUG + if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j); +#endif + if (FLP_MAX >= flp_size + j - 1){ + if (j != 1){ + memmove (&flp[i+j], &flp[i+1], sizeof (value) * (flp_size-i-1)); + } + if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j); + flp_size += j - 1; + }else{ + if (FLP_MAX > i + j){ + if (j != 1){ + memmove (&flp[i+j], &flp[i+1], sizeof (value) * (FLP_MAX-i-j)); + } + if (j > 0) memmove (&flp[i], &buf[0], sizeof (value) * j); + }else{ + if (i != FLP_MAX){ + memmove (&flp[i], &buf[0], sizeof (value) * (FLP_MAX - i)); + } + } + flp_size = FLP_MAX - 1; + beyond = Next_small (flp[FLP_MAX - 1]); + } + } + } + return result; +} + +/* Location of the last fragment seen by the sweeping code. + This is a pointer to the first word after the fragment, which is + the header of the next block. + Note that [ff_last_fragment] doesn't point to the fragment itself, + but to the block after it. +*/ +static header_t *ff_last_fragment; + +static void ff_init_merge (void) +{ +#ifdef CAML_INSTR + int i; + for (i = 1; i < 20; i++){ + CAML_INSTR_INT (instr_name[i], instr_size[i]); + instr_size[i] = 0; + } +#endif /* CAML_INSTR */ + ff_last_fragment = NULL; + caml_fl_merge = Ff_head; +#ifdef DEBUG + ff_check (); +#endif +} + +static void ff_truncate_flp (value changed) +{ + if (changed == Ff_head){ + flp_size = 0; + beyond = Val_NULL; + }else{ + while (flp_size > 0 && + Bp_val (Next_small (flp[flp_size - 1])) >= Bp_val (changed)) + -- flp_size; + if (Bp_val (beyond) >= Bp_val (changed)) beyond = Val_NULL; + } +} + +static void ff_reset (void) +{ + Next_small (Ff_head) = Val_NULL; + ff_truncate_flp (Ff_head); + caml_fl_cur_wsz = 0; + ff_init_merge (); +} + +/* Note: the [limit] parameter is unused because we merge blocks one by one. */ +static header_t *ff_merge_block (value bp, char *limit) +{ + value prev, cur, adj; + header_t hd = Hd_val (bp); + mlsize_t prev_wosz; + + caml_fl_cur_wsz += Whsize_hd (hd); + + /* [merge_block] is now responsible for calling the finalization function. */ + if (Tag_hd (hd) == Custom_tag){ + void (*final_fun)(value) = Custom_ops_val(bp)->finalize; + if (final_fun != NULL) final_fun(bp); + } + +#ifdef DEBUG + caml_set_fields (bp, 0, Debug_free_major); +#endif + prev = caml_fl_merge; + cur = Next_small (prev); + /* The sweep code makes sure that this is the right place to insert + this block: */ + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head); + CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL); + + ff_truncate_flp (prev); + + /* If [ff_last_fragment] and [bp] are adjacent, merge them. */ + if (ff_last_fragment == Hp_bp (bp)){ + mlsize_t bp_whsz = Whsize_val (bp); + if (bp_whsz <= Max_wosize){ + hd = Make_header (bp_whsz, 0, Caml_white); + bp = (value) ff_last_fragment; + Hd_val (bp) = hd; + caml_fl_cur_wsz += Whsize_wosize (0); + } + } + + /* If [bp] and [cur] are adjacent, remove [cur] from the free-list + and merge them. */ + adj = Next_in_mem (bp); + if (adj == cur){ + value next_cur = Next_small (cur); + mlsize_t cur_whsz = Whsize_val (cur); + + if (Wosize_hd (hd) + cur_whsz <= Max_wosize){ + Next_small (prev) = next_cur; + hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue); + Hd_val (bp) = hd; + adj = Next_in_mem (bp); +#ifdef DEBUG + ff_last = Val_NULL; + Next_small (cur) = (value) Debug_free_major; + Hd_val (cur) = Debug_free_major; +#endif + cur = next_cur; + } + } + /* If [prev] and [bp] are adjacent merge them, else insert [bp] into + the free-list if it is big enough. */ + prev_wosz = Wosize_val (prev); + if (Next_in_mem (prev) == bp && prev_wosz + Whsize_hd (hd) < Max_wosize){ + Hd_val (prev) = Make_header (prev_wosz + Whsize_hd (hd), 0, Caml_blue); +#ifdef DEBUG + Hd_val (bp) = Debug_free_major; +#endif + CAMLassert (caml_fl_merge == prev); + }else if (Wosize_hd (hd) != 0){ + Hd_val (bp) = Bluehd_hd (hd); + Next_small (bp) = cur; + Next_small (prev) = bp; + caml_fl_merge = bp; + }else{ + /* This is a fragment. Leave it in white but remember it for eventual + merging with the next block. */ + ff_last_fragment = (header_t *) bp; + caml_fl_cur_wsz -= Whsize_wosize (0); + } + return Hp_val (adj); +} + +/* This is a heap extension. We have to insert it in the right place + in the free-list. + [ff_add_blocks] can only be called right after a call to + [ff_allocate] that returned Val_NULL. + Most of the heap extensions are expected to be at the end of the + free list. (This depends on the implementation of [malloc].) + + [bp] must point to a list of blocks chained by their field 0, + terminated by Val_NULL, and field 1 of the first block must point to + the last block. +*/ +static void ff_add_blocks (value bp) +{ + value cur = bp; + CAMLassert (ff_last != Val_NULL); + CAMLassert (Next_small (ff_last) == Val_NULL); + do { + caml_fl_cur_wsz += Whsize_bp (cur); + cur = Field(cur, 0); + } while (cur != Val_NULL); + + if (Bp_val (bp) > Bp_val (ff_last)){ + Next_small (ff_last) = bp; + if (ff_last == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){ + caml_fl_merge = Field (bp, 1); + } + if (flp_size < FLP_MAX){ + flp [flp_size++] = ff_last; + } + }else{ + value prev; + + prev = Ff_head; + cur = Next_small (prev); + while (cur != Val_NULL && Bp_val (cur) < Bp_val (bp)){ + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head); + /* XXX TODO: extend flp on the fly */ + prev = cur; + cur = Next_small (prev); + } + CAMLassert (Bp_val (prev) < Bp_val (bp) || prev == Ff_head); + CAMLassert (Bp_val (cur) > Bp_val (bp) || cur == Val_NULL); + Next_small (Field (bp, 1)) = cur; + Next_small (prev) = bp; + /* When inserting blocks between [caml_fl_merge] and [caml_gc_sweep_hp], + we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge] + is always the last free-list block before [caml_gc_sweep_hp]. */ + if (prev == caml_fl_merge && (char *) bp < caml_gc_sweep_hp){ + caml_fl_merge = Field (bp, 1); + } + ff_truncate_flp (bp); + } +} + +static void ff_make_free_blocks + (value *p, mlsize_t size, int do_merge, int color) +{ + mlsize_t sz; + + while (size > 0){ + if (size > Whsize_wosize (Max_wosize)){ + sz = Whsize_wosize (Max_wosize); + }else{ + sz = size; + } + *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color); + if (do_merge) ff_merge_block (Val_hp (p), NULL); + size -= sz; + p += sz; + } +} + +/********************* best-fit allocation policy *********************/ + +/* quick-fit + FIFO-ordered best fit (Wilson's nomenclature) + We use Standish's data structure (a tree of doubly-linked lists) + with a splay tree (Sleator & Tarjan). +*/ + +/* [BF_NUM_SMALL] must be at least 4 for this code to work + and at least 5 for good performance on typical OCaml programs. + For portability reasons, BF_NUM_SMALL cannot be more than 32. +*/ +#define BF_NUM_SMALL 16 + +/* Note that indexing into [bf_small_fl] starts at 1, so the first entry + in this array is unused. +*/ +static struct { + value free; + value *merge; +} bf_small_fl [BF_NUM_SMALL + 1]; +static int bf_small_map = 0; + +/* Small free blocks have only one pointer to the next block. + Large free blocks have 5 fields: + tree fields: + - node flag + - left son + - right son + list fields: + - next + - prev +*/ +typedef struct large_free_block { + int isnode; + struct large_free_block *left; + struct large_free_block *right; + struct large_free_block *prev; + struct large_free_block *next; +} large_free_block; + +static inline mlsize_t bf_large_wosize (struct large_free_block *n) { + return Wosize_val((value)(n)); +} + +static struct large_free_block *bf_large_tree; +static struct large_free_block *bf_large_least; +/* [bf_large_least] is either NULL or a pointer to the smallest (leftmost) + block in the tree. In this latter case, the block must be alone in its + doubly-linked list (i.e. have [isnode] true and [prev] and [next] + both pointing back to this block) +*/ + +/* Auxiliary functions for bitmap */ + +/* Find first (i.e. least significant) bit set in a word. */ +#ifdef HAS_FFS +#include +#elif defined(HAS_BITSCANFORWARD) +#include +static inline int ffs (int x) +{ + unsigned long index; + unsigned char result; + result = _BitScanForward (&index, (unsigned long) x); + return result ? (int) index + 1 : 0; +} +#else +static inline int ffs (int x) +{ + /* adapted from Hacker's Delight */ + int bnz, b0, b1, b2, b3, b4; + CAMLassert ((x & 0xFFFFFFFF) == x); + x = x & -x; + bnz = x != 0; + b4 = !!(x & 0xFFFF0000) << 4; + b3 = !!(x & 0xFF00FF00) << 3; + b2 = !!(x & 0xF0F0F0F0) << 2; + b1 = !!(x & 0xCCCCCCCC) << 1; + b0 = !!(x & 0xAAAAAAAA); + return bnz + b0 + b1 + b2 + b3 + b4; +} +#endif /* HAS_FFS or HAS_BITSCANFORWARD */ + +/* Indexing starts at 1 because that's the minimum block size. */ +static inline void set_map (int index) +{ + bf_small_map |= (1 << (index - 1)); +} +static inline void unset_map (int index) +{ + bf_small_map &= ~(1 << (index - 1)); +} + + +/* debug functions for checking the data structures */ + +#if defined (DEBUG) || FREELIST_DEBUG + +static mlsize_t bf_check_cur_size = 0; +static asize_t bf_check_subtree (large_free_block *p) +{ + mlsize_t wosz; + large_free_block *cur, *next; + asize_t total_size = 0; + + if (p == NULL) return 0; + + wosz = bf_large_wosize(p); + CAMLassert (p->isnode == 1); + total_size += bf_check_subtree (p->left); + CAMLassert (wosz > BF_NUM_SMALL); + CAMLassert (wosz > bf_check_cur_size); + bf_check_cur_size = wosz; + cur = p; + while (1){ + CAMLassert (bf_large_wosize (cur) == wosz); + CAMLassert (Color_val ((value) cur) == Caml_blue); + CAMLassert ((cur == p && cur->isnode == 1) || cur->isnode == 0); + total_size += Whsize_wosize (wosz); + next = cur->next; + CAMLassert (next->prev == cur); + if (next == p) break; + cur = next; + } + total_size += bf_check_subtree (p->right); + return total_size; +} + +static void bf_check (void) +{ + mlsize_t i; + asize_t total_size = 0; + int map = 0; + + /* check free lists */ + CAMLassert (BF_NUM_SMALL <= 8 * sizeof (int)); + for (i = 1; i <= BF_NUM_SMALL; i++){ + value b; + int col = 0; + int merge_found = 0; + + if (bf_small_fl[i].merge == &bf_small_fl[i].free){ + merge_found = 1; + }else{ + CAMLassert (caml_gc_phase != Phase_sweep + || caml_fl_merge == Val_NULL + || Val_bp (bf_small_fl[i].merge) < caml_fl_merge); + } + CAMLassert (*bf_small_fl[i].merge == Val_NULL + || Color_val (*bf_small_fl[i].merge) == Caml_blue); + if (bf_small_fl[i].free != Val_NULL) map |= 1 << (i-1); + for (b = bf_small_fl[i].free; b != Val_NULL; b = Next_small (b)){ + if (bf_small_fl[i].merge == &Next_small (b)) merge_found = 1; + CAMLassert (Wosize_val (b) == i); + total_size += Whsize_wosize (i); + if (Color_val (b) == Caml_blue){ + col = 1; + CAMLassert (Next_small (b) == Val_NULL + || Bp_val (Next_small (b)) > Bp_val (b)); + }else{ + CAMLassert (col == 0); + CAMLassert (Color_val (b) == Caml_white); + } + } + if (caml_gc_phase == Phase_sweep) CAMLassert (merge_found); + } + CAMLassert (map == bf_small_map); + /* check [caml_fl_merge] */ + CAMLassert (caml_gc_phase != Phase_sweep + || caml_fl_merge == Val_NULL + || Hp_val (caml_fl_merge) < (header_t *) caml_gc_sweep_hp); + /* check the tree */ + bf_check_cur_size = 0; + total_size += bf_check_subtree (bf_large_tree); + /* check the total free set size */ + CAMLassert (total_size == caml_fl_cur_wsz); + /* check the smallest-block pointer */ + if (bf_large_least != NULL){ + large_free_block *x = bf_large_tree; + while (x->left != NULL) x = x->left; + CAMLassert (x == bf_large_least); + CAMLassert (x->isnode == 1); + CAMLassert (x->prev == x); + CAMLassert (x->next == x); + } +} + +#endif /* DEBUG || FREELIST_DEBUG */ + +#if FREELIST_DEBUG +#define FREELIST_DEBUG_bf_check() bf_check () +#else +#define FREELIST_DEBUG_bf_check() +#endif + +/**************************************************************************/ +/* splay trees */ + +/* Our tree is composed of nodes. Each node is the head of a doubly-linked + circular list of blocks, all of the same size. +*/ + +/* Search for the node of the given size. Return a pointer to the pointer + to the node, or a pointer to the NULL where the node should have been + (it can be inserted here). +*/ +static large_free_block **bf_search (mlsize_t wosz) +{ + large_free_block **p = &bf_large_tree; + large_free_block *cur; + mlsize_t cursz; + + while (1){ + cur = *p; + INSTR_alloc_jump (1); + if (cur == NULL) break; + cursz = bf_large_wosize (cur); + if (cursz == wosz){ + break; + }else if (cursz > wosz){ + p = &(cur->left); + }else{ + CAMLassert (cursz < wosz); + p = &(cur->right); + } + } + return p; +} + +/* Search for the least node that is large enough to accomodate the given + size. Return in [next_lower] an upper bound on either the size of the + next-lower node in the tree, or BF_NUM_SMALL if there is no such node. +*/ +static large_free_block **bf_search_best (mlsize_t wosz, mlsize_t *next_lower) +{ + large_free_block **p = &bf_large_tree; + large_free_block **best = NULL; + mlsize_t lowsz = BF_NUM_SMALL; + large_free_block *cur; + mlsize_t cursz; + + while (1){ + cur = *p; + INSTR_alloc_jump (1); + if (cur == NULL){ + *next_lower = lowsz; + break; + } + cursz = bf_large_wosize (cur); + if (cursz == wosz){ + best = p; + *next_lower = wosz; + break; + }else if (cursz > wosz){ + best = p; + p = &(cur->left); + }else{ + CAMLassert (cursz < wosz); + lowsz = cursz; + p = &(cur->right); + } + } + return best; +} + +/* Splay the tree at the given size. If a node of this size exists, it will + become the root. If not, the last visited node will be the root. This is + either the least node larger or the greatest node smaller than the given + size. + We use simple top-down splaying as described in S&T 85. +*/ +static void bf_splay (mlsize_t wosz) +{ + large_free_block *x, *y; + mlsize_t xsz; + large_free_block *left_top = NULL; + large_free_block *right_top = NULL; + large_free_block **left_bottom = &left_top; + large_free_block **right_bottom = &right_top; + + x = bf_large_tree; + if (x == NULL) return; + while (1){ + xsz = bf_large_wosize (x); + if (xsz == wosz) break; + if (xsz > wosz){ + /* zig */ + y = x->left; + INSTR_alloc_jump (1); + if (y == NULL) break; + if (bf_large_wosize (y) > wosz){ + /* zig-zig: rotate right */ + x->left = y->right; + y->right = x; + x = y; + y = x->left; + INSTR_alloc_jump (2); + if (y == NULL) break; + } + /* link right */ + *right_bottom = x; + right_bottom = &(x->left); + x = y; + }else{ + CAMLassert (xsz < wosz); + /* zag */ + y = x->right; + INSTR_alloc_jump (1); + if (y == NULL) break; + if (bf_large_wosize (y) < wosz){ + /* zag-zag : rotate left */ + x->right = y->left; + y->left = x; + x = y; + y = x->right; + INSTR_alloc_jump (2); + if (y == NULL) break; + } + /* link left */ + *left_bottom = x; + left_bottom = &(x->right); + x = y; + } + } + /* reassemble the tree */ + *left_bottom = x->left; + *right_bottom = x->right; + x->left = left_top; + x->right = right_top; + INSTR_alloc_jump (2); + bf_large_tree = x; +} + +/* Splay the subtree at [p] on its leftmost (least) node. After this + operation, the root node of the subtree is the least node and it + has no left child. + The subtree must not be empty. +*/ +static void bf_splay_least (large_free_block **p) +{ + large_free_block *x, *y; + large_free_block *right_top = NULL; + large_free_block **right_bottom = &right_top; + + x = *p; + INSTR_alloc_jump (1); + CAMLassert (x != NULL); + while (1){ + /* We are always in the zig case. */ + y = x->left; + INSTR_alloc_jump (1); + if (y == NULL) break; + /* And in the zig-zig case. rotate right */ + x->left = y->right; + y->right = x; + x = y; + y = x->left; + INSTR_alloc_jump (2); + if (y == NULL) break; + /* link right */ + *right_bottom = x; + right_bottom = &(x->left); + x = y; + } + /* reassemble the tree */ + CAMLassert (x->left == NULL); + *right_bottom = x->right; + INSTR_alloc_jump (1); + x->right = right_top; + *p = x; +} + +/* Remove the node at [p], if any. */ +static void bf_remove_node (large_free_block **p) +{ + large_free_block *x; + large_free_block *l, *r; + + x = *p; + INSTR_alloc_jump (1); + if (x == NULL) return; + if (x == bf_large_least) bf_large_least = NULL; + l = x->left; + r = x->right; + INSTR_alloc_jump (2); + if (l == NULL){ + *p = r; + }else if (r == NULL){ + *p = l; + }else{ + bf_splay_least (&r); + r->left = l; + *p = r; + } +} + +/* Insert a block into the tree, either as a new node or as a block in an + existing list. + Splay if the list is already present. +*/ +static void bf_insert_block (large_free_block *n) +{ + mlsize_t sz = bf_large_wosize (n); + large_free_block **p = bf_search (sz); + large_free_block *x = *p; + INSTR_alloc_jump (1); + + if (bf_large_least != NULL){ + mlsize_t least_sz = bf_large_wosize (bf_large_least); + if (sz < least_sz){ + CAMLassert (x == NULL); + bf_large_least = n; + }else if (sz == least_sz){ + CAMLassert (x == bf_large_least); + bf_large_least = NULL; + } + } + + CAMLassert (Color_val ((value) n) == Caml_blue); + CAMLassert (Wosize_val ((value) n) > BF_NUM_SMALL); + if (x == NULL){ + /* add new node */ + n->isnode = 1; + n->left = n->right = NULL; + n->prev = n->next = n; + *p = n; + }else{ + /* insert at tail of doubly-linked list */ + CAMLassert (x->isnode == 1); + n->isnode = 0; +#ifdef DEBUG + n->left = n->right = (large_free_block *) Debug_free_unused; +#endif + n->prev = x->prev; + n->next = x; + x->prev->next = n; + x->prev = n; + INSTR_alloc_jump (2); + bf_splay (sz); + } +} + +#if defined (DEBUG) || FREELIST_DEBUG +static int bf_is_in_tree (large_free_block *b) +{ + int wosz = bf_large_wosize (b); + large_free_block **p = bf_search (wosz); + large_free_block *n = *p; + large_free_block *cur = n; + + if (n == NULL) return 0; + while (1){ + if (cur == b) return 1; + cur = cur->next; + if (cur == n) return 0; + } +} +#endif /* DEBUG || FREELIST_DEBUG */ + +/**************************************************************************/ + +/* Add back a remnant into a small free list. The block must be small + and white (or a 0-size fragment). + The block may be left out of the list depending on the sweeper's state. + The free list size is updated accordingly. + + The block will be left out of the list if the GC is in its Sweep phase + and the block is in the still-to-be-swept region because every block of + the free list encountered by the sweeper must be blue and linked in + its proper place in the increasing-addresses order of the list. This is + to ensure that coalescing is always done when two or more free blocks + are adjacent. +*/ +static void bf_insert_remnant_small (value v) +{ + mlsize_t wosz = Wosize_val (v); + + CAMLassert (Color_val (v) == Caml_white); + CAMLassert (wosz <= BF_NUM_SMALL); + if (wosz != 0 + && (caml_gc_phase != Phase_sweep + || (char *) Hp_val (v) < (char *) caml_gc_sweep_hp)){ + caml_fl_cur_wsz += Whsize_wosize (wosz); + Next_small (v) = bf_small_fl[wosz].free; + bf_small_fl[wosz].free = v; + if (bf_small_fl[wosz].merge == &bf_small_fl[wosz].free){ + bf_small_fl[wosz].merge = &Next_small (v); + } + set_map (wosz); + } +} + +/* Add back a remnant into the free set. The block must have the + appropriate color: + - White if it is a fragment or a small block (wosize <= BF_NUM_SMALL) + - Blue if it is a large block (BF_NUM_SMALL < wosize) + The block may be left out or the set, depending on its size and the + sweeper's state. + The free list size is updated accordingly. +*/ +static void bf_insert_remnant (value v) +{ + mlsize_t wosz = Wosize_val (v); + + if (wosz <= BF_NUM_SMALL){ + CAMLassert (Color_val (v) == Caml_white); + bf_insert_remnant_small (v); + }else{ + CAMLassert (Color_val (v) == Caml_blue); + bf_insert_block ((large_free_block *) v); + caml_fl_cur_wsz += Whsize_wosize (wosz); + } +} +/* Insert the block into the free set during sweep. The block must be blue. */ +static void bf_insert_sweep (value v) +{ + mlsize_t wosz = Wosize_val (v); + value next; + + CAMLassert (Color_val (v) == Caml_blue); + if (wosz <= BF_NUM_SMALL){ + while (1){ + next = *bf_small_fl[wosz].merge; + if (next == Val_NULL){ + set_map (wosz); + break; + } + if (Bp_val (next) >= Bp_val (v)) break; + bf_small_fl[wosz].merge = &Next_small (next); + } + Next_small (v) = *bf_small_fl[wosz].merge; + *bf_small_fl[wosz].merge = v; + bf_small_fl[wosz].merge = &Next_small (v); + }else{ + bf_insert_block ((large_free_block *) v); + } +} + +/* Remove a given block from the free set. */ +static void bf_remove (value v) +{ + mlsize_t wosz = Wosize_val (v); + + CAMLassert (Color_val (v) == Caml_blue); + if (wosz <= BF_NUM_SMALL){ + while (*bf_small_fl[wosz].merge != v){ + CAMLassert (Bp_val (*bf_small_fl[wosz].merge) < Bp_val (v)); + bf_small_fl[wosz].merge = &Next_small (*bf_small_fl[wosz].merge); + } + *bf_small_fl[wosz].merge = Next_small (v); + if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz); + }else{ + large_free_block *b = (large_free_block *) v; + CAMLassert (bf_is_in_tree (b)); + CAMLassert (b->prev->next == b); + CAMLassert (b->next->prev == b); + if (b->isnode){ + large_free_block **p = bf_search (bf_large_wosize (b)); + CAMLassert (*p != NULL); + if (b->next == b){ + bf_remove_node (p); + }else{ + large_free_block *n = b->next; + n->prev = b->prev; + b->prev->next = n; + *p = n; + n->isnode = 1; + n->left = b->left; + n->right = b->right; +#ifdef DEBUG + Field ((value) b, 0) = Debug_free_major; + b->left = b->right = b->next = b->prev = + (large_free_block *) Debug_free_major; +#endif + } + }else{ + b->prev->next = b->next; + b->next->prev = b->prev; + } + } +} + +/* Split the given block, return a new block of the given size. + The remnant is still at the same address, its size is changed + and its color becomes white. + The size of the free set is decremented by the whole block size + and the caller must readjust it if the remnant is reinserted or + remains in the free set. + The size of [v] must be strictly greater than [wosz]. +*/ +static header_t *bf_split_small (mlsize_t wosz, value v) +{ + intnat blocksz = Whsize_val (v); + intnat remwhsz = blocksz - Whsize_wosize (wosz); + + CAMLassert (Wosize_val (v) > wosz); + caml_fl_cur_wsz -= blocksz; + Hd_val (v) = Make_header (Wosize_whsize (remwhsz), Abstract_tag, Caml_white); + return (header_t *) &Field (v, Wosize_whsize (remwhsz)); +} + +/* Split the given block, return a new block of the given size. + The original block is at the same address but its size is changed. + Its color and tag are changed as appropriate for calling the + insert_remnant* functions. + The size of the free set is decremented by the whole block size + and the caller must readjust it if the remnant is reinserted or + remains in the free set. + The size of [v] must be strictly greater than [wosz]. +*/ +static header_t *bf_split (mlsize_t wosz, value v) +{ + header_t hd = Hd_val (v); + mlsize_t remwhsz = Whsize_hd (hd) - Whsize_wosize (wosz); + + CAMLassert (Wosize_val (v) > wosz); + CAMLassert (remwhsz > 0); + caml_fl_cur_wsz -= Whsize_hd (hd); + if (remwhsz <= Whsize_wosize (BF_NUM_SMALL)){ + /* Same as bf_split_small. */ + Hd_val (v) = Make_header (Wosize_whsize(remwhsz), Abstract_tag, Caml_white); + }else{ + Hd_val (v) = Make_header (Wosize_whsize (remwhsz), 0, Caml_blue); + } + return (header_t *) &Field (v, Wosize_whsize (remwhsz)); +} + +/* Allocate from a large block at [p]. If the node is single and the remaining + size is greater than [bound], it stays at the same place in the tree. + If [set_least] is true, [wosz] is guaranteed to be [<= BF_NUM_SMALL], so + the block has the smallest size in the tree. + In this case, the large block becomes (or remains) the single smallest + in the tree and we set the [bf_large_least] pointer. +*/ +static header_t *bf_alloc_from_large (mlsize_t wosz, large_free_block **p, + mlsize_t bound, int set_least) +{ + large_free_block *n = *p; + large_free_block *b; + header_t *result; + mlsize_t wosize_n = bf_large_wosize (n); + + CAMLassert (bf_large_wosize (n) >= wosz); + if (n->next == n){ + if (wosize_n > bound + Whsize_wosize (wosz)){ + /* TODO splay at [n]? if the remnant is larger than [wosz]? */ + if (set_least){ + CAMLassert (bound == BF_NUM_SMALL); + bf_large_least = n; + } + result = bf_split (wosz, (value) n); + caml_fl_cur_wsz += Whsize_wosize (wosize_n) - Whsize_wosize (wosz); + /* remnant stays in tree */ + return result; + }else{ + bf_remove_node (p); + if (wosize_n == wosz){ + caml_fl_cur_wsz -= Whsize_wosize (wosz); + return Hp_val ((value) n); + }else{ + result = bf_split (wosz, (value) n); + bf_insert_remnant ((value) n); + return result; + } + } + }else{ + b = n->next; + CAMLassert (bf_large_wosize (b) == bf_large_wosize (n)); + n->next = b->next; + b->next->prev = n; + if (wosize_n == wosz){ + caml_fl_cur_wsz -= Whsize_wosize (wosz); + return Hp_val ((value) b); + }else{ + result = bf_split (wosz, (value) b); + bf_insert_remnant ((value) b); + /* TODO: splay at [n] if the remnant is smaller than [wosz] */ + if (set_least){ + CAMLassert (bound == BF_NUM_SMALL); + if (bf_large_wosize (b) > BF_NUM_SMALL){ + bf_large_least = b; + } + } + return result; + } + } +} + +static header_t *bf_allocate_from_tree (mlsize_t wosz, int set_least) +{ + large_free_block **n; + mlsize_t bound; + + n = bf_search_best (wosz, &bound); + if (n == NULL) return NULL; + return bf_alloc_from_large (wosz, n, bound, set_least); +} + +static header_t *bf_allocate (mlsize_t wosz) +{ + value block; + header_t *result; + + CAMLassert (sizeof (char *) == sizeof (value)); + CAMLassert (wosz >= 1); + +#ifdef CAML_INSTR + if (wosz < 10){ + ++instr_size[wosz]; + }else if (wosz < 100){ + ++instr_size[wosz/10 + 9]; + }else{ + ++instr_size[19]; + } +#endif /* CAML_INSTR */ + + if (wosz <= BF_NUM_SMALL){ + if (bf_small_fl[wosz].free != Val_NULL){ + /* fast path: allocate from the corresponding free list */ + block = bf_small_fl[wosz].free; + if (bf_small_fl[wosz].merge == &Next_small (block)){ + bf_small_fl[wosz].merge = &bf_small_fl[wosz].free; + } + bf_small_fl[wosz].free = Next_small (block); + if (bf_small_fl[wosz].free == Val_NULL) unset_map (wosz); + caml_fl_cur_wsz -= Whsize_wosize (wosz); + FREELIST_DEBUG_bf_check (); + return Hp_val (block); + }else{ + /* allocate from the next available size */ + mlsize_t s = ffs (bf_small_map & ((-1) << wosz)); + FREELIST_DEBUG_bf_check (); + if (s != 0){ + block = bf_small_fl[s].free; + CAMLassert (block != Val_NULL); + if (bf_small_fl[s].merge == &Next_small (block)){ + bf_small_fl[s].merge = &bf_small_fl[s].free; + } + bf_small_fl[s].free = Next_small (block); + if (bf_small_fl[s].free == Val_NULL) unset_map (s); + result = bf_split_small (wosz, block); + bf_insert_remnant_small (block); + FREELIST_DEBUG_bf_check (); + return result; + } + } + /* Failed to find a suitable small block: try [bf_large_least]. */ + if (bf_large_least != NULL){ + mlsize_t least_wosz = bf_large_wosize (bf_large_least); + if (least_wosz > BF_NUM_SMALL + Whsize_wosize (wosz)){ + result = bf_split (wosz, (value) bf_large_least); + caml_fl_cur_wsz += Whsize_wosize (least_wosz) - Whsize_wosize (wosz); + /* remnant stays in tree */ + CAMLassert (Color_val ((value) bf_large_least) == Caml_blue); + return result; + } + } + + /* Allocate from the tree and update [bf_large_least]. */ + result = bf_allocate_from_tree (wosz, 1); + FREELIST_DEBUG_bf_check (); + return result; + }else{ + result = bf_allocate_from_tree (wosz, 0); + FREELIST_DEBUG_bf_check (); + return result; + } +} + +static void bf_init_merge (void) +{ + mlsize_t i; + +#ifdef CAML_INSTR + for (i = 1; i < 20; i++){ + CAML_INSTR_INT (instr_name[i], instr_size[i]); + instr_size[i] = 0; + } +#endif /* CAML_INSTR */ + + caml_fl_merge = Val_NULL; + + for (i = 1; i <= BF_NUM_SMALL; i++){ + /* At the beginning of each small free list is a segment of remnants + that were pushed back to the list after splitting. These are white + and they are not in order. We need to remove them + from the list for coalescing to work. They + will be picked up by the sweeping code and inserted in the right + place in the list. + */ + value p = bf_small_fl[i].free; + while (1){ + if (p == Val_NULL){ + unset_map (i); + break; + } + if (Color_val (p) == Caml_blue) break; + CAMLassert (Color_val (p) == Caml_white); + caml_fl_cur_wsz -= Whsize_val (p); + p = Next_small (p); + } + bf_small_fl[i].free = p; + /* Set the merge pointer to its initial value */ + bf_small_fl[i].merge = &bf_small_fl[i].free; + } +} + +static void bf_reset (void) +{ + mlsize_t i; + + for (i = 1; i <= BF_NUM_SMALL; i++){ + bf_small_fl[i].free = Val_NULL; + bf_small_fl[i].merge = &bf_small_fl[i].free; + } + bf_small_map = 0; + bf_large_tree = NULL; + bf_large_least = NULL; + caml_fl_cur_wsz = 0; + bf_init_merge (); +} + +static header_t *bf_merge_block (value bp, char *limit) +{ + value start; + value cur; + mlsize_t wosz; + + CAMLassert (Color_val (bp) == Caml_white); + /* Find the starting point of the current run of free blocks. */ + if (caml_fl_merge != Val_NULL && Next_in_mem (caml_fl_merge) == bp + && Color_val (caml_fl_merge) == Caml_blue){ + start = caml_fl_merge; + bf_remove (start); + }else{ + start = bp; + } + cur = bp; + while (1){ + /* This slightly convoluted loop is just going over the run of + white or blue blocks, doing the right thing for each color, and + stopping on a gray or black block or when limit is passed. + It is convoluted because we start knowing that the first block + is white. */ + white: + if (Tag_val (cur) == Custom_tag){ + void (*final_fun)(value) = Custom_ops_val(cur)->finalize; + if (final_fun != NULL) final_fun(cur); + } + caml_fl_cur_wsz += Whsize_val (cur); + next: + cur = Next_in_mem (cur); + if (Hp_val (cur) >= (header_t *) limit){ + CAMLassert (Hp_val (cur) == (header_t *) limit); + goto end_of_run; + } + switch (Color_val (cur)){ + case Caml_white: goto white; + case Caml_blue: bf_remove (cur); goto next; + case Caml_gray: + case Caml_black: + goto end_of_run; + } + } + end_of_run: + wosz = Wosize_whsize ((value *) cur - (value *) start); +#ifdef DEBUG + { + value *p; + for (p = (value *) start; p < (value *) Hp_val (cur); p++){ + *p = Debug_free_major; + } + } +#endif + while (wosz > Max_wosize){ + Hd_val (start) = Make_header (Max_wosize, 0, Caml_blue); + bf_insert_sweep (start); + start = Next_in_mem (start); + wosz -= Whsize_wosize (Max_wosize); + } + if (wosz > 0){ + Hd_val (start) = Make_header (wosz, 0, Caml_blue); + bf_insert_sweep (start); + }else{ + Hd_val (start) = Make_header (0, 0, Caml_white); + caml_fl_cur_wsz -= Whsize_wosize (0); + } + FREELIST_DEBUG_bf_check (); + return Hp_val (cur); +} + +static void bf_add_blocks (value bp) +{ + while (bp != Val_NULL){ + value next = Next_small (bp); + mlsize_t wosz = Wosize_val (bp); + + if (wosz > BF_NUM_SMALL){ + caml_fl_cur_wsz += Whsize_wosize (wosz); + bf_insert_block ((large_free_block *) bp); + }else{ + Hd_val (bp) = Make_header (wosz, Abstract_tag, Caml_white); + bf_insert_remnant_small (bp); + } + bp = next; + } +} + +static void bf_make_free_blocks (value *p, mlsize_t size, int do_merge, + int color) +{ + mlsize_t sz, wosz; + + while (size > 0){ + if (size > Whsize_wosize (Max_wosize)){ + sz = Whsize_wosize (Max_wosize); + }else{ + sz = size; + } + wosz = Wosize_whsize (sz); + if (do_merge){ + if (wosz <= BF_NUM_SMALL){ + color = Caml_white; + }else{ + color = Caml_blue; + } + *(header_t *)p = Make_header (wosz, 0, color); + bf_insert_remnant (Val_hp (p)); + }else{ + *(header_t *)p = Make_header (wosz, 0, color); + } + size -= sz; + p += sz; + } +} + +/*********************** policy selection *****************************/ + +enum { + policy_next_fit = 0, + policy_first_fit = 1, + policy_best_fit = 2, +}; + +uintnat caml_allocation_policy = policy_next_fit; + +/********************* exported functions *****************************/ + +/* [caml_fl_allocate] does not set the header of the newly allocated block. + The calling function must do it before any GC function gets called. + [caml_fl_allocate] returns a head pointer, or NULL if no suitable block + is found in the free set. +*/ +header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = &nf_allocate; + +/* Initialize the merge_block machinery (at start of sweeping). */ +void (*caml_fl_p_init_merge) (void) = &nf_init_merge; + +/* This is called by caml_compact_heap. */ +void (*caml_fl_p_reset) (void) = &nf_reset; + +/* [caml_fl_merge_block] returns the head pointer of the next block after [bp], + because merging blocks may change the size of [bp]. */ +header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = &nf_merge_block; + +/* [bp] must point to a list of blocks of wosize >= 1 chained by their field 0, + terminated by Val_NULL, and field 1 of the first block must point to + the last block. + The blocks must be blue. +*/ +void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks; + +/* Cut a block of memory into pieces of size [Max_wosize], give them headers, + and optionally merge them into the free list. + arguments: + p: pointer to the first word of the block + size: size of the block (in words) + do_merge: 1 -> do merge; 0 -> do not merge + color: which color to give to the pieces; if [do_merge] is 1, this + is overridden by the merge code, but we have historically used + [Caml_white]. +*/ +void (*caml_fl_p_make_free_blocks) + (value *p, mlsize_t size, int do_merge, int color) + = &nf_make_free_blocks; +#ifdef DEBUG +void (*caml_fl_p_check) (void) = &nf_check; +#endif + +void caml_set_allocation_policy (intnat p) +{ switch (p){ - case Policy_next_fit: - fl_prev = Fl_head; - policy = p; + case policy_next_fit: default: + caml_allocation_policy = policy_next_fit; + caml_fl_p_allocate = &nf_allocate; + caml_fl_p_init_merge = &nf_init_merge; + caml_fl_p_reset = &nf_reset; + caml_fl_p_merge_block = &nf_merge_block; + caml_fl_p_add_blocks = &nf_add_blocks; + caml_fl_p_make_free_blocks = &nf_make_free_blocks; +#ifdef DEBUG + caml_fl_p_check = &nf_check; +#endif break; - case Policy_first_fit: - flp_size = 0; - beyond = Val_NULL; - policy = p; + case policy_first_fit: + caml_allocation_policy = policy_first_fit; + caml_fl_p_allocate = &ff_allocate; + caml_fl_p_init_merge = &ff_init_merge; + caml_fl_p_reset = &ff_reset; + caml_fl_p_merge_block = &ff_merge_block; + caml_fl_p_add_blocks = &ff_add_blocks; + caml_fl_p_make_free_blocks = &ff_make_free_blocks; +#ifdef DEBUG + caml_fl_p_check = &ff_check; +#endif break; - default: + case policy_best_fit: + caml_allocation_policy = policy_best_fit; + caml_fl_p_allocate = &bf_allocate; + caml_fl_p_init_merge = &bf_init_merge; + caml_fl_p_reset = &bf_reset; + caml_fl_p_merge_block = &bf_merge_block; + caml_fl_p_add_blocks = &bf_add_blocks; + caml_fl_p_make_free_blocks = &bf_make_free_blocks; +#ifdef DEBUG + caml_fl_p_check = &bf_check; +#endif break; } } diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c index bb83ba10..e444b9c5 100644 --- a/runtime/gc_ctrl.c +++ b/runtime/gc_ctrl.c @@ -41,17 +41,6 @@ extern uintnat caml_max_stack_size; /* defined in stacks.c */ #endif -double caml_stat_minor_words = 0.0, - caml_stat_promoted_words = 0.0, - caml_stat_major_words = 0.0; - -intnat caml_stat_minor_collections = 0, - caml_stat_major_collections = 0, - caml_stat_heap_wsz = 0, - caml_stat_top_heap_wsz = 0, - caml_stat_compactions = 0, - caml_stat_heap_chunks = 0; - extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */ extern uintnat caml_percent_free; /* see major_gc.c */ extern uintnat caml_percent_max; /* see compact.c */ @@ -223,24 +212,27 @@ static value heap_stats (int returnstats) #ifdef DEBUG caml_final_invariant_check(); + caml_fl_check (); #endif - CAMLassert (heap_chunks == caml_stat_heap_chunks); - CAMLassert (live_words + free_words + fragments == caml_stat_heap_wsz); + CAMLassert (heap_chunks == Caml_state->stat_heap_chunks); + CAMLassert (live_words + free_words + fragments == Caml_state->stat_heap_wsz); if (returnstats){ CAMLlocal1 (res); /* get a copy of these before allocating anything... */ - double minwords = caml_stat_minor_words - + (double) (caml_young_alloc_end - caml_young_ptr); - double prowords = caml_stat_promoted_words; - double majwords = caml_stat_major_words + (double) caml_allocated_words; - intnat mincoll = caml_stat_minor_collections; - intnat majcoll = caml_stat_major_collections; - intnat heap_words = caml_stat_heap_wsz; - intnat cpct = caml_stat_compactions; - intnat top_heap_words = caml_stat_top_heap_wsz; + double minwords = + Caml_state->stat_minor_words + + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr); + double prowords = Caml_state->stat_promoted_words; + double majwords = + Caml_state->stat_major_words + (double) caml_allocated_words; + intnat mincoll = Caml_state->stat_minor_collections; + intnat majcoll = Caml_state->stat_major_collections; + intnat heap_words = Caml_state->stat_heap_wsz; + intnat cpct = Caml_state->stat_compactions; + intnat top_heap_words = Caml_state->stat_top_heap_wsz; res = caml_alloc_tuple (16); Store_field (res, 0, caml_copy_double (minwords)); @@ -288,16 +280,18 @@ CAMLprim value caml_gc_quick_stat(value v) CAMLlocal1 (res); /* get a copy of these before allocating anything... */ - double minwords = caml_stat_minor_words - + (double) (caml_young_alloc_end - caml_young_ptr); - double prowords = caml_stat_promoted_words; - double majwords = caml_stat_major_words + (double) caml_allocated_words; - intnat mincoll = caml_stat_minor_collections; - intnat majcoll = caml_stat_major_collections; - intnat heap_words = caml_stat_heap_wsz; - intnat top_heap_words = caml_stat_top_heap_wsz; - intnat cpct = caml_stat_compactions; - intnat heap_chunks = caml_stat_heap_chunks; + double minwords = + Caml_state->stat_minor_words + + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr); + double prowords = Caml_state->stat_promoted_words; + double majwords = + Caml_state->stat_major_words + (double) caml_allocated_words; + intnat mincoll = Caml_state->stat_minor_collections; + intnat majcoll = Caml_state->stat_major_collections; + intnat heap_words = Caml_state->stat_heap_wsz; + intnat top_heap_words = Caml_state->stat_top_heap_wsz; + intnat cpct = Caml_state->stat_compactions; + intnat heap_chunks = Caml_state->stat_heap_chunks; res = caml_alloc_tuple (16); Store_field (res, 0, caml_copy_double (minwords)); @@ -321,8 +315,8 @@ CAMLprim value caml_gc_quick_stat(value v) double caml_gc_minor_words_unboxed() { - return (caml_stat_minor_words - + (double) (caml_young_alloc_end - caml_young_ptr)); + return (Caml_state->stat_minor_words + + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr)); } CAMLprim value caml_gc_minor_words(value v) @@ -337,10 +331,12 @@ CAMLprim value caml_gc_counters(value v) CAMLlocal1 (res); /* get a copy of these before allocating anything... */ - double minwords = caml_stat_minor_words - + (double) (caml_young_alloc_end - caml_young_ptr); - double prowords = caml_stat_promoted_words; - double majwords = caml_stat_major_words + (double) caml_allocated_words; + double minwords = + Caml_state->stat_minor_words + + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr); + double prowords = Caml_state->stat_promoted_words; + double majwords = + Caml_state->stat_major_words + (double) caml_allocated_words; res = caml_alloc_tuple (3); Store_field (res, 0, caml_copy_double (minwords)); @@ -360,7 +356,7 @@ CAMLprim value caml_gc_get(value v) CAMLlocal1 (res); res = caml_alloc_tuple (11); - Store_field (res, 0, Val_long (caml_minor_heap_wsz)); /* s */ + Store_field (res, 0, Val_long (Caml_state->minor_heap_wsz)); /* s */ Store_field (res, 1, Val_long (caml_major_heap_increment)); /* i */ Store_field (res, 2, Val_long (caml_percent_free)); /* o */ Store_field (res, 3, Val_long (caml_verb_gc)); /* v */ @@ -424,7 +420,7 @@ CAMLprim value caml_gc_set(value v) uintnat newpf, newpm; asize_t newheapincr; asize_t newminwsz; - uintnat oldpolicy; + uintnat newpolicy; uintnat new_custom_maj, new_custom_min, new_custom_sz; CAML_INSTR_SETUP (tmr, ""); @@ -461,12 +457,6 @@ CAMLprim value caml_gc_set(value v) caml_major_heap_increment); } } - oldpolicy = caml_allocation_policy; - caml_set_allocation_policy (Long_val (Field (v, 6))); - if (oldpolicy != caml_allocation_policy){ - caml_gc_message (0x20, "New allocation policy: %" - ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocation_policy); - } /* This field was added in 4.03.0. */ if (Wosize_val (v) >= 8){ @@ -503,15 +493,32 @@ CAMLprim value caml_gc_set(value v) } } - /* Minor heap size comes last because it will trigger a minor collection - (thus invalidating [v]) and it can raise [Out_of_memory]. */ + /* Save field 0 before [v] is invalidated. */ newminwsz = norm_minsize (Long_val (Field (v, 0))); - if (newminwsz != caml_minor_heap_wsz){ + + /* Switching allocation policies must trigger a compaction, so it + invalidates [v]. */ + newpolicy = Long_val (Field (v, 6)); + if (newpolicy != caml_allocation_policy){ + caml_empty_minor_heap (); + caml_finish_major_cycle (); + caml_finish_major_cycle (); + caml_compact_heap (newpolicy); + caml_gc_message (0x20, "New allocation policy: %" + ARCH_INTNAT_PRINTF_FORMAT "u\n", newpolicy); + } + + /* Minor heap size comes last because it can raise [Out_of_memory]. */ + if (newminwsz != Caml_state->minor_heap_wsz){ caml_gc_message (0x20, "New minor heap size: %" ARCH_SIZET_PRINTF_FORMAT "uk words\n", newminwsz / 1024); caml_set_minor_heap_size (Bsize_wsize (newminwsz)); } CAML_INSTR_TIME (tmr, "explicit/gc_set"); + + /* The compaction may have triggered some finalizers that we need to call. */ + caml_process_pending_actions(); + return Val_unit; } @@ -520,7 +527,8 @@ CAMLprim value caml_gc_minor(value v) CAML_INSTR_SETUP (tmr, ""); CAMLassert (v == Val_unit); caml_request_minor_gc (); - caml_gc_dispatch (); + // call the gc and call finalisers + caml_process_pending_actions(); CAML_INSTR_TIME (tmr, "explicit/gc_minor"); return Val_unit; } @@ -529,14 +537,14 @@ static void test_and_compact (void) { double fp; - fp = 100.0 * caml_fl_cur_wsz / (caml_stat_heap_wsz - caml_fl_cur_wsz); + fp = 100.0 * caml_fl_cur_wsz / (Caml_state->stat_heap_wsz - caml_fl_cur_wsz); if (fp > 999999.0) fp = 999999.0; caml_gc_message (0x200, "Estimated overhead (lower bound) = %" ARCH_INTNAT_PRINTF_FORMAT "u%%\n", (uintnat) fp); if (fp >= caml_percent_max){ caml_gc_message (0x200, "Automatic compaction triggered.\n"); - caml_compact_heap (); + caml_compact_heap (-1); } } @@ -548,7 +556,8 @@ CAMLprim value caml_gc_major(value v) caml_empty_minor_heap (); caml_finish_major_cycle (); test_and_compact (); - caml_final_do_calls (); + // call finalisers + caml_process_pending_actions(); CAML_INSTR_TIME (tmr, "explicit/gc_major"); return Val_unit; } @@ -560,11 +569,13 @@ CAMLprim value caml_gc_full_major(value v) caml_gc_message (0x1, "Full major GC cycle requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); - caml_final_do_calls (); + // call finalisers + caml_process_pending_actions(); caml_empty_minor_heap (); caml_finish_major_cycle (); test_and_compact (); - caml_final_do_calls (); + // call finalisers + caml_process_pending_actions(); CAML_INSTR_TIME (tmr, "explicit/gc_full_major"); return Val_unit; } @@ -585,18 +596,20 @@ CAMLprim value caml_gc_compaction(value v) caml_gc_message (0x10, "Heap compaction requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); - caml_final_do_calls (); + // call finalisers + caml_process_pending_actions(); caml_empty_minor_heap (); caml_finish_major_cycle (); - caml_compact_heap (); - caml_final_do_calls (); + caml_compact_heap (-1); + // call finalisers + caml_process_pending_actions(); CAML_INSTR_TIME (tmr, "explicit/gc_compact"); return Val_unit; } CAMLprim value caml_get_minor_free (value v) { - return Val_int (caml_young_ptr - caml_young_alloc_start); + return Val_int (Caml_state->young_ptr - Caml_state->young_alloc_start); } CAMLprim value caml_get_major_bucket (value v) @@ -633,9 +646,6 @@ void caml_init_gc (uintnat minor_size, uintnat major_size, major_bsize = ((major_bsize + Page_size - 1) >> Page_log) << Page_log; caml_instr_init (); - if (caml_init_alloc_for_heap () != 0){ - caml_fatal_error ("cannot initialize heap: mmap failed"); - } if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_bsize)){ caml_fatal_error ("cannot initialize page table"); } @@ -650,7 +660,7 @@ void caml_init_gc (uintnat minor_size, uintnat major_size, caml_custom_minor_max_bsz = custom_bsz; caml_gc_message (0x20, "Initial minor heap size: %" ARCH_SIZET_PRINTF_FORMAT "uk words\n", - caml_minor_heap_wsz / 1024); + Caml_state->minor_heap_wsz / 1024); caml_gc_message (0x20, "Initial major heap size: %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", major_bsize / 1024); @@ -700,7 +710,7 @@ CAMLprim value caml_runtime_parameters (value unit) ("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d," "s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u", /* a */ (int) caml_allocation_policy, - /* b */ caml_backtrace_active, + /* b */ (int) Caml_state->backtrace_active, /* h */ /* missing */ /* FIXME add when changed to min_heap_size */ /* H */ caml_use_huge_pages, /* i */ caml_major_heap_increment, @@ -713,7 +723,7 @@ CAMLprim value caml_runtime_parameters (value unit) /* O */ caml_percent_max, /* p */ caml_parser_trace, /* R */ /* missing */ - /* s */ caml_minor_heap_wsz, + /* s */ Caml_state->minor_heap_wsz, /* t */ caml_trace_level, /* v */ caml_verb_gc, /* w */ caml_major_window, diff --git a/runtime/gen_domain_state32_inc.awk b/runtime/gen_domain_state32_inc.awk new file mode 100644 index 00000000..f8409023 --- /dev/null +++ b/runtime/gen_domain_state32_inc.awk @@ -0,0 +1,36 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* KC Sivaramakrishnan, Indian Institute of Technology, Madras * +#* * +#* Copyright 2019 Indian Institute of Technology, Madras * +#* * +#* All rights reserved. This file is distributed under the terms of * +#* the GNU Lesser General Public License version 2.1, with the * +#* special exception on linking described in the file LICENSE. * +#* * +#************************************************************************** + +BEGIN{FS="[,)] *";count=0}; +/DOMAIN_STATE/{ + print "Store_" $2 " MACRO reg1, reg2"; + print " mov [reg1+" count "], reg2"; + print "ENDM"; + print "Load_" $2 " MACRO reg1, reg2"; + print " mov reg2, [reg1+" count "]"; + print "ENDM"; + print "Push_" $2 " MACRO reg1"; + print " push [reg1+" count "]"; + print "ENDM"; + print "Pop_" $2 " MACRO reg1"; + print " pop [reg1+" count "]"; + print "ENDM"; + print "Cmp_" $2 " MACRO reg1, reg2"; + print " cmp reg2, [reg1+" count "]"; + print "ENDM"; + print "Sub_" $2 " MACRO reg1, reg2"; + print " sub reg2, [reg1+" count "]"; + print "ENDM"; + count+=8 +} diff --git a/runtime/gen_domain_state64_inc.awk b/runtime/gen_domain_state64_inc.awk new file mode 100644 index 00000000..8280d4d1 --- /dev/null +++ b/runtime/gen_domain_state64_inc.awk @@ -0,0 +1,33 @@ +#************************************************************************** +#* * +#* OCaml * +#* * +#* KC Sivaramakrishnan, Indian Institute of Technology, Madras * +#* * +#* Copyright 2019 Indian Institute of Technology, Madras * +#* * +#* All rights reserved. This file is distributed under the terms of * +#* the GNU Lesser General Public License version 2.1, with the * +#* special exception on linking described in the file LICENSE. * +#* * +#************************************************************************** + +BEGIN{FS="[,)] *";count=0}; +/DOMAIN_STATE/{ + print "Store_" $2 " MACRO reg"; + print " mov [r14+" count "], reg"; + print "ENDM"; + print "Load_" $2 " MACRO reg"; + print " mov reg, [r14+" count "]"; + print "ENDM"; + print "Push_" $2 " MACRO"; + print " push [r14+" count "]"; + print "ENDM"; + print "Pop_" $2 " MACRO"; + print " pop [r14+" count "]"; + print "ENDM"; + print "Cmp_" $2 " MACRO reg"; + print " cmp reg, [r14+" count "]"; + print "ENDM"; + count+=8 +} diff --git a/runtime/gen_primitives.sh b/runtime/gen_primitives.sh index 63365a7f..a157bae4 100755 --- a/runtime/gen_primitives.sh +++ b/runtime/gen_primitives.sh @@ -23,10 +23,10 @@ export LC_ALL=C ( for prim in \ alloc array compare extern floats gc_ctrl hash intern interp ints io \ - lexing md5 meta obj parsing signals str sys callback weak finalise \ - stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray + lexing md5 meta memprof obj parsing signals str sys callback weak \ + finalise stacks dynlink backtrace_byt backtrace spacetime_byt afl bigarray do - sed -n -e "s/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" "$prim.c" + sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' "$prim.c" done sed -n -e 's/^CAMLprim_int64_[0-9](\([a-z0-9_][a-z0-9_]*\)).*/caml_int64_\1\ caml_int64_\1_native/p' ints.c diff --git a/runtime/i386.S b/runtime/i386.S index a3f05877..b8a614d4 100644 --- a/runtime/i386.S +++ b/runtime/i386.S @@ -44,7 +44,18 @@ #define FUNCTION_ALIGN 2 #endif +#if defined(FUNCTION_SECTIONS) +#if defined(SYS_macosx) || defined(SYS_mingw) || defined(SYS_cygwin) +#define TEXT_SECTION(name) +#else +#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits +#endif +#else +#define TEXT_SECTION(name) +#endif + #define FUNCTION(name) \ + TEXT_SECTION(caml.##name); \ .globl G(name); \ .align FUNCTION_ALIGN; \ G(name): @@ -71,13 +82,31 @@ #define STACK_PROBE_SIZE 16384 #endif + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE + +#define CAML_STATE(var,reg) 8*domain_field_caml_##var(reg) + /* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays, even if only MacOS X's ABI formally requires it. */ #define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount) #define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount) -/* Allocation */ +#if defined(FUNCTION_SECTIONS) + TEXT_SECTION(caml_hot__code_begin) + .globl G(caml_hot__code_begin) +G(caml_hot__code_begin): + + TEXT_SECTION(caml_hot__code_end) + .globl G(caml_hot__code_end) +G(caml_hot__code_end): +#endif +/* Allocation */ .text .globl G(caml_system__code_begin) G(caml_system__code_begin): @@ -85,10 +114,13 @@ G(caml_system__code_begin): FUNCTION(caml_call_gc) CFI_STARTPROC /* Record lowest stack address and return address */ - movl 0(%esp), %eax - movl %eax, G(caml_last_return_address) - leal 4(%esp), %eax - movl %eax, G(caml_bottom_of_stack) + pushl %ebx; CFI_ADJUST(4) + movl G(Caml_state), %ebx + movl 4(%esp), %eax + movl %eax, CAML_STATE(last_return_address, %ebx) + leal 8(%esp), %eax + movl %eax, CAML_STATE(bottom_of_stack, %ebx) + popl %ebx; CFI_ADJUST(-4) LBL(105): #if !defined(SYS_mingw) && !defined(SYS_cygwin) /* Touch the stack to trigger a recoverable segfault @@ -97,7 +129,7 @@ LBL(105): movl %eax, 0(%esp) addl $(STACK_PROBE_SIZE), %esp; CFI_ADJUST(-STACK_PROBE_SIZE); #endif - /* Build array of registers, save it into caml_gc_regs */ + /* Build array of registers, save it into Caml_state->gc_regs */ pushl %ebp; CFI_ADJUST(4) pushl %edi; CFI_ADJUST(4) pushl %esi; CFI_ADJUST(4) @@ -105,7 +137,8 @@ LBL(105): pushl %ecx; CFI_ADJUST(4) pushl %ebx; CFI_ADJUST(4) pushl %eax; CFI_ADJUST(4) - movl %esp, G(caml_gc_regs) + movl G(Caml_state), %ebx + movl %esp, CAML_STATE(gc_regs, %ebx) /* MacOSX note: 16-alignment of stack preserved at this point */ /* Call the garbage collector */ call G(caml_garbage_collection) @@ -124,17 +157,21 @@ LBL(105): FUNCTION(caml_alloc1) CFI_STARTPROC - movl G(caml_young_ptr), %eax + pushl %ebx; CFI_ADJUST(4) + movl G(Caml_state), %ebx + movl CAML_STATE(young_ptr, %ebx), %eax subl $8, %eax - movl %eax, G(caml_young_ptr) - cmpl G(caml_young_limit), %eax + cmpl CAML_STATE(young_limit, %ebx), %eax jb LBL(100) + movl %eax, CAML_STATE(young_ptr, %ebx) + popl %ebx; CFI_ADJUST(-4) ret LBL(100): - movl 0(%esp), %eax - movl %eax, G(caml_last_return_address) - leal 4(%esp), %eax - movl %eax, G(caml_bottom_of_stack) + movl 4(%esp), %eax + movl %eax, CAML_STATE(last_return_address, %ebx) + leal 8(%esp), %eax + movl %eax, CAML_STATE(bottom_of_stack, %ebx) + popl %ebx; CFI_ADJUST(-4) ALIGN_STACK(12) call LBL(105) UNDO_ALIGN_STACK(12) @@ -144,17 +181,21 @@ LBL(100): FUNCTION(caml_alloc2) CFI_STARTPROC - movl G(caml_young_ptr), %eax + pushl %ebx; CFI_ADJUST(4) + movl G(Caml_state), %ebx + movl CAML_STATE(young_ptr, %ebx), %eax subl $12, %eax - movl %eax, G(caml_young_ptr) - cmpl G(caml_young_limit), %eax + cmpl CAML_STATE(young_limit, %ebx), %eax jb LBL(101) + movl %eax, CAML_STATE(young_ptr, %ebx) + popl %ebx; CFI_ADJUST(-4) ret LBL(101): - movl 0(%esp), %eax - movl %eax, G(caml_last_return_address) - leal 4(%esp), %eax - movl %eax, G(caml_bottom_of_stack) + movl 4(%esp), %eax + movl %eax, CAML_STATE(last_return_address, %ebx) + leal 8(%esp), %eax + movl %eax, CAML_STATE(bottom_of_stack, %ebx) + popl %ebx; CFI_ADJUST(-4) ALIGN_STACK(12) call LBL(105) UNDO_ALIGN_STACK(12) @@ -164,17 +205,21 @@ LBL(101): FUNCTION(caml_alloc3) CFI_STARTPROC - movl G(caml_young_ptr), %eax + pushl %ebx; CFI_ADJUST(4) + movl G(Caml_state), %ebx + movl CAML_STATE(young_ptr, %ebx), %eax subl $16, %eax - movl %eax, G(caml_young_ptr) - cmpl G(caml_young_limit), %eax + cmpl CAML_STATE(young_limit, %ebx), %eax jb LBL(102) + movl %eax, CAML_STATE(young_ptr, %ebx) + popl %ebx; CFI_ADJUST(-4) ret LBL(102): - movl 0(%esp), %eax - movl %eax, G(caml_last_return_address) - leal 4(%esp), %eax - movl %eax, G(caml_bottom_of_stack) + movl 4(%esp), %eax + movl %eax, CAML_STATE(last_return_address, %ebx) + leal 8(%esp), %eax + movl %eax, CAML_STATE(bottom_of_stack, %ebx) + popl %ebx; CFI_ADJUST(-4) ALIGN_STACK(12) call LBL(105) UNDO_ALIGN_STACK(12) @@ -184,21 +229,24 @@ LBL(102): FUNCTION(caml_allocN) CFI_STARTPROC - subl G(caml_young_ptr), %eax /* eax = size - caml_young_ptr */ - negl %eax /* eax = caml_young_ptr - size */ - cmpl G(caml_young_limit), %eax + pushl %eax; CFI_ADJUST(4) /* saved desired size */ + pushl %ebx; CFI_ADJUST(4) + movl G(Caml_state), %ebx + /* eax = size - Caml_state->young_ptr */ + subl CAML_STATE(young_ptr, %ebx), %eax + negl %eax /* eax = Caml_state->young_ptr - size */ + cmpl CAML_STATE(young_limit, %ebx), %eax jb LBL(103) - movl %eax, G(caml_young_ptr) + movl %eax, CAML_STATE(young_ptr, %ebx) + popl %ebx; CFI_ADJUST(-4) + addl $4, %esp; CFI_ADJUST(-4) /* drop desired size */ ret LBL(103): - subl G(caml_young_ptr), %eax /* eax = - size */ - negl %eax /* eax = size */ - pushl %eax; CFI_ADJUST(4) /* save desired size */ - subl %eax, G(caml_young_ptr) /* must update young_ptr */ - movl 4(%esp), %eax - movl %eax, G(caml_last_return_address) - leal 8(%esp), %eax - movl %eax, G(caml_bottom_of_stack) + movl 8(%esp), %eax + movl %eax, CAML_STATE(last_return_address, %ebx) + leal 12(%esp), %eax + movl %eax, CAML_STATE(bottom_of_stack, %ebx) + popl %ebx; CFI_ADJUST(-4) ALIGN_STACK(8) call LBL(105) UNDO_ALIGN_STACK(8) @@ -212,10 +260,12 @@ LBL(103): FUNCTION(caml_c_call) CFI_STARTPROC /* Record lowest stack address and return address */ + /* ecx and edx are destroyed at C call. Use them as temp. */ + movl G(Caml_state), %ecx movl (%esp), %edx - movl %edx, G(caml_last_return_address) + movl %edx, CAML_STATE(last_return_address, %ecx) leal 4(%esp), %edx - movl %edx, G(caml_bottom_of_stack) + movl %edx, CAML_STATE(bottom_of_stack, %ecx) #if !defined(SYS_mingw) && !defined(SYS_cygwin) /* Touch the stack to trigger a recoverable segfault if insufficient space remains */ @@ -241,27 +291,30 @@ FUNCTION(caml_start_program) movl $ G(caml_program), %esi /* Common code for caml_start_program and caml_callback* */ LBL(106): + movl G(Caml_state), %edi /* Build a callback link */ - pushl G(caml_gc_regs); CFI_ADJUST(4) - pushl G(caml_last_return_address); CFI_ADJUST(4) - pushl G(caml_bottom_of_stack); CFI_ADJUST(4) + pushl CAML_STATE(gc_regs, %edi); CFI_ADJUST(4) + pushl CAML_STATE(last_return_address, %edi); CFI_ADJUST(4) + pushl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(4) /* Note: 16-alignment preserved on MacOSX at this point */ /* Build an exception handler */ pushl $ LBL(108); CFI_ADJUST(4) ALIGN_STACK(8) - pushl G(caml_exception_pointer); CFI_ADJUST(4) - movl %esp, G(caml_exception_pointer) + pushl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(4) + movl %esp, CAML_STATE(exception_pointer, %edi) /* Call the OCaml code */ call *%esi LBL(107): + movl G(Caml_state), %edi /* Pop the exception handler */ - popl G(caml_exception_pointer); CFI_ADJUST(-4) + popl CAML_STATE(exception_pointer, %edi); CFI_ADJUST(-4) addl $12, %esp ; CFI_ADJUST(-12) LBL(109): + movl G(Caml_state), %edi /* Reload for LBL(109) entry */ /* Pop the callback link, restoring the global variables */ - popl G(caml_bottom_of_stack); CFI_ADJUST(-4) - popl G(caml_last_return_address); CFI_ADJUST(-4) - popl G(caml_gc_regs); CFI_ADJUST(-4) + popl CAML_STATE(bottom_of_stack, %edi); CFI_ADJUST(-4) + popl CAML_STATE(last_return_address, %edi); CFI_ADJUST(-4) + popl CAML_STATE(gc_regs, %edi); CFI_ADJUST(-4) /* Restore callee-save registers. */ popl %ebp; CFI_ADJUST(-4) popl %edi; CFI_ADJUST(-4) @@ -281,15 +334,16 @@ LBL(108): FUNCTION(caml_raise_exn) CFI_STARTPROC - testl $1, G(caml_backtrace_active) + movl G(Caml_state), %ebx + testl $1, CAML_STATE(backtrace_active, %ebx) jne LBL(110) - movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer); CFI_ADJUST(-4) + movl CAML_STATE(exception_pointer, %ebx), %esp + popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret LBL(110): movl %eax, %esi /* Save exception bucket in esi */ - movl G(caml_exception_pointer), %edi /* SP of handler */ + movl CAML_STATE(exception_pointer, %ebx), %edi /* SP of handler */ movl 0(%esp), %eax /* PC of raise */ leal 4(%esp), %edx /* SP of raise */ ALIGN_STACK(12) @@ -300,7 +354,7 @@ LBL(110): call G(caml_stash_backtrace) movl %esi, %eax /* Recover exception bucket */ movl %edi, %esp - popl G(caml_exception_pointer); CFI_ADJUST(-4) + popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret CFI_ENDPROC @@ -310,24 +364,29 @@ LBL(110): FUNCTION(caml_raise_exception) CFI_STARTPROC - testl $1, G(caml_backtrace_active) + movl G(Caml_state), %ebx + testl $1, CAML_STATE(backtrace_active, %ebx) jne LBL(112) - movl 4(%esp), %eax - movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer); CFI_ADJUST(-4) + movl 8(%esp), %eax + movl CAML_STATE(exception_pointer, %ebx), %esp + popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret LBL(112): - movl 4(%esp), %esi /* Save exception bucket in esi */ + movl 8(%esp), %esi /* Save exception bucket in esi */ ALIGN_STACK(12) - pushl G(caml_exception_pointer); CFI_ADJUST(4) /* 4: sp of handler */ - pushl G(caml_bottom_of_stack); CFI_ADJUST(4) /* 3: sp of raise */ - pushl G(caml_last_return_address); CFI_ADJUST(4)/* 2: pc of raise */ - pushl %esi; CFI_ADJUST(4) /* 1: exception bucket */ + /* 4: sp of handler */ + pushl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(4) + /* 3: sp of raise */ + pushl CAML_STATE(bottom_of_stack, %ebx); CFI_ADJUST(4) + /* 2: pc of raise */ + pushl CAML_STATE(last_return_address, %ebx); CFI_ADJUST(4) + /* 1: exception bucket */ + pushl %esi; CFI_ADJUST(4) call G(caml_stash_backtrace) movl %esi, %eax /* Recover exception bucket */ - movl G(caml_exception_pointer), %esp - popl G(caml_exception_pointer); CFI_ADJUST(-4) + movl CAML_STATE(exception_pointer, %ebx), %esp + popl CAML_STATE(exception_pointer, %ebx); CFI_ADJUST(-4) UNDO_ALIGN_STACK(8) ret CFI_ENDPROC @@ -335,7 +394,7 @@ LBL(112): /* Callback from C to OCaml */ -FUNCTION(caml_callback_exn) +FUNCTION(caml_callback_asm) CFI_STARTPROC /* Save callee-save registers */ pushl %ebx; CFI_ADJUST(4) @@ -343,14 +402,15 @@ FUNCTION(caml_callback_exn) pushl %edi; CFI_ADJUST(4) pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ - movl 20(%esp), %ebx /* closure */ - movl 24(%esp), %eax /* argument */ + movl 24(%esp), %ebx /* arg2: closure */ + movl 28(%esp), %edi /* arguments array */ + movl 0(%edi), %eax /* arg1: argument */ movl 0(%ebx), %esi /* code pointer */ jmp LBL(106) CFI_ENDPROC - ENDFUNCTION(caml_callback_exn) +ENDFUNCTION(caml_callback_asm) -FUNCTION(caml_callback2_exn) +FUNCTION(caml_callback2_asm) CFI_STARTPROC /* Save callee-save registers */ pushl %ebx; CFI_ADJUST(4) @@ -358,15 +418,16 @@ FUNCTION(caml_callback2_exn) pushl %edi; CFI_ADJUST(4) pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ - movl 20(%esp), %ecx /* closure */ - movl 24(%esp), %eax /* first argument */ - movl 28(%esp), %ebx /* second argument */ + movl 24(%esp), %ecx /* arg3: closure */ + movl 28(%esp), %edi /* arguments array */ + movl 0(%edi), %eax /* arg1: first argument */ + movl 4(%edi), %ebx /* arg2: second argument */ movl $ G(caml_apply2), %esi /* code pointer */ jmp LBL(106) CFI_ENDPROC - ENDFUNCTION(caml_callback2_exn) +ENDFUNCTION(caml_callback2_asm) -FUNCTION(caml_callback3_exn) +FUNCTION(caml_callback3_asm) CFI_STARTPROC /* Save callee-save registers */ pushl %ebx; CFI_ADJUST(4) @@ -374,14 +435,15 @@ FUNCTION(caml_callback3_exn) pushl %edi; CFI_ADJUST(4) pushl %ebp; CFI_ADJUST(4) /* Initial loading of arguments */ - movl 20(%esp), %edx /* closure */ - movl 24(%esp), %eax /* first argument */ - movl 28(%esp), %ebx /* second argument */ - movl 32(%esp), %ecx /* third argument */ + movl 24(%esp), %edx /* arg4: closure */ + movl 28(%esp), %edi /* arguments array */ + movl 0(%edi), %eax /* arg1: first argument */ + movl 4(%edi), %ebx /* arg2: second argument */ + movl 8(%edi), %ecx /* arg3: third argument */ movl $ G(caml_apply3), %esi /* code pointer */ jmp LBL(106) CFI_ENDPROC - ENDFUNCTION(caml_callback3_exn) +ENDFUNCTION(caml_callback3_asm) FUNCTION(caml_ml_array_bound_error) CFI_STARTPROC @@ -395,10 +457,11 @@ FUNCTION(caml_ml_array_bound_error) ffree %st(6) ffree %st(7) /* Record lowest stack address and return address */ + movl G(Caml_state), %ebx movl (%esp), %edx - movl %edx, G(caml_last_return_address) + movl %edx, CAML_STATE(last_return_address, %ebx) leal 4(%esp), %edx - movl %edx, G(caml_bottom_of_stack) + movl %edx, CAML_STATE(bottom_of_stack, %ebx) /* Re-align the stack */ andl $-16, %esp /* Branch to [caml_array_bound_error] (never returns) */ diff --git a/runtime/i386nt.asm b/runtime/i386nt.asm index b6730676..557994e2 100644 --- a/runtime/i386nt.asm +++ b/runtime/i386nt.asm @@ -23,31 +23,29 @@ EXTERN _caml_apply3: PROC EXTERN _caml_program: PROC EXTERN _caml_array_bound_error: PROC - EXTERN _caml_young_limit: DWORD - EXTERN _caml_young_ptr: DWORD - EXTERN _caml_bottom_of_stack: DWORD - EXTERN _caml_last_return_address: DWORD - EXTERN _caml_gc_regs: DWORD - EXTERN _caml_exception_pointer: DWORD - EXTERN _caml_backtrace_pos: DWORD - EXTERN _caml_backtrace_active: DWORD EXTERN _caml_stash_backtrace: PROC + EXTERN _Caml_state: DWORD ; Allocation .CODE + PUBLIC _caml_call_gc PUBLIC _caml_alloc1 PUBLIC _caml_alloc2 PUBLIC _caml_alloc3 PUBLIC _caml_allocN - PUBLIC _caml_call_gc + +INCLUDE domain_state32.inc _caml_call_gc: ; Record lowest stack address and return address - mov eax, [esp] - mov _caml_last_return_address, eax - lea eax, [esp+4] - mov _caml_bottom_of_stack, eax + push ebx ; make a tmp reg + mov ebx, _Caml_state + mov eax, [esp+4] + Store_last_return_address ebx, eax + lea eax, [esp+8] + Store_bottom_of_stack ebx, eax + pop ebx ; Save all regs used by the code generator L105: push ebp push edi @@ -56,7 +54,8 @@ L105: push ebp push ecx push ebx push eax - mov _caml_gc_regs, esp + mov ebx, _Caml_state + Store_gc_regs ebx, esp ; Call the garbage collector call _caml_garbage_collection ; Restore all regs used by the code generator @@ -72,65 +71,80 @@ L105: push ebp ALIGN 4 _caml_alloc1: - mov eax, _caml_young_ptr + push ebx ; make a tmp reg + mov ebx, _Caml_state + Load_young_ptr ebx, eax sub eax, 8 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit + Cmp_young_limit ebx, eax jb L100 + Store_young_ptr ebx, eax + pop ebx ret -L100: mov eax, [esp] - mov _caml_last_return_address, eax - lea eax, [esp+4] - mov _caml_bottom_of_stack, eax +L100: mov eax, [esp + 4] + Store_last_return_address ebx, eax + lea eax, [esp+8] + Store_bottom_of_stack ebx, eax + pop ebx call L105 jmp _caml_alloc1 ALIGN 4 _caml_alloc2: - mov eax, _caml_young_ptr + push ebx ; make a tmp reg + mov ebx, _Caml_state + Load_young_ptr ebx, eax sub eax, 12 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit + Cmp_young_limit ebx, eax jb L101 + Store_young_ptr ebx, eax + pop ebx ret -L101: mov eax, [esp] - mov _caml_last_return_address, eax - lea eax, [esp+4] - mov _caml_bottom_of_stack, eax +L101: mov eax, [esp+4] + Store_last_return_address ebx, eax + lea eax, [esp+8] + Store_bottom_of_stack ebx, eax + pop ebx call L105 jmp _caml_alloc2 ALIGN 4 _caml_alloc3: - mov eax, _caml_young_ptr + push ebx ; make a tmp reg + mov ebx, _Caml_state + Load_young_ptr ebx, eax sub eax, 16 - mov _caml_young_ptr, eax - cmp eax, _caml_young_limit + Cmp_young_limit ebx, eax jb L102 + Store_young_ptr ebx, eax + pop ebx ret -L102: mov eax, [esp] - mov _caml_last_return_address, eax - lea eax, [esp+4] - mov _caml_bottom_of_stack, eax +L102: mov eax, [esp+4] + Store_last_return_address ebx, eax + lea eax, [esp+8] + Store_bottom_of_stack ebx, eax + pop ebx call L105 jmp _caml_alloc3 + ALIGN 4 _caml_allocN: - sub eax, _caml_young_ptr ; eax = size - young_ptr - neg eax ; eax = young_ptr - size - cmp eax, _caml_young_limit + push eax ; Save desired size + push ebx ; Make a tmp reg + mov ebx, _Caml_state + Sub_young_ptr ebx, eax ; eax = size - young_ptr + neg eax ; eax = young_ptr - size + Cmp_young_limit ebx, eax jb L103 - mov _caml_young_ptr, eax + Store_young_ptr ebx, eax + pop ebx + add esp, 4 ; drop desired size ret -L103: sub eax, _caml_young_ptr ; eax = - size - neg eax ; eax = size - push eax ; save desired size - sub _caml_young_ptr, eax ; must update young_ptr - mov eax, [esp+4] - mov _caml_last_return_address, eax - lea eax, [esp+8] - mov _caml_bottom_of_stack, eax +L103: mov eax, [esp+8] + Store_last_return_address ebx, eax + lea eax, [esp+12] + Store_bottom_of_stack ebx, eax + pop ebx call L105 pop eax ; recover desired size jmp _caml_allocN @@ -141,10 +155,12 @@ L103: sub eax, _caml_young_ptr ; eax = - size ALIGN 4 _caml_c_call: ; Record lowest stack address and return address + ; ecx and edx are destroyed at C call. Use them as temp. + mov ecx, _Caml_state mov edx, [esp] - mov _caml_last_return_address, edx + Store_last_return_address ecx, edx lea edx, [esp+4] - mov _caml_bottom_of_stack, edx + Store_bottom_of_stack ecx, edx ; Call the function (address in %eax) jmp eax @@ -164,26 +180,29 @@ _caml_start_program: ; Code shared between caml_start_program and callback* L106: + mov edi, _Caml_state ; Build a callback link - push _caml_gc_regs - push _caml_last_return_address - push _caml_bottom_of_stack + Push_gc_regs edi + Push_last_return_address edi + Push_bottom_of_stack edi ; Build an exception handler push L108 - push _caml_exception_pointer - mov _caml_exception_pointer, esp + Push_exception_pointer edi + Store_exception_pointer edi, esp ; Call the OCaml code call esi L107: + mov edi, _Caml_state ; Pop the exception handler - pop _caml_exception_pointer - pop esi ; dummy register + Pop_exception_pointer edi + add esp, 4 L109: + mov edi, _Caml_state ; Pop the callback link, restoring the global variables ; used by caml_c_call - pop _caml_bottom_of_stack - pop _caml_last_return_address - pop _caml_gc_regs + Pop_bottom_of_stack edi + Pop_last_return_address edi + Pop_gc_regs edi ; Restore callee-save registers. pop ebp pop edi @@ -202,16 +221,18 @@ L108: PUBLIC _caml_raise_exn ALIGN 4 _caml_raise_exn: - test _caml_backtrace_active, 1 + mov ebx, _Caml_state + Load_backtrace_active ebx, ecx + test ecx, 1 jne L110 - mov esp, _caml_exception_pointer - pop _caml_exception_pointer + Load_exception_pointer ebx, esp + Pop_exception_pointer ebx ret L110: mov esi, eax ; Save exception bucket in esi - mov edi, _caml_exception_pointer ; SP of handler + Load_exception_pointer ebx, edi ; SP of handler mov eax, [esp] ; PC of raise - lea edx, [esp+4] + lea edx, [esp+4] ; SP of raise push edi ; arg 4: SP of handler push edx ; arg 3: SP of raise push eax ; arg 2: PC of raise @@ -219,7 +240,7 @@ L110: call _caml_stash_backtrace mov eax, esi ; recover exception bucket mov esp, edi ; cut the stack - pop _caml_exception_pointer + Pop_exception_pointer ebx ret ; Raise an exception from C @@ -227,68 +248,73 @@ L110: PUBLIC _caml_raise_exception ALIGN 4 _caml_raise_exception: - test _caml_backtrace_active, 1 + mov ebx, _Caml_state + Load_backtrace_active ebx, ecx + test ecx, 1 jne L112 - mov eax, [esp+4] - mov esp, _caml_exception_pointer - pop _caml_exception_pointer + mov eax, [esp+8] + Load_exception_pointer ebx, esp + Pop_exception_pointer ebx ret L112: - mov esi, [esp+4] ; Save exception bucket in esi - push _caml_exception_pointer ; arg 4: SP of handler - push _caml_bottom_of_stack ; arg 3: SP of raise - push _caml_last_return_address ; arg 2: PC of raise + mov esi, [esp+8] ; Save exception bucket in esi + Push_exception_pointer ebx ; arg 4: SP of handler + Push_bottom_of_stack ebx ; arg 3: SP of raise + Push_last_return_address ebx ; arg 2: PC of raise push esi ; arg 1: exception bucket call _caml_stash_backtrace mov eax, esi ; recover exception bucket - mov esp, _caml_exception_pointer ; cut the stack - pop _caml_exception_pointer + Load_exception_pointer ebx, esp ; cut the stack + Pop_exception_pointer ebx ret ; Callback from C to OCaml - PUBLIC _caml_callback_exn + PUBLIC _caml_callback_asm ALIGN 4 -_caml_callback_exn: +_caml_callback_asm: ; Save callee-save registers push ebx push esi push edi push ebp ; Initial loading of arguments - mov ebx, [esp+20] ; closure - mov eax, [esp+24] ; argument + mov ebx, [esp+24] ; arg2: closure + mov edi, [esp+28] ; arguments array + mov eax, [edi] ; arg1: argument mov esi, [ebx] ; code pointer jmp L106 - PUBLIC _caml_callback2_exn + PUBLIC _caml_callback2_asm ALIGN 4 -_caml_callback2_exn: +_caml_callback2_asm: ; Save callee-save registers push ebx push esi push edi push ebp ; Initial loading of arguments - mov ecx, [esp+20] ; closure - mov eax, [esp+24] ; first argument - mov ebx, [esp+28] ; second argument + mov ecx, [esp+24] ; arg3: closure + mov edi, [esp+28] ; arguments array + mov eax, [edi] ; arg1: first argument + mov ebx, [edi+4] ; arg2: second argument mov esi, offset _caml_apply2 ; code pointer jmp L106 - PUBLIC _caml_callback3_exn + PUBLIC _caml_callback3_asm ALIGN 4 -_caml_callback3_exn: +_caml_callback3_asm: ; Save callee-save registers push ebx push esi push edi push ebp ; Initial loading of arguments - mov edx, [esp+20] ; closure - mov eax, [esp+24] ; first argument - mov ebx, [esp+28] ; second argument - mov ecx, [esp+32] ; third argument + mov edx, [esp+24] ; arg4: closure + mov edi, [esp+28] ; arguments array + mov eax, [edi] ; arg1: first argument + mov ebx, [edi+4] ; arg2: second argument + mov ecx, [edi+8] ; arg3: third argument mov esi, offset _caml_apply3 ; code pointer jmp L106 diff --git a/runtime/instrtrace.c b/runtime/instrtrace.c index 3aa99448..3e5cbb56 100644 --- a/runtime/instrtrace.c +++ b/runtime/instrtrace.c @@ -190,9 +190,10 @@ caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f) fprintf (f, "=code@%ld", (long) ((code_t) v - prog)); else if (Is_long (v)) fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v)); - else if ((void*)v >= (void*)caml_stack_low - && (void*)v < (void*)caml_stack_high) - fprintf (f, "=stack_%ld", (long) ((intnat*)caml_stack_high - (intnat*)v)); + else if ((void*)v >= (void*)Caml_state->stack_low + && (void*)v < (void*)Caml_state->stack_high) + fprintf (f, "=stack_%ld", + (long) ((intnat*)Caml_state->stack_high - (intnat*)v)); else if (Is_block (v)) { int s = Wosize_val (v); int tg = Tag_val (v); @@ -256,10 +257,11 @@ caml_trace_accu_sp_file (value accu, value * sp, code_t prog, asize_t proglen, fprintf (f, "accu="); caml_trace_value_file (accu, prog, proglen, f); fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%ld:", - (intnat) sp, (long) (caml_stack_high - sp)); - for (p = sp, i = 0; i < 12 + (1 << caml_trace_level) && p < caml_stack_high; + (intnat) sp, (long) (Caml_state->stack_high - sp)); + for (p = sp, i = 0; + i < 12 + (1 << caml_trace_level) && p < Caml_state->stack_high; p++, i++) { - fprintf (f, "\n[%ld] ", (long) (caml_stack_high - p)); + fprintf (f, "\n[%ld] ", (long) (Caml_state->stack_high - p)); caml_trace_value_file (*p, prog, proglen, f); }; putc ('\n', f); diff --git a/runtime/intern.c b/runtime/intern.c index 6e2dcc79..7e0d4fd3 100644 --- a/runtime/intern.c +++ b/runtime/intern.c @@ -31,9 +31,12 @@ #include "caml/io.h" #include "caml/md5.h" #include "caml/memory.h" +#include "caml/memprof.h" #include "caml/mlvalues.h" #include "caml/misc.h" #include "caml/reverse.h" +#include "caml/signals.h" + static unsigned char * intern_src; /* Reading pointer in block holding input data. */ @@ -573,7 +576,7 @@ static void intern_rec(value *dest) if (ops->finalize != NULL && Is_young(v)) { /* Remember that the block has a finalizer. */ - add_to_custom_table (&caml_custom_table, v, 0, 1); + add_to_custom_table (Caml_state->custom_table, v, 0, 1); } intern_dest += 1 + size; @@ -625,11 +628,15 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects, if (wosize <= Max_young_wosize){ if (wosize == 0){ intern_block = Atom (String_tag); - } else { - intern_block = caml_alloc_small (wosize, String_tag); + }else{ +#define Setup_for_gc +#define Restore_after_gc + Alloc_small_no_track(intern_block, wosize, String_tag); +#undef Setup_for_gc +#undef Restore_after_gc } }else{ - intern_block = caml_alloc_shr_no_raise (wosize, String_tag); + intern_block = caml_alloc_shr_no_track_noexc (wosize, String_tag); /* do not do the urgent_gc check here because it might darken intern_block into gray and break the intern_color assertion below */ if (intern_block == 0) { @@ -655,8 +662,9 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects, CAMLassert(intern_obj_table == NULL); } -static void intern_add_to_heap(mlsize_t whsize) +static header_t* intern_add_to_heap(mlsize_t whsize) { + header_t* res = NULL; /* Add new heap chunk to heap if needed */ if (intern_extra_block != NULL) { /* If heap chunk not filled totally, build free block at end */ @@ -671,11 +679,37 @@ static void intern_add_to_heap(mlsize_t whsize) } caml_allocated_words += Wsize_bsize ((char *) intern_dest - intern_extra_block); - caml_add_to_heap(intern_extra_block); + if(caml_add_to_heap(intern_extra_block) != 0) { + intern_cleanup(); + caml_raise_out_of_memory(); + } + res = (header_t*)intern_extra_block; intern_extra_block = NULL; // To prevent intern_cleanup freeing it - } else { + } else if(intern_block != 0) { /* [intern_block = 0] when [whsize = 0] */ + res = Hp_val(intern_block); intern_block = 0; // To prevent intern_cleanup rewriting its header } + return res; +} + +static value intern_end(value res, mlsize_t whsize) +{ + CAMLparam1(res); + header_t *block = intern_add_to_heap(whsize); + header_t *blockend = intern_dest; + + /* Free everything */ + intern_cleanup(); + + /* Memprof tracking has to be done here, because unmarshalling can + still fail until now. */ + if(block != NULL) + caml_memprof_track_interned(block, blockend); + + // Give gc a chance to run, and run memprof callbacks + caml_process_pending_actions(); + + CAMLreturn(res); } /* Parsing the header */ @@ -772,16 +806,16 @@ static value caml_input_val_core(struct channel *chan, int outside_heap) intern_alloc(h.whsize, h.num_objects, outside_heap); /* Fill it in */ intern_rec(&res); - if (!outside_heap) { - intern_add_to_heap(h.whsize); - } else { + if (!outside_heap) + return intern_end(res, h.whsize); + else { caml_disown_for_heap(intern_extra_block); intern_extra_block = NULL; intern_block = 0; + /* Free everything */ + intern_cleanup(); + return caml_check_urgent_gc(res); } - /* Free everything */ - intern_cleanup(); - return caml_check_urgent_gc(res); } value caml_input_val(struct channel* chan) @@ -831,10 +865,7 @@ CAMLexport value caml_input_val_from_bytes(value str, intnat ofs) intern_src = &Byte_u(str, ofs + h.header_len); /* If a GC occurred */ /* Fill it in */ intern_rec(&obj); - intern_add_to_heap(h.whsize); - /* Free everything */ - intern_cleanup(); - CAMLreturn (caml_check_urgent_gc(obj)); + CAMLreturn (intern_end(obj, h.whsize)); } CAMLprim value caml_input_value_from_string(value str, value ofs) @@ -854,10 +885,7 @@ static value input_val_from_block(struct marshal_header * h) intern_alloc(h->whsize, h->num_objects, 0); /* Fill it in */ intern_rec(&obj); - intern_add_to_heap(h->whsize); - /* Free internal data structures */ - intern_cleanup(); - return caml_check_urgent_gc(obj); + return (intern_end(obj, h->whsize)); } CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) diff --git a/runtime/interp.c b/runtime/interp.c index b4205f64..6bee2b0e 100644 --- a/runtime/interp.c +++ b/runtime/interp.c @@ -40,10 +40,10 @@ sp the stack pointer (grows downward) accu the accumulator env heap-allocated environment - caml_trapsp pointer to the current trap frame + Caml_state->trapsp pointer to the current trap frame extra_args number of extra arguments provided by the caller -sp is a local copy of the global variable caml_extern_sp. */ +sp is a local copy of the global variable Caml_state->extern_sp. */ /* Instruction decoding */ @@ -67,16 +67,26 @@ sp is a local copy of the global variable caml_extern_sp. */ /* GC interface */ +#undef Alloc_small_origin +// Do call asynchronous callbacks from allocation functions +#define Alloc_small_origin CAML_FROM_CAML #define Setup_for_gc \ - { sp -= 2; sp[0] = accu; sp[1] = env; caml_extern_sp = sp; } + { sp -= 2; sp[0] = accu; sp[1] = env; Caml_state->extern_sp = sp; } #define Restore_after_gc \ { accu = sp[0]; env = sp[1]; sp += 2; } + +/* We store [pc+1] in the stack so that, in case of an exception, the + first backtrace slot points to the event following the C call + instruction. */ #define Setup_for_c_call \ - { saved_pc = pc; *--sp = env; caml_extern_sp = sp; } + { sp -= 2; sp[0] = env; sp[1] = (value)(pc + 1); Caml_state->extern_sp = sp; } #define Restore_after_c_call \ - { sp = caml_extern_sp; env = *sp++; saved_pc = NULL; } + { sp = Caml_state->extern_sp; env = *sp; sp += 2; } -/* An event frame must look like accu + a C_CALL frame + a RETURN 1 frame */ +/* For VM threads purposes, an event frame must look like accu + a + C_CALL frame + a RETURN 1 frame. + TODO: now that VM threads are gone, we could get rid of that. But + we need to make sure that this is not used elsewhere. */ #define Setup_for_event \ { sp -= 6; \ sp[0] = accu; /* accu */ \ @@ -85,9 +95,9 @@ sp is a local copy of the global variable caml_extern_sp. */ sp[3] = (value) pc; /* RETURN frame: saved return address */ \ sp[4] = env; /* RETURN frame: saved environment */ \ sp[5] = Val_long(extra_args); /* RETURN frame: saved extra args */ \ - caml_extern_sp = sp; } + Caml_state->extern_sp = sp; } #define Restore_after_event \ - { sp = caml_extern_sp; accu = sp[0]; \ + { sp = Caml_state->extern_sp; accu = sp[0]; \ pc = (code_t) sp[3]; env = sp[4]; extra_args = Long_val(sp[5]); \ sp += 6; } @@ -97,18 +107,22 @@ sp is a local copy of the global variable caml_extern_sp. */ { sp -= 4; \ sp[0] = accu; sp[1] = (value)(pc - 1); \ sp[2] = env; sp[3] = Val_long(extra_args); \ - caml_extern_sp = sp; } + Caml_state->extern_sp = sp; } #define Restore_after_debugger { sp += 4; } #ifdef THREADED_CODE #define Restart_curr_instr \ - goto *(jumptable[caml_saved_code[pc - 1 - caml_start_code]]) + goto *((void*)(jumptbl_base + caml_debugger_saved_instruction(pc - 1))) #else #define Restart_curr_instr \ - curr_instr = caml_saved_code[pc - 1 - caml_start_code]; \ + curr_instr = caml_debugger_saved_instruction(pc - 1); \ goto dispatch_instr #endif +#define Check_trap_barrier \ + if (Caml_state->trapsp >= Caml_state->trap_barrier) \ + caml_debugger(TRAP_BARRIER, Val_unit) + /* Register optimization. Some compilers underestimate the use of the local variables representing the abstract machine registers, and don't put them in hardware registers, @@ -214,10 +228,9 @@ value caml_interprete(code_t prog, asize_t prog_size) intnat extra_args; struct longjmp_buffer * initial_external_raise; intnat initial_sp_offset; - /* volatile ensures that initial_local_roots and saved_pc + /* volatile ensures that initial_local_roots will keep correct value across longjmp */ struct caml__roots_block * volatile initial_local_roots; - volatile code_t saved_pc = NULL; struct longjmp_buffer raise_buf; #ifndef THREADED_CODE opcode_t curr_instr; @@ -240,24 +253,29 @@ value caml_interprete(code_t prog, asize_t prog_size) #if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32) jumptbl_base = Jumptbl_base; #endif - initial_local_roots = caml_local_roots; - initial_sp_offset = (char *) caml_stack_high - (char *) caml_extern_sp; - initial_external_raise = caml_external_raise; + initial_local_roots = Caml_state->local_roots; + initial_sp_offset = + (char *) Caml_state->stack_high - (char *) Caml_state->extern_sp; + initial_external_raise = Caml_state->external_raise; caml_callback_depth++; - saved_pc = NULL; if (sigsetjmp(raise_buf.buf, 0)) { - caml_local_roots = initial_local_roots; - sp = caml_extern_sp; - accu = caml_exn_bucket; - pc = saved_pc; saved_pc = NULL; - if (pc != NULL) pc += 2; - /* +2 adjustment for the sole purpose of backtraces */ - goto raise_exception; + Caml_state->local_roots = initial_local_roots; + sp = Caml_state->extern_sp; + accu = Caml_state->exn_bucket; + + Check_trap_barrier; + if (Caml_state->backtrace_active) { + /* pc has already been pushed on the stack when calling the C + function that raised the exception. No need to push it again + here. */ + caml_stash_backtrace(accu, sp, 0); + } + goto raise_notrace; } - caml_external_raise = &raise_buf; + Caml_state->external_raise = &raise_buf; - sp = caml_extern_sp; + sp = Caml_state->extern_sp; pc = prog; extra_args = 0; env = Atom(0); @@ -267,8 +285,8 @@ value caml_interprete(code_t prog, asize_t prog_size) #ifdef DEBUG next_instr: if (caml_icount-- == 0) caml_stop_here (); - CAMLassert(sp >= caml_stack_low); - CAMLassert(sp <= caml_stack_high); + CAMLassert(sp >= Caml_state->stack_low); + CAMLassert(sp <= Caml_state->stack_high); #endif goto *(void *)(jumptbl_base + *pc++); /* Jump to the first instruction */ #else @@ -286,8 +304,8 @@ value caml_interprete(code_t prog, asize_t prog_size) caml_trace_accu_sp_file(accu,sp,prog,prog_size,stdout); fflush(stdout); }; - CAMLassert(sp >= caml_stack_low); - CAMLassert(sp <= caml_stack_high); + CAMLassert(sp >= Caml_state->stack_low); + CAMLassert(sp <= Caml_state->stack_high); #endif curr_instr = *pc++; @@ -825,10 +843,10 @@ value caml_interprete(code_t prog, asize_t prog_size) Instruct(PUSHTRAP): sp -= 4; Trap_pc(sp) = pc + *pc; - Trap_link(sp) = caml_trapsp; + Trap_link(sp) = Caml_state->trapsp; sp[2] = env; sp[3] = Val_long(extra_args); - caml_trapsp = sp; + Caml_state->trapsp = sp; pc++; Next; @@ -838,37 +856,42 @@ value caml_interprete(code_t prog, asize_t prog_size) handler triggers an exception, the exception is trapped by the current try...with, not the enclosing one. */ pc--; /* restart the POPTRAP after processing the signal */ - goto process_signal; + goto process_actions; } - caml_trapsp = Trap_link(sp); + Caml_state->trapsp = Trap_link(sp); sp += 4; Next; Instruct(RAISE_NOTRACE): - if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER); + Check_trap_barrier; goto raise_notrace; Instruct(RERAISE): - if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER); - if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 1); + Check_trap_barrier; + if (Caml_state->backtrace_active) { + *--sp = (value)(pc - 1); + caml_stash_backtrace(accu, sp, 1); + } goto raise_notrace; Instruct(RAISE): - raise_exception: - if (caml_trapsp >= caml_trap_barrier) caml_debugger(TRAP_BARRIER); - if (caml_backtrace_active) caml_stash_backtrace(accu, pc, sp, 0); + Check_trap_barrier; + if (Caml_state->backtrace_active) { + *--sp = (value)(pc - 1); + caml_stash_backtrace(accu, sp, 0); + } raise_notrace: - if ((char *) caml_trapsp - >= (char *) caml_stack_high - initial_sp_offset) { - caml_external_raise = initial_external_raise; - caml_extern_sp = (value *) ((char *) caml_stack_high + if ((char *) Caml_state->trapsp + >= (char *) Caml_state->stack_high - initial_sp_offset) { + Caml_state->external_raise = initial_external_raise; + Caml_state->extern_sp = (value *) ((char *) Caml_state->stack_high - initial_sp_offset); caml_callback_depth--; return Make_exception_result(accu); } - sp = caml_trapsp; + sp = Caml_state->trapsp; pc = Trap_pc(sp); - caml_trapsp = Trap_link(sp); + Caml_state->trapsp = Trap_link(sp); env = sp[2]; extra_args = Long_val(sp[3]); sp += 4; @@ -877,23 +900,22 @@ value caml_interprete(code_t prog, asize_t prog_size) /* Stack checks */ check_stacks: - if (sp < caml_stack_threshold) { - caml_extern_sp = sp; + if (sp < Caml_state->stack_threshold) { + Caml_state->extern_sp = sp; caml_realloc_stack(Stack_threshold / sizeof(value)); - sp = caml_extern_sp; + sp = Caml_state->extern_sp; } /* Fall through CHECK_SIGNALS */ /* Signal handling */ Instruct(CHECK_SIGNALS): /* accu not preserved */ - if (caml_something_to_do) goto process_signal; + if (caml_something_to_do) goto process_actions; Next; - process_signal: - caml_something_to_do = 0; + process_actions: Setup_for_event; - caml_process_event(); + caml_process_pending_actions(); Restore_after_event; Next; @@ -907,28 +929,28 @@ value caml_interprete(code_t prog, asize_t prog_size) Next; Instruct(C_CALL2): Setup_for_c_call; - accu = Primitive(*pc)(accu, sp[1]); + accu = Primitive(*pc)(accu, sp[2]); Restore_after_c_call; sp += 1; pc++; Next; Instruct(C_CALL3): Setup_for_c_call; - accu = Primitive(*pc)(accu, sp[1], sp[2]); + accu = Primitive(*pc)(accu, sp[2], sp[3]); Restore_after_c_call; sp += 2; pc++; Next; Instruct(C_CALL4): Setup_for_c_call; - accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3]); + accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4]); Restore_after_c_call; sp += 3; pc++; Next; Instruct(C_CALL5): Setup_for_c_call; - accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3], sp[4]); + accu = Primitive(*pc)(accu, sp[2], sp[3], sp[4], sp[5]); Restore_after_c_call; sp += 4; pc++; @@ -937,7 +959,7 @@ value caml_interprete(code_t prog, asize_t prog_size) int nargs = *pc++; *--sp = accu; Setup_for_c_call; - accu = Primitive(*pc)(sp + 1, nargs); + accu = Primitive(*pc)(sp + 2, nargs); Restore_after_c_call; sp += nargs; pc++; @@ -1123,22 +1145,22 @@ value caml_interprete(code_t prog, asize_t prog_size) /* Debugging and machine control */ Instruct(STOP): - caml_external_raise = initial_external_raise; - caml_extern_sp = sp; + Caml_state->external_raise = initial_external_raise; + Caml_state->extern_sp = sp; caml_callback_depth--; return accu; Instruct(EVENT): if (--caml_event_count == 0) { Setup_for_debugger; - caml_debugger(EVENT_COUNT); + caml_debugger(EVENT_COUNT, Val_unit); Restore_after_debugger; } Restart_curr_instr; Instruct(BREAK): Setup_for_debugger; - caml_debugger(BREAKPOINT); + caml_debugger(BREAKPOINT, Val_unit); Restore_after_debugger; Restart_curr_instr; diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 2fde9e84..a723c40e 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -125,7 +125,7 @@ static void realloc_gray_vals (void) value *new; CAMLassert (gray_vals_cur == gray_vals_end); - if (gray_vals_size < caml_stat_heap_wsz / 32){ + if (gray_vals_size < Caml_state->stat_heap_wsz / 32){ caml_gc_message (0x08, "Growing gray_vals to %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", (intnat) gray_vals_size * sizeof (value) / 512); @@ -270,10 +270,10 @@ static inline value* mark_slice_darken(value *gray_vals_ptr, /* 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)){ - 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)); + if(in_ephemeron) { + add_to_ephe_ref_table (Caml_state->ephe_ref_table, v, i); + } else { + add_to_ref_table (Caml_state->ref_table, &Field (v, i)); } } } @@ -562,11 +562,7 @@ static void sweep_slice (intnat work) caml_gc_sweep_hp += Bhsize_hd (hd); switch (Color_hd (hd)){ case Caml_white: - if (Tag_hd (hd) == Custom_tag){ - void (*final_fun)(value) = Custom_ops_val(Val_hp(hp))->finalize; - if (final_fun != NULL) final_fun(Val_hp(hp)); - } - caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp)); + caml_gc_sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp), limit); break; case Caml_blue: /* Only the blocks of the free-list are blue. See [freelist.c]. */ @@ -582,7 +578,7 @@ static void sweep_slice (intnat work) chunk = Chunk_next (chunk); if (chunk == NULL){ /* Sweeping is done. */ - ++ caml_stat_major_collections; + ++ Caml_state->stat_major_collections; work = 0; caml_gc_phase = Phase_idle; caml_request_minor_gc (); @@ -627,7 +623,7 @@ void caml_major_collection_slice (intnat howmuch) int i; /* Free memory at the start of the GC cycle (garbage + free list) (assumed): - FM = caml_stat_heap_wsz * caml_percent_free + FM = Caml_state->stat_heap_wsz * caml_percent_free / (100 + caml_percent_free) Assuming steady state and enforcing a constant allocation rate, then @@ -639,7 +635,7 @@ void caml_major_collection_slice (intnat howmuch) Proportion of G consumed since the previous slice: PH = caml_allocated_words / G = caml_allocated_words * 3 * (100 + caml_percent_free) - / (2 * caml_stat_heap_wsz * caml_percent_free) + / (2 * Caml_state->stat_heap_wsz * caml_percent_free) Proportion of extra-heap resources consumed since the previous slice: PE = caml_extra_heap_resources Proportion of total work to do in this slice: @@ -650,10 +646,10 @@ void caml_major_collection_slice (intnat howmuch) the P above. Amount of marking work for the GC cycle: - MW = caml_stat_heap_wsz * 100 / (100 + caml_percent_free) - + caml_incremental_roots_count + MW = Caml_state->stat_heap_wsz * 100 / (100 + caml_percent_free) + + caml_incremental_roots_count Amount of sweeping work for the GC cycle: - SW = caml_stat_heap_wsz + SW = Caml_state->stat_heap_wsz In order to finish marking with a non-empty free list, we will use 40% of the time for marking, and 60% for sweeping. @@ -673,11 +669,12 @@ void caml_major_collection_slice (intnat howmuch) Amount of marking work for a marking slice: MS = P * MW / (40/100) - MS = P * (caml_stat_heap_wsz * 250 / (100 + caml_percent_free) + MS = P * (Caml_state->stat_heap_wsz * 250 + / (100 + caml_percent_free) + 2.5 * caml_incremental_roots_count) Amount of sweeping work for a sweeping slice: SS = P * SW / (60/100) - SS = P * caml_stat_heap_wsz * 5 / 3 + SS = P * Caml_state->stat_heap_wsz * 5 / 3 This slice will either mark MS words or sweep SS words. */ @@ -686,7 +683,7 @@ void caml_major_collection_slice (intnat howmuch) CAML_INSTR_SETUP (tmr, "major"); p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free) - / caml_stat_heap_wsz / caml_percent_free / 2.0; + / Caml_state->stat_heap_wsz / caml_percent_free / 2.0; if (caml_dependent_size > 0){ dp = (double) caml_dependent_allocated * (100 + caml_percent_free) / caml_dependent_size / caml_percent_free; @@ -752,9 +749,11 @@ void caml_major_collection_slice (intnat howmuch) }else{ /* manual setting */ filt_p = (double) howmuch * 3.0 * (100 + caml_percent_free) - / caml_stat_heap_wsz / caml_percent_free / 2.0; + / Caml_state->stat_heap_wsz / caml_percent_free / 2.0; } caml_major_work_credit += filt_p; + /* Limit work credit to 1.0 */ + caml_major_work_credit = fmin(caml_major_work_credit, 1.0); } p = filt_p; @@ -764,7 +763,7 @@ void caml_major_collection_slice (intnat howmuch) (intnat) (p * 1000000)); if (caml_gc_phase == Phase_idle){ - if (caml_young_ptr == caml_young_alloc_end){ + if (Caml_state->young_ptr == Caml_state->young_alloc_end){ /* We can only start a major GC cycle if the minor allocation arena is empty, otherwise we'd have to treat it as a set of roots. */ start_cycle (); @@ -780,11 +779,11 @@ void caml_major_collection_slice (intnat howmuch) } if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean){ - computed_work = (intnat) (p * ((double) caml_stat_heap_wsz * 250 + computed_work = (intnat) (p * ((double) Caml_state->stat_heap_wsz * 250 / (100 + caml_percent_free) + caml_incremental_roots_count)); }else{ - computed_work = (intnat) (p * caml_stat_heap_wsz * 5 / 3); + computed_work = (intnat) (p * Caml_state->stat_heap_wsz * 5 / 3); } caml_gc_message (0x40, "computed work = %" ARCH_INTNAT_PRINTF_FORMAT "d words\n", computed_work); @@ -825,7 +824,7 @@ void caml_major_collection_slice (intnat howmuch) for (i = 0; i < caml_major_window; i++) caml_major_ring[i] += p; } - caml_stat_major_words += caml_allocated_words; + Caml_state->stat_major_words += caml_allocated_words; caml_allocated_words = 0; caml_dependent_allocated = 0; caml_extra_heap_resources = 0.0; @@ -847,7 +846,7 @@ void caml_finish_major_cycle (void) CAMLassert (caml_gc_phase == Phase_sweep); while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX); CAMLassert (caml_gc_phase == Phase_idle); - caml_stat_major_words += caml_allocated_words; + Caml_state->stat_major_words += caml_allocated_words; caml_allocated_words = 0; } @@ -863,7 +862,7 @@ asize_t caml_clip_heap_chunk_wsz (asize_t wsz) if (caml_major_heap_increment > 1000){ incr = caml_major_heap_increment; }else{ - incr = caml_stat_heap_wsz / 100 * caml_major_heap_increment; + incr = Caml_state->stat_heap_wsz / 100 * caml_major_heap_increment; } if (result < incr){ @@ -880,27 +879,28 @@ void caml_init_major_heap (asize_t heap_size) { int i; - caml_stat_heap_wsz = caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size)); - caml_stat_top_heap_wsz = caml_stat_heap_wsz; - CAMLassert (Bsize_wsize (caml_stat_heap_wsz) % Page_size == 0); + Caml_state->stat_heap_wsz = + caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size)); + Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz; + CAMLassert (Bsize_wsize (Caml_state->stat_heap_wsz) % Page_size == 0); caml_heap_start = - (char *) caml_alloc_for_heap (Bsize_wsize (caml_stat_heap_wsz)); + (char *) caml_alloc_for_heap (Bsize_wsize (Caml_state->stat_heap_wsz)); if (caml_heap_start == NULL) caml_fatal_error ("cannot allocate initial major heap"); Chunk_next (caml_heap_start) = NULL; - caml_stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start)); - caml_stat_heap_chunks = 1; - caml_stat_top_heap_wsz = caml_stat_heap_wsz; + Caml_state->stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start)); + Caml_state->stat_heap_chunks = 1; + Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz; if (caml_page_table_add(In_heap, caml_heap_start, - caml_heap_start + Bsize_wsize (caml_stat_heap_wsz)) + caml_heap_start + Bsize_wsize (Caml_state->stat_heap_wsz)) != 0) { caml_fatal_error ("cannot allocate initial page table"); } caml_fl_init_merge (); caml_make_free_blocks ((value *) caml_heap_start, - caml_stat_heap_wsz, 1, Caml_white); + Caml_state->stat_heap_wsz, 1, Caml_white); caml_gc_phase = Phase_idle; gray_vals_size = 2048; gray_vals = (value *) caml_stat_alloc_noexc (gray_vals_size * sizeof (value)); diff --git a/runtime/memory.c b/runtime/memory.c index c13503f8..0c3f151a 100644 --- a/runtime/memory.c +++ b/runtime/memory.c @@ -32,6 +32,7 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/signals.h" +#include "caml/memprof.h" int caml_huge_fallback_count = 0; /* Number of times that mmapping big pages fails and we fell back to small @@ -238,17 +239,6 @@ int caml_page_table_remove(int kind, void * start, void * end) return 0; } - -/* Initialize the [alloc_for_heap] system. - This function must be called exactly once, and it must be called - before the first call to [alloc_for_heap]. - It returns 0 on success and -1 on failure. -*/ -int caml_init_alloc_for_heap (void) -{ - return 0; -} - /* Allocate a block of the requested size, to be passed to [caml_add_to_heap] later. [request] will be rounded up to some implementation-dependent size. @@ -334,7 +324,7 @@ int caml_add_to_heap (char *m) caml_gc_message (0x04, "Growing heap to %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", - (Bsize_wsize (caml_stat_heap_wsz) + Chunk_size (m)) / 1024); + (Bsize_wsize (Caml_state->stat_heap_wsz) + Chunk_size (m)) / 1024); /* Register block in page table */ if (caml_page_table_add(In_heap, m, m + Chunk_size(m)) != 0) @@ -352,12 +342,12 @@ int caml_add_to_heap (char *m) Chunk_next (m) = cur; *last = m; - ++ caml_stat_heap_chunks; + ++ Caml_state->stat_heap_chunks; } - caml_stat_heap_wsz += Wsize_bsize (Chunk_size (m)); - if (caml_stat_heap_wsz > caml_stat_top_heap_wsz){ - caml_stat_top_heap_wsz = caml_stat_heap_wsz; + Caml_state->stat_heap_wsz += Wsize_bsize (Chunk_size (m)); + if (Caml_state->stat_heap_wsz > Caml_state->stat_top_heap_wsz){ + Caml_state->stat_top_heap_wsz = Caml_state->stat_heap_wsz; } return 0; } @@ -436,10 +426,10 @@ void caml_shrink_heap (char *chunk) */ if (chunk == caml_heap_start) return; - caml_stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk)); + Caml_state->stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk)); caml_gc_message (0x04, "Shrinking heap to %" ARCH_INTNAT_PRINTF_FORMAT "uk words\n", - caml_stat_heap_wsz / 1024); + Caml_state->stat_heap_wsz / 1024); #ifdef DEBUG { @@ -450,7 +440,7 @@ void caml_shrink_heap (char *chunk) } #endif - -- caml_stat_heap_chunks; + -- Caml_state->stat_heap_chunks; /* Remove [chunk] from the list of chunks. */ cp = &caml_heap_start; @@ -466,18 +456,18 @@ void caml_shrink_heap (char *chunk) color_t caml_allocation_color (void *hp) { - if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean - || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){ + if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean || + (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){ return Caml_black; }else{ CAMLassert (caml_gc_phase == Phase_idle || (caml_gc_phase == Phase_sweep - && (addr)hp < (addr)caml_gc_sweep_hp)); + && (char *)hp < (char *)caml_gc_sweep_hp)); return Caml_white; } } -static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, +static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track, int raise_oom, uintnat profinfo) { header_t *hp; @@ -495,7 +485,7 @@ static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, if (new_block == NULL) { if (!raise_oom) return 0; - else if (caml_in_minor_collection) + else if (Caml_state->in_minor_collection) caml_fatal_error ("out of memory"); else caml_raise_out_of_memory (); @@ -507,20 +497,20 @@ static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, CAMLassert (Is_in_heap (Val_hp (hp))); /* Inline expansion of caml_allocation_color. */ - if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean - || (caml_gc_phase == Phase_sweep && (addr)hp >= (addr)caml_gc_sweep_hp)){ + if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean || + (caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){ Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_black, profinfo); }else{ CAMLassert (caml_gc_phase == Phase_idle || (caml_gc_phase == Phase_sweep - && (addr)hp < (addr)caml_gc_sweep_hp)); + && (char *)hp < (char *)caml_gc_sweep_hp)); Hd_hp (hp) = Make_header_with_profinfo (wosize, tag, Caml_white, profinfo); } CAMLassert (Hd_hp (hp) == Make_header_with_profinfo (wosize, tag, caml_allocation_color (hp), profinfo)); caml_allocated_words += Whsize_wosize (wosize); - if (caml_allocated_words > caml_minor_heap_wsz){ + if (caml_allocated_words > Caml_state->minor_heap_wsz){ CAML_INSTR_INT ("request_major/alloc_shr@", 1); caml_request_major_slice (); } @@ -532,14 +522,11 @@ static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, } } #endif + if(track) + caml_memprof_track_alloc_shr(Val_hp (hp)); return Val_hp (hp); } -CAMLexport value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t tag) -{ - return caml_alloc_shr_aux(wosize, tag, 0, 0); -} - #ifdef WITH_PROFINFO /* Use this to debug problems with macros... */ @@ -548,17 +535,23 @@ CAMLexport value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t tag) CAMLexport value caml_alloc_shr_with_profinfo (mlsize_t wosize, tag_t tag, intnat profinfo) { - return caml_alloc_shr_aux(wosize, tag, 1, profinfo); + return caml_alloc_shr_aux(wosize, tag, 1, 1, profinfo); } -CAMLexport value caml_alloc_shr_preserving_profinfo (mlsize_t wosize, - tag_t tag, header_t old_header) +CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize, + tag_t tag, header_t old_header) { - return caml_alloc_shr_with_profinfo (wosize, tag, Profinfo_hd(old_header)); + return caml_alloc_shr_aux (wosize, tag, 0, 1, Profinfo_hd(old_header)); } #else #define NO_PROFINFO 0 + +CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize, + tag_t tag, header_t old_header) +{ + return caml_alloc_shr_aux (wosize, tag, 0, 1, NO_PROFINFO); +} #endif /* WITH_PROFINFO */ #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) @@ -569,10 +562,21 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag) return caml_alloc_shr_with_profinfo (wosize, tag, caml_spacetime_my_profinfo (NULL, wosize)); } + +CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag) +{ + return caml_alloc_shr_aux (wosize, tag, 0, 0, + caml_spacetime_my_profinfo (NULL, wosize)); +} #else CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag) { - return caml_alloc_shr_aux (wosize, tag, 1, NO_PROFINFO); + return caml_alloc_shr_aux (wosize, tag, 1, 1, NO_PROFINFO); +} + +CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag) +{ + return caml_alloc_shr_aux (wosize, tag, 0, 0, NO_PROFINFO); } #endif @@ -633,7 +637,7 @@ CAMLexport CAMLweakdef void caml_initialize (value *fp, value val) CAMLassert(Is_in_heap_or_young(fp)); *fp = val; if (!Is_young((value)fp) && Is_block (val) && Is_young (val)) { - add_to_ref_table (&caml_ref_table, fp); + add_to_ref_table (Caml_state->ref_table, fp); } } @@ -658,6 +662,11 @@ CAMLexport CAMLweakdef void caml_modify (value *fp, value val) while the GC is in the marking phase --> call [caml_darken] on the overwritten pointer so that the major GC treats it as an additional root. + + The logic implemented below is duplicated in caml_array_fill to + avoid repated calls to caml_modify and repeated tests on the + values. Don't forget to update caml_array_fill if the logic + below changes! */ value old; @@ -681,7 +690,7 @@ CAMLexport CAMLweakdef void caml_modify (value *fp, value val) } /* Check for condition 1. */ if (Is_block(val) && Is_young(val)) { - add_to_ref_table (&caml_ref_table, fp); + add_to_ref_table (Caml_state->ref_table, fp); } } } diff --git a/runtime/memprof.c b/runtime/memprof.c new file mode 100644 index 00000000..4aba3ef9 --- /dev/null +++ b/runtime/memprof.c @@ -0,0 +1,527 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Jacques-Henri Jourdan, projet Gallium, INRIA Paris */ +/* */ +/* Copyright 2016 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS + +#include +#include +#include "caml/memprof.h" +#include "caml/fail.h" +#include "caml/alloc.h" +#include "caml/callback.h" +#include "caml/signals.h" +#include "caml/memory.h" +#include "caml/minor_gc.h" +#include "caml/backtrace_prim.h" +#include "caml/weak.h" +#include "caml/stack.h" +#include "caml/misc.h" + +static uint32_t mt_state[624]; +static uint32_t mt_index; + +/* [lambda] is the mean number of samples for each allocated word (including + block headers). */ +static double lambda = 0; + /* Precomputed value of [1/log(1-lambda)], for fast sampling of + geometric distribution. + Dummy if [lambda = 0]. */ +static double one_log1m_lambda; + +int caml_memprof_suspended = 0; +static intnat callstack_size = 0; +static value memprof_callback = Val_unit; + +/* Pointer to the word following the next sample in the minor + heap. Equals [Caml_state->young_alloc_start] if no sampling is planned in + the current minor heap. + Invariant: [caml_memprof_young_trigger <= Caml_state->young_ptr]. + */ +value* caml_memprof_young_trigger; + +/* Whether memprof has been initialized. */ +static int init = 0; + +/**** Statistical sampling ****/ + +static double mt_generate_uniform(void) +{ + int i; + uint32_t y; + + /* Mersenne twister PRNG */ + if (mt_index == 624) { + for(i = 0; i < 227; i++) { + y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff); + mt_state[i] = mt_state[i+397] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df); + } + for(i = 227; i < 623; i++) { + y = (mt_state[i] & 0x80000000) + (mt_state[i+1] & 0x7fffffff); + mt_state[i] = mt_state[i-227] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df); + } + y = (mt_state[623] & 0x80000000) + (mt_state[0] & 0x7fffffff); + mt_state[623] = mt_state[396] ^ (y >> 1) ^ ((-(y&1)) & 0x9908b0df); + mt_index = 0; + } + + y = mt_state[mt_index]; + y = y ^ (y >> 11); + y = y ^ ((y << 7) & 0x9d2c5680); + y = y ^ ((y << 15) & 0xefc60000); + y = y ^ (y >> 18); + + mt_index++; + return y*2.3283064365386962890625e-10 + /* 2^-32 */ + 1.16415321826934814453125e-10; /* 2^-33 */ +} + +/* Simulate a geometric variable of parameter [lambda]. + The result is clipped in [1..Max_long] + Requires [lambda > 0]. */ +static uintnat mt_generate_geom() +{ + /* We use the float versions of exp/log, since these functions are + significantly faster, and we really don't need much precision + here. The entropy contained in [next_mt_generate_geom] is anyway + bounded by the entropy provided by [mt_generate_uniform], which + is 32bits. */ + double res = 1 + logf(mt_generate_uniform()) * one_log1m_lambda; + if (res > Max_long) return Max_long; + return (uintnat)res; +} + +static uintnat next_mt_generate_binom; +/* Simulate a binomial variable of parameters [len] and [lambda]. + This sampling algorithm has running time linear with [len * + lambda]. We could use more a involved algorithm, but this should + be good enough since, in the average use case, [lambda] <= 0.01 and + therefore the generation of the binomial variable is amortized by + the initialialization of the corresponding block. + + If needed, we could use algorithm BTRS from the paper: + Hormann, Wolfgang. "The generation of binomial random variates." + Journal of statistical computation and simulation 46.1-2 (1993), pp101-110. + + Requires [lambda > 0] and [len < Max_long]. + */ +static uintnat mt_generate_binom(uintnat len) +{ + uintnat res; + for(res = 0; next_mt_generate_binom < len; res++) + next_mt_generate_binom += mt_generate_geom(); + next_mt_generate_binom -= len; + return res; +} + +/**** Interface with the OCaml code. ****/ + +static void purge_postponed_queue(void); + +CAMLprim value caml_memprof_set(value v) +{ + CAMLparam1(v); + double l = Double_val(Field(v, 0)); + intnat sz = Long_val(Field(v, 1)); + + if (sz < 0 || !(l >= 0.) || l > 1.) /* Checks that [l] is not NAN. */ + caml_invalid_argument("caml_memprof_set"); + + /* This call to [caml_memprof_set] may stop sampling or change the + callback. We have to make sure that the postponed queue is empty + before continuing. */ + if (!caml_memprof_suspended) + caml_raise_if_exception(caml_memprof_handle_postponed_exn()); + else + /* But if we are currently running a callback, there is nothing + else we can do than purging the queue. */ + purge_postponed_queue(); + + if (!init) { + int i; + init = 1; + + mt_index = 624; + mt_state[0] = 42; + for(i = 1; i < 624; i++) + mt_state[i] = 0x6c078965 * (mt_state[i-1] ^ (mt_state[i-1] >> 30)) + i; + + caml_register_generational_global_root(&memprof_callback); + } + + lambda = l; + if (l > 0) { + one_log1m_lambda = l == 1 ? 0 : 1/caml_log1p(-l); + next_mt_generate_binom = mt_generate_geom(); + } + + caml_memprof_renew_minor_sample(); + + callstack_size = sz; + + caml_modify_generational_global_root(&memprof_callback, Field(v, 2)); + + CAMLreturn(Val_unit); +} + +/* Cf. Gc.Memprof.alloc_kind */ +enum ml_alloc_kind { + Minor = Val_long(0), + Major = Val_long(1), + Unmarshalled = Val_long(2) +}; + +/* When we call do_callback_exn, we suspend/resume sampling. In order + to avoid a systematic unnecessary polling after each memprof + callback, we do not call [caml_set_action_pending] when resuming. + Therefore, any call to [do_callback_exn] has to also make sure the + postponed queue will be handled fully at some point. */ +static value do_callback_exn(tag_t tag, uintnat wosize, uintnat occurrences, + value callstack, enum ml_alloc_kind cb_kind) +{ + CAMLparam1(callstack); + CAMLlocal1(sample_info); + value res; /* Not a root, can be an exception result. */ + CAMLassert(occurrences > 0 && !caml_memprof_suspended); + + caml_memprof_suspended = 1; + + sample_info = caml_alloc_small(5, 0); + Field(sample_info, 0) = Val_long(occurrences); + Field(sample_info, 1) = cb_kind; + Field(sample_info, 2) = Val_long(tag); + Field(sample_info, 3) = Val_long(wosize); + Field(sample_info, 4) = callstack; + + res = caml_callback_exn(memprof_callback, sample_info); + + caml_memprof_suspended = 0; + + CAMLreturn(res); +} + +/**** Capturing the call stack *****/ + +/* This function is called for postponed blocks, so it guarantees + that the GC is not called. */ +static value capture_callstack_postponed(void) +{ + value res; + uintnat wosize = caml_current_callstack_size(callstack_size); + /* We do not use [caml_alloc] to make sure the GC will not get called. */ + if (wosize == 0) return Atom (0); + res = caml_alloc_shr_no_track_noexc(wosize, 0); + if (res != 0) caml_current_callstack_write(res); + return res; +} + +static value capture_callstack(void) +{ + value res; + uintnat wosize = caml_current_callstack_size(callstack_size); + CAMLassert(!caml_memprof_suspended); + caml_memprof_suspended = 1; /* => no samples in the call stack. */ + res = caml_alloc(wosize, 0); + caml_memprof_suspended = 0; + caml_current_callstack_write(res); + return res; +} + +/**** Handling postponed sampled blocks. ****/ +/* When allocating in from C code, we cannot call the callback, + because the [caml_alloc_***] are guaranteed not to do so. These + functions make it possible to register a sampled block in a + todo-list so that the callback call is performed when possible. */ +/* Note: the shorter the delay is, the better, because the block is + linked to a root during the delay, so that the reachability + properties of the sampled block are artificially modified. */ + +#define POSTPONED_DEFAULT_QUEUE_SIZE 128 +static struct postponed_block { + value block; + value callstack; + uintnat occurrences; + enum ml_alloc_kind kind; +} default_postponed_queue[POSTPONED_DEFAULT_QUEUE_SIZE], + *postponed_queue = default_postponed_queue, + *postponed_queue_end = default_postponed_queue + POSTPONED_DEFAULT_QUEUE_SIZE, + *postponed_tl = default_postponed_queue, /* Pointer to next pop */ + *postponed_hd = default_postponed_queue; /* Pointer to next push */ + +static struct postponed_block* postponed_next(struct postponed_block* p) +{ + p++; + if (p == postponed_queue_end) return postponed_queue; + else return p; +} + +static void purge_postponed_queue(void) +{ + if (postponed_queue != default_postponed_queue) { + caml_stat_free(postponed_queue); + postponed_queue = default_postponed_queue; + postponed_queue_end = postponed_queue + POSTPONED_DEFAULT_QUEUE_SIZE; + } + postponed_hd = postponed_tl = postponed_queue; +} + +/* This function does not call the GC. This is important since it is + called when allocating a block using [caml_alloc_shr]: The new + block is allocated, but not yet initialized, so that the heap + invariants are broken. */ +static void register_postponed_callback(value block, uintnat occurrences, + enum ml_alloc_kind kind, + value* callstack) +{ + struct postponed_block* new_hd; + if (occurrences == 0) return; + if (*callstack == 0) *callstack = capture_callstack_postponed(); + if (*callstack == 0) return; /* OOM */ + + new_hd = postponed_next(postponed_hd); + if (new_hd == postponed_tl) { + /* Queue is full, reallocate it. (We always leave one free slot in + order to be able to distinguish the 100% full and the empty + states). */ + uintnat sz = 2 * (postponed_queue_end - postponed_queue); + struct postponed_block* new_queue = + caml_stat_alloc_noexc(sz * sizeof(struct postponed_block)); + if (new_queue == NULL) return; + new_hd = new_queue; + while (postponed_tl != postponed_hd) { + *new_hd = *postponed_tl; + new_hd++; + postponed_tl = postponed_next(postponed_tl); + } + if (postponed_queue != default_postponed_queue) + caml_stat_free(postponed_queue); + postponed_tl = postponed_queue = new_queue; + postponed_hd = new_hd; + postponed_queue_end = postponed_queue + sz; + new_hd++; + } + + postponed_hd->block = block; + postponed_hd->callstack = *callstack; + postponed_hd->occurrences = occurrences; + postponed_hd->kind = kind; + postponed_hd = new_hd; + + if (!caml_memprof_suspended) caml_set_action_pending(); +} + +value caml_memprof_handle_postponed_exn(void) +{ + CAMLparam0(); + CAMLlocal1(block); + value ephe; + + if (caml_memprof_suspended) + CAMLreturn(Val_unit); + + while (postponed_tl != postponed_hd) { + struct postponed_block pb = *postponed_tl; + block = pb.block; /* pb.block is not a root! */ + postponed_tl = postponed_next(postponed_tl); + if (postponed_tl == postponed_hd) purge_postponed_queue(); + + /* If using threads, this call can trigger reentrant calls to + [caml_memprof_handle_postponed] even though we set + [caml_memprof_suspended]. */ + ephe = do_callback_exn(Tag_val(block), Wosize_val(block), + pb.occurrences, pb.callstack, pb.kind); + + if (Is_exception_result(ephe)) CAMLreturn(ephe); + + if (Is_block(ephe)) caml_ephemeron_set_key(Field(ephe, 0), 0, block); + } + + CAMLreturn(Val_unit); +} + +/* We don't expect these roots to live long. No need to have a special + case for young roots. */ +void caml_memprof_scan_roots(scanning_action f) { + struct postponed_block* p; + for(p = postponed_tl; p != postponed_hd; p = postponed_next(p)) { + f(p->block, &p->block); + f(p->callstack, &p->callstack); + } +} + +/**** Sampling procedures ****/ + +void caml_memprof_track_alloc_shr(value block) +{ + value callstack = 0; + CAMLassert(Is_in_heap(block)); + /* This test also makes sure memprof is initialized. */ + if (lambda == 0 || caml_memprof_suspended) return; + register_postponed_callback( + block, mt_generate_binom(Whsize_val(block)), Major, &callstack); +} + +/* Shifts the next sample in the minor heap by [n] words. Essentially, + this tells the sampler to ignore the next [n] words of the minor + heap. */ +static void shift_sample(uintnat n) +{ + if (caml_memprof_young_trigger - Caml_state->young_alloc_start > n) + caml_memprof_young_trigger -= n; + else + caml_memprof_young_trigger = Caml_state->young_alloc_start; + caml_update_young_limit(); +} + +/* Renew the next sample in the minor heap. This needs to be called + after each minor sampling and after each minor collection. In + practice, this is called at each sampling in the minor heap and at + each minor collection. Extra calls do not change the statistical + properties of the sampling because of the memorylessness of the + geometric distribution. */ +void caml_memprof_renew_minor_sample(void) +{ + + if (lambda == 0) /* No trigger in the current minor heap. */ + caml_memprof_young_trigger = Caml_state->young_alloc_start; + else { + uintnat geom = mt_generate_geom(); + if(Caml_state->young_ptr - Caml_state->young_alloc_start < geom) + /* No trigger in the current minor heap. */ + caml_memprof_young_trigger = Caml_state->young_alloc_start; + caml_memprof_young_trigger = Caml_state->young_ptr - (geom - 1); + } + + caml_update_young_limit(); +} + +/* Called when exceeding the threshold for the next sample in the + minor heap, from the C code (the handling is different when called + from natively compiled OCaml code). */ +void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml) +{ + CAMLparam0(); + CAMLlocal2(ephe, callstack); + uintnat whsize = Whsize_wosize(wosize); + uintnat occurrences; + + if (caml_memprof_suspended) { + caml_memprof_renew_minor_sample(); + CAMLreturn0; + } + + /* If [lambda == 0], then [caml_memprof_young_trigger] should be + equal to [Caml_state->young_alloc_start]. But this function is only + called with [Caml_state->young_alloc_start <= Caml_state->young_ptr < + caml_memprof_young_trigger], which is contradictory. */ + CAMLassert(lambda > 0); + + occurrences = + mt_generate_binom(caml_memprof_young_trigger - 1 + - Caml_state->young_ptr) + 1; + + if (!from_caml) { + value callstack = 0; + register_postponed_callback(Val_hp(Caml_state->young_ptr), occurrences, + Minor, &callstack); + caml_memprof_renew_minor_sample(); + CAMLreturn0; + } + + /* We need to call the callback for this sampled block. Since the + callback can potentially allocate, the sampled block will *not* + be the one pointed to by [caml_memprof_young_trigger]. Instead, + we remember that we need to sample the next allocated word, + call the callback and use as a sample the block which will be + allocated right after the callback. */ + + /* Restore the minor heap in a valid state for calling the callback. + We should not call the GC before these two instructions. */ + Caml_state->young_ptr += whsize; + caml_memprof_renew_minor_sample(); + + /* Empty the queue to make sure callbacks are called in the right + order. */ + caml_raise_if_exception(caml_memprof_handle_postponed_exn()); + + callstack = capture_callstack(); + ephe = caml_raise_if_exception(do_callback_exn(tag, wosize, occurrences, + callstack, Minor)); + + /* We can now restore the minor heap in the state needed by + [Alloc_small_aux]. */ + if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) { + CAML_INSTR_INT ("force_minor/memprof@", 1); + caml_gc_dispatch(); + } + + /* Re-allocate the block in the minor heap. We should not call the + GC after this. */ + Caml_state->young_ptr -= whsize; + + /* Make sure this block is not going to be sampled again. */ + shift_sample(whsize); + + /* Write the ephemeron if not [None]. */ + if (Is_block(ephe)) { + /* Subtlety: we are actually writing the ephemeron with an invalid + (uninitialized) block. This is correct for two reasons: + - The logic of [caml_ephemeron_set_key] never inspects the content of + the block. In only checks that the block is young. + - The allocation and initialization happens right after returning + from [caml_memprof_track_young]. */ + caml_ephemeron_set_key(Field(ephe, 0), 0, Val_hp(Caml_state->young_ptr)); + } + + /* /!\ Since the heap is in an invalid state before initialization, + very little heap operations are allowed until then. */ + + CAMLreturn0; +} + +void caml_memprof_track_interned(header_t* block, header_t* blockend) { + header_t *p; + value callstack = 0; + + if(lambda == 0 || caml_memprof_suspended) + return; + + /* We have to select the sampled blocks before sampling them, + because sampling may trigger GC, and then blocks can escape from + [block, blockend[. So we use the postponing machinery for + selecting blocks. [intern.c] will call [check_urgent_gc] which + will call [caml_memprof_handle_postponed] in turn. */ + p = block; + while(1) { + uintnat next_sample = mt_generate_geom(); + header_t *next_sample_p, *next_p; + if(next_sample > blockend - p) + break; + /* [next_sample_p] is the block *following* the next sampled + block! */ + next_sample_p = p + next_sample; + + while(1) { + next_p = p + Whsize_hp(p); + if(next_p >= next_sample_p) break; + p = next_p; + } + + register_postponed_callback( + Val_hp(p), mt_generate_binom(next_p - next_sample_p) + 1, + Unmarshalled, &callstack); + + p = next_p; + } +} diff --git a/runtime/meta.c b/runtime/meta.c index 613da124..28283328 100644 --- a/runtime/meta.c +++ b/runtime/meta.c @@ -19,7 +19,9 @@ #include #include "caml/alloc.h" +#include "caml/backtrace_prim.h" #include "caml/config.h" +#include "caml/debugger.h" #include "caml/fail.h" #include "caml/fix_code.h" #include "caml/interp.h" @@ -30,8 +32,8 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/prims.h" +#include "caml/signals.h" #include "caml/stacks.h" -#include "caml/backtrace_prim.h" #ifndef NATIVE_CODE @@ -117,6 +119,10 @@ CAMLprim value caml_reify_bytecode(value ls_prog, caml_thread_code((code_t) prog, len); #endif caml_prepare_bytecode((code_t) prog, len); + + /* Notify debugger after fragment gets added and reified. */ + caml_debugger(CODE_LOADED, Val_long(caml_code_fragments_table.size - 1)); + clos = caml_alloc_small (1, Closure_tag); Code_val(clos) = (code_t) prog; bytecode = caml_alloc_small (2, Abstract_tag); @@ -136,26 +142,21 @@ CAMLprim value caml_static_release_bytecode(value bc) { code_t prog; asize_t len; - struct code_fragment * cf = NULL, * cfi; - int i; + int found, index; + struct code_fragment *cf; + prog = Bytecode_val(bc)->prog; len = Bytecode_val(bc)->len; caml_remove_debug_info(prog); - for (i = 0; i < caml_code_fragments_table.size; i++) { - cfi = (struct code_fragment *) caml_code_fragments_table.contents[i]; - if (cfi->code_start == (char *) prog && - cfi->code_end == (char *) prog + len) { - cf = cfi; - break; - } - } - if (!cf) { - /* [cf] Not matched with a caml_reify_bytecode call; impossible. */ - CAMLassert (0); - } else { - caml_ext_table_remove(&caml_code_fragments_table, cf); - } + found = caml_find_code_fragment((char*) prog, &index, &cf); + /* Not matched with a caml_reify_bytecode call; impossible. */ + CAMLassert(found); (void) found; /* Silence unused variable warning. */ + + /* Notify debugger before the fragment gets destroyed. */ + caml_debugger(CODE_UNLOADED, Val_long(index)); + + caml_ext_table_remove(&caml_code_fragments_table, cf); #ifndef NATIVE_CODE caml_release_bytecode(prog, len); @@ -166,17 +167,6 @@ CAMLprim value caml_static_release_bytecode(value bc) return Val_unit; } -CAMLprim value caml_register_code_fragment(value prog, value len, value digest) -{ - struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment)); - cf->code_start = (char *) prog; - cf->code_end = (char *) prog + Long_val(len); - memcpy(cf->digest, String_val(digest), 16); - cf->digest_computed = 1; - caml_ext_table_add(&caml_code_fragments_table, cf); - return Val_unit; -} - CAMLprim value caml_realloc_global(value size) { mlsize_t requested_size, actual_size, i; @@ -195,14 +185,16 @@ CAMLprim value caml_realloc_global(value size) for (i = actual_size; i < requested_size; i++){ Field (new_global_data, i) = Val_long (0); } + // Give gc a chance to run, and run memprof callbacks caml_global_data = new_global_data; + caml_process_pending_actions(); } return Val_unit; } CAMLprim value caml_get_current_environment(value unit) { - return *caml_extern_sp; + return *Caml_state->extern_sp; } CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg) @@ -214,6 +206,7 @@ CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg) arg1 to call_original_code (codeptr) arg3 to call_original_code (arg) arg2 to call_original_code (env) + saved pc saved env */ /* Stack layout on exit: @@ -223,24 +216,25 @@ CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg) extra_args = 0 environment = env PC = codeptr - arg3 to call_original_code (arg) same 6 bottom words as + arg3 to call_original_code (arg) same 7 bottom words as arg2 to call_original_code (env) on entrance, but arg1 to call_original_code (codeptr) shifted down 4 words arg3 to call_original_code (arg) arg2 to call_original_code (env) + saved pc saved env */ value * osp, * nsp; int i; - osp = caml_extern_sp; - caml_extern_sp -= 4; - nsp = caml_extern_sp; - for (i = 0; i < 6; i++) nsp[i] = osp[i]; - nsp[6] = codeptr; - nsp[7] = env; - nsp[8] = Val_int(0); - nsp[9] = arg; + osp = Caml_state->extern_sp; + Caml_state->extern_sp -= 4; + nsp = Caml_state->extern_sp; + for (i = 0; i < 7; i++) nsp[i] = osp[i]; + nsp[7] = codeptr; + nsp[8] = env; + nsp[9] = Val_int(0); + nsp[10] = arg; return Val_unit; } @@ -284,14 +278,4 @@ value caml_static_release_bytecode(value prog, value len) return Val_unit; /* not reached */ } -value * caml_stack_low; -value * caml_stack_high; -value * caml_stack_threshold; -value * caml_extern_sp; -value * caml_trapsp; -int caml_callback_depth; -int volatile caml_something_to_do; -void (* volatile caml_async_action_hook)(void); -struct longjmp_buffer * caml_external_raise; - #endif diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c index a2e20fb0..e4dacfc5 100644 --- a/runtime/minor_gc.c +++ b/runtime/minor_gc.c @@ -30,54 +30,58 @@ #include "caml/roots.h" #include "caml/signals.h" #include "caml/weak.h" +#include "caml/memprof.h" /* Pointers into the minor heap. - [caml_young_base] + [Caml_state->young_base] The [malloc] block that contains the heap. - [caml_young_start] ... [caml_young_end] + [Caml_state->young_start] ... [Caml_state->young_end] The whole range of the minor heap: all young blocks are inside this interval. - [caml_young_alloc_start]...[caml_young_alloc_end] + [Caml_state->young_alloc_start]...[Caml_state->young_alloc_end] The allocation arena: newly-allocated blocks are carved from - this interval, starting at [caml_young_alloc_end]. - [caml_young_alloc_mid] is the mid-point of this interval. - [caml_young_ptr], [caml_young_trigger], [caml_young_limit] + this interval, starting at [Caml_state->young_alloc_end]. + [Caml_state->young_alloc_mid] is the mid-point of this interval. + [Caml_state->young_ptr], [Caml_state->young_trigger], + [Caml_state->young_limit] These pointers are all inside the allocation arena. - - [caml_young_ptr] is where the next allocation will take place. - - [caml_young_trigger] is how far we can allocate before triggering - [caml_gc_dispatch]. Currently, it is either [caml_young_alloc_start] - or the mid-point of the allocation arena. - - [caml_young_limit] is the pointer that is compared to - [caml_young_ptr] for allocation. It is either - [caml_young_alloc_end] if a signal is pending and we are in - native code, or [caml_young_trigger]. + - [Caml_state->young_ptr] is where the next allocation will take place. + - [Caml_state->young_trigger] is how far we can allocate before + triggering [caml_gc_dispatch]. Currently, it is either + [Caml_state->young_alloc_start] or the mid-point of the allocation + arena. + - [Caml_state->young_limit] is the pointer that is compared to + [Caml_state->young_ptr] for allocation. It is either: + + [Caml_state->young_alloc_end] if a signal handler or + finaliser or memprof callback is pending, or if a major + or minor collection has been requested, or an + asynchronous callback has just raised an exception, + + [caml_memprof_young_trigger] if a memprof sample is planned, + + or [Caml_state->young_trigger]. */ struct generic_table CAML_TABLE_STRUCT(char); -asize_t caml_minor_heap_wsz; -static void *caml_young_base = NULL; -CAMLexport value *caml_young_start = NULL, *caml_young_end = NULL; -CAMLexport value *caml_young_alloc_start = NULL, - *caml_young_alloc_mid = NULL, - *caml_young_alloc_end = NULL; -CAMLexport value *caml_young_ptr = NULL, *caml_young_limit = NULL; -CAMLexport value *caml_young_trigger = NULL; - -CAMLexport struct caml_ref_table - caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}; - -CAMLexport struct caml_ephe_ref_table - caml_ephe_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}; - -CAMLexport struct caml_custom_table - caml_custom_table = { NULL, NULL, NULL, NULL, NULL, 0, 0}; -/* Table of custom blocks in the minor heap that contain finalizers - or GC speed parameters. */ - -int caml_in_minor_collection = 0; - -double caml_extra_heap_resources_minor = 0; +void caml_alloc_minor_tables () +{ + Caml_state->ref_table = + caml_stat_alloc_noexc(sizeof(struct caml_ref_table)); + if (Caml_state->ref_table == NULL) + caml_fatal_error ("cannot initialize minor heap"); + memset(Caml_state->ref_table, 0, sizeof(struct caml_ref_table)); + + Caml_state->ephe_ref_table = + caml_stat_alloc_noexc(sizeof(struct caml_ephe_ref_table)); + if (Caml_state->ephe_ref_table == NULL) + caml_fatal_error ("cannot initialize minor heap"); + memset(Caml_state->ephe_ref_table, 0, sizeof(struct caml_ephe_ref_table)); + + Caml_state->custom_table = + caml_stat_alloc_noexc(sizeof(struct caml_custom_table)); + if (Caml_state->custom_table == NULL) + caml_fatal_error ("cannot initialize minor heap"); + memset(Caml_state->custom_table, 0, sizeof(struct caml_custom_table)); +} /* [sz] and [rsv] are numbers of entries */ static void alloc_generic_table (struct generic_table *tbl, asize_t sz, @@ -140,37 +144,40 @@ void caml_set_minor_heap_size (asize_t bsz) CAMLassert (bsz <= Bsize_wsize(Minor_heap_max)); CAMLassert (bsz % Page_size == 0); CAMLassert (bsz % sizeof (value) == 0); - if (caml_young_ptr != caml_young_alloc_end){ + if (Caml_state->young_ptr != Caml_state->young_alloc_end){ CAML_INSTR_INT ("force_minor/set_minor_heap_size@", 1); - caml_requested_minor_gc = 0; - caml_young_trigger = caml_young_alloc_mid; - caml_young_limit = caml_young_trigger; + Caml_state->requested_minor_gc = 0; + Caml_state->young_trigger = Caml_state->young_alloc_mid; + caml_update_young_limit(); caml_empty_minor_heap (); } - CAMLassert (caml_young_ptr == caml_young_alloc_end); + CAMLassert (Caml_state->young_ptr == Caml_state->young_alloc_end); new_heap = caml_stat_alloc_aligned_noexc(bsz, 0, &new_heap_base); if (new_heap == NULL) caml_raise_out_of_memory(); if (caml_page_table_add(In_young, new_heap, new_heap + bsz) != 0) caml_raise_out_of_memory(); - if (caml_young_start != NULL){ - caml_page_table_remove(In_young, caml_young_start, caml_young_end); - caml_stat_free (caml_young_base); + if (Caml_state->young_start != NULL){ + caml_page_table_remove(In_young, Caml_state->young_start, + Caml_state->young_end); + caml_stat_free (Caml_state->young_base); } - caml_young_base = new_heap_base; - caml_young_start = (value *) new_heap; - caml_young_end = (value *) (new_heap + bsz); - caml_young_alloc_start = caml_young_start; - caml_young_alloc_mid = caml_young_alloc_start + Wsize_bsize (bsz) / 2; - caml_young_alloc_end = caml_young_end; - caml_young_trigger = caml_young_alloc_start; - caml_young_limit = caml_young_trigger; - caml_young_ptr = caml_young_alloc_end; - caml_minor_heap_wsz = Wsize_bsize (bsz); - - reset_table ((struct generic_table *) &caml_ref_table); - reset_table ((struct generic_table *) &caml_ephe_ref_table); - reset_table ((struct generic_table *) &caml_custom_table); + Caml_state->young_base = new_heap_base; + Caml_state->young_start = (value *) new_heap; + Caml_state->young_end = (value *) (new_heap + bsz); + Caml_state->young_alloc_start = Caml_state->young_start; + Caml_state->young_alloc_mid = + Caml_state->young_alloc_start + Wsize_bsize (bsz) / 2; + Caml_state->young_alloc_end = Caml_state->young_end; + Caml_state->young_trigger = Caml_state->young_alloc_start; + caml_update_young_limit(); + Caml_state->young_ptr = Caml_state->young_alloc_end; + Caml_state->minor_heap_wsz = Wsize_bsize (bsz); + caml_memprof_renew_minor_sample(); + + reset_table ((struct generic_table *) Caml_state->ref_table); + reset_table ((struct generic_table *) Caml_state->ephe_ref_table); + reset_table ((struct generic_table *) Caml_state->custom_table); } static value oldify_todo_list = 0; @@ -187,7 +194,7 @@ void caml_oldify_one (value v, value *p) tail_call: if (Is_block (v) && Is_young (v)){ - CAMLassert ((value *) Hp_val (v) >= caml_young_ptr); + CAMLassert ((value *) Hp_val (v) >= Caml_state->young_ptr); hd = Hd_val (v); if (hd == 0){ /* If already forwarded */ *p = Field (v, 0); /* then forward pointer is first field. */ @@ -197,7 +204,7 @@ void caml_oldify_one (value v, value *p) value field0; sz = Wosize_hd (hd); - result = caml_alloc_shr_preserving_profinfo (sz, tag, hd); + result = caml_alloc_shr_for_minor_gc (sz, tag, hd); *p = result; field0 = Field (v, 0); Hd_val (v) = 0; /* Set forward flag */ @@ -214,7 +221,7 @@ void caml_oldify_one (value v, value *p) } }else if (tag >= No_scan_tag){ sz = Wosize_hd (hd); - result = caml_alloc_shr_preserving_profinfo (sz, tag, hd); + result = caml_alloc_shr_for_minor_gc (sz, tag, hd); for (i = 0; i < sz; i++) Field (result, i) = Field (v, i); Hd_val (v) = 0; /* Set forward flag */ Field (v, 0) = result; /* and forward pointer. */ @@ -247,7 +254,7 @@ void caml_oldify_one (value v, value *p) ){ /* Do not short-circuit the pointer. Copy as a normal block. */ CAMLassert (Wosize_hd (hd) == 1); - result = caml_alloc_shr_preserving_profinfo (1, Forward_tag, hd); + result = caml_alloc_shr_for_minor_gc (1, Forward_tag, hd); *p = result; Hd_val (v) = 0; /* Set (GC) forward flag */ Field (v, 0) = result; /* and forward pointer. */ @@ -313,8 +320,8 @@ 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++){ + for (re = Caml_state->ephe_ref_table->base; + re < Caml_state->ephe_ref_table->ptr; re++){ /* look only at ephemeron with data in the minor heap */ if (re->offset == 1){ value *data = &Field(re->ephe,1); @@ -344,23 +351,24 @@ void caml_empty_minor_heap (void) uintnat prev_alloc_words; struct caml_ephe_ref_elt *re; - if (caml_young_ptr != caml_young_alloc_end){ + if (Caml_state->young_ptr != Caml_state->young_alloc_end){ if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) (); CAML_INSTR_SETUP (tmr, "minor"); prev_alloc_words = caml_allocated_words; - caml_in_minor_collection = 1; + Caml_state->in_minor_collection = 1; caml_gc_message (0x02, "<"); caml_oldify_local_roots(); CAML_INSTR_TIME (tmr, "minor/local_roots"); - for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++){ + for (r = Caml_state->ref_table->base; + r < Caml_state->ref_table->ptr; r++) { caml_oldify_one (**r, *r); } CAML_INSTR_TIME (tmr, "minor/ref_table"); caml_oldify_mopup (); CAML_INSTR_TIME (tmr, "minor/copy"); /* Update the ephemerons */ - for (re = caml_ephe_ref_table.base; - re < caml_ephe_ref_table.ptr; re++){ + for (re = Caml_state->ephe_ref_table->base; + re < Caml_state->ephe_ref_table->ptr; re++){ if(re->offset < Wosize_val(re->ephe)){ /* If it is not the case, the ephemeron has been truncated */ value *key = &Field(re->ephe,re->offset); @@ -378,7 +386,8 @@ void caml_empty_minor_heap (void) /* Update the OCaml finalise_last values */ caml_final_update_minor_roots(); /* Run custom block finalisation of dead minor values */ - for (elt = caml_custom_table.base; elt < caml_custom_table.ptr; elt++){ + for (elt = Caml_state->custom_table->base; + elt < Caml_state->custom_table->ptr; elt++){ value v = elt->block; if (Hd_val (v) == 0){ /* Block was copied to the major heap: adjust GC speed numbers. */ @@ -390,21 +399,24 @@ void caml_empty_minor_heap (void) } } CAML_INSTR_TIME (tmr, "minor/update_weak"); - 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; - caml_young_ptr = caml_young_alloc_end; - clear_table ((struct generic_table *) &caml_ref_table); - clear_table ((struct generic_table *) &caml_ephe_ref_table); - clear_table ((struct generic_table *) &caml_custom_table); - caml_extra_heap_resources_minor = 0; + Caml_state->stat_minor_words += + Caml_state->young_alloc_end - Caml_state->young_ptr; + caml_gc_clock += + (double) (Caml_state->young_alloc_end - Caml_state->young_ptr) + / Caml_state->minor_heap_wsz; + Caml_state->young_ptr = Caml_state->young_alloc_end; + clear_table ((struct generic_table *) Caml_state->ref_table); + clear_table ((struct generic_table *) Caml_state->ephe_ref_table); + clear_table ((struct generic_table *) Caml_state->custom_table); + Caml_state->extra_heap_resources_minor = 0; caml_gc_message (0x02, ">"); - caml_in_minor_collection = 0; + Caml_state->in_minor_collection = 0; caml_final_empty_young (); CAML_INSTR_TIME (tmr, "minor/finalized"); - caml_stat_promoted_words += caml_allocated_words - prev_alloc_words; + Caml_state->stat_promoted_words += caml_allocated_words - prev_alloc_words; CAML_INSTR_INT ("minor/promoted#", caml_allocated_words - prev_alloc_words); - ++ caml_stat_minor_collections; + ++ Caml_state->stat_minor_collections; + caml_memprof_renew_minor_sample(); if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) (); }else{ /* The minor heap is empty nothing to do. */ @@ -413,7 +425,8 @@ void caml_empty_minor_heap (void) #ifdef DEBUG { value *p; - for (p = caml_young_alloc_start; p < caml_young_alloc_end; ++p){ + for (p = Caml_state->young_alloc_start; p < Caml_state->young_alloc_end; + ++p) { *p = Debug_free_minor; } } @@ -427,10 +440,11 @@ extern uintnat caml_instr_alloc_jump; /* Do a minor collection or a slice of major collection, call finalisation functions, etc. Leave enough room in the minor heap to allocate at least one object. + Guaranteed not to call any OCaml callback. */ CAMLexport void caml_gc_dispatch (void) { - value *trigger = caml_young_trigger; /* save old value of trigger */ + value *trigger = Caml_state->young_trigger; /* save old value of trigger */ #ifdef CAML_INSTR CAML_INSTR_SETUP(tmr, "dispatch"); CAML_INSTR_TIME (tmr, "overhead"); @@ -438,59 +452,102 @@ CAMLexport void caml_gc_dispatch (void) caml_instr_alloc_jump = 0; #endif - if (trigger == caml_young_alloc_start || caml_requested_minor_gc){ + if (trigger == Caml_state->young_alloc_start + || Caml_state->requested_minor_gc) { /* The minor heap is full, we must do a minor collection. */ /* reset the pointers first because the end hooks might allocate */ - caml_requested_minor_gc = 0; - caml_young_trigger = caml_young_alloc_mid; - caml_young_limit = caml_young_trigger; + Caml_state->requested_minor_gc = 0; + Caml_state->young_trigger = Caml_state->young_alloc_mid; + caml_update_young_limit(); caml_empty_minor_heap (); /* The minor heap is empty, we can start a major collection. */ if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1); CAML_INSTR_TIME (tmr, "dispatch/minor"); - - caml_final_do_calls (); - CAML_INSTR_TIME (tmr, "dispatch/finalizers"); - - while (caml_young_ptr - caml_young_alloc_start < Max_young_whsize){ - /* The finalizers or the hooks have filled up the minor heap, we must - repeat the minor collection. */ - caml_requested_minor_gc = 0; - caml_young_trigger = caml_young_alloc_mid; - caml_young_limit = caml_young_trigger; - caml_empty_minor_heap (); - /* The minor heap is empty, we can start a major collection. */ - if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1); - CAML_INSTR_TIME (tmr, "dispatch/finalizers_minor"); - } } - if (trigger != caml_young_alloc_start || caml_requested_major_slice){ + if (trigger != Caml_state->young_alloc_start + || Caml_state->requested_major_slice) { /* The minor heap is half-full, do a major GC slice. */ - caml_requested_major_slice = 0; - caml_young_trigger = caml_young_alloc_start; - caml_young_limit = caml_young_trigger; + Caml_state->requested_major_slice = 0; + Caml_state->young_trigger = Caml_state->young_alloc_start; + caml_update_young_limit(); caml_major_collection_slice (-1); CAML_INSTR_TIME (tmr, "dispatch/major"); } } -/* For backward compatibility with Lablgtk: do a minor collection to - ensure that the minor heap is empty. +/* Called by [Alloc_small] when [Caml_state->young_ptr] reaches + [Caml_state->young_limit]. We may have to either call memprof or + the gc. */ +void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags) +{ + intnat whsize = Whsize_wosize (wosize); + + /* First, we un-do the allocation performed in [Alloc_small] */ + Caml_state->young_ptr += whsize; + + while(1) { + /* We might be here because of an async callback / urgent GC + request. Take the opportunity to do what has been requested. */ + if (flags & CAML_FROM_CAML) + /* In the case of allocations performed from OCaml, execute + asynchronous callbacks. */ + caml_raise_if_exception(caml_do_pending_actions_exn ()); + else { + caml_check_urgent_gc (Val_unit); + /* In the case of long-running C code that regularly polls with + caml_process_pending_actions, force a query of all callbacks + at every minor collection or major slice. */ + caml_something_to_do = 1; + } + + /* Now, there might be enough room in the minor heap to do our + allocation. */ + if (Caml_state->young_ptr - whsize >= Caml_state->young_trigger) + break; + + /* If not, then empty the minor heap, and check again for async + callbacks. */ + CAML_INSTR_INT ("force_minor/alloc_small@", 1); + caml_gc_dispatch (); + } + + /* Re-do the allocation: we now have enough space in the minor heap. */ + Caml_state->young_ptr -= whsize; + + /* Check if the allocated block has been sampled by memprof. */ + if(Caml_state->young_ptr < caml_memprof_young_trigger){ + if(flags & CAML_DO_TRACK) { + caml_memprof_track_young(tag, wosize, flags & CAML_FROM_CAML); + /* Until the allocation actually takes place, the heap is in an invalid + state (see comments in [caml_memprof_track_young]). Hence, very little + heap operations are allowed before the actual allocation. + + Moreover, [Caml_state->young_ptr] should not be modified before the + allocation, because its value has been used as the pointer to + the sampled block. + */ + } else caml_memprof_renew_minor_sample(); + } +} + +/* Exported for backward compatibility with Lablgtk: do a minor + collection to ensure that the minor heap is empty. */ CAMLexport void caml_minor_collection (void) { - caml_requested_minor_gc = 1; + Caml_state->requested_minor_gc = 1; caml_gc_dispatch (); } CAMLexport value caml_check_urgent_gc (value extra_root) { - CAMLparam1 (extra_root); - if (caml_requested_major_slice || caml_requested_minor_gc){ + if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc){ + CAMLparam1 (extra_root); CAML_INSTR_INT ("force_minor/check_urgent_gc@", 1); caml_gc_dispatch(); + CAMLdrop; } - CAMLreturn (extra_root); + return extra_root; } static void realloc_generic_table @@ -502,7 +559,7 @@ static void realloc_generic_table CAMLassert (tbl->limit >= tbl->threshold); if (tbl->base == NULL){ - alloc_generic_table (tbl, caml_minor_heap_wsz / 8, 256, + alloc_generic_table (tbl, Caml_state->minor_heap_wsz / 8, 256, element_size); }else if (tbl->limit == tbl->threshold){ CAML_INSTR_INT (msg_intr_int, 1); @@ -512,7 +569,7 @@ static void realloc_generic_table }else{ asize_t sz; asize_t cur_ptr = tbl->ptr - tbl->base; - CAMLassert (caml_requested_minor_gc); + CAMLassert (Caml_state->requested_minor_gc); tbl->size *= 2; sz = (tbl->size + tbl->reserve) * element_size; diff --git a/runtime/misc.c b/runtime/misc.c index 576f982a..c1534bc5 100644 --- a/runtime/misc.c +++ b/runtime/misc.c @@ -76,15 +76,21 @@ void caml_gc_message (int level, char *msg, ...) } } +void (*caml_fatal_error_hook) (char *msg, va_list args) = NULL; + CAMLexport void caml_fatal_error (char *msg, ...) { va_list ap; va_start(ap, msg); - fprintf (stderr, "Fatal error: "); - vfprintf (stderr, msg, ap); + if(caml_fatal_error_hook != NULL) { + caml_fatal_error_hook(msg, ap); + } else { + fprintf (stderr, "Fatal error: "); + vfprintf (stderr, msg, ap); + fprintf (stderr, "\n"); + } va_end(ap); - fprintf (stderr, "\n"); - exit(2); + abort(); } /* If you change the caml_ext_table* functions, also update @@ -238,7 +244,8 @@ void caml_instr_atexit (void) char *name = fname; if (name[0] == '@'){ - snprintf (buf, sizeof(buf), "%s.%d", name + 1, getpid ()); + snprintf (buf, sizeof(buf), "%s.%lld", + name + 1, (long long) (getpid ())); name = buf; } if (name[0] == '+'){ @@ -281,3 +288,19 @@ void caml_instr_atexit (void) } } #endif /* CAML_INSTR */ + +int caml_find_code_fragment(char *pc, int *index, struct code_fragment **cf) +{ + struct code_fragment *cfi; + int i; + + for (i = 0; i < caml_code_fragments_table.size; i++) { + cfi = (struct code_fragment *) caml_code_fragments_table.contents[i]; + if ((char*) pc >= cfi->code_start && (char*) pc < cfi->code_end) { + if (index != NULL) *index = i; + if (cf != NULL) *cf = cfi; + return 1; + } + } + return 0; +} diff --git a/runtime/obj.c b/runtime/obj.c index a2644866..d73595dc 100644 --- a/runtime/obj.c +++ b/runtime/obj.c @@ -28,6 +28,7 @@ #include "caml/misc.h" #include "caml/mlvalues.h" #include "caml/prims.h" +#include "caml/signals.h" #include "caml/spacetime.h" /* [size] is a value encoding a number of bytes */ @@ -118,6 +119,8 @@ CAMLprim value caml_obj_with_tag(value new_tag_v, value arg) } else { res = caml_alloc_shr(sz, tg); for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i)); + // Give gc a chance to run, and run memprof callbacks + caml_process_pending_actions(); } CAMLreturn (res); } diff --git a/runtime/power.S b/runtime/power.S index b58391ed..94983a6e 100644 --- a/runtime/power.S +++ b/runtime/power.S @@ -17,6 +17,17 @@ .abiversion 2 #endif +/* Special registers */ +#define START_PRG_ARG 12 +#define START_PRG_DOMAIN_STATE_PTR 7 +#define C_CALL_FUN 25 +#define C_CALL_TOC 26 +#define C_CALL_RET_ADDR 27 +#define DOMAIN_STATE_PTR 28 +#define TRAP_PTR 29 +#define ALLOC_LIMIT 30 +#define ALLOC_PTR 31 + #if defined(MODEL_ppc64) || defined(MODEL_ppc64le) #define EITHER(a,b) b #else @@ -121,19 +132,6 @@ #define Addrglobal(reg,glob) \ addis reg, 0, glob@ha; \ addi reg, reg, glob@l -#define Loadglobal(reg,glob,tmp) \ - addis tmp, 0, glob@ha; \ - lg reg, glob@l(tmp) -#define Storeglobal(reg,glob,tmp) \ - addis tmp, 0, glob@ha; \ - stg reg, glob@l(tmp) -#define Loadglobal32(reg,glob,tmp) \ - addis tmp, 0, glob@ha; \ - lwz reg, glob@l(tmp) -#define Storeglobal32(reg,glob,tmp) \ - addis tmp, 0, glob@ha; \ - stw reg, glob@l(tmp) - #endif #if defined(MODEL_ppc64) || defined(MODEL_ppc64le) @@ -142,21 +140,17 @@ #define Addrglobal(reg,glob) \ ld reg, LSYMB(glob)@toc(2) -#define Loadglobal(reg,glob,tmp) \ - Addrglobal(tmp,glob); \ - lg reg, 0(tmp) -#define Storeglobal(reg,glob,tmp) \ - Addrglobal(tmp,glob); \ - stg reg, 0(tmp) -#define Loadglobal32(reg,glob,tmp) \ - Addrglobal(tmp,glob); \ - lwz reg, 0(tmp) -#define Storeglobal32(reg,glob,tmp) \ - Addrglobal(tmp,glob); \ - stw reg, 0(tmp) - #endif + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE + +#define Caml_state(var) 8*domain_field_caml_##var(28) + #if defined(MODEL_ppc64) .section ".opd","aw" #else @@ -174,17 +168,17 @@ FUNCTION(caml_call_gc) stwu 1, -STACKSIZE(1) /* Record return address into OCaml code */ mflr 0 - Storeglobal(0, caml_last_return_address, 11) + stg 0, Caml_state(last_return_address) /* Record lowest stack address */ addi 0, 1, STACKSIZE - Storeglobal(0, caml_bottom_of_stack, 11) + stg 0, Caml_state(bottom_of_stack) /* Record pointer to register array */ addi 0, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - Storeglobal(0, caml_gc_regs, 11) + stg 0, Caml_state(gc_regs) /* Save current allocation pointer for debugging purposes */ - Storeglobal(31, caml_young_ptr, 11) + stg ALLOC_PTR, Caml_state(young_ptr) /* Save exception pointer (if e.g. a sighandler raises) */ - Storeglobal(29, caml_exception_pointer, 11) + stg TRAP_PTR, Caml_state(exception_pointer) /* Save all registers used by the code generator */ addi 11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD stgu 3, WORD(11) @@ -248,8 +242,8 @@ FUNCTION(caml_call_gc) nop #endif /* Reload new allocation pointer and allocation limit */ - Loadglobal(31, caml_young_ptr, 11) - Loadglobal(30, caml_young_limit, 11) + lg ALLOC_PTR, Caml_state(young_ptr) + lg ALLOC_LIMIT, Caml_state(young_limit) /* Restore all regs used by the code generator */ addi 11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD lgu 3, WORD(11) @@ -308,7 +302,7 @@ FUNCTION(caml_call_gc) lfdu 30, 8(11) lfdu 31, 8(11) /* Return to caller, restarting the allocation */ - Loadglobal(11, caml_last_return_address, 11) + lg 11, Caml_state(last_return_address) addi 11, 11, -16 /* Restart the allocation (4 instructions) */ mtlr 11 /* For PPC64: restore the TOC that the caller saved at the usual place */ @@ -326,39 +320,39 @@ ENDFUNCTION(caml_call_gc) FUNCTION(caml_c_call) .cfi_startproc /* Save return address in a callee-save register */ - mflr 27 - .cfi_register 65, 27 + mflr C_CALL_RET_ADDR + .cfi_register 65, C_CALL_RET_ADDR /* Record lowest stack address and return address */ - Storeglobal(1, caml_bottom_of_stack, 11) - Storeglobal(27, caml_last_return_address, 11) + stg 1, Caml_state(bottom_of_stack) + stg C_CALL_RET_ADDR, Caml_state(last_return_address) /* Make the exception handler and alloc ptr available to the C code */ - Storeglobal(31, caml_young_ptr, 11) - Storeglobal(29, caml_exception_pointer, 11) - /* Call C function (address in r28) */ + stg ALLOC_PTR, Caml_state(young_ptr) + stg TRAP_PTR, Caml_state(exception_pointer) + /* Call C function (address in C_CALL_FUN) */ #if defined(MODEL_ppc) - mtctr 28 + mtctr C_CALL_FUN bctrl #elif defined(MODEL_ppc64) - ld 0, 0(28) - mr 26, 2 /* save current TOC in a callee-save register */ + ld 0, 0(C_CALL_FUN) + mr C_CALL_TOC, 2 /* save current TOC in a callee-save register */ mtctr 0 - ld 2, 8(28) + ld 2, 8(C_CALL_FUN) bctrl - mr 2, 26 /* restore current TOC */ + mr 2, C_CALL_TOC /* restore current TOC */ #elif defined(MODEL_ppc64le) - mtctr 28 - mr 12, 28 - mr 26, 2 /* save current TOC in a callee-save register */ + mtctr C_CALL_FUN + mr 12, C_CALL_FUN + mr C_CALL_TOC, 2 /* save current TOC in a callee-save register */ bctrl - mr 2, 26 /* restore current TOC */ + mr 2, C_CALL_TOC /* restore current TOC */ #else #error "wrong MODEL" #endif /* Restore return address (in 27, preserved by the C function) */ - mtlr 27 + mtlr C_CALL_RET_ADDR /* Reload allocation pointer and allocation limit*/ - Loadglobal(31, caml_young_ptr, 11) - Loadglobal(30, caml_young_limit, 11) + lg ALLOC_PTR, Caml_state(young_ptr) + lg ALLOC_LIMIT, Caml_state(young_limit) /* Return to caller */ blr .cfi_endproc @@ -367,67 +361,70 @@ ENDFUNCTION(caml_c_call) /* Raise an exception from OCaml */ FUNCTION(caml_raise_exn) - Loadglobal32(0, caml_backtrace_active, 11) + lg 0, Caml_state(backtrace_active) cmpwi 0, 0 bne .L111 .L110: /* Pop trap frame */ - lg 0, TRAP_HANDLER_OFFSET(29) - mr 1, 29 + lg 0, TRAP_HANDLER_OFFSET(TRAP_PTR) + mr 1, TRAP_PTR mtctr 0 - lg 29, TRAP_PREVIOUS_OFFSET(1) + lg TRAP_PTR, TRAP_PREVIOUS_OFFSET(1) addi 1, 1, TRAP_SIZE /* Branch to handler */ bctr .L111: - mr 28, 3 /* preserve exn bucket in callee-save reg */ + mr 27, 3 /* preserve exn bucket in callee-save reg */ /* arg1: exception bucket, already in r3 */ mflr 4 /* arg2: PC of raise */ mr 5, 1 /* arg3: SP of raise */ - mr 6, 29 /* arg4: SP of handler */ + mr 6, TRAP_PTR /* arg4: SP of handler */ addi 1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK) /* reserve stack space for C call */ bl caml_stash_backtrace #if defined(MODEL_ppc64) || defined(MODEL_ppc64le) nop #endif - mr 3, 28 /* restore exn bucket */ + mr 3, 27 /* restore exn bucket */ b .L110 /* raise the exn */ ENDFUNCTION(caml_raise_exn) /* Raise an exception from C */ FUNCTION(caml_raise_exception) - Loadglobal32(0, caml_backtrace_active, 11) + /* Load domain state pointer */ + mr DOMAIN_STATE_PTR, 3 + mr 3, 4 + lg 0, Caml_state(backtrace_active) cmpwi 0, 0 bne .L121 .L120: /* Reload OCaml global registers */ - Loadglobal(1, caml_exception_pointer, 11) - Loadglobal(31, caml_young_ptr, 11) - Loadglobal(30, caml_young_limit, 11) + lg 1, Caml_state(exception_pointer) + lg ALLOC_PTR, Caml_state(young_ptr) + lg ALLOC_LIMIT, Caml_state(young_limit) /* Pop trap frame */ lg 0, TRAP_HANDLER_OFFSET(1) mtctr 0 - lg 29, TRAP_PREVIOUS_OFFSET(1) + lg TRAP_PTR, TRAP_PREVIOUS_OFFSET(1) addi 1, 1, TRAP_SIZE /* Branch to handler */ bctr .L121: li 0, 0 - Storeglobal32(0, caml_backtrace_pos, 11) - mr 28, 3 /* preserve exn bucket in callee-save reg */ + stg 0, Caml_state(backtrace_pos) + mr 27, 3 /* preserve exn bucket in callee-save reg */ /* arg1: exception bucket, already in r3 */ - Loadglobal(4, caml_last_return_address, 11) /* arg2: PC of raise */ - Loadglobal(5, caml_bottom_of_stack, 11) /* arg3: SP of raise */ - Loadglobal(6, caml_exception_pointer, 11) /* arg4: SP of handler */ + lg 4, Caml_state(last_return_address) /* arg2: PC of raise */ + lg 5, Caml_state(bottom_of_stack) /* arg3: SP of raise */ + lg 6, Caml_state(exception_pointer) /* arg4: SP of handler */ addi 1, 1, -(PARAM_SAVE_AREA + RESERVED_STACK) /* reserve stack space for C call */ bl caml_stash_backtrace #if defined(MODEL_ppc64) || defined(MODEL_ppc64le) nop #endif - mr 3, 28 /* restore exn bucket */ + mr 3, 27 /* restore exn bucket */ b .L120 /* raise the exn */ ENDFUNCTION(caml_raise_exception) @@ -437,7 +434,9 @@ FUNCTION(caml_start_program) .cfi_startproc #define STACKSIZE (WORD*18 + 8*18 + CALLBACK_LINK_SIZE + RESERVED_STACK) /* 18 callee-save GPR14...GPR31 + 18 callee-save FPR14...FPR31 */ - Addrglobal(12, caml_program) + /* Domain state pointer is the first arg to caml_start_program. Move it */ + mr START_PRG_DOMAIN_STATE_PTR, 3 + Addrglobal(START_PRG_ARG, caml_program) /* Code shared between caml_start_program and caml_callback */ .L102: /* Allocate and link stack frame */ @@ -489,12 +488,14 @@ FUNCTION(caml_start_program) stfdu 29, 8(11) stfdu 30, 8(11) stfdu 31, 8(11) + /* Load domain state pointer from argument */ + mr DOMAIN_STATE_PTR, START_PRG_DOMAIN_STATE_PTR /* Set up a callback link */ - Loadglobal(11, caml_bottom_of_stack, 11) + lg 11, Caml_state(bottom_of_stack) stg 11, CALLBACK_LINK_OFFSET(1) - Loadglobal(11, caml_last_return_address, 11) + lg 11, Caml_state(last_return_address) stg 11, (CALLBACK_LINK_OFFSET + WORD)(1) - Loadglobal(11, caml_gc_regs, 11) + lg 11, Caml_state(gc_regs) stg 11, (CALLBACK_LINK_OFFSET + 2 * WORD)(1) /* Build an exception handler to catch exceptions escaping out of OCaml */ bl .L103 @@ -504,12 +505,12 @@ FUNCTION(caml_start_program) .cfi_adjust_cfa_offset TRAP_SIZE mflr 0 stg 0, TRAP_HANDLER_OFFSET(1) - Loadglobal(11, caml_exception_pointer, 11) + lg 11, Caml_state(exception_pointer) stg 11, TRAP_PREVIOUS_OFFSET(1) - mr 29, 1 + mr TRAP_PTR, 1 /* Reload allocation pointers */ - Loadglobal(31, caml_young_ptr, 11) - Loadglobal(30, caml_young_limit, 11) + lg ALLOC_PTR, Caml_state(young_ptr) + lg ALLOC_LIMIT, Caml_state(young_limit) /* Call the OCaml code (address in r12) */ #if defined(MODEL_ppc) mtctr 12 @@ -531,19 +532,19 @@ FUNCTION(caml_start_program) #endif /* Pop the trap frame, restoring caml_exception_pointer */ lg 0, TRAP_PREVIOUS_OFFSET(1) - Storeglobal(0, caml_exception_pointer, 11) + stg 0, Caml_state(exception_pointer) addi 1, 1, TRAP_SIZE .cfi_adjust_cfa_offset -TRAP_SIZE /* Pop the callback link, restoring the global variables */ .L106: lg 0, CALLBACK_LINK_OFFSET(1) - Storeglobal(0, caml_bottom_of_stack, 11) + stg 0, Caml_state(bottom_of_stack) lg 0, (CALLBACK_LINK_OFFSET + WORD)(1) - Storeglobal(0, caml_last_return_address, 11) + stg 0, Caml_state(last_return_address) lg 0, (CALLBACK_LINK_OFFSET + 2 * WORD)(1) - Storeglobal(0, caml_gc_regs, 11) + stg 0, Caml_state(gc_regs) /* Update allocation pointer */ - Storeglobal(31, caml_young_ptr, 11) + stg ALLOC_PTR, Caml_state(young_ptr) /* Restore callee-save registers */ addi 11, 1, CALLBACK_LINK_SIZE + RESERVED_STACK - WORD lgu 14, WORD(11) @@ -596,7 +597,7 @@ FUNCTION(caml_start_program) ld 2, (STACKSIZE + TOC_SAVE_PARENT)(1) #endif /* Update caml_exception_pointer */ - Storeglobal(29, caml_exception_pointer, 11) + stg TRAP_PTR, Caml_state(exception_pointer) /* Encode exception bucket as an exception result and return it */ ori 3, 3, 2 b .L106 @@ -606,33 +607,39 @@ ENDFUNCTION(caml_start_program) /* Callback from C to OCaml */ -FUNCTION(caml_callback_exn) +FUNCTION(caml_callback_asm) /* Initial shuffling of arguments */ - mr 0, 3 /* Closure */ - mr 3, 4 /* Argument */ - mr 4, 0 - lg 12, 0(4) /* Code pointer */ + /* r3 = Caml_state, r4 = closure, 0(r5) = first arg */ + mr START_PRG_DOMAIN_STATE_PTR, 3 + lg 3, 0(5) /* r3 = Argument */ + /* r4 = Closure */ + lg START_PRG_ARG, 0(4) /* Code pointer */ b .L102 -ENDFUNCTION(caml_callback_exn) - -FUNCTION(caml_callback2_exn) - mr 0, 3 /* Closure */ - mr 3, 4 /* First argument */ - mr 4, 5 /* Second argument */ - mr 5, 0 - Addrglobal(12, caml_apply2) +ENDFUNCTION(caml_callback_asm) + +FUNCTION(caml_callback2_asm) + /* r3 = Caml_state, r4 = closure, 0(r5) = first arg, + WORD(r5) = second arg */ + mr START_PRG_DOMAIN_STATE_PTR, 3 + mr 0, 4 + lg 3, 0(5) /* r3 = First argument */ + lg 4, WORD(5) /* r4 = Second argument */ + mr 5, 0 /* r5 = Closure */ + Addrglobal(START_PRG_ARG, caml_apply2) b .L102 -ENDFUNCTION(caml_callback2_exn) - -FUNCTION(caml_callback3_exn) - mr 0, 3 /* Closure */ - mr 3, 4 /* First argument */ - mr 4, 5 /* Second argument */ - mr 5, 6 /* Third argument */ - mr 6, 0 - Addrglobal(12, caml_apply3) +ENDFUNCTION(caml_callback2_asm) + +FUNCTION(caml_callback3_asm) + /* r3 = Caml_state, r4 = closure, 0(r5) = first arg, WORD(r5) = second arg, + 2*WORD(r5) = third arg */ + mr START_PRG_DOMAIN_STATE_PTR, 3 + mr 6, 4 /* r6 = Closure */ + lg 3, 0(5) /* r3 = First argument */ + lg 4, WORD(5) /* r4 = Second argument */ + lg 5, 2*WORD(5) /* r5 = Third argument */ + Addrglobal(START_PRG_ARG, caml_apply3) b .L102 -ENDFUNCTION(caml_callback3_exn) +ENDFUNCTION(caml_callback3_asm) #if defined(MODEL_ppc64) .section ".opd","aw" @@ -664,15 +671,7 @@ caml_system__frametable: TOCENTRY(caml_apply2) TOCENTRY(caml_apply3) -TOCENTRY(caml_backtrace_active) -TOCENTRY(caml_backtrace_pos) -TOCENTRY(caml_bottom_of_stack) -TOCENTRY(caml_exception_pointer) -TOCENTRY(caml_gc_regs) -TOCENTRY(caml_last_return_address) TOCENTRY(caml_program) -TOCENTRY(caml_young_limit) -TOCENTRY(caml_young_ptr) #endif diff --git a/runtime/printexc.c b/runtime/printexc.c index 3220a21d..e18beda3 100644 --- a/runtime/printexc.c +++ b/runtime/printexc.c @@ -28,6 +28,7 @@ #include "caml/mlvalues.h" #include "caml/printexc.h" #include "caml/memory.h" +#include "caml/memprof.h" struct stringbuf { char * ptr; @@ -117,18 +118,18 @@ static void default_fatal_uncaught_exception(value exn) msg = caml_format_exception(exn); /* Perform "at_exit" processing, ignoring all exceptions that may be triggered by this */ - saved_backtrace_active = caml_backtrace_active; - saved_backtrace_pos = caml_backtrace_pos; - caml_backtrace_active = 0; + saved_backtrace_active = Caml_state->backtrace_active; + saved_backtrace_pos = Caml_state->backtrace_pos; + Caml_state->backtrace_active = 0; at_exit = caml_named_value("Pervasives.do_at_exit"); if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit); - caml_backtrace_active = saved_backtrace_active; - caml_backtrace_pos = saved_backtrace_pos; + Caml_state->backtrace_active = saved_backtrace_active; + Caml_state->backtrace_pos = saved_backtrace_pos; /* Display the uncaught exception */ fprintf(stderr, "Fatal error: exception %s\n", msg); caml_stat_free(msg); /* Display the backtrace if available */ - if (caml_backtrace_active && !DEBUGGER_IN_USE) + if (Caml_state->backtrace_active && !DEBUGGER_IN_USE) caml_print_exception_backtrace(); } @@ -140,6 +141,13 @@ void caml_fatal_uncaught_exception(value exn) handle_uncaught_exception = caml_named_value("Printexc.handle_uncaught_exception"); + + /* If the callback allocates, memprof could be called. In this case, + memprof's callback could raise an exception while + [handle_uncaught_exception] is running, so that the printing of + the exception fails. */ + caml_memprof_suspended = 1; + if (handle_uncaught_exception != NULL) /* [Printexc.handle_uncaught_exception] does not raise exception. */ caml_callback2(*handle_uncaught_exception, exn, Val_bool(DEBUGGER_IN_USE)); diff --git a/runtime/roots_byt.c b/runtime/roots_byt.c index 6536ceea..a0b6e624 100644 --- a/runtime/roots_byt.c +++ b/runtime/roots_byt.c @@ -26,8 +26,7 @@ #include "caml/mlvalues.h" #include "caml/roots.h" #include "caml/stacks.h" - -CAMLexport struct caml__roots_block *caml_local_roots = NULL; +#include "caml/memprof.h" CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL; @@ -42,11 +41,11 @@ void caml_oldify_local_roots (void) intnat i, j; /* The stack */ - for (sp = caml_extern_sp; sp < caml_stack_high; sp++) { + for (sp = Caml_state->extern_sp; sp < Caml_state->stack_high; sp++) { caml_oldify_one (*sp, sp); } /* Local C roots */ /* FIXME do the old-frame trick ? */ - for (lr = caml_local_roots; lr != NULL; lr = lr->next) { + for (lr = Caml_state->local_roots; lr != NULL; lr = lr->next) { for (i = 0; i < lr->ntables; i++){ for (j = 0; j < lr->nitems; j++){ sp = &(lr->tables[i][j]); @@ -58,6 +57,8 @@ void caml_oldify_local_roots (void) caml_scan_global_young_roots(&caml_oldify_one); /* Finalised values */ caml_final_oldify_young_roots (); + /* Memprof */ + caml_memprof_scan_roots (&caml_oldify_one); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one); } @@ -85,7 +86,8 @@ void caml_do_roots (scanning_action f, int do_globals) f(caml_global_data, &caml_global_data); CAML_INSTR_TIME (tmr, "major_roots/global"); /* The stack and the local C roots */ - caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots); + caml_do_local_roots(f, Caml_state->extern_sp, Caml_state->stack_high, + Caml_state->local_roots); CAML_INSTR_TIME (tmr, "major_roots/local"); /* Global C roots */ caml_scan_global_roots(f); @@ -93,6 +95,9 @@ void caml_do_roots (scanning_action f, int do_globals) /* Finalised values */ caml_final_do_roots (f); CAML_INSTR_TIME (tmr, "major_roots/finalised"); + /* Memprof */ + caml_memprof_scan_roots (f); + CAML_INSTR_TIME (tmr, "major_roots/memprof"); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); CAML_INSTR_TIME (tmr, "major_roots/hook"); diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c index 38483b41..d8feb1bd 100644 --- a/runtime/roots_nat.c +++ b/runtime/roots_nat.c @@ -26,13 +26,12 @@ #include "caml/mlvalues.h" #include "caml/stack.h" #include "caml/roots.h" +#include "caml/memprof.h" #include #include /* Roots registered from C functions */ -struct caml__roots_block *caml_local_roots = NULL; - void (*caml_scan_roots_hook) (scanning_action) = NULL; /* The hashtable of frame descriptors */ @@ -220,10 +219,6 @@ void caml_unregister_frametable(intnat *table) { /* Communication with [caml_start_program] and [caml_call_gc]. */ -char * caml_top_of_stack; -char * caml_bottom_of_stack = NULL; /* no stack initially */ -uintnat caml_last_return_address = 1; /* not in OCaml code initially */ -value * caml_gc_regs; intnat caml_globals_inited = 0; static intnat caml_globals_scanned = 0; static link * caml_dyn_globals = NULL; @@ -271,9 +266,9 @@ void caml_oldify_local_roots (void) } /* The stack and local roots */ - sp = caml_bottom_of_stack; - retaddr = caml_last_return_address; - regs = caml_gc_regs; + sp = Caml_state->bottom_of_stack; + retaddr = Caml_state->last_return_address; + regs = Caml_state->gc_regs; if (sp != NULL) { while (1) { /* Find the descriptor corresponding to the return address */ @@ -316,7 +311,7 @@ void caml_oldify_local_roots (void) } } /* Local C roots */ - for (lr = caml_local_roots; lr != NULL; lr = lr->next) { + for (lr = Caml_state->local_roots; lr != NULL; lr = lr->next) { for (i = 0; i < lr->ntables; i++){ for (j = 0; j < lr->nitems; j++){ root = &(lr->tables[i][j]); @@ -328,6 +323,8 @@ void caml_oldify_local_roots (void) caml_scan_global_young_roots(&caml_oldify_one); /* Finalised values */ caml_final_oldify_young_roots (); + /* Memprof */ + caml_memprof_scan_roots (&caml_oldify_one); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one); } @@ -414,8 +411,9 @@ void caml_do_roots (scanning_action f, int do_globals) } CAML_INSTR_TIME (tmr, "major_roots/dynamic_global"); /* The stack and local roots */ - caml_do_local_roots(f, caml_bottom_of_stack, caml_last_return_address, - caml_gc_regs, caml_local_roots); + caml_do_local_roots(f, Caml_state->bottom_of_stack, + Caml_state->last_return_address, Caml_state->gc_regs, + Caml_state->local_roots); CAML_INSTR_TIME (tmr, "major_roots/local"); /* Global C roots */ caml_scan_global_roots(f); @@ -423,6 +421,9 @@ void caml_do_roots (scanning_action f, int do_globals) /* Finalised values */ caml_final_do_roots (f); CAML_INSTR_TIME (tmr, "major_roots/finalised"); + /* Memprof */ + caml_memprof_scan_roots (f); + CAML_INSTR_TIME (tmr, "major_roots/memprof"); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); CAML_INSTR_TIME (tmr, "major_roots/hook"); @@ -499,7 +500,8 @@ uintnat (*caml_stack_usage_hook)(void) = NULL; uintnat caml_stack_usage (void) { uintnat sz; - sz = (value *) caml_top_of_stack - (value *) caml_bottom_of_stack; + sz = (value *) Caml_state->top_of_stack - + (value *) Caml_state->bottom_of_stack; if (caml_stack_usage_hook != NULL) sz += (*caml_stack_usage_hook)(); return sz; diff --git a/runtime/s390x.S b/runtime/s390x.S index 65923be0..0ae3f82a 100644 --- a/runtime/s390x.S +++ b/runtime/s390x.S @@ -19,30 +19,21 @@ #define Addrglobal(reg,glob) \ lgrl reg, glob@GOTENT -#define Loadglobal(reg,glob) \ - lgrl %r1, glob@GOTENT; lg reg, 0(%r1) -#define Storeglobal(reg,glob) \ - lgrl %r1, glob@GOTENT; stg reg, 0(%r1) -#define Loadglobal32(reg,glob) \ - lgrl %r1, glob@GOTENT; lgf reg, 0(%r1) -#define Storeglobal32(reg,glob) \ - lgrl %r1, glob@GOTENT; sty reg, 0(%r1) - #else #define Addrglobal(reg,glob) \ larl reg, glob -#define Loadglobal(reg,glob) \ - lgrl reg, glob -#define Storeglobal(reg,glob) \ - stgrl reg, glob -#define Loadglobal32(reg,glob) \ - lgfrl reg, glob -#define Storeglobal32(reg,glob) \ - strl reg, glob - #endif + .set domain_curr_field, 0 +#define DOMAIN_STATE(c_type, name) \ + .equ domain_field_caml_##name, domain_curr_field ; \ + .set domain_curr_field, domain_curr_field + 1 +#include "../runtime/caml/domain_state.tbl" +#undef DOMAIN_STATE + +#define Caml_state(var) 8*domain_field_caml_##var(%r10) + .section ".text" /* Invoke the garbage collector. */ @@ -57,17 +48,17 @@ caml_call_gc: #define FRAMESIZE (16*8 + 16*8) lay %r15, -FRAMESIZE(%r15) /* Record return address into OCaml code */ - Storeglobal(%r14, caml_last_return_address) + stg %r14, Caml_state(last_return_address) /* Record lowest stack address */ lay %r0, FRAMESIZE(%r15) - Storeglobal(%r0, caml_bottom_of_stack) + stg %r0, Caml_state(bottom_of_stack) /* Record pointer to register array */ lay %r0, (8*16)(%r15) - Storeglobal(%r0, caml_gc_regs) + stg %r0, Caml_state(gc_regs) /* Save current allocation pointer for debugging purposes */ - Storeglobal(%r11, caml_young_ptr) + stg %r11, Caml_state(young_ptr) /* Save exception pointer (if e.g. a sighandler raises) */ - Storeglobal(%r13, caml_exception_pointer) + stg %r13, Caml_state(exception_pointer) /* Save all registers used by the code generator */ stmg %r2,%r9, (8*16)(%r15) stg %r12, (8*16 + 8*8)(%r15) @@ -88,13 +79,12 @@ caml_call_gc: std %f14, 112(%r15) std %f15, 120(%r15) /* Call the GC */ - lay %r15, -160(%r15) + lay %r15, -160(%r15) stg %r15, 0(%r15) brasl %r14, caml_garbage_collection@PLT - lay %r15, 160(%r15) - /* Reload new allocation pointer and allocation limit */ - Loadglobal(%r11, caml_young_ptr) - Loadglobal(%r10, caml_young_limit) + lay %r15, 160(%r15) + /* Reload new allocation pointer */ + lg %r11, Caml_state(young_ptr) /* Restore all regs used by the code generator */ lmg %r2,%r9, (8*16)(%r15) lg %r12, (8*16 + 8*8)(%r15) @@ -115,34 +105,33 @@ caml_call_gc: ld %f14, 112(%r15) ld %f15, 120(%r15) /* Return to caller */ - Loadglobal(%r1, caml_last_return_address) + lg %r1, Caml_state(last_return_address) /* Deallocate stack frame */ lay %r15, FRAMESIZE(%r15) /* Return */ - br %r1 + br %r1 /* Call a C function from OCaml */ .globl caml_c_call .type caml_c_call, @function caml_c_call: - Storeglobal(%r15, caml_bottom_of_stack) + stg %r15, Caml_state(bottom_of_stack) .L101: /* Save return address */ ldgr %f15, %r14 /* Get ready to call C function (address in r7) */ /* Record lowest stack address and return address */ - Storeglobal(%r14, caml_last_return_address) + stg %r14, Caml_state(last_return_address) /* Make the exception handler and alloc ptr available to the C code */ - Storeglobal(%r11, caml_young_ptr) - Storeglobal(%r13, caml_exception_pointer) + stg %r11, Caml_state(young_ptr) + stg %r13, Caml_state(exception_pointer) /* Call the function */ basr %r14, %r7 /* restore return address */ lgdr %r14,%f15 - /* Reload allocation pointer and allocation limit*/ - Loadglobal(%r11, caml_young_ptr) - Loadglobal(%r10, caml_young_limit) + /* Reload allocation pointer */ + lg %r11, Caml_state(young_ptr) /* Return to caller */ br %r14 @@ -150,24 +139,24 @@ caml_c_call: .globl caml_raise_exn .type caml_raise_exn, @function caml_raise_exn: - Loadglobal32(%r0, caml_backtrace_active) + lg %r0, Caml_state(backtrace_active) cgfi %r0, 0 jne .L110 .L111: /* Pop trap frame */ lg %r1, 0(%r13) lgr %r15, %r13 - lg %r13, 8(13) - agfi %r15, 16 + lg %r13, 8(13) + agfi %r15, 16 /* Branch to handler */ br %r1 .L110: ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */ - /* arg1: exception bucket, already in r3 */ - lgr %r3,%r14 /* arg2: PC of raise */ + /* arg1: exception bucket, already in r2 */ + lgr %r3, %r14 /* arg2: PC of raise */ lgr %r4, %r15 /* arg3: SP of raise */ - lgr %r5, %r13 /* arg4: SP of handler */ - agfi %r15, -160 /* reserve stack space for C call */ + lgr %r5, %r13 /* arg4: SP of handler */ + agfi %r15, -160 /* reserve stack space for C call */ brasl %r14, caml_stash_backtrace@PLT agfi %r15, 160 lgdr %r2,%f15 /* restore exn bucket */ @@ -178,14 +167,15 @@ caml_raise_exn: .globl caml_raise_exception .type caml_raise_exception, @function caml_raise_exception: - Loadglobal32(%r0, caml_backtrace_active) + lgr %r10, %r2 /* Load domain state pointer */ + lgr %r2, %r3 /* Move exception bucket to arg1 register */ + lg %r0, Caml_state(backtrace_active) cgfi %r0, 0 jne .L112 .L113: /* Reload OCaml global registers */ - Loadglobal(%r15, caml_exception_pointer) - Loadglobal(%r11, caml_young_ptr) - Loadglobal(%r10, caml_young_limit) + lg %r15, Caml_state(exception_pointer) + lg %r11, Caml_state(young_ptr) /* Pop trap frame */ lg %r1, 0(%r15) lg %r13, 8(%r15) @@ -193,17 +183,17 @@ caml_raise_exception: /* Branch to handler */ br %r1; .L112: - lgfi %r0, 0 - Storeglobal32(%r0, caml_backtrace_pos) + lgfi %r0, 0 + stg %r0, Caml_state(backtrace_pos) ldgr %f15,%r2 /* preserve exn bucket in callee-save reg */ /* arg1: exception bucket, already in r2 */ - Loadglobal(%r3, caml_last_return_address) /* arg2: PC of raise */ - Loadglobal(%r4, caml_bottom_of_stack) /* arg3: SP of raise */ - Loadglobal(%r5, caml_exception_pointer) /* arg4: SP of handler */ - /* reserve stack space for C call */ - lay %r15, -160(%r15) + lg %r3, Caml_state(last_return_address) /* arg2: PC of raise */ + lg %r4, Caml_state(bottom_of_stack) /* arg3: SP of raise */ + lg %r5, Caml_state(exception_pointer) /* arg4: SP of handler */ + /* reserve stack space for C call */ + lay %r15, -160(%r15) brasl %r14, caml_stash_backtrace@PLT - lay %r15, 160(%r15) + lay %r15, 160(%r15) lgdr %r2,%f15 /* restore exn bucket */ j .L113 /* raise the exn */ @@ -212,6 +202,8 @@ caml_raise_exception: .globl caml_start_program .type caml_start_program, @function caml_start_program: + /* Move Caml_state passed as first argument to r1 */ + lgr %r1, %r2 Addrglobal(%r0, caml_program) /* Code shared between caml_start_program and caml_callback */ @@ -231,13 +223,15 @@ caml_start_program: std %f14, 120(%r15) std %f15, 128(%r15) + /* Load Caml_state to r10 register */ + lgr %r10, %r1 /* Set up a callback link */ lay %r15, -32(%r15) - Loadglobal(%r1, caml_bottom_of_stack) + lg %r1, Caml_state(bottom_of_stack) stg %r1, 0(%r15) - Loadglobal(%r1, caml_last_return_address) + lg %r1, Caml_state(last_return_address) stg %r1, 8(%r15) - Loadglobal(%r1, caml_gc_regs) + lg %r1, Caml_state(gc_regs) stg %r1, 16(%r15) /* Build an exception handler to catch exceptions escaping out of OCaml */ brasl %r14, .L103 @@ -245,43 +239,42 @@ caml_start_program: .L103: lay %r15, -16(%r15) stg %r14, 0(%r15) - Loadglobal(%r1, caml_exception_pointer) + lg %r1, Caml_state(exception_pointer) stg %r1, 8(%r15) lgr %r13, %r15 - /* Reload allocation pointers */ - Loadglobal(%r11, caml_young_ptr) - Loadglobal(%r10, caml_young_limit) + /* Reload allocation pointer */ + lg %r11, Caml_state(young_ptr) /* Call the OCaml code */ - lgr %r1,%r0 - basr %r14, %r1 + lgr %r1,%r0 + basr %r14, %r1 .L105: /* Pop the trap frame, restoring caml_exception_pointer */ - lg %r0, 8(%r15) - Storeglobal(%r0, caml_exception_pointer) + lg %r0, 8(%r15) + stg %r0, Caml_state(exception_pointer) la %r15, 16(%r15) /* Pop the callback link, restoring the global variables */ .L106: lg %r5, 0(%r15) lg %r6, 8(%r15) lg %r0, 16(%r15) - Storeglobal(%r5, caml_bottom_of_stack) - Storeglobal(%r6, caml_last_return_address) - Storeglobal(%r0, caml_gc_regs) + stg %r5, Caml_state(bottom_of_stack) + stg %r6, Caml_state(last_return_address) + stg %r0, Caml_state(gc_regs) la %r15, 32(%r15) /* Update allocation pointer */ - Storeglobal(%r11, caml_young_ptr) + stg %r11, Caml_state(young_ptr) - /* Restore registers */ - lmg %r6,%r14, 0(%r15) - ld %f8, 72(%r15) - ld %f9, 80(%r15) - ld %f10, 88(%r15) - ld %f11, 96(%r15) - ld %f12, 104(%r15) - ld %f13, 112(%r15) - ld %f14, 120(%r15) - ld %f15, 128(%r15) + /* Restore registers */ + lmg %r6,%r14, 0(%r15) + ld %f8, 72(%r15) + ld %f9, 80(%r15) + ld %f10, 88(%r15) + ld %f11, 96(%r15) + ld %f12, 104(%r15) + ld %f13, 112(%r15) + ld %f14, 120(%r15) + ld %f15, 128(%r15) /* Return */ lay %r15, 144(%r15) @@ -290,42 +283,49 @@ caml_start_program: /* The trap handler: */ .L104: /* Update caml_exception_pointer */ - Storeglobal(%r13, caml_exception_pointer) + stg %r13, Caml_state(exception_pointer) /* Encode exception bucket as an exception result and return it */ oill %r2, 2 j .L106 /* Callback from C to OCaml */ - .globl caml_callback_exn - .type caml_callback_exn, @function -caml_callback_exn: + .globl caml_callback_asm + .type caml_callback_asm, @function +caml_callback_asm: /* Initial shuffling of arguments */ - lgr %r0, %r2 /* Closure */ - lgr %r2, %r3 /* Argument */ - lgr %r3, %r0 - lg %r0, 0(%r3) /* Code pointer */ + /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1) */ + lgr %r1, %r2 /* r1 = Caml_state */ + lg %r2, 0(%r4) /* r2 = Argument */ + /* r3 = Closure */ + lg %r0, 0(%r3) /* r0 = Code pointer */ j .L102 - .globl caml_callback2_exn - .type caml_callback2_exn, @function -caml_callback2_exn: - lgr %r0, %r2 /* Closure */ - lgr %r2, %r3 /* First argument */ - lgr %r3, %r4 /* Second argument */ - lgr %r4, %r0 - Addrglobal(%r0, caml_apply2) + .globl caml_callback2_asm + .type caml_callback2_asm, @function +caml_callback2_asm: + /* Initial shuffling of arguments */ + /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2) */ + lgr %r1, %r2 /* r1 = Caml_state */ + lgr %r0, %r3 + lg %r2, 0(%r4) /* r2 = First argument */ + lg %r3, 8(%r4) /* r3 = Second argument */ + lgr %r4, %r0 /* r4 = Closure */ + Addrglobal(%r0, caml_apply2) /* r0 = Code pointer */ j .L102 - .globl caml_callback3_exn - .type caml_callback3_exn, @function -caml_callback3_exn: - lgr %r0, %r2 /* Closure */ - lgr %r2, %r3 /* First argument */ - lgr %r3, %r4 /* Second argument */ - lgr %r4, %r5 /* Third argument */ - lgr %r5, %r0 - Addrglobal(%r0, caml_apply3) + .globl caml_callback3_asm + .type caml_callback3_asm, @function +caml_callback3_asm: + /* Initial shuffling of arguments */ + /* (r2 = Caml_state, r3 = closure, 0(r4) = arg1, 8(r4) = arg2, + 16(r4) = arg3) */ + lgr %r1, %r2 /* r1 = Caml_state */ + lgr %r5, %r3 /* r5 = Closure */ + lg %r2, 0(%r4) /* r2 = First argument */ + lg %r3, 8(%r4) /* r3 = Second argument */ + lg %r4, 16(%r4) /* r4 = Third argument */ + Addrglobal(%r0, caml_apply3) /* r0 = Code pointer */ j .L102 .globl caml_ml_array_bound_error @@ -333,7 +333,7 @@ caml_callback3_exn: caml_ml_array_bound_error: /* Save return address before decrementing SP, otherwise the frame descriptor for the call site is not correct */ - Storeglobal(%r15, caml_bottom_of_stack) + stg %r15, Caml_state(bottom_of_stack) lay %r15, -160(%r15) /* Reserve stack space for C call */ Addrglobal(%r7, caml_array_bound_error) j .L101 diff --git a/runtime/signals.c b/runtime/signals.c index 743d10a3..10e3b1ed 100644 --- a/runtime/signals.c +++ b/runtime/signals.c @@ -30,6 +30,8 @@ #include "caml/signals.h" #include "caml/signals_machdep.h" #include "caml/sys.h" +#include "caml/memprof.h" +#include "caml/finalise.h" #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) #include "caml/spacetime.h" @@ -39,9 +41,11 @@ #define NSIG 64 #endif +CAMLexport int volatile caml_something_to_do = 0; + /* The set of pending signals (received but not yet processed) */ -CAMLexport intnat volatile caml_signals_are_pending = 0; +static intnat volatile signals_are_pending = 0; CAMLexport intnat volatile caml_pending_signals[NSIG]; #ifdef POSIX_SIGNALS @@ -60,7 +64,7 @@ CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *) /* Execute all pending signals */ -void caml_process_pending_signals(void) +value caml_process_pending_signals_exn(void) { int i; int really_pending; @@ -68,9 +72,9 @@ void caml_process_pending_signals(void) sigset_t set; #endif - if(!caml_signals_are_pending) - return; - caml_signals_are_pending = 0; + if(!signals_are_pending) + return Val_unit; + signals_are_pending = 0; /* Check that there is indeed a pending signal before issuing the syscall in [caml_sigmask_hook]. */ @@ -81,7 +85,7 @@ void caml_process_pending_signals(void) break; } if(!really_pending) - return; + return Val_unit; #ifdef POSIX_SIGNALS caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set); @@ -94,26 +98,40 @@ void caml_process_pending_signals(void) continue; #endif caml_pending_signals[i] = 0; - caml_execute_signal(i, 0); + { + value exn = caml_execute_signal_exn(i, 0); + if (Is_exception_result(exn)) return exn; + } } + return Val_unit; +} + +CAMLno_tsan /* When called from [caml_record_signal], these memory + accesses may not be synchronized. */ +void caml_set_action_pending(void) +{ + caml_something_to_do = 1; + + /* When this function is called without [caml_c_call] (e.g., in + [caml_modify]), this is only moderately effective on ports that cache + [Caml_state->young_limit] in a register, so it may take a while before the + register is reloaded from [Caml_state->young_limit]. */ + Caml_state->young_limit = Caml_state->young_alloc_end; } /* Record the delivery of a signal, and arrange for it to be processed as soon as possible: - - in bytecode: via caml_something_to_do, processed in caml_process_event - - in native-code: by playing with the allocation limit, processed - in caml_garbage_collection + - via caml_something_to_do, processed in + caml_process_pending_actions_exn. + - by playing with the allocation limit, processed in + caml_garbage_collection and caml_alloc_small_dispatch. */ -void caml_record_signal(int signal_number) +CAMLno_tsan void caml_record_signal(int signal_number) { caml_pending_signals[signal_number] = 1; - caml_signals_are_pending = 1; -#ifndef NATIVE_CODE - caml_something_to_do = 1; -#else - caml_young_limit = caml_young_alloc_end; -#endif + signals_are_pending = 1; + caml_set_action_pending(); } /* Management of blocking sections. */ @@ -146,15 +164,16 @@ CAMLexport void (*caml_leave_blocking_section_hook)(void) = CAMLexport int (*caml_try_leave_blocking_section_hook)(void) = caml_try_leave_blocking_section_default; +CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */ CAMLexport void caml_enter_blocking_section(void) { while (1){ /* Process all pending signals now */ - caml_process_pending_signals(); + caml_raise_if_exception(caml_process_pending_signals_exn()); caml_enter_blocking_section_hook (); /* Check again for pending signals. If none, done; otherwise, try again */ - if (! caml_signals_are_pending) break; + if (! signals_are_pending) break; caml_leave_blocking_section_hook (); } } @@ -167,7 +186,7 @@ CAMLexport void caml_leave_blocking_section(void) caml_leave_blocking_section_hook (); /* Some other thread may have switched - [caml_signals_are_pending] to 0 even though there are still + [signals_are_pending] to 0 even though there are still pending signals (masked in the other thread). To handle this case, we force re-examination of all signals by setting it back to 1. @@ -175,11 +194,11 @@ CAMLexport void caml_leave_blocking_section(void) Another case where this is necessary (even in a single threaded setting) is when the blocking section unmasks a pending signal: If the signal is pending and masked but has already been - examinated by [caml_process_pending_signals], then - [caml_signals_are_pending] is 0 but the signal needs to be + examined by [caml_process_pending_signals_exn], then + [signals_are_pending] is 0 but the signal needs to be handled at this point. */ - caml_signals_are_pending = 1; - caml_process_pending_signals(); + signals_are_pending = 1; + caml_raise_if_exception(caml_process_pending_signals_exn()); errno = saved_errno; } @@ -188,7 +207,7 @@ CAMLexport void caml_leave_blocking_section(void) static value caml_signal_handlers = 0; -void caml_execute_signal(int signal_number, int in_signal_handler) +value caml_execute_signal_exn(int signal_number, int in_signal_handler) { value res; value handler; @@ -214,7 +233,7 @@ void caml_execute_signal(int signal_number, int in_signal_handler) #if defined(NATIVE_CODE) && defined(WITH_SPACETIME) /* Handled action may have no associated handler, which we interpret as meaning the signal should be handled by a call to exit. This is - is used to allow spacetime profiles to be completed on interrupt */ + used to allow spacetime profiles to be completed on interrupt */ if (caml_signal_handlers == 0) { res = caml_sys_exit(Val_int(2)); } else { @@ -243,37 +262,96 @@ void caml_execute_signal(int signal_number, int in_signal_handler) caml_sigmask_hook(SIG_SETMASK, &sigs, NULL); } #endif - if (Is_exception_result(res)) caml_raise(Extract_exception(res)); + return res; } -/* Arrange for a garbage collection to be performed as soon as possible */ +void caml_update_young_limit (void) +{ + /* The minor heap grows downwards. The first trigger is the largest one. */ + Caml_state->young_limit = + caml_memprof_young_trigger < Caml_state->young_trigger ? + Caml_state->young_trigger : caml_memprof_young_trigger; + + if(caml_something_to_do) + Caml_state->young_limit = Caml_state->young_alloc_end; +} -int volatile caml_requested_major_slice = 0; -int volatile caml_requested_minor_gc = 0; +/* Arrange for a garbage collection to be performed as soon as possible */ void caml_request_major_slice (void) { - caml_requested_major_slice = 1; -#ifndef NATIVE_CODE - caml_something_to_do = 1; -#else - caml_young_limit = caml_young_alloc_end; - /* This is only moderately effective on ports that cache [caml_young_limit] - in a register, since [caml_modify] is called directly, not through - [caml_c_call], so it may take a while before the register is reloaded - from [caml_young_limit]. */ -#endif + Caml_state->requested_major_slice = 1; + caml_set_action_pending(); } void caml_request_minor_gc (void) { - caml_requested_minor_gc = 1; -#ifndef NATIVE_CODE - caml_something_to_do = 1; -#else - caml_young_limit = caml_young_alloc_end; - /* Same remark as above in [caml_request_major_slice]. */ -#endif + Caml_state->requested_minor_gc = 1; + caml_set_action_pending(); +} + +value caml_do_pending_actions_exn(void) +{ + value exn; + + caml_something_to_do = 0; + + // Do any pending minor collection or major slice + caml_check_urgent_gc(Val_unit); + + caml_update_young_limit(); + + // Call signal handlers first + exn = caml_process_pending_signals_exn(); + if (Is_exception_result(exn)) goto exception; + + // Call memprof callbacks + exn = caml_memprof_handle_postponed_exn(); + if (Is_exception_result(exn)) goto exception; + + // Call finalisers + exn = caml_final_do_calls_exn(); + if (Is_exception_result(exn)) goto exception; + + return Val_unit; + +exception: + /* If an exception is raised during an asynchronous callback, then + it might be the case that we did not run all the callbacks we + needed. Therefore, we set [caml_something_to_do] again in order + to force reexamination of callbacks. */ + caml_set_action_pending(); + return exn; +} + +CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */ +static inline value process_pending_actions_with_root_exn(value extra_root) +{ + if (caml_something_to_do) { + CAMLparam1(extra_root); + value exn = caml_do_pending_actions_exn(); + if (Is_exception_result(exn)) + CAMLreturn(exn); + CAMLdrop; + } + return extra_root; +} + +value caml_process_pending_actions_with_root(value extra_root) +{ + value res = process_pending_actions_with_root_exn(extra_root); + return caml_raise_if_exception(res); +} + +CAMLexport value caml_process_pending_actions_exn(void) +{ + return process_pending_actions_with_root_exn(Val_unit); +} + +CAMLexport void caml_process_pending_actions(void) +{ + value exn = process_pending_actions_with_root_exn(Val_unit); + caml_raise_if_exception(exn); } /* OS-independent numbering of signals */ @@ -445,6 +523,6 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action) } caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0)); } - caml_process_pending_signals(); + caml_raise_if_exception(caml_process_pending_signals_exn()); CAMLreturn (res); } diff --git a/runtime/signals_byt.c b/runtime/signals_byt.c index bdbcf726..040de03c 100644 --- a/runtime/signals_byt.c +++ b/runtime/signals_byt.c @@ -21,6 +21,8 @@ #include #include "caml/config.h" #include "caml/memory.h" +#include "caml/fail.h" +#include "caml/finalise.h" #include "caml/osdeps.h" #include "caml/signals.h" #include "caml/signals_machdep.h" @@ -35,22 +37,6 @@ extern sighandler caml_win32_signal(int sig, sighandler action); #define signal(sig,act) caml_win32_signal(sig,act) #endif -CAMLexport int volatile caml_something_to_do = 0; -CAMLexport void (* volatile caml_async_action_hook)(void) = NULL; - -void caml_process_event(void) -{ - void (*async_action)(void); - - caml_check_urgent_gc (Val_unit); - caml_process_pending_signals(); - async_action = caml_async_action_hook; - if (async_action != NULL) { - caml_async_action_hook = NULL; - (*async_action)(); - } -} - static void handle_signal(int signal_number) { int saved_errno; @@ -61,7 +47,7 @@ static void handle_signal(int signal_number) #endif if (signal_number < 0 || signal_number >= NSIG) return; if (caml_try_leave_blocking_section_hook()) { - caml_execute_signal(signal_number, 1); + caml_raise_if_exception(caml_execute_signal_exn(signal_number, 1)); caml_enter_blocking_section_hook(); }else{ caml_record_signal(signal_number); @@ -99,3 +85,5 @@ int caml_set_signal_action(int signo, int action) else return 0; } + +void caml_setup_stack_overflow_detection(void) {} diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c index 29a5f49e..01729839 100644 --- a/runtime/signals_nat.c +++ b/runtime/signals_nat.c @@ -31,11 +31,8 @@ #include "signals_osdep.h" #include "caml/stack.h" #include "caml/spacetime.h" - -#ifdef HAS_STACK_OVERFLOW_DETECTION -#include -#include -#endif +#include "caml/memprof.h" +#include "caml/finalise.h" #ifndef NSIG #define NSIG 64 @@ -72,19 +69,29 @@ extern char caml_system__code_begin, caml_system__code_end; void caml_garbage_collection(void) { - caml_young_limit = caml_young_trigger; - if (caml_requested_major_slice || caml_requested_minor_gc || - caml_young_ptr - caml_young_trigger < Max_young_whsize){ + /* TEMPORARY: if we have just sampled an allocation in native mode, + we simply renew the sample to ignore it. Otherwise, renewing now + will not have any effect on the sampling distribution, because of + the memorylessness of the Bernoulli process. + + FIXME: if the sampling rate is 1, this leads to infinite loop, + because we are using a binomial distribution in [memprof.c]. This + will go away when the sampling of natively allocated blocks will + be correctly implemented. + */ + caml_memprof_renew_minor_sample(); + if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc || + Caml_state->young_ptr - Caml_state->young_trigger < Max_young_whsize){ caml_gc_dispatch (); } #ifdef WITH_SPACETIME - if (caml_young_ptr == caml_young_alloc_end) { + if (Caml_state->young_ptr == Caml_state->young_alloc_end) { caml_spacetime_automatic_snapshot(); } #endif - caml_process_pending_signals(); + caml_raise_if_exception(caml_do_pending_actions_exn()); } DECLARE_SIGNAL_HANDLER(handle_signal) @@ -97,16 +104,16 @@ DECLARE_SIGNAL_HANDLER(handle_signal) #endif if (sig < 0 || sig >= NSIG) return; if (caml_try_leave_blocking_section_hook ()) { - caml_execute_signal(sig, 1); + caml_raise_if_exception(caml_execute_signal_exn(sig, 1)); caml_enter_blocking_section_hook(); } else { caml_record_signal(sig); - /* Some ports cache [caml_young_limit] in a register. + /* Some ports cache [Caml_state->young_limit] in a register. Use the signal context to modify that register too, but only if we are inside OCaml code (not inside C code). */ #if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT) if (Is_in_code_area(CONTEXT_PC)) - CONTEXT_YOUNG_LIMIT = (context_reg) caml_young_limit; + CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit; #endif } errno = saved_errno; @@ -169,10 +176,10 @@ DECLARE_SIGNAL_HANDLER(trap_handler) caml_sigmask_hook(SIG_UNBLOCK, &mask, NULL); } #endif - caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER; - caml_young_ptr = (value *) CONTEXT_YOUNG_PTR; - caml_bottom_of_stack = (char *) CONTEXT_SP; - caml_last_return_address = (uintnat) CONTEXT_PC; + Caml_state->exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER; + Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR; + Caml_state->bottom_of_stack = (char *) CONTEXT_SP; + Caml_state->last_return_address = (uintnat) CONTEXT_PC; caml_array_bound_error(); } #endif @@ -180,38 +187,37 @@ DECLARE_SIGNAL_HANDLER(trap_handler) /* Machine- and OS-dependent handling of stack overflow */ #ifdef HAS_STACK_OVERFLOW_DETECTION +#ifndef CONTEXT_SP +#error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined" +#endif -static char * system_stack_top; static char sig_alt_stack[SIGSTKSZ]; -#if defined(SYS_linux) -/* PR#4746: recent Linux kernels with support for stack randomization - silently add 2 Mb of stack space on top of RLIMIT_STACK. - 2 Mb = 0x200000, to which we add 8 kB (=0x2000) for overshoot. */ -#define EXTRA_STACK 0x202000 -#else -#define EXTRA_STACK 0x2000 -#endif +/* Code compiled with ocamlopt never accesses more than + EXTRA_STACK bytes below the stack pointer. */ +#define EXTRA_STACK 256 #ifdef RETURN_AFTER_STACK_OVERFLOW -extern void caml_stack_overflow(void); +extern void caml_stack_overflow(caml_domain_state*); #endif +/* Address sanitizer is confused when running the stack overflow + handler in an alternate stack. We deactivate it for all the + functions used by the stack overflow handler. */ +CAMLno_asan DECLARE_SIGNAL_HANDLER(segv_handler) { - struct rlimit limit; struct sigaction act; char * fault_addr; /* Sanity checks: - faulting address is word-aligned - - faulting address is within the stack + - faulting address is on the stack, or within EXTRA_STACK of it - we are in OCaml code */ fault_addr = CONTEXT_FAULTING_ADDRESS; if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0 - && getrlimit(RLIMIT_STACK, &limit) == 0 - && fault_addr < system_stack_top - && fault_addr >= system_stack_top - limit.rlim_cur - EXTRA_STACK + && fault_addr < Caml_state->top_of_stack + && (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK #ifdef CONTEXT_PC && Is_in_code_area(CONTEXT_PC) #endif @@ -221,6 +227,7 @@ DECLARE_SIGNAL_HANDLER(segv_handler) handler, we jump to the asm function [caml_stack_overflow] (from $ARCH.S). */ #ifdef CONTEXT_PC + CONTEXT_C_ARG_1 = (context_reg) Caml_state; CONTEXT_PC = (context_reg) &caml_stack_overflow; #else #error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is" @@ -228,8 +235,8 @@ DECLARE_SIGNAL_HANDLER(segv_handler) #else /* Raise a Stack_overflow exception straight from this signal handler */ #if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER) - caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER; - caml_young_ptr = (value *) CONTEXT_YOUNG_PTR; + Caml_state->exception_pointer == (char *) CONTEXT_EXCEPTION_POINTER; + Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR; #endif caml_raise_stack_overflow(); #endif @@ -270,7 +277,6 @@ void caml_init_signals(void) } #endif - /* Stack overflow handling */ #ifdef HAS_STACK_OVERFLOW_DETECTION { stack_t stk; @@ -281,8 +287,19 @@ void caml_init_signals(void) SET_SIGACT(act, segv_handler); act.sa_flags |= SA_ONSTACK | SA_NODEFER; sigemptyset(&act.sa_mask); - system_stack_top = (char *) &act; if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); } } #endif } + +void caml_setup_stack_overflow_detection(void) +{ +#ifdef HAS_STACK_OVERFLOW_DETECTION + stack_t stk; + stk.ss_sp = malloc(SIGSTKSZ); + stk.ss_size = SIGSTKSZ; + stk.ss_flags = 0; + if (stk.ss_sp) + sigaltstack(&stk, NULL); +#endif +} diff --git a/runtime/signals_osdep.h b/runtime/signals_osdep.h index 417768f0..d507d5a6 100644 --- a/runtime/signals_osdep.h +++ b/runtime/signals_osdep.h @@ -27,8 +27,9 @@ sigact.sa_flags = SA_SIGINFO typedef greg_t context_reg; + #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI]) #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP]) - #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14]) + #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP]) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15]) #define CONTEXT_FAULTING_ADDRESS ((char *)context->uc_mcontext.gregs[REG_CR2]) @@ -55,8 +56,8 @@ typedef unsigned long long context_reg; #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss)) + #define CONTEXT_C_ARG_1 (CONTEXT_STATE.CONTEXT_REG(rdi)) #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(rip)) - #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r14)) #define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r15)) #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(rsp)) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -79,6 +80,7 @@ typedef unsigned long context_reg; #define CONTEXT_PC (context->uc_mcontext.arm_pc) + #define CONTEXT_SP (context->uc_mcontext.arm_sp) #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.arm_fp) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r8) #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address) @@ -98,6 +100,7 @@ typedef unsigned long context_reg; #define CONTEXT_PC (context->uc_mcontext.pc) + #define CONTEXT_SP (context->uc_mcontext.sp) #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26]) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27]) #define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address) @@ -117,6 +120,7 @@ typedef unsigned long context_reg; #define CONTEXT_PC (context->uc_mcontext.mc_gpregs.gp_elr) + #define CONTEXT_SP (context->uc_mcontext.mc_gpregs.gp_sp) #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.mc_gpregs.gp_x[26]) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.mc_gpregs.gp_x[27]) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -137,7 +141,8 @@ typedef greg_t context_reg; #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP]) - #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14]) + #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI]) + #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP]) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15]) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -153,7 +158,8 @@ sigact.sa_flags = SA_SIGINFO #define CONTEXT_PC (context->sc_rip) - #define CONTEXT_EXCEPTION_POINTER (context->sc_r14) + #define CONTEXT_C_ARG_1 (context->sc_rdi) + #define CONTEXT_SP (context->sc_rsp) #define CONTEXT_YOUNG_PTR (context->sc_r15) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -170,7 +176,8 @@ sigact.sa_flags = SA_SIGINFO #define CONTEXT_PC (_UC_MACHINE_PC(context)) - #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[REG_R14]) + #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI]) + #define CONTEXT_SP (_UC_MACHINE_SP(context)) #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15]) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -186,6 +193,8 @@ sigact.sa_flags = 0 #define CONTEXT_FAULTING_ADDRESS ((char *) context.cr2) + #define CONTEXT_PC (context.eip) + #define CONTEXT_SP (context.esp) /****************** I386, BSD_ELF */ @@ -206,8 +215,10 @@ #if defined (__NetBSD__) #define CONTEXT_PC (_UC_MACHINE_PC(context)) + #define CONTEXT_SP (_UC_MACHINE_SP(context)) #else #define CONTEXT_PC (context->sc_eip) + #define CONTEXT_SP (context->sc_esp) #endif #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) @@ -247,6 +258,7 @@ #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss)) #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(eip)) + #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(esp)) #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) /****************** I386, Solaris x86 */ diff --git a/runtime/spacetime_nat.c b/runtime/spacetime_nat.c index cb3d9b79..1dce654b 100644 --- a/runtime/spacetime_nat.c +++ b/runtime/spacetime_nat.c @@ -686,8 +686,9 @@ CAMLprim value* caml_spacetime_indirect_node_hole_ptr caml_call_gc only invokes OCaml functions in the following circumstances: 1. running an OCaml finaliser; - 2. executing an OCaml signal handler. - Both of these are done on the finaliser trie. Furthermore, both of + 2. executing an OCaml signal handler; + 3. executing memprof callbacks. + All of these are done on the finaliser trie. Furthermore, all of these invocations start via caml_callback; the code in this file for handling that (caml_spacetime_c_to_ocaml) correctly copes with that by attaching a single "caml_start_program" node that can cope with any @@ -708,10 +709,10 @@ static NOINLINE void* find_trie_node_from_libunwind(int for_allocation, uintnat wosize, struct ext_table** cached_frames) { #ifdef HAS_LIBUNWIND - /* Given that [caml_last_return_address] is the most recent call site in - OCaml code, and that we are now in C (or other) code called from that + /* Given that [Caml_state->last_return_address] is the most recent call site + in OCaml code, and that we are now in C (or other) code called from that site, obtain a backtrace using libunwind and graft the most recent - portion (everything back to but not including [caml_last_return_address]) + portion (everything back to but not including [last_return_address]) onto the trie. See the important comment below regarding the fact that call site, and not callee, addresses are recorded during this process. @@ -774,7 +775,7 @@ static NOINLINE void* find_trie_node_from_libunwind(int for_allocation, } if (!have_frames_already) { - /* Get the stack backtrace as far as [caml_last_return_address]. */ + /* Get the stack backtrace as far as [Caml_state->last_return_address]. */ ret = unw_getcontext(&ctx); if (ret != UNW_ESUCCESS) { @@ -789,7 +790,7 @@ static NOINLINE void* find_trie_node_from_libunwind(int for_allocation, while ((ret = unw_step(&cur)) > 0) { unw_word_t ip; unw_get_reg(&cur, UNW_REG_IP, &ip); - if (caml_last_return_address == (uintnat) ip) { + if (Caml_state->last_return_address == (uintnat) ip) { break; } else { @@ -824,7 +825,7 @@ static NOINLINE void* find_trie_node_from_libunwind(int for_allocation, for (frame = frames->size - 1; frame >= innermost_frame; frame--) { c_node_type expected_type; void* pc = frames->contents[frame]; - CAMLassert (pc != (void*) caml_last_return_address); + CAMLassert (pc != (void*) Caml_state->last_return_address); if (!for_allocation) { expected_type = CALL; @@ -946,7 +947,7 @@ void caml_spacetime_c_to_ocaml(void* ocaml_entry_point, value node; /* Update the trie with the current backtrace, as far back as - [caml_last_return_address], and leave the node hole pointer at + [Caml_state->last_return_address], and leave the node hole pointer at the correct place for attachment of a [caml_start_program] node. */ #ifdef HAS_LIBUNWIND diff --git a/runtime/spacetime_snapshot.c b/runtime/spacetime_snapshot.c index a89b730a..4ce31ceb 100644 --- a/runtime/spacetime_snapshot.c +++ b/runtime/spacetime_snapshot.c @@ -108,17 +108,18 @@ static value take_gc_stats(void) v_stats = allocate_outside_heap(sizeof(gc_stats)); stats = (gc_stats*) v_stats; - stats->minor_words = Val_long(caml_stat_minor_words); - stats->promoted_words = Val_long(caml_stat_promoted_words); + stats->minor_words = Val_long(Caml_state->stat_minor_words); + stats->promoted_words = Val_long(Caml_state->stat_promoted_words); stats->major_words = - Val_long(((uintnat) caml_stat_major_words) + Val_long(((uintnat) Caml_state->stat_major_words) + ((uintnat) caml_allocated_words)); - stats->minor_collections = Val_long(caml_stat_minor_collections); - stats->major_collections = Val_long(caml_stat_major_collections); - stats->heap_words = Val_long(caml_stat_heap_wsz / sizeof(value)); - stats->heap_chunks = Val_long(caml_stat_heap_chunks); - stats->compactions = Val_long(caml_stat_compactions); - stats->top_heap_words = Val_long(caml_stat_top_heap_wsz / sizeof(value)); + stats->minor_collections = Val_long(Caml_state->stat_minor_collections); + stats->major_collections = Val_long(Caml_state->stat_major_collections); + stats->heap_words = Val_long(Caml_state->stat_heap_wsz / sizeof(value)); + stats->heap_chunks = Val_long(Caml_state->stat_heap_chunks); + stats->compactions = Val_long(Caml_state->stat_compactions); + stats->top_heap_words = + Val_long(Caml_state->stat_top_heap_wsz / sizeof(value)); return v_stats; } diff --git a/runtime/stacks.c b/runtime/stacks.c index d6e7f53c..2e3be6a0 100644 --- a/runtime/stacks.c +++ b/runtime/stacks.c @@ -24,24 +24,19 @@ #include "caml/mlvalues.h" #include "caml/stacks.h" -CAMLexport value * caml_stack_low; -CAMLexport value * caml_stack_high; -CAMLexport value * caml_stack_threshold; -CAMLexport value * caml_extern_sp; -CAMLexport value * caml_trapsp; -CAMLexport value * caml_trap_barrier; value caml_global_data = 0; uintnat caml_max_stack_size; /* also used in gc_ctrl.c */ void caml_init_stack (uintnat initial_max_size) { - caml_stack_low = (value *) caml_stat_alloc(Stack_size); - caml_stack_high = caml_stack_low + Stack_size / sizeof (value); - caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value); - caml_extern_sp = caml_stack_high; - caml_trapsp = caml_stack_high; - caml_trap_barrier = caml_stack_high + 1; + Caml_state->stack_low = (value *) caml_stat_alloc(Stack_size); + Caml_state->stack_high = Caml_state->stack_low + Stack_size / sizeof (value); + Caml_state->stack_threshold = + Caml_state->stack_low + Stack_threshold / sizeof (value); + Caml_state->extern_sp = Caml_state->stack_high; + Caml_state->trapsp = Caml_state->stack_high; + Caml_state->trap_barrier = Caml_state->stack_high + 1; caml_max_stack_size = initial_max_size; caml_gc_message (0x08, "Initial stack limit: %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", @@ -54,12 +49,13 @@ void caml_realloc_stack(asize_t required_space) value * new_low, * new_high, * new_sp; value * p; - CAMLassert(caml_extern_sp >= caml_stack_low); - size = caml_stack_high - caml_stack_low; + CAMLassert(Caml_state->extern_sp >= Caml_state->stack_low); + size = Caml_state->stack_high - Caml_state->stack_low; do { if (size >= caml_max_stack_size) caml_raise_stack_overflow(); size *= 2; - } while (size < caml_stack_high - caml_extern_sp + required_space); + } while (size < Caml_state->stack_high - Caml_state->extern_sp + + required_space); caml_gc_message (0x08, "Growing stack to %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", (uintnat) size * sizeof(value) / 1024); @@ -67,21 +63,22 @@ void caml_realloc_stack(asize_t required_space) new_high = new_low + size; #define shift(ptr) \ - ((char *) new_high - ((char *) caml_stack_high - (char *) (ptr))) + ((char *) new_high - ((char *) Caml_state->stack_high - (char *) (ptr))) - new_sp = (value *) shift(caml_extern_sp); + new_sp = (value *) shift(Caml_state->extern_sp); memmove((char *) new_sp, - (char *) caml_extern_sp, - (caml_stack_high - caml_extern_sp) * sizeof(value)); - caml_stat_free(caml_stack_low); - caml_trapsp = (value *) shift(caml_trapsp); - caml_trap_barrier = (value *) shift(caml_trap_barrier); - for (p = caml_trapsp; p < new_high; p = Trap_link(p)) + (char *) Caml_state->extern_sp, + (Caml_state->stack_high - Caml_state->extern_sp) * sizeof(value)); + caml_stat_free(Caml_state->stack_low); + Caml_state->trapsp = (value *) shift(Caml_state->trapsp); + Caml_state->trap_barrier = (value *) shift(Caml_state->trap_barrier); + for (p = Caml_state->trapsp; p < new_high; p = Trap_link(p)) Trap_link(p) = (value *) shift(Trap_link(p)); - caml_stack_low = new_low; - caml_stack_high = new_high; - caml_stack_threshold = caml_stack_low + Stack_threshold / sizeof (value); - caml_extern_sp = new_sp; + Caml_state->stack_low = new_low; + Caml_state->stack_high = new_high; + Caml_state->stack_threshold = + Caml_state->stack_low + Stack_threshold / sizeof (value); + Caml_state->extern_sp = new_sp; #undef shift } @@ -89,13 +86,14 @@ void caml_realloc_stack(asize_t required_space) CAMLprim value caml_ensure_stack_capacity(value required_space) { asize_t req = Long_val(required_space); - if (caml_extern_sp - req < caml_stack_low) caml_realloc_stack(req); + if (Caml_state->extern_sp - req < Caml_state->stack_low) + caml_realloc_stack(req); return Val_unit; } void caml_change_max_stack_size (uintnat new_max_size) { - asize_t size = caml_stack_high - caml_extern_sp + asize_t size = Caml_state->stack_high - Caml_state->extern_sp + Stack_threshold / sizeof (value); if (new_max_size < size) new_max_size = size; @@ -112,7 +110,7 @@ CAMLexport uintnat (*caml_stack_usage_hook)(void) = NULL; uintnat caml_stack_usage(void) { uintnat sz; - sz = caml_stack_high - caml_extern_sp; + sz = Caml_state->stack_high - Caml_state->extern_sp; if (caml_stack_usage_hook != NULL) sz += (*caml_stack_usage_hook)(); return sz; diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index 97bf4037..d265ac69 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -30,6 +30,10 @@ #include "caml/startup_aux.h" +#ifdef _WIN32 +extern void caml_win32_unregister_overflow_detection (void); +#endif + CAMLexport header_t *caml_atom_table = NULL; /* Initialize the atom table */ @@ -109,9 +113,10 @@ void caml_parse_ocamlrunparam(void) if (opt != NULL){ while (*opt != '\0'){ switch (*opt++){ - case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break; + case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p); + break; case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); - break; + break; case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break; case 'h': scanmult (opt, &caml_init_heap_wsz); break; case 'H': scanmult (opt, &caml_use_huge_pages); break; @@ -189,6 +194,9 @@ CAMLexport void caml_shutdown(void) caml_free_shared_libs(); #endif caml_stat_destroy_pool(); +#if defined(_WIN32) && defined(NATIVE_CODE) + caml_win32_unregister_overflow_detection(); +#endif shutdown_happened = 1; } diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c index a996788b..4e9ba799 100644 --- a/runtime/startup_byt.c +++ b/runtime/startup_byt.c @@ -33,6 +33,7 @@ #include "caml/callback.h" #include "caml/custom.h" #include "caml/debugger.h" +#include "caml/domain.h" #include "caml/dynlink.h" #include "caml/exec.h" #include "caml/fail.h" @@ -298,7 +299,8 @@ static int parse_command_line(char_os **argv) exit(0); break; default: - caml_fatal_error("unknown option %s", caml_stat_strdup_of_os(argv[i])); + fprintf(stderr, "unknown option %s", caml_stat_strdup_of_os(argv[i])); + exit(127); } } return i; @@ -333,6 +335,9 @@ CAMLexport void caml_main(char_os **argv) caml_ensure_spacetime_dot_o_is_included++; + /* Initialize the domain */ + caml_init_domain(); + /* Determine options */ #ifdef DEBUG caml_verb_gc = 0x3F; @@ -353,7 +358,6 @@ CAMLexport void caml_main(char_os **argv) #endif caml_init_custom_operations(); caml_ext_table_init(&caml_shared_libs_path, 8); - caml_external_raise = NULL; /* Determine position of bytecode file */ pos = 0; @@ -375,27 +379,32 @@ CAMLexport void caml_main(char_os **argv) if (fd < 0) { pos = parse_command_line(argv); - if (argv[pos] == 0) - caml_fatal_error("no bytecode file specified"); + if (argv[pos] == 0) { + fprintf(stderr, "no bytecode file specified"); + exit(127); + } exe_name = argv[pos]; fd = caml_attempt_open(&exe_name, &trail, 1); switch(fd) { case FILE_NOT_FOUND: - caml_fatal_error("cannot find file '%s'", + fprintf(stderr, "cannot find file '%s'", caml_stat_strdup_of_os(argv[pos])); + exit(127); break; case BAD_BYTECODE: - caml_fatal_error( + fprintf(stderr, "the file '%s' is not a bytecode executable file", caml_stat_strdup_of_os(exe_name)); + exit(127); break; case WRONG_MAGIC: - caml_fatal_error( + fprintf(stderr, "the file '%s' has not the right magic number: "\ "expected %s, got %s", caml_stat_strdup_of_os(exe_name), EXEC_MAGIC, magicstr); + exit(127); break; } } @@ -444,16 +453,16 @@ CAMLexport void caml_main(char_os **argv) _beginthread(caml_signal_thread, 4096, NULL); #endif /* Execute the program */ - caml_debugger(PROGRAM_START); + caml_debugger(PROGRAM_START, Val_unit); res = caml_interprete(caml_start_code, caml_code_size); if (Is_exception_result(res)) { - caml_exn_bucket = Extract_exception(res); + Caml_state->exn_bucket = Extract_exception(res); if (caml_debugger_in_use) { - caml_extern_sp = &caml_exn_bucket; /* The debugger needs the + Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the exception value.*/ - caml_debugger(UNCAUGHT_EXC); + caml_debugger(UNCAUGHT_EXC, Val_unit); } - caml_fatal_uncaught_exception(caml_exn_bucket); + caml_fatal_uncaught_exception(Caml_state->exn_bucket); } } @@ -469,6 +478,8 @@ CAMLexport value caml_startup_code_exn( char_os * cds_file; char_os * exe_name; + /* Initialize the domain */ + caml_init_domain(); /* Determine options */ #ifdef DEBUG caml_verb_gc = 0x3F; @@ -494,7 +505,6 @@ CAMLexport value caml_startup_code_exn( } exe_name = caml_executable_name(); if (exe_name == NULL) exe_name = caml_search_exe_in_path(argv[0]); - caml_external_raise = NULL; /* Initialize the abstract machine */ caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz, caml_init_heap_chunk_sz, caml_init_percent_free, @@ -513,12 +523,6 @@ CAMLexport value caml_startup_code_exn( caml_code_size = code_size; caml_init_code_fragments(); caml_init_debug_info(); - if (caml_debugger_in_use) { - uintnat len, i; - len = code_size / sizeof(opcode_t); - caml_saved_code = (unsigned char *) caml_stat_alloc(len); - for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i]; - } #ifdef THREADED_CODE caml_thread_code(caml_start_code, code_size); #endif @@ -535,7 +539,7 @@ CAMLexport value caml_startup_code_exn( /* Initialize system libraries */ caml_sys_init(exe_name, argv); /* Execute the program */ - caml_debugger(PROGRAM_START); + caml_debugger(PROGRAM_START, Val_unit); return caml_interprete(caml_start_code, caml_code_size); } @@ -552,12 +556,12 @@ CAMLexport void caml_startup_code( section_table, section_table_size, pooling, argv); if (Is_exception_result(res)) { - caml_exn_bucket = Extract_exception(res); + Caml_state->exn_bucket = Extract_exception(res); if (caml_debugger_in_use) { - caml_extern_sp = &caml_exn_bucket; /* The debugger needs the + Caml_state->extern_sp = &Caml_state->exn_bucket; /* The debugger needs the exception value.*/ - caml_debugger(UNCAUGHT_EXC); + caml_debugger(UNCAUGHT_EXC, Val_unit); } - caml_fatal_uncaught_exception(caml_exn_bucket); + caml_fatal_uncaught_exception(Caml_state->exn_bucket); } } diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c index 7eca5fa5..91ff81b3 100644 --- a/runtime/startup_nat.c +++ b/runtime/startup_nat.c @@ -23,6 +23,7 @@ #include "caml/backtrace.h" #include "caml/custom.h" #include "caml/debugger.h" +#include "caml/domain.h" #include "caml/fail.h" #include "caml/freelist.h" #include "caml/gc.h" @@ -89,7 +90,7 @@ static void init_static(void) struct longjmp_buffer caml_termination_jmpbuf; void (*caml_termination_hook)(void *) = NULL; -extern value caml_start_program (void); +extern value caml_start_program (caml_domain_state*); extern void caml_init_ieee_floats (void); extern void caml_init_signals (void); #ifdef _WIN32 @@ -108,6 +109,8 @@ value caml_startup_common(char_os **argv, int pooling) char_os * exe_name, * proc_self_exe; char tos; + /* Initialize the domain */ + caml_init_domain(); /* Determine options */ #ifdef DEBUG caml_verb_gc = 0x3F; @@ -131,7 +134,7 @@ value caml_startup_common(char_os **argv, int pooling) caml_install_invalid_parameter_handler(); #endif caml_init_custom_operations(); - caml_top_of_stack = &tos; + Caml_state->top_of_stack = &tos; caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz, caml_init_heap_chunk_sz, caml_init_percent_free, caml_init_max_percent_free, caml_init_major_window, @@ -156,7 +159,7 @@ value caml_startup_common(char_os **argv, int pooling) if (caml_termination_hook != NULL) caml_termination_hook(NULL); return Val_unit; } - return caml_start_program(); + return caml_start_program(Caml_state); } value caml_startup_exn(char_os **argv) diff --git a/runtime/str.c b/runtime/str.c index 80efcc8a..32ca54c7 100644 --- a/runtime/str.c +++ b/runtime/str.c @@ -440,7 +440,7 @@ CAMLexport value caml_alloc_sprintf(const char * format, ...) "n" is the actual length of the output. Allocate a Caml string of length "n" and copy the characters into it. */ res = caml_alloc_string(n); - memcpy(String_val(res), buf, n); + memcpy((char *)String_val(res), buf, n); } else { /* PR#7568: if the format is in the Caml heap, the following caml_alloc_string could move or free the format. To prevent @@ -455,7 +455,7 @@ CAMLexport value caml_alloc_sprintf(const char * format, ...) Note that caml_alloc_string left room for a '\0' at position n, so the size passed to _vsnprintf is n+1. */ va_start(args, format); - _vsnprintf(String_val(res), n + 1, saved_format, args); + _vsnprintf((char *)String_val(res), n + 1, saved_format, args); va_end(args); caml_stat_free(saved_format); } diff --git a/runtime/sys.c b/runtime/sys.c index 226d596c..ab4704e5 100644 --- a/runtime/sys.c +++ b/runtime/sys.c @@ -118,17 +118,18 @@ CAMLprim value caml_sys_exit(value retcode_v) if ((caml_verb_gc & 0x400) != 0) { /* cf caml_gc_counters */ - double minwords = caml_stat_minor_words - + (double) (caml_young_end - caml_young_ptr); - double prowords = caml_stat_promoted_words; - double majwords = caml_stat_major_words + (double) caml_allocated_words; + double minwords = Caml_state->stat_minor_words + + (double) (Caml_state->young_end - Caml_state->young_ptr); + double prowords = Caml_state->stat_promoted_words; + double majwords = + Caml_state->stat_major_words + (double) caml_allocated_words; double allocated_words = minwords + majwords - prowords; - intnat mincoll = caml_stat_minor_collections; - intnat majcoll = caml_stat_major_collections; - intnat heap_words = caml_stat_heap_wsz; - intnat heap_chunks = caml_stat_heap_chunks; - intnat top_heap_words = caml_stat_top_heap_wsz; - intnat cpct = caml_stat_compactions; + intnat mincoll = Caml_state->stat_minor_collections; + intnat majcoll = Caml_state->stat_major_collections; + intnat heap_words = Caml_state->stat_heap_wsz; + intnat heap_chunks = Caml_state->stat_heap_chunks; + intnat top_heap_words = Caml_state->stat_top_heap_wsz; + intnat cpct = Caml_state->stat_compactions; caml_gc_message(0x400, "allocated_words: %.0f\n", allocated_words); caml_gc_message(0x400, "minor_words: %.0f\n", minwords); caml_gc_message(0x400, "promoted_words: %.0f\n", prowords); @@ -148,7 +149,7 @@ CAMLprim value caml_sys_exit(value retcode_v) } #ifndef NATIVE_CODE - caml_debugger(PROGRAM_EXIT); + caml_debugger(PROGRAM_EXIT, Val_unit); #endif caml_instr_atexit (); if (caml_cleanup_on_exit) diff --git a/runtime/weak.c b/runtime/weak.c index a2df1c86..9fda2166 100644 --- a/runtime/weak.c +++ b/runtime/weak.c @@ -110,7 +110,9 @@ CAMLexport value caml_ephemeron_create (mlsize_t len) CAMLprim value caml_ephe_create (value len) { - return caml_ephemeron_create(Long_val(len)); + value res = caml_ephemeron_create(Long_val(len)); + // run memprof callbacks + return caml_process_pending_actions_with_root(res); } CAMLprim value caml_weak_create (value len) @@ -189,7 +191,7 @@ 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_ephe_ref_table (&caml_ephe_ref_table, ar, offset); + add_to_ephe_ref_table (Caml_state->ephe_ref_table, ar, offset); } }else{ Field (ar, offset) = v; @@ -290,6 +292,9 @@ static value optionalize(int status, value *x) } else { res = None_val; } + // run memprof callbacks both for the option we are allocating here + // and the calling function. + caml_process_pending_actions(); CAMLreturn(res); } @@ -404,8 +409,7 @@ CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, if(8 == loop){ /** One minor gc must be enough */ elt = Val_unit; CAML_INSTR_INT ("force_minor/weak@", 1); - caml_request_minor_gc (); - caml_gc_dispatch (); + caml_minor_collection (); } else { /* cases where loop is between 0 to 7 and where loop is equal to 9 */ elt = caml_alloc (Wosize_val (v), Tag_val (v)); @@ -419,8 +423,8 @@ CAMLexport int caml_ephemeron_get_key_copy(value ar, mlsize_t offset, CAMLprim value caml_ephe_get_key_copy (value ar, value n) { value key; - return optionalize(caml_ephemeron_get_key_copy(ar, Long_val(n), &key), - &key); + int status = caml_ephemeron_get_key_copy(ar, Long_val(n), &key); + return optionalize(status, &key); } CAMLprim value caml_weak_get_copy (value ar, value n) @@ -460,8 +464,7 @@ CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data) if(8 == loop){ /** One minor gc must be enough */ elt = Val_unit; CAML_INSTR_INT ("force_minor/weak@", 1); - caml_request_minor_gc (); - caml_gc_dispatch (); + caml_minor_collection (); } else { /* cases where loop is between 0 to 7 and where loop is equal to 9 */ elt = caml_alloc (Wosize_val (v), Tag_val (v)); @@ -475,7 +478,8 @@ CAMLexport int caml_ephemeron_get_data_copy (value ar, value *data) CAMLprim value caml_ephe_get_data_copy (value ar) { value data; - return optionalize(caml_ephemeron_get_data_copy(ar, &data), &data); + int status = caml_ephemeron_get_data_copy(ar, &data); + return optionalize(status, &data); } CAMLexport int caml_ephemeron_key_is_set(value ar, mlsize_t offset) diff --git a/runtime/win32.c b/runtime/win32.c index de4757d0..059e8eb0 100644 --- a/runtime/win32.c +++ b/runtime/win32.c @@ -334,8 +334,7 @@ static void expand_pattern(wchar_t * arg); static void out_of_memory(void) { - fprintf(stderr, "Out of memory while expanding command line\n"); - exit(2); + caml_fatal_error("out of memory while expanding command line"); } static void store_argument(wchar_t * arg) @@ -561,8 +560,6 @@ static LONG CALLBACK } #else -extern char *caml_exception_pointer; -extern value *caml_young_ptr; /* Do not use the macro from address_class.h here. */ #undef Is_in_code_area @@ -590,8 +587,7 @@ static LONG CALLBACK faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1]; /* refresh runtime parameters from registers */ - caml_exception_pointer = (char *) ctx->R14; - caml_young_ptr = (value *) ctx->R15; + Caml_state->young_ptr = (value *) ctx->R15; /* call caml_reset_stack(faulting_address) using the alternate stack */ alt_rsp = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat); @@ -606,9 +602,20 @@ static LONG CALLBACK } #endif /* _WIN64 */ +static PVOID caml_stack_overflow_handle; + void caml_win32_overflow_detection(void) { - AddVectoredExceptionHandler(1, caml_stack_overflow_VEH); + caml_stack_overflow_handle = + AddVectoredExceptionHandler(1, caml_stack_overflow_VEH); + if (caml_stack_overflow_handle == NULL) { + caml_fatal_error("cannot install stack overflow detection"); + } +} + +void caml_win32_unregister_overflow_detection(void) +{ + RemoveVectoredExceptionHandler(caml_stack_overflow_handle); } #endif /* NATIVE_CODE */ @@ -876,7 +883,7 @@ CAMLexport value caml_copy_string_of_utf16(const wchar_t *s) /* Do not include final NULL */ retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0); v = caml_alloc_string(retcode); - win_wide_char_to_multi_byte(s, slen, String_val(v), retcode); + win_wide_char_to_multi_byte(s, slen, (char *)String_val(v), retcode); return v; } diff --git a/stdlib/.depend b/stdlib/.depend index 7c6f3494..458c478a 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -211,6 +211,7 @@ stdlib__filename.cmo : \ stdlib__string.cmi \ stdlib__random.cmi \ stdlib__printf.cmi \ + stdlib__list.cmi \ stdlib__lazy.cmi \ stdlib__buffer.cmi \ stdlib__filename.cmi @@ -219,6 +220,7 @@ stdlib__filename.cmx : \ stdlib__string.cmx \ stdlib__random.cmx \ stdlib__printf.cmx \ + stdlib__list.cmx \ stdlib__lazy.cmx \ stdlib__buffer.cmx \ stdlib__filename.cmi diff --git a/stdlib/HACKING.adoc b/stdlib/HACKING.adoc index 407d079e..af8358b2 100644 --- a/stdlib/HACKING.adoc +++ b/stdlib/HACKING.adoc @@ -5,32 +5,25 @@ link:../CONTRIBUTING.md#contributing-to-the-standard-library[]. Note: All paths are given relative to the root of the repository. -First, build the compiler. Run `./configure`, then `make world.opt`. See +First, build the compiler. Run `./configure`, then `make`. See link:../HACKING.adoc[]. To add a new module, you must: * Create new `.mli` and `.ml` files for the modules, obviously. -* Define the module in `stdlib/stdlib.mli`, `stdlib/stdlib.ml`, and - `otherlibs/threads/stdlib.ml` in the section of the code commented, - "MODULE ALIASES". Please maintain the same style as the rest of the code, in - particular the alphabetical ordering and whitespace alignment of module - aliases. Note that `otherlibs/threads/stdlib.mli` is a symbolic link to - `stdlib/stdlib.mli`. - -* Add `$(P)module_name.cmo` to the definition of `OTHERS` in `stdlib/Makefile`. - -* Add `$(LIB)/$(P)module_name.cmo` to the definition of `LIB_OBJS` in - `otherlibs/threads/Makefile`. +* Define the module in `stdlib/stdlib.mli` and `stdlib/stdlib.ml` in + the section of the code commented "MODULE ALIASES". Please maintain + the same style as the rest of the code, in particular the + alphabetical ordering and whitespace alignment of module aliases. * Add `$(P)module_name` to the definition of `STDLIB_MODULES` in - `stdlib/StdlibModules`. Please maintain the alphabetical order. + `stdlib/StdlibModules`. You must keep the list sorted in dependency order. * Run `make alldepend` to update all the `.depend` files. These files are not edited by hand. -* Run `make clean` or `make partialclean`, then `make world.opt`. +* Run `make clean` or `make partialclean`, then `make`. If you are adding multiple modules, follow the steps above and rebuild the compiler after adding each module. If you add multiple modules before diff --git a/stdlib/Makefile b/stdlib/Makefile index 97135b5a..6d609bc9 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -30,6 +30,9 @@ OPTCOMPFLAGS=-O3 else OPTCOMPFLAGS= endif +ifeq "$(FUNCTION_SECTIONS)" "true" +OPTCOMPFLAGS += -function-sections +endif OPTCOMPILER=$(ROOTDIR)/ocamlopt CAMLOPT=$(CAMLRUN) $(OPTCOMPILER) CAMLDEP=$(BOOT_OCAMLC) -depend @@ -40,25 +43,10 @@ OC_CPPFLAGS += -I$(ROOTDIR)/runtime # Object file prefix P=stdlib__ -OBJS=camlinternalFormatBasics.cmo stdlib.cmo $(OTHERS) -OTHERS= $(P)pervasives.cmo $(P)seq.cmo $(P)option.cmo $(P)result.cmo \ - $(P)bool.cmo $(P)char.cmo $(P)uchar.cmo $(P)sys.cmo $(P)list.cmo \ - $(P)bytes.cmo $(P)string.cmo $(P)unit.cmo \ - $(P)marshal.cmo $(P)obj.cmo $(P)array.cmo $(P)float.cmo \ - $(P)int.cmo $(P)int32.cmo $(P)int64.cmo $(P)nativeint.cmo \ - $(P)lexing.cmo $(P)parsing.cmo \ - $(P)set.cmo $(P)map.cmo $(P)stack.cmo $(P)queue.cmo \ - camlinternalLazy.cmo $(P)lazy.cmo $(P)stream.cmo \ - $(P)buffer.cmo camlinternalFormat.cmo $(P)printf.cmo \ - $(P)arg.cmo $(P)printexc.cmo $(P)fun.cmo $(P)gc.cmo \ - $(P)digest.cmo $(P)random.cmo $(P)hashtbl.cmo $(P)weak.cmo \ - $(P)format.cmo $(P)scanf.cmo $(P)callback.cmo \ - camlinternalOO.cmo $(P)oo.cmo camlinternalMod.cmo \ - $(P)genlex.cmo $(P)ephemeron.cmo \ - $(P)filename.cmo $(P)complex.cmo \ - $(P)arrayLabels.cmo $(P)listLabels.cmo $(P)bytesLabels.cmo \ - $(P)stringLabels.cmo $(P)moreLabels.cmo $(P)stdLabels.cmo \ - $(P)spacetime.cmo $(P)bigarray.cmo +include StdlibModules + +OBJS=$(addsuffix .cmo,$(STDLIB_MODULES)) +OTHERS=$(filter-out camlinternalFormatBasics.cmo stdlib.cmo,$(OBJS)) PREFIXED_OBJS=$(filter stdlib__%.cmo,$(OBJS)) UNPREFIXED_OBJS=$(PREFIXED_OBJS:stdlib__%.cmo=%) @@ -131,6 +119,9 @@ endif TARGETHEADERPROGRAM = target_$(HEADERPROGRAM) +# The shebang test in configure.ac will need updating if any runtime is +# introduced with a suffix more than one character long (camlheader_ur doesn't +# matter). CAMLHEADERS =\ camlheader target_camlheader camlheader_ur \ camlheaderd target_camlheaderd \ @@ -138,10 +129,17 @@ CAMLHEADERS =\ # The % in pattern rules must always match something, hence the slightly strange # patterns and $(subst ...) since `camlheader%:` wouldn't match `camlheader` -ifeq "$(HASHBANGSCRIPTS)" "true" +ifeq "$(SHEBANGSCRIPTS)" "true" camlhead%: $(ROOTDIR)/Makefile.config Makefile +ifeq "$(LONG_SHEBANG)" "true" + echo '#!/bin/sh' > $@ + echo 'exec "$(BINDIR)/ocamlrun$(subst er,,$*)" "$$0" "$$@"' >> $@ +else echo '#!$(BINDIR)/ocamlrun$(subst er,,$*)' > $@ +endif +# TODO This does not take long shebangs into account (since TARGET_BINDIR is not +# yet processed by configure) target_%: $(ROOTDIR)/Makefile.config Makefile echo '#!$(TARGET_BINDIR)/ocamlrun$(subst camlheader,,$*)' > $@ @@ -166,10 +164,11 @@ ifneq "$(UNIX_OR_WIN32)" "win32" strip $@ endif +$(HEADERPROGRAM)%$(O): \ + OC_CPPFLAGS += -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"' + $(HEADERPROGRAM)%$(O): $(HEADERPROGRAM).c - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) \ - -DRUNTIME_NAME='"$(HEADER_PATH)ocamlrun$(subst .,,$*)"' \ - $(OUTPUTOBJ)$@ $^ + $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $^ camlheader_ur: camlheader cp camlheader $@ @@ -192,7 +191,7 @@ target_%: % cp $< $@ endif -endif # ifeq "$(HASHBANGSCRIPTS)" "true" +endif # ifeq "$(SHEBANGSCRIPTS)" "true" stdlib.cma: $(OBJS) $(CAMLC) -a -o $@ $^ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index a8ee625a..928d509c 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -20,64 +20,66 @@ P ?= stdlib__ +# Modules should be listed in dependency order. + STDLIB_MODULES=\ - $(P)spacetime \ - $(P)arg \ - $(P)array \ - $(P)arrayLabels \ - $(P)bigarray \ - $(P)bool \ - $(P)buffer \ - $(P)bytes \ - $(P)bytesLabels \ - $(P)callback \ - camlinternalFormat \ camlinternalFormatBasics \ - camlinternalLazy \ - camlinternalMod \ - camlinternalOO \ + stdlib \ + $(P)pervasives \ + $(P)seq \ + $(P)option \ + $(P)result \ + $(P)bool \ $(P)char \ - $(P)complex \ - $(P)digest \ - $(P)ephemeron \ - $(P)filename \ + $(P)uchar \ + $(P)sys \ + $(P)list \ + $(P)bytes \ + $(P)string \ + $(P)unit \ + $(P)marshal \ + $(P)obj \ + $(P)array \ $(P)float \ - $(P)format \ - $(P)fun \ - $(P)gc \ - $(P)genlex \ - $(P)hashtbl \ $(P)int \ $(P)int32 \ $(P)int64 \ - $(P)lazy \ - $(P)lexing \ - $(P)list \ - $(P)listLabels \ - $(P)map \ - $(P)marshal \ - $(P)moreLabels \ $(P)nativeint \ - $(P)obj \ - $(P)oo \ - $(P)option \ + $(P)lexing \ $(P)parsing \ - $(P)pervasives \ - $(P)printexc \ - $(P)printf \ - $(P)queue \ - $(P)random \ - $(P)result \ - $(P)scanf \ - $(P)seq \ $(P)set \ + $(P)map \ $(P)stack \ - $(P)stdLabels \ - stdlib \ + $(P)queue \ + camlinternalLazy \ + $(P)lazy \ $(P)stream \ - $(P)string \ + $(P)buffer \ + camlinternalFormat \ + $(P)printf \ + $(P)arg \ + $(P)printexc \ + $(P)fun \ + $(P)gc \ + $(P)digest \ + $(P)random \ + $(P)hashtbl \ + $(P)weak \ + $(P)format \ + $(P)scanf \ + $(P)callback \ + camlinternalOO \ + $(P)oo \ + camlinternalMod \ + $(P)genlex \ + $(P)ephemeron \ + $(P)filename \ + $(P)complex \ + $(P)arrayLabels \ + $(P)listLabels \ + $(P)bytesLabels \ $(P)stringLabels \ - $(P)sys \ - $(P)uchar \ - $(P)unit \ - $(P)weak + $(P)moreLabels \ + $(P)stdLabels \ + $(P)spacetime \ + $(P)bigarray diff --git a/stdlib/array.ml b/stdlib/array.ml index a1b9663f..19ceab10 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -30,6 +30,8 @@ external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append" external concat : 'a array list -> 'a array = "caml_array_concat" external unsafe_blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit" +external unsafe_fill : + 'a array -> int -> int -> 'a -> unit = "caml_array_fill" external create_float: int -> float array = "caml_make_float_vect" let make_float = create_float @@ -81,7 +83,7 @@ let sub a ofs len = let fill a ofs len v = if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Array.fill" - else for i = ofs to ofs + len - 1 do unsafe_set a i v done + else unsafe_fill a ofs len v let blit a1 ofs1 a2 ofs2 len = if len < 0 || ofs1 < 0 || ofs1 > length a1 - len diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli index df84a7d3..6d940282 100644 --- a/stdlib/arrayLabels.mli +++ b/stdlib/arrayLabels.mli @@ -13,33 +13,43 @@ (* *) (**************************************************************************) +(** Array operations + + This module is intended to be used via {!StdLabels} which replaces + {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts + + For example: + {[ + open StdLabels + + let everything = Array.create_matrix ~dimx:42 ~dimy:42 42 + ]} *) + type 'a t = 'a array (** An alias for the type of arrays. *) -(** Array operations. *) - external length : 'a array -> int = "%array_length" (** Return the length (number of elements) of the given array. *) external get : 'a array -> int -> 'a = "%array_safe_get" -(** [Array.get a n] returns the element number [n] of array [a]. +(** [get a n] returns the element number [n] of array [a]. The first element has number 0. - The last element has number [Array.length a - 1]. - You can also write [a.(n)] instead of [Array.get a n]. + The last element has number [length a - 1]. + You can also write [a.(n)] instead of [get a n]. - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(Array.length a - 1)]. *) + @raise Invalid_argument + if [n] is outside the range 0 to [(length a - 1)]. *) external set : 'a array -> int -> 'a -> unit = "%array_safe_set" -(** [Array.set a n x] modifies array [a] in place, replacing +(** [set a n x] modifies array [a] in place, replacing element number [n] with [x]. - You can also write [a.(n) <- x] instead of [Array.set a n x]. + You can also write [a.(n) <- x] instead of [set a n x]. - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [Array.length a - 1]. *) + @raise Invalid_argument + if [n] is outside the range 0 to [length a - 1]. *) external make : int -> 'a -> 'a array = "caml_make_vect" -(** [Array.make n x] returns a fresh array of length [n], +(** [make n x] returns a fresh array of length [n], initialized with [x]. All the elements of this new array are initially physically equal to [x] (in the sense of the [==] predicate). @@ -47,117 +57,116 @@ external make : int -> 'a -> 'a array = "caml_make_vect" of the array, and modifying [x] through one of the array entries will modify all other entries at the same time. - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length]. If the value of [x] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2].*) external create : int -> 'a -> 'a array = "caml_make_vect" [@@ocaml.deprecated "Use Array.make instead."] -(** @deprecated [Array.create] is an alias for {!Array.make}. *) +(** @deprecated [create] is an alias for {!make}. *) val init : int -> f:(int -> 'a) -> 'a array -(** [Array.init n f] returns a fresh array of length [n], +(** [init n ~f] returns a fresh array of length [n], with element number [i] initialized to the result of [f i]. - In other terms, [Array.init n f] tabulates the results of [f] + In other terms, [init n ~f] tabulates the results of [f] applied to the integers [0] to [n-1]. - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + @raise Invalid_argument if [n < 0] or [n > Sys.max_array_length]. If the return type of [f] is [float], then the maximum size is only [Sys.max_array_length / 2].*) val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array -(** [Array.make_matrix dimx dimy e] returns a two-dimensional array +(** [make_matrix ~dimx ~dimy e] returns a two-dimensional array (an array of arrays) with first dimension [dimx] and second dimension [dimy]. All the elements of this new matrix are initially physically equal to [e]. The element ([x,y]) of a matrix [m] is accessed with the notation [m.(x).(y)]. - Raise [Invalid_argument] if [dimx] or [dimy] is negative or + @raise Invalid_argument if [dimx] or [dimy] is negative or greater than {!Sys.max_array_length}. If the value of [e] is a floating-point number, then the maximum size is only [Sys.max_array_length / 2]. *) val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array [@@ocaml.deprecated "Use Array.make_matrix instead."] -(** @deprecated [Array.create_matrix] is an alias for - {!Array.make_matrix}. *) +(** @deprecated [create_matrix] is an alias for {!make_matrix}. *) val append : 'a array -> 'a array -> 'a array -(** [Array.append v1 v2] returns a fresh array containing the +(** [append v1 v2] returns a fresh array containing the concatenation of the arrays [v1] and [v2]. *) val concat : 'a array list -> 'a array -(** Same as {!Array.append}, but concatenates a list of arrays. *) +(** Same as {!append}, but concatenates a list of arrays. *) val sub : 'a array -> pos:int -> len:int -> 'a array -(** [Array.sub a start len] returns a fresh array of length [len], - containing the elements number [start] to [start + len - 1] +(** [sub a ~pos ~len] returns a fresh array of length [len], + containing the elements number [pos] to [pos + len - 1] of array [a]. - Raise [Invalid_argument "Array.sub"] if [start] and [len] do not + @raise Invalid_argument if [pos] and [len] do not designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. *) + [pos < 0], or [len < 0], or [pos + len > length a]. *) val copy : 'a array -> 'a array -(** [Array.copy a] returns a copy of [a], that is, a fresh array +(** [copy a] returns a copy of [a], that is, a fresh array containing the same elements as [a]. *) val fill : 'a array -> pos:int -> len:int -> 'a -> unit -(** [Array.fill a ofs len x] modifies the array [a] in place, - storing [x] in elements number [ofs] to [ofs + len - 1]. +(** [fill a ~pos ~len x] modifies the array [a] in place, + storing [x] in elements number [pos] to [pos + len - 1]. - Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not + @raise Invalid_argument if [pos] and [len] do not designate a valid subarray of [a]. *) val blit : src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int -> unit -(** [Array.blit v1 o1 v2 o2 len] copies [len] elements - from array [v1], starting at element number [o1], to array [v2], - starting at element number [o2]. It works correctly even if - [v1] and [v2] are the same array, and the source and +(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements + from array [src], starting at element number [src_pos], to array [dst], + starting at element number [dst_pos]. It works correctly even if + [src] and [dst] are the same array, and the source and destination chunks overlap. - Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not - designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. *) + @raise Invalid_argument if [src_pos] and [len] do not + designate a valid subarray of [src], or if [dst_pos] and [len] do not + designate a valid subarray of [dst]. *) val to_list : 'a array -> 'a list -(** [Array.to_list a] returns the list of all the elements of [a]. *) +(** [to_list a] returns the list of all the elements of [a]. *) val of_list : 'a list -> 'a array -(** [Array.of_list l] returns a fresh array containing the elements +(** [of_list l] returns a fresh array containing the elements of [l]. *) val iter : f:('a -> unit) -> 'a array -> unit -(** [Array.iter f a] applies function [f] in turn to all +(** [iter ~f a] applies function [f] in turn to all the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) + [f a.(0); f a.(1); ...; f a.(length a - 1); ()]. *) val map : f:('a -> 'b) -> 'a array -> 'b array -(** [Array.map f a] applies function [f] to all the elements of [a], +(** [map ~f a] applies function [f] to all the elements of [a], and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) + [[| f a.(0); f a.(1); ...; f a.(length a - 1) |]]. *) val iteri : f:(int -> 'a -> unit) -> 'a array -> unit -(** Same as {!Array.iter}, but the +(** Same as {!iter}, but the function is applied to the index of the element as first argument, and the element itself as second argument. *) val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array -(** Same as {!Array.map}, but the +(** Same as {!map}, but the function is applied to the index of the element as first argument, and the element itself as second argument. *) val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a -(** [Array.fold_left f x a] computes - [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], +(** [fold_left ~f ~init a] computes + [f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)], where [n] is the length of the array [a]. *) val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a -(** [Array.fold_right f a x] computes - [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], +(** [fold_right ~f a ~init] computes + [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))], where [n] is the length of the array [a]. *) @@ -165,16 +174,16 @@ val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a val iter2 : f:('a -> 'b -> unit) -> 'a array -> 'b array -> unit -(** [Array.iter2 f a b] applies function [f] to all the elements of [a] +(** [iter2 ~f a b] applies function [f] to all the elements of [a] and [b]. - Raise [Invalid_argument] if the arrays are not the same size. + @raise Invalid_argument if the arrays are not the same size. @since 4.05.0 *) val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array -(** [Array.map2 f a b] applies function [f] to all the elements of [a] +(** [map2 ~f a b] applies function [f] to all the elements of [a] and [b], and builds an array with the results returned by [f]: - [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. - Raise [Invalid_argument] if the arrays are not the same size. + [[| f a.(0) b.(0); ...; f a.(length a - 1) b.(length b - 1)|]]. + @raise Invalid_argument if the arrays are not the same size. @since 4.05.0 *) @@ -182,36 +191,36 @@ val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val exists : f:('a -> bool) -> 'a array -> bool -(** [Array.exists p [|a1; ...; an|]] checks if at least one element of - the array satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. +(** [exists ~f [|a1; ...; an|]] checks if at least one element of + the array satisfies the predicate [f]. That is, it returns + [(f a1) || (f a2) || ... || (f an)]. @since 4.03.0 *) val for_all : f:('a -> bool) -> 'a array -> bool -(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. +(** [for_all ~f [|a1; ...; an|]] checks if all elements + of the array satisfy the predicate [f]. That is, it returns + [(f a1) && (f a2) && ... && (f an)]. @since 4.03.0 *) val mem : 'a -> set:'a array -> bool -(** [mem x a] is true if and only if [x] is equal - to an element of [a]. +(** [mem x ~set] is true if and only if [x] is equal + to an element of [set]. @since 4.03.0 *) val memq : 'a -> set:'a array -> bool -(** Same as {!Array.mem}, but uses physical equality instead of structural - equality to compare list elements. +(** Same as {!mem}, but uses physical equality + instead of structural equality to compare list elements. @since 4.03.0 *) external create_float: int -> float array = "caml_make_float_vect" -(** [Array.create_float n] returns a fresh float array of length [n], +(** [create_float n] returns a fresh float array of length [n], with uninitialized data. @since 4.03 *) val make_float: int -> float array [@@ocaml.deprecated "Use Array.create_float instead."] -(** @deprecated [Array.make_float] is an alias for - {!Array.create_float}. *) +(** @deprecated {!make_float} is an alias for + {!create_float}. *) (** {1 Sorting} *) @@ -224,9 +233,9 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit and a negative integer if the first is smaller (see below for a complete specification). For example, {!Stdlib.compare} is a suitable comparison function, provided there are no floating-point - NaN values in the data. After calling [Array.sort], the + NaN values in the data. After calling [sort], the array is sorted in place in increasing order. - [Array.sort] is guaranteed to run in constant heap space + [sort] is guaranteed to run in constant heap space and (at most) logarithmic stack space. The current implementation uses Heap Sort. It runs in constant @@ -238,25 +247,23 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit - [cmp x y] > 0 if and only if [cmp y x] < 0 - if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 - When [Array.sort] returns, [a] contains the same elements as before, + When [sort] returns, [a] contains the same elements as before, reordered in such a way that for all i and j valid indices of [a] : - [cmp a.(i) a.(j)] >= 0 if and only if i >= j *) val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. +(** Same as {!sort}, but the sorting algorithm is stable (i.e. elements that compare equal are kept in their original order) and not guaranteed to run in constant heap space. The current implementation uses Merge Sort. It uses [n/2] words of heap space, where [n] is the length of the array. - It is usually faster than the current implementation of {!Array.sort}. + It is usually faster than the current implementation of {!sort}. *) val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is - faster on typical input. -*) +(** Same as {!sort} or {!stable_sort}, whichever is faster on typical input. *) (** {1 Iterators} *) diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli index 1016c685..08b5fd54 100644 --- a/stdlib/bytes.mli +++ b/stdlib/bytes.mli @@ -130,8 +130,8 @@ val blit : bytes -> int -> bytes -> int -> int -> unit do not designate a valid range of [dst]. *) val blit_string : string -> int -> bytes -> int -> int -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from string - [src], starting at index [srcoff], to byte sequence [dst], +(** [blit_string src srcoff dst dstoff len] copies [len] bytes from + string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not @@ -218,7 +218,7 @@ val index_from : bytes -> int -> char -> int Raise [Not_found] if [c] does not occur in [s] after position [i]. *) val index_from_opt: bytes -> int -> char -> int option -(** [index_from _opts i c] returns the index of the first occurrence of +(** [index_from_opt s i c] returns the index of the first occurrence of byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli index baa7d1fb..9cd02dc8 100644 --- a/stdlib/bytesLabels.mli +++ b/stdlib/bytesLabels.mli @@ -15,7 +15,16 @@ (** Byte sequence operations. @since 4.02.0 - *) + + This module is intended to be used through {!StdLabels} which replaces + {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts. + + For example: + {[ + open StdLabels + + let first = Bytes.sub ~pos:0 ~len:1 + ]} *) external length : bytes -> int = "%bytes_length" (** Return the length (number of bytes) of the argument. *) diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml index b10fba81..5c2a2b3b 100644 --- a/stdlib/camlinternalFormat.ml +++ b/stdlib/camlinternalFormat.ml @@ -219,8 +219,9 @@ type precision_ebb = Precision_EBB : ('a, 'b) precision -> precision_ebb (* Default precision for float printing. *) let default_float_precision fconv = match snd fconv with - | Float_f | Float_e | Float_E | Float_g | Float_G | Float_h | Float_H -> -6 - (* For %h and %H formats, a negative precision means "as many digits as + | Float_f | Float_e | Float_E | Float_g | Float_G | Float_h | Float_H + | Float_CF -> -6 + (* For %h %H and %#F formats, a negative precision means "as many digits as necessary". For the other FP formats, we take the absolute value of the precision, hence 6 digits by default. *) | Float_F -> 12 @@ -297,6 +298,7 @@ let char_of_fconv ?(cF='F') fconv = match snd fconv with | Float_E -> 'E' | Float_g -> 'g' | Float_G -> 'G' | Float_F -> cF | Float_h -> 'h' | Float_H -> 'H' + | Float_CF -> 'F' (* Convert a scanning counter to char. *) @@ -438,11 +440,16 @@ let bprint_altint_fmt buf ign_flag iconv pad prec c = (***) -(* Print the optional '+' associated to a float conversion. *) -let bprint_fconv_flag buf fconv = match fst fconv with +(* Print the optional '+', ' ' and/or '#' associated to a float conversion. *) +let bprint_fconv_flag buf fconv = + begin match fst fconv with | Float_flag_p -> buffer_add_char buf '+' | Float_flag_s -> buffer_add_char buf ' ' - | Float_flag_ -> () + | Float_flag_ -> () end; + match snd fconv with + | Float_CF -> buffer_add_char buf '#' + | Float_f | Float_e | Float_E | Float_g | Float_G + | Float_F | Float_h | Float_H -> () (* Print a complete float format in a buffer (ex: "%+*.3f"). *) let bprint_float_fmt buf ign_flag fconv pad prec = @@ -453,8 +460,8 @@ let bprint_float_fmt buf ign_flag fconv pad prec = bprint_precision buf prec; buffer_add_char buf (char_of_fconv fconv) -(* Compute the literal string representation of a formatting_lit. *) -(* Also used by Printf and Scanf where formatting is not interpreted. *) +(* Compute the literal string representation of a Formatting_lit. *) +(* Used by Printf and Scanf where formatting is not interpreted. *) let string_of_formatting_lit formatting_lit = match formatting_lit with | Close_box -> "@]" | Close_tag -> "@}" @@ -467,14 +474,6 @@ let string_of_formatting_lit formatting_lit = match formatting_lit with | Escaped_percent -> "@%" | Scan_indic c -> "@" ^ (String.make 1 c) -(* Compute the literal string representation of a formatting. *) -(* Also used by Printf and Scanf where formatting is not interpreted. *) -let string_of_formatting_gen : type a b c d e f . - (a, b, c, d, e, f) formatting_gen -> string = - fun formatting_gen -> match formatting_gen with - | Open_tag (Format (_, str)) -> str - | Open_box (Format (_, str)) -> str - (***) (* Print a literal char in a buffer, escape '%' by "%%". *) @@ -626,8 +625,12 @@ let bprint_fmt buf fmt = bprint_string_literal buf (string_of_formatting_lit fmting_lit); fmtiter rest ign_flag; | Formatting_gen (fmting_gen, rest) -> - bprint_string_literal buf "@{"; - bprint_string_literal buf (string_of_formatting_gen fmting_gen); + begin match fmting_gen with + | Open_tag (Format (_, str)) -> + buffer_add_string buf "@{"; buffer_add_string buf str + | Open_box (Format (_, str)) -> + buffer_add_string buf "@["; buffer_add_string buf str + end; fmtiter rest ign_flag; | End_of_format -> () @@ -1456,34 +1459,34 @@ let convert_int64 iconv n = (* Convert a float to string. *) (* Fix special case of "OCaml float format". *) let convert_float fconv prec x = - match snd fconv with - | Float_h | Float_H -> + let hex () = let sign = match fst fconv with | Float_flag_p -> '+' | Float_flag_s -> ' ' | _ -> '-' in - let str = hexstring_of_float x prec sign in - begin match snd fconv with - | Float_H -> String.uppercase_ascii str - | _ -> str - end - | _ -> + hexstring_of_float x prec sign in + let add_dot_if_needed str = + let len = String.length str in + let rec is_valid i = + if i = len then false else + match str.[i] with + | '.' | 'e' | 'E' -> true + | _ -> is_valid (i + 1) in + if is_valid 0 then str else str ^ "." in + let caml_special_val str = match classify_float x with + | FP_normal | FP_subnormal | FP_zero -> str + | FP_infinite -> if x < 0.0 then "neg_infinity" else "infinity" + | FP_nan -> "nan" in + match snd fconv with + | Float_h -> hex () + | Float_H -> String.uppercase_ascii (hex ()) + | Float_CF -> caml_special_val (hex ()) + | Float_F -> let str = format_float (format_of_fconv fconv prec) x in - if snd fconv <> Float_F then str else - let len = String.length str in - let rec is_valid i = - if i = len then false else - match str.[i] with - | '.' | 'e' | 'E' -> true - | _ -> is_valid (i + 1) - in - match classify_float x with - | FP_normal | FP_subnormal | FP_zero -> - if is_valid 0 then str else str ^ "." - | FP_infinite -> - if x < 0.0 then "neg_infinity" else "infinity" - | FP_nan -> "nan" + caml_special_val (add_dot_if_needed str) + | Float_f | Float_e | Float_E | Float_g | Float_G -> + format_float (format_of_fconv fconv prec) x (* Convert a char to a string according to the OCaml lexical convention. *) let format_caml_char c = @@ -2477,8 +2480,9 @@ let fmt_ebb_of_string ?legacy_behavior str = make_padprec_fmt_ebb (get_int_pad ()) (get_prec ()) fmt_rest in Fmt_EBB (Int64 (iconv, pad', prec', fmt_rest')) | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' | 'h' | 'H' -> - let fconv = compute_float_conv pct_ind str_ind (get_plus ()) - (get_space ()) symb in + let fconv = + compute_float_conv pct_ind str_ind + (get_plus ()) (get_hash ()) (get_space ()) symb in let Fmt_EBB fmt_rest = parse str_ind end_ind in if get_ign () then let ignored = Ignored_float (get_pad_opt '_', get_prec_opt ()) in @@ -2629,14 +2633,6 @@ let fmt_ebb_of_string ?legacy_behavior str = let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest)) - and check_open_box : type a b c d e f . (a, b, c, d, e, f) fmt -> unit = - fun fmt -> match fmt with - | String_literal (str, End_of_format) -> ( - try ignore (open_box_of_string str) with Failure _ -> - ((* Emit warning: invalid open box *)) - ) - | _ -> () - (* Try to read the optional after "@{" or "@[". *) and parse_tag : type e f . bool -> int -> int -> (_, _, e, f) fmt_ebb = fun is_open_tag str_ind end_ind -> @@ -2650,9 +2646,8 @@ let fmt_ebb_of_string ?legacy_behavior str = let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in let Fmt_EBB sub_fmt = parse str_ind (ind + 1) in let sub_format = Format (sub_fmt, sub_str) in - let formatting = if is_open_tag then Open_tag sub_format else ( - check_open_box sub_fmt; - Open_box sub_format) in + let formatting = + if is_open_tag then Open_tag sub_format else Open_box sub_format in Fmt_EBB (Formatting_gen (formatting, fmt_rest)) | _ -> raise Not_found @@ -2940,7 +2935,7 @@ let fmt_ebb_of_string ?legacy_behavior str = | false, _, false, _ -> assert false (* Convert (plus, space, symb) to its associated float_conv. *) - and compute_float_conv pct_ind str_ind plus space symb = + and compute_float_conv pct_ind str_ind plus hash space symb = let flag = match plus, space with | false, false -> Float_flag_ | false, true -> Float_flag_s @@ -2949,15 +2944,16 @@ let fmt_ebb_of_string ?legacy_behavior str = (* plus and space: legacy implementation prefers plus *) if legacy_behavior then Float_flag_p else incompatible_flag pct_ind str_ind ' ' "'+'" in - let kind = match symb with - | 'f' -> Float_f - | 'e' -> Float_e - | 'E' -> Float_E - | 'g' -> Float_g - | 'G' -> Float_G - | 'h' -> Float_h - | 'H' -> Float_H - | 'F' -> Float_F + let kind = match hash, symb with + | _, 'f' -> Float_f + | _, 'e' -> Float_e + | _, 'E' -> Float_E + | _, 'g' -> Float_g + | _, 'G' -> Float_G + | _, 'h' -> Float_h + | _, 'H' -> Float_H + | false, 'F' -> Float_F + | true, 'F' -> Float_CF | _ -> assert false in flag, kind diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli index 94d77729..bd97a793 100644 --- a/stdlib/camlinternalFormat.mli +++ b/stdlib/camlinternalFormat.mli @@ -91,8 +91,6 @@ val format_of_string_format : val char_of_iconv : CamlinternalFormatBasics.int_conv -> char val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string -val string_of_formatting_gen : - ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.formatting_gen -> string val string_of_fmtty : ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string diff --git a/stdlib/camlinternalFormatBasics.ml b/stdlib/camlinternalFormatBasics.ml index c7fe17e6..61088232 100644 --- a/stdlib/camlinternalFormatBasics.ml +++ b/stdlib/camlinternalFormatBasics.ml @@ -45,6 +45,7 @@ type float_kind_conv = | Float_F (* %F | %+F | % F *) | Float_h (* %h | %+h | % h *) | Float_H (* %H | %+H | % H *) + | Float_CF (* %#F| %+#F| % #F *) type float_conv = float_flag_conv * float_kind_conv (***) diff --git a/stdlib/camlinternalFormatBasics.mli b/stdlib/camlinternalFormatBasics.mli index 952f67a5..adf76a26 100644 --- a/stdlib/camlinternalFormatBasics.mli +++ b/stdlib/camlinternalFormatBasics.mli @@ -26,7 +26,7 @@ type float_flag_conv = | Float_flag_ | Float_flag_p | Float_flag_s type float_kind_conv = | Float_f | Float_e | Float_E | Float_g | Float_G - | Float_F | Float_h | Float_H + | Float_F | Float_h | Float_H | Float_CF type float_conv = float_flag_conv * float_kind_conv type char_set = string diff --git a/stdlib/filename.ml b/stdlib/filename.ml index 18827aa2..b0dd5c21 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -69,7 +69,27 @@ let generic_dirname is_dir_sep current_dir_name name = then current_dir_name else trailing_sep (String.length name - 1) -module Unix = struct +module type SYSDEPS = sig + val null : string + val current_dir_name : string + val parent_dir_name : string + val dir_sep : string + val is_dir_sep : string -> int -> bool + val is_relative : string -> bool + val is_implicit : string -> bool + val check_suffix : string -> string -> bool + val chop_suffix_opt : suffix:string -> string -> string option + val temp_dir_name : string + val quote : string -> string + val quote_command : + string -> ?stdin: string -> ?stdout: string -> ?stderr: string + -> string list -> string + val basename : string -> string + val dirname : string -> string +end + +module Unix : SYSDEPS = struct + let null = "/dev/null" let current_dir_name = "." let parent_dir_name = ".." let dir_sep = "/" @@ -98,11 +118,19 @@ module Unix = struct let temp_dir_name = try Sys.getenv "TMPDIR" with Not_found -> "/tmp" let quote = generic_quote "'\\''" + let quote_command cmd ?stdin ?stdout ?stderr args = + String.concat " " (List.map quote (cmd :: args)) + ^ (match stdin with None -> "" | Some f -> " <" ^ quote f) + ^ (match stdout with None -> "" | Some f -> " >" ^ quote f) + ^ (match stderr with None -> "" | Some f -> if stderr = stdout + then " 2>&1" + else " 2>" ^ quote f) let basename = generic_basename is_dir_sep current_dir_name let dirname = generic_dirname is_dir_sep current_dir_name end -module Win32 = struct +module Win32 : SYSDEPS = struct + let null = "NUL" let current_dir_name = "." let parent_dir_name = ".." let dir_sep = "\\" @@ -161,6 +189,61 @@ module Win32 = struct in loop 0; Buffer.contents b +(* +Quoting commands for execution by cmd.exe is difficult. +1- Each argument is first quoted using the "quote" function above, to + protect it against the processing performed by the C runtime system, + then cmd.exe's special characters are escaped with '^', using + the "quote_cmd" function below. For more details, see + https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23 +2- The command and the redirection files, if any, must be double-quoted + in case they contain spaces. This quoting is interpreted by cmd.exe, + not by the C runtime system, hence the "quote" function above + cannot be used. The two characters we don't know how to quote + inside a double-quoted cmd.exe string are double-quote and percent. + We just fail if the command name or the redirection file names + contain a double quote (not allowed in Windows file names, anyway) + or a percent. See function "quote_cmd_filename" below. +3- The whole string passed to Sys.command is then enclosed in double + quotes, which are immediately stripped by cmd.exe. Otherwise, + some of the double quotes from step 2 above can be misparsed. + See e.g. https://stackoverflow.com/a/9965141 +*) + let quote_cmd s = + let b = Buffer.create (String.length s + 20) in + String.iter + (fun c -> + match c with + | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' -> + Buffer.add_char b '^'; Buffer.add_char b c + | _ -> + Buffer.add_char b c) + s; + Buffer.contents b + let quote_cmd_filename f = + if String.contains f '\"' || String.contains f '%' then + failwith ("Filename.quote_command: bad file name " ^ f) + else if String.contains f ' ' then + "\"" ^ f ^ "\"" + else + f + (* Redirections in cmd.exe: see https://ss64.com/nt/syntax-redirection.html + and https://docs.microsoft.com/en-us/previous-versions/windows/it-pro/windows-xp/bb490982(v=technet.10) + *) + let quote_command cmd ?stdin ?stdout ?stderr args = + String.concat "" [ + "\""; + quote_cmd_filename cmd; + " "; + quote_cmd (String.concat " " (List.map quote args)); + (match stdin with None -> "" | Some f -> " <" ^ quote_cmd_filename f); + (match stdout with None -> "" | Some f -> " >" ^ quote_cmd_filename f); + (match stderr with None -> "" | Some f -> + if stderr = stdout + then " 2>&1" + else " 2>" ^ quote_cmd_filename f); + "\"" + ] let has_drive s = let is_letter = function | 'A' .. 'Z' | 'a' .. 'z' -> true @@ -180,7 +263,8 @@ module Win32 = struct generic_basename is_dir_sep current_dir_name path end -module Cygwin = struct +module Cygwin : SYSDEPS = struct + let null = "/dev/null" let current_dir_name = "." let parent_dir_name = ".." let dir_sep = "/" @@ -191,33 +275,18 @@ module Cygwin = struct let chop_suffix_opt = Win32.chop_suffix_opt let temp_dir_name = Unix.temp_dir_name let quote = Unix.quote + let quote_command = Unix.quote_command let basename = generic_basename is_dir_sep current_dir_name let dirname = generic_dirname is_dir_sep current_dir_name end -let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, - is_relative, is_implicit, check_suffix, chop_suffix_opt, - temp_dir_name, quote, basename, - dirname) = - match Sys.os_type with - | "Win32" -> - (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep, - Win32.is_dir_sep, - Win32.is_relative, Win32.is_implicit, Win32.check_suffix, - Win32.chop_suffix_opt, - Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname) - | "Cygwin" -> - (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep, - Cygwin.is_dir_sep, - Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix, - Cygwin.chop_suffix_opt, - Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname) - | _ -> (* normally "Unix" *) - (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep, - Unix.is_dir_sep, - Unix.is_relative, Unix.is_implicit, Unix.check_suffix, - Unix.chop_suffix_opt, - Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname) +module Sysdeps = + (val (match Sys.os_type with + | "Win32" -> (module Win32: SYSDEPS) + | "Cygwin" -> (module Cygwin: SYSDEPS) + | _ -> (module Unix: SYSDEPS))) + +include Sysdeps let concat dirname filename = let l = String.length dirname in diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 9221c9ef..1e77c0d8 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -118,6 +118,12 @@ val dirname : string -> string This function conforms to the specification of POSIX.1-2008 for the [dirname] utility. *) +val null : string +(** [null] is ["/dev/null"] on POSIX and ["NUL"] on Windows. It represents a + file on the OS that discards all writes and returns end of file on reads. + + @since 4.10.0 *) + val temp_file : ?temp_dir: string -> string -> string -> string (** [temp_file prefix suffix] returns the name of a fresh temporary file in the temporary directory. @@ -186,3 +192,35 @@ val quote : string -> string with programs that follow the standard Windows quoting conventions. *) + +val quote_command : + string -> ?stdin:string -> ?stdout:string -> ?stderr:string + -> string list -> string +(** [quote_command cmd args] returns a quoted command line, suitable + for use as an argument to {!Sys.command}, {!Unix.system}, and the + {!Unix.open_process} functions. + + The string [cmd] is the command to call. The list [args] is + the list of arguments to pass to this command. It can be empty. + + The optional arguments [?stdin] and [?stdout] and [?stderr] are + file names used to redirect the standard input, the standard + output, or the standard error of the command. + If [~stdin:f] is given, a redirection [< f] is performed and the + standard input of the command reads from file [f]. + If [~stdout:f] is given, a redirection [> f] is performed and the + standard output of the command is written to file [f]. + If [~stderr:f] is given, a redirection [2> f] is performed and the + standard error of the command is written to file [f]. + If both [~stdout:f] and [~stderr:f] are given, with the exact + same file name [f], a [2>&1] redirection is performed so that the + standard output and the standard error of the command are interleaved + and redirected to the same file [f]. + + Under Unix and Cygwin, the command, the arguments, and the redirections + if any are quoted using {!Filename.quote}, then concatenated. + Under Win32, additional quoting is performed as required by the + [cmd.exe] shell that is called by {!Sys.command}. + + Raise [Failure] if the command cannot be escaped on the current platform. +*) diff --git a/stdlib/gc.ml b/stdlib/gc.ml index 41a8f8c8..692b4f0b 100644 --- a/stdlib/gc.ml +++ b/stdlib/gc.ml @@ -2,10 +2,11 @@ (* *) (* OCaml *) (* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* Jacques-Henri Jourdan, projet Gallium, INRIA Paris *) (* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) +(* Copyright 1996-2016 Institut National de Recherche en Informatique *) +(* et en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 47e7dedf..0ba8ef41 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -2,10 +2,11 @@ (* *) (* OCaml *) (* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* Jacques-Henri Jourdan, projet Gallium, INRIA Paris *) (* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) +(* Copyright 1996-2016 Institut National de Recherche en Informatique *) +(* et en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) @@ -18,9 +19,7 @@ type stat = { minor_words : float; (** Number of words allocated in the minor heap since - the program was started. This number is accurate in - byte-code programs, but only an approximation in programs - compiled to native code. *) + the program was started. *) promoted_words : float; (** Number of words allocated in the minor heap that @@ -134,7 +133,7 @@ type control = (this setting is intended for testing purposes only). If [max_overhead >= 1000000], compaction is never triggered. If compaction is permanently disabled, it is strongly suggested - to set [allocation_policy] to 1. + to set [allocation_policy] to 2. Default: 500. *) mutable stack_limit : int; @@ -146,12 +145,47 @@ type control = mutable allocation_policy : int; [@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.allocation_policy = ...}"] - (** The policy used for allocating in the heap. Possible - values are 0 and 1. 0 is the next-fit policy, which is - quite fast but can result in fragmentation. 1 is the - first-fit policy, which can be slower in some cases but - can be better for programs with fragmentation problems. - Default: 0. @since 3.11.0 *) + (** The policy used for allocating in the major heap. + Possible values are 0, 1 and 2. + + - 0 is the next-fit policy, which is usually fast but can + result in fragmentation, increasing memory consumption. + + - 1 is the first-fit policy, which avoids fragmentation but + has corner cases (in certain realistic workloads) where it + is sensibly slower. + + - 2 is the best-fit policy, which is fast and avoids + fragmentation. In our experiments it is faster and uses less + memory than both next-fit and first-fit. + (since OCaml 4.10) + + The current default is next-fit, as the best-fit policy is new + and not yet widely tested. We expect best-fit to become the + default in the future. + + On one example that was known to be bad for next-fit and first-fit, + next-fit takes 28s using 855Mio of memory, + first-fit takes 47s using 566Mio of memory, + best-fit takes 27s using 545Mio of memory. + + Note: When changing to a low-fragmentation policy, you may + need to augment the [space_overhead] setting, for example + using [100] instead of the default [80] which is tuned for + next-fit. Indeed, the difference in fragmentation behavior + means that different policies will have different proportion + of "wasted space" for a given program. Less fragmentation + means a smaller heap so, for the same amount of wasted space, + a higher proportion of wasted space. This makes the GC work + harder, unless you relax it by increasing [space_overhead]. + + Note: changing the allocation policy at run-time forces + a heap compaction, which is a lengthy operation unless the + heap is small (e.g. at the start of the program). + + Default: 0. + + @since 3.11.0 *) window_size : int; (** The size of the window used by the major GC for smoothing diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml index 82ee9db7..97bc5321 100644 --- a/stdlib/hashtbl.ml +++ b/stdlib/hashtbl.ml @@ -15,15 +15,6 @@ (* Hash tables *) -external seeded_hash_param : - int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc] -external old_hash_param : - int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc] - -let hash x = seeded_hash_param 10 100 0 x -let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x -let seeded_hash seed x = seeded_hash_param 10 100 seed x - (* We do dynamic hashing, and resize the table and rehash the elements when buckets become too long. *) @@ -68,6 +59,10 @@ let is_randomized () = !randomized let prng = lazy (Random.State.make_self_init()) +(* Functions which appear before the functorial interface must either be + independent of the hash function or take it as a parameter (see #2202 and + code below the functor definitions. *) + (* Creating a fresh, empty table *) let rec power_2_above x n = @@ -81,11 +76,10 @@ let create ?(random = !randomized) initial_size = { 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 + if h.size > 0 then begin + h.size <- 0; + Array.fill h.data 0 (Array.length h.data) Empty + end let reset h = let len = Array.length h.data in @@ -153,111 +147,6 @@ let resize indexfun h = done; end -let key_index h key = - (* compatibility with old hash tables *) - if Obj.size (Obj.repr h) >= 3 - then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1) - else (old_hash_param 10 100 key) mod (Array.length h.data) - -let add h key data = - let i = key_index h key in - let bucket = Cons{key; data; next=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 rec remove_bucket h i key prec = function - | Empty -> - () - | (Cons {key=k; next}) as c -> - if compare k key = 0 - then begin - h.size <- h.size - 1; - match prec with - | Empty -> h.data.(i) <- next - | Cons c -> c.next <- next - end - else remove_bucket h i key c next - -let remove h key = - let i = key_index h key in - remove_bucket h i key Empty h.data.(i) - -let rec find_rec key = function - | Empty -> - raise Not_found - | Cons{key=k; data; next} -> - if compare key k = 0 then data else find_rec key next - -let find h key = - match h.data.(key_index h key) with - | Empty -> raise Not_found - | Cons{key=k1; data=d1; next=next1} -> - if compare key k1 = 0 then d1 else - match next1 with - | Empty -> raise Not_found - | Cons{key=k2; data=d2; next=next2} -> - if compare key k2 = 0 then d2 else - match next2 with - | Empty -> raise Not_found - | Cons{key=k3; data=d3; next=next3} -> - if compare key k3 = 0 then d3 else find_rec key next3 - -let rec find_rec_opt key = function - | Empty -> - None - | Cons{key=k; data; next} -> - if compare key k = 0 then Some data else find_rec_opt key next - -let find_opt h key = - match h.data.(key_index h key) with - | Empty -> None - | Cons{key=k1; data=d1; next=next1} -> - if compare key k1 = 0 then Some d1 else - match next1 with - | Empty -> None - | Cons{key=k2; data=d2; next=next2} -> - if compare key k2 = 0 then Some d2 else - match next2 with - | Empty -> None - | Cons{key=k3; data=d3; next=next3} -> - if compare key k3 = 0 then Some d3 else find_rec_opt key next3 - -let find_all h key = - let rec find_in_bucket = function - | Empty -> - [] - | Cons{key=k; data; next} -> - if compare k key = 0 - then data :: find_in_bucket next - else find_in_bucket next in - find_in_bucket h.data.(key_index h key) - -let rec replace_bucket key data = function - | Empty -> - true - | Cons ({key=k; next} as slot) -> - if compare k key = 0 - then (slot.key <- key; slot.data <- data; false) - else replace_bucket key data next - -let replace h key data = - let i = key_index h key in - let l = h.data.(i) in - if replace_bucket key data l then begin - h.data.(i) <- Cons{key; data; next=l}; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h - end - -let mem h key = - let rec mem_in_bucket = function - | Empty -> - false - | Cons{key=k; next} -> - compare k key = 0 || mem_in_bucket next in - mem_in_bucket h.data.(key_index h key) - let iter f h = let rec do_bucket = function | Empty -> @@ -375,17 +264,6 @@ let to_seq_keys m = Seq.map fst (to_seq m) let to_seq_values m = Seq.map snd (to_seq m) -let add_seq tbl i = - Seq.iter (fun (k,v) -> add tbl k v) i - -let replace_seq tbl i = - Seq.iter (fun (k,v) -> replace tbl k v) i - -let of_seq i = - let tbl = create 16 in - replace_seq tbl i; - tbl - (* Functorial interface *) module type HashedType = @@ -604,3 +482,132 @@ module Make(H: HashedType): (S with type key = H.t) = replace_seq tbl i; tbl end + +(* Polymorphic hash function-based tables *) +(* Code included below the functorial interface to guard against accidental + use - see #2202 *) + +external seeded_hash_param : + int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc] +external old_hash_param : + int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc] + +let hash x = seeded_hash_param 10 100 0 x +let hash_param n1 n2 x = seeded_hash_param n1 n2 0 x +let seeded_hash seed x = seeded_hash_param 10 100 seed x + +let key_index h key = + (* compatibility with old hash tables *) + if Obj.size (Obj.repr h) >= 3 + then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1) + else (old_hash_param 10 100 key) mod (Array.length h.data) + +let add h key data = + let i = key_index h key in + let bucket = Cons{key; data; next=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 rec remove_bucket h i key prec = function + | Empty -> + () + | (Cons {key=k; next}) as c -> + if compare k key = 0 + then begin + h.size <- h.size - 1; + match prec with + | Empty -> h.data.(i) <- next + | Cons c -> c.next <- next + end + else remove_bucket h i key c next + +let remove h key = + let i = key_index h key in + remove_bucket h i key Empty h.data.(i) + +let rec find_rec key = function + | Empty -> + raise Not_found + | Cons{key=k; data; next} -> + if compare key k = 0 then data else find_rec key next + +let find h key = + match h.data.(key_index h key) with + | Empty -> raise Not_found + | Cons{key=k1; data=d1; next=next1} -> + if compare key k1 = 0 then d1 else + match next1 with + | Empty -> raise Not_found + | Cons{key=k2; data=d2; next=next2} -> + if compare key k2 = 0 then d2 else + match next2 with + | Empty -> raise Not_found + | Cons{key=k3; data=d3; next=next3} -> + if compare key k3 = 0 then d3 else find_rec key next3 + +let rec find_rec_opt key = function + | Empty -> + None + | Cons{key=k; data; next} -> + if compare key k = 0 then Some data else find_rec_opt key next + +let find_opt h key = + match h.data.(key_index h key) with + | Empty -> None + | Cons{key=k1; data=d1; next=next1} -> + if compare key k1 = 0 then Some d1 else + match next1 with + | Empty -> None + | Cons{key=k2; data=d2; next=next2} -> + if compare key k2 = 0 then Some d2 else + match next2 with + | Empty -> None + | Cons{key=k3; data=d3; next=next3} -> + if compare key k3 = 0 then Some d3 else find_rec_opt key next3 + +let find_all h key = + let rec find_in_bucket = function + | Empty -> + [] + | Cons{key=k; data; next} -> + if compare k key = 0 + then data :: find_in_bucket next + else find_in_bucket next in + find_in_bucket h.data.(key_index h key) + +let rec replace_bucket key data = function + | Empty -> + true + | Cons ({key=k; next} as slot) -> + if compare k key = 0 + then (slot.key <- key; slot.data <- data; false) + else replace_bucket key data next + +let replace h key data = + let i = key_index h key in + let l = h.data.(i) in + if replace_bucket key data l then begin + h.data.(i) <- Cons{key; data; next=l}; + h.size <- h.size + 1; + if h.size > Array.length h.data lsl 1 then resize key_index h + end + +let mem h key = + let rec mem_in_bucket = function + | Empty -> + false + | Cons{key=k; next} -> + compare k key = 0 || mem_in_bucket next in + mem_in_bucket h.data.(key_index h key) + +let add_seq tbl i = + Seq.iter (fun (k,v) -> add tbl k v) i + +let replace_seq tbl i = + Seq.iter (fun (k,v) -> replace tbl k v) i + +let of_seq i = + let tbl = create 16 in + replace_seq tbl i; + tbl diff --git a/stdlib/list.ml b/stdlib/list.ml index 3980ddd6..2b9e545b 100644 --- a/stdlib/list.ml +++ b/stdlib/list.ml @@ -228,6 +228,14 @@ let rec find_opt p = function | [] -> None | x :: l -> if p x then Some x else find_opt p l +let rec find_map f = function + | [] -> None + | x :: l -> + begin match f x with + | Some _ as result -> result + | None -> find_map f l + end + let find_all p = let rec find accu = function | [] -> rev accu @@ -246,6 +254,14 @@ let filter_map f = in aux [] +let concat_map f l = + let rec aux f acc = function + | [] -> rev acc + | x :: l -> + let xs = f x in + aux f (rev_append xs acc) l + in aux f [] l + let partition p l = let rec part yes no = function | [] -> (rev yes, rev no) @@ -275,14 +291,6 @@ let rec merge cmp l1 l2 = else h2 :: merge cmp l1 t2 -let rec chop k l = - if k = 0 then l else begin - match l with - | _::t -> chop (k-1) t - | _ -> assert false - end - - let stable_sort cmp l = let rec rev_merge l1 l2 accu = match l1, l2 with @@ -304,49 +312,51 @@ let stable_sort cmp l = in let rec sort n l = match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 <= 0 then begin - if cmp x2 x3 <= 0 then [x1; x2; x3] - else if cmp x1 x3 <= 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 <= 0 then [x2; x1; x3] - else if cmp x2 x3 <= 0 then [x2; x3; x1] - else [x3; x2; x1] - end + | 2, x1 :: x2 :: tl -> + let s = if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] in + (s, tl) + | 3, x1 :: x2 :: x3 :: tl -> + let s = + if cmp x1 x2 <= 0 then + if cmp x2 x3 <= 0 then [x1; x2; x3] + else if cmp x1 x3 <= 0 then [x1; x3; x2] + else [x3; x1; x2] + else if cmp x1 x3 <= 0 then [x2; x1; x3] + else if cmp x2 x3 <= 0 then [x2; x3; x1] + else [x3; x2; x1] + in + (s, tl) | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = rev_sort n1 l in + let s2, tl = rev_sort n2 l2 in + (rev_merge_rev s1 s2 [], tl) and rev_sort n l = match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 > 0 then begin - if cmp x2 x3 > 0 then [x1; x2; x3] - else if cmp x1 x3 > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 > 0 then [x2; x1; x3] - else if cmp x2 x3 > 0 then [x2; x3; x1] - else [x3; x2; x1] - end + | 2, x1 :: x2 :: tl -> + let s = if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] in + (s, tl) + | 3, x1 :: x2 :: x3 :: tl -> + let s = + if cmp x1 x2 > 0 then + if cmp x2 x3 > 0 then [x1; x2; x3] + else if cmp x1 x3 > 0 then [x1; x3; x2] + else [x3; x1; x2] + else if cmp x1 x3 > 0 then [x2; x1; x3] + else if cmp x2 x3 > 0 then [x2; x3; x1] + else [x3; x2; x1] + in + (s, tl) | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = sort n1 l in + let s2, tl = sort n2 l2 in + (rev_merge s1 s2 [], tl) in let len = length l in - if len < 2 then l else sort len l + if len < 2 then l else fst (sort len l) let sort = stable_sort @@ -412,79 +422,88 @@ let sort_uniq cmp l = in let rec sort n l = match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c < 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c < 0 then [x2; x3] else [x3; x2] - end else if c < 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x3; x1] - else [x3; x2; x1] - end + | 2, x1 :: x2 :: tl -> + let s = + let c = cmp x1 x2 in + if c = 0 then [x1] else if c < 0 then [x1; x2] else [x2; x1] + in + (s, tl) + | 3, x1 :: x2 :: x3 :: tl -> + let s = + let c = cmp x1 x2 in + if c = 0 then + let c = cmp x2 x3 in + if c = 0 then [x2] else if c < 0 then [x2; x3] else [x3; x2] + else if c < 0 then + let c = cmp x2 x3 in + if c = 0 then [x1; x2] + else if c < 0 then [x1; x2; x3] + else + let c = cmp x1 x3 in + if c = 0 then [x1; x2] + else if c < 0 then [x1; x3; x2] + else [x3; x1; x2] + else + let c = cmp x1 x3 in + if c = 0 then [x2; x1] + else if c < 0 then [x2; x1; x3] + else + let c = cmp x2 x3 in + if c = 0 then [x2; x1] + else if c < 0 then [x2; x3; x1] + else [x3; x2; x1] + in + (s, tl) | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = rev_sort n1 l in + let s2, tl = rev_sort n2 l2 in + (rev_merge_rev s1 s2 [], tl) and rev_sort n l = match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c > 0 then [x2; x3] else [x3; x2] - end else if c > 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x3; x1] - else [x3; x2; x1] - end + | 2, x1 :: x2 :: tl -> + let s = + let c = cmp x1 x2 in + if c = 0 then [x1] else if c > 0 then [x1; x2] else [x2; x1] + in + (s, tl) + | 3, x1 :: x2 :: x3 :: tl -> + let s = + let c = cmp x1 x2 in + if c = 0 then + let c = cmp x2 x3 in + if c = 0 then [x2] else if c > 0 then [x2; x3] else [x3; x2] + else if c > 0 then + let c = cmp x2 x3 in + if c = 0 then [x1; x2] + else if c > 0 then [x1; x2; x3] + else + let c = cmp x1 x3 in + if c = 0 then [x1; x2] + else if c > 0 then [x1; x3; x2] + else [x3; x1; x2] + else + let c = cmp x1 x3 in + if c = 0 then [x2; x1] + else if c > 0 then [x2; x1; x3] + else + let c = cmp x2 x3 in + if c = 0 then [x2; x1] + else if c > 0 then [x2; x3; x1] + else [x3; x2; x1] + in + (s, tl) | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] + let n1 = n asr 1 in + let n2 = n - n1 in + let s1, l2 = sort n1 l in + let s2, tl = sort n2 l2 in + (rev_merge s1 s2 [], tl) in let len = length l in - if len < 2 then l else sort len l + if len < 2 then l else fst (sort len l) + let rec compare_lengths l1 l2 = match l1, l2 with diff --git a/stdlib/list.mli b/stdlib/list.mli index d0250afd..b7b6a89b 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -141,6 +141,13 @@ val filter_map : ('a -> 'b option) -> 'a list -> 'b list @since 4.08.0 *) +val concat_map : ('a -> 'b list) -> 'a list -> 'b list +(** [List.concat_map f l] gives the same result as + {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive. + + @since 4.10.0 +*) + val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a (** [List.fold_left f a [b1; ...; bn]] is [f (... (f (f a b1) b2) ...) bn]. *) @@ -230,6 +237,13 @@ val find_opt: ('a -> bool) -> 'a list -> 'a option satisfies [p] in the list [l]. @since 4.05 *) +val find_map: ('a -> 'b option) -> 'a list -> 'b option +(** [find_map f l] applies [f] to the elements of [l] in order, + and returns the first result of the form [Some v], or [None] + if none exist. + @since 4.10.0 +*) + val filter : ('a -> bool) -> 'a list -> 'a list (** [filter p l] returns all the elements of the list [l] that satisfy the predicate [p]. The order of the elements diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index 2fc4780f..7004d789 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -27,7 +27,16 @@ type 'a t = 'a list = [] | (::) of 'a * 'a list (**) The above considerations can usually be ignored if your lists are not longer than about 10000 elements. -*) + + This module is intended to be used through {!StdLabels} which replaces + {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts. + + For example: + {[ + open StdLabels + + let seq len = List.init ~f:(function i -> i) ~len + ]} *) val length : 'a list -> int (** Return the length (number of elements) of the given list. *) @@ -143,6 +152,13 @@ val filter_map : f:('a -> 'b option) -> 'a list -> 'b list @since 4.08.0 *) +val concat_map : f:('a -> 'b list) -> 'a list -> 'b list +(** [List.concat_map f l] gives the same result as + {!List.concat}[ (]{!List.map}[ f l)]. Tail-recursive. + + @since 4.10.0 +*) + val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a (** [List.fold_left f a [b1; ...; bn]] is [f (... (f (f a b1) b2) ...) bn]. *) @@ -235,6 +251,13 @@ val find_opt: f:('a -> bool) -> 'a list -> 'a option list [l]. @since 4.05 *) +val find_map: f:('a -> 'b option) -> 'a list -> 'b option +(** [find_map f l] applies [f] to the elements of [l] in order, + and returns the first result of the form [Some v], or [None] + if none exist. + @since 4.10.0 +*) + val filter : f:('a -> bool) -> 'a list -> 'a list (** [filter p l] returns all the elements of the list [l] that satisfy the predicate [p]. The order of the elements diff --git a/stdlib/option.ml b/stdlib/option.ml index 97fa0b4e..c6a56bef 100644 --- a/stdlib/option.ml +++ b/stdlib/option.ml @@ -20,7 +20,7 @@ let some v = Some v let value o ~default = match o with Some v -> v | None -> default let get = function Some v -> v | None -> invalid_arg "option is None" let bind o f = match o with None -> None | Some v -> f v -let join = function Some (Some _ as o) -> o | _ -> None +let join = function Some o -> o | None -> None let map f o = match o with None -> None | Some v -> Some (f v) let fold ~none ~some = function Some v -> some v | None -> none let iter f = function Some v -> f v | None -> () diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index c215ad76..c15b783d 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -157,7 +157,7 @@ external raise_with_backtrace: exn -> raw_backtrace -> 'a (** {1 Current call stack} *) -val get_callstack: int -> raw_backtrace +external get_callstack: int -> raw_backtrace = "caml_get_current_callstack" (** [Printexc.get_callstack n] returns a description of the top of the call stack on the current program point (for the current thread), with at most [n] entries. (Note: this function is not related to diff --git a/stdlib/printf.mli b/stdlib/printf.mli index 44571830..8ecb819e 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -36,14 +36,19 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a The types and their meanings are: - [d], [i]: convert an integer argument to signed decimal. + The flag [#] adds underscores to large values for readability. - [u], [n], [l], [L], or [N]: convert an integer argument to unsigned decimal. Warning: [n], [l], [L], and [N] are used for [scanf], and should not be used for [printf]. + The flag [#] adds underscores to large values for readability. - [x]: convert an integer argument to unsigned hexadecimal, using lowercase letters. + The flag [#] adds a [0x] prefix to non zero values. - [X]: convert an integer argument to unsigned hexadecimal, using uppercase letters. + The flag [#] adds a [0X] prefix to non zero values. - [o]: convert an integer argument to unsigned octal. + The flag [#] adds a [0] prefix to non zero values. - [s]: insert a string argument. - [S]: convert a string argument to OCaml syntax (double quotes, escapes). - [c]: insert a character argument. @@ -53,6 +58,7 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a in the style [dddd.ddd]. - [F]: convert a floating-point argument to OCaml syntax ([dddd.] or [dddd.ddd] or [d.ddd e+-dd]). + Converts to hexadecimal with the [#] flag (see [h]). - [e] or [E]: convert a floating-point argument to decimal notation, in the style [d.ddd e+-dd] (mantissa and exponent). - [g] or [G]: convert a floating-point argument to decimal notation, @@ -101,8 +107,7 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a - space: for signed numerical conversions, prefix number with a space if positive. - [#]: request an alternate formatting style for the integer types - ([x], [X], [o], [lx], [lX], [lo], [Lx], [LX], [Lo], [d], [i], [u], - [ld], [li], [lu], [Ld], [Li], [Lu], [nd], [ni], [nu]). + and the floating-point type [F]. The optional [width] is an integer indicating the minimal width of the result. For instance, [%6d] prints an integer, diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml index b72c1e6d..91fcd66d 100644 --- a/stdlib/scanf.ml +++ b/stdlib/scanf.ml @@ -1348,7 +1348,7 @@ fun ib fmt readers -> match fmt with let c = integer_conversion_of_char (char_of_iconv iconv) in let scan width _ ib = scan_int_conversion c width ib in pad_prec_scanf ib rest readers pad prec scan (token_int64 c) - | Float ((_, Float_F), pad, prec, rest) -> + | Float ((_, (Float_F | Float_CF)), pad, prec, rest) -> pad_prec_scanf ib rest readers pad prec scan_caml_float token_float | Float ((_, (Float_f | Float_e | Float_E | Float_g | Float_G)), pad, prec, rest) -> diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index 7087901a..737e37d9 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -79,13 +79,16 @@ exception Not_found exception Out_of_memory (** Exception raised by the garbage collector when there is - insufficient memory to complete the computation. *) + insufficient memory to complete the computation. (Not reliable for + allocations on the minor heap.) *) exception Stack_overflow (** Exception raised by the bytecode interpreter when the evaluation stack reaches its maximal size. This often indicates infinite or - excessively deep recursion in the user's program. (Not fully - implemented by the native-code compiler.) *) + excessively deep recursion in the user's program. + + Before 4.10, it was not fully implemented by the native-code + compiler. *) exception Sys_error of string [@ocaml.warn_on_literal_pattern] diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli index d136a169..29126b73 100644 --- a/stdlib/stringLabels.mli +++ b/stdlib/stringLabels.mli @@ -13,7 +13,16 @@ (* *) (**************************************************************************) -(** String operations. *) +(** String operations. + This module is intended to be used through {!StdLabels} which replaces + {!Array}, {!Bytes}, {!List} and {!String} with their labeled counterparts + + For example: + {[ + open StdLabels + + let to_upper = String.map ~f:Char.uppercase_ascii + ]} *) external length : string -> int = "%string_length" (** Return the length (number of characters) of the given string. *) diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 87fd0622..eed700a8 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -66,7 +66,24 @@ val getenv_opt: string -> string option *) external command : string -> int = "caml_sys_system_command" -(** Execute the given shell command and return its exit code. *) +(** Execute the given shell command and return its exit code. + + The argument of {!Sys.command} is generally the name of a + command followed by zero, one or several arguments, separated + by whitespace. The given argument is interpreted by a + shell: either the Windows shell [cmd.exe] for the Win32 ports of + OCaml, or the POSIX shell [sh] for other ports. It can contain + shell builtin commands such as [echo], and also special characters + such as file redirections [>] and [<], which will be honored by the + shell. + + Conversely, whitespace or special shell characters occuring in + command names or in their arguments must be quoted or escaped + so that the shell does not interpret them. The quoting rules vary + between the POSIX shell and the Windows shell. + The {!Filename.quote_command} performs the appropriate quoting + given a command name, a list of arguments, and optional file redirections. +*) external time : unit -> (float [@unboxed]) = "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc] @@ -340,3 +357,28 @@ external opaque_identity : 'a -> 'a = "%opaque" @since 4.03.0 *) + +module Immediate64 : sig + (** This module allows to define a type [t] with the [immediate64] + attribute. This attribute means that the type is immediate on 64 + bit architectures. On other architectures, it might or might not + be immediate. + + @since 4.10.0 + *) + + module type Non_immediate = sig + type t + end + module type Immediate = sig + type t [@@immediate] + end + + module Make(Immediate : Immediate)(Non_immediate : Non_immediate) : sig + type t [@@immediate64] + type 'a repr = + | Immediate : Immediate.t repr + | Non_immediate : Non_immediate.t repr + val repr : t repr + end +end diff --git a/stdlib/sys.mlp b/stdlib/sys.mlp index 2da2b778..e89dd458 100644 --- a/stdlib/sys.mlp +++ b/stdlib/sys.mlp @@ -131,3 +131,25 @@ let ocaml_version = "%%VERSION%%" (* Optimization *) external opaque_identity : 'a -> 'a = "%opaque" + +module Immediate64 = struct + module type Non_immediate = sig + type t + end + module type Immediate = sig + type t [@@immediate] + end + + module Make(Immediate : Immediate)(Non_immediate : Non_immediate) = struct + type t [@@immediate64] + type 'a repr = + | Immediate : Immediate.t repr + | Non_immediate : Non_immediate.t repr + external magic : _ repr -> t repr = "%identity" + let repr = + if word_size = 64 then + magic Immediate + else + magic Non_immediate + end +end diff --git a/testsuite/Makefile b/testsuite/Makefile index b383ec23..fb33f638 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -39,6 +39,7 @@ ifeq "$(UNIX_OR_WIN32)" "unix" else # Non-cygwin Unix find := find endif + FLEXLINK_ENV = else # Windows find := /usr/bin/find FLEXDLL_SUBMODULE_PRESENT := $(wildcard ../flexdll/Makefile) @@ -65,8 +66,6 @@ endif default: @echo "Available targets:" @echo " all launch all tests" - @echo " legacy launch legacy tests" - @echo " new launch new (ocamltest based) tests" @echo " all-foo launch all tests beginning with foo" @echo " parallel launch all tests using GNU parallel" @echo " parallel-foo launch all tests beginning with foo using \ @@ -85,26 +84,6 @@ default: .PHONY: all all: - @rm -f $(TESTLOG) - @$(MAKE) $(NO_PRINT) legacy-without-report - @$(MAKE) $(NO_PRINT) new-without-report - @$(MAKE) $(NO_PRINT) report - -.PHONY: legacy -legacy: - @rm -f $(TESTLOG) - @$(MAKE) $(NO_PRINT) legacy-without-report - @$(MAKE) $(NO_PRINT) report - -.PHONY: legacy-without-report -legacy-without-report: lib tools - @for dir in tests/*; do \ - $(MAKE) $(NO_PRINT) exec-one DIR=$$dir LEGACY=y; \ - done 2>&1 | tee -a $(TESTLOG) - @$(MAKE) $(NO_PRINT) retries - -.PHONY: new -new: @rm -f $(TESTLOG) @$(MAKE) $(NO_PRINT) new-without-report @$(MAKE) $(NO_PRINT) report @@ -112,8 +91,8 @@ new: .PHONY: new-without-report new-without-report: lib tools @rm -f $(failstamp) - @(for file in `$(find) tests -name ocamltests`; do \ - dir=`dirname $$file`; \ + @(IFS=$$(printf "\r\n"); \ + $(ocamltest) -find-test-dirs tests | while read dir; do \ echo Running tests from \'$$dir\' ... ; \ $(MAKE) exec-ocamltest DIR=$$dir \ OCAMLTESTENV="" OCAMLTESTFLAGS=""; \ @@ -208,33 +187,29 @@ one: lib tools .PHONY: exec-one exec-one: - @if [ ! -f $(DIR)/Makefile -a ! -f $(DIR)/ocamltests ]; then \ + @if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \ + echo "Running tests from '$$DIR' ..."; \ + $(MAKE) exec-ocamltest DIR=$(DIR) \ + OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \ + OCAMLTESTFLAGS=""; \ + else \ for dir in $(DIR)/*; do \ if [ -d $$dir ]; then \ $(MAKE) exec-one DIR=$$dir; \ fi; \ done; \ - elif [ -f $(DIR)/Makefile ]; then \ - echo "Running tests from '$$DIR' ..."; \ - cd $(DIR) && \ - $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) || echo '=> unexpected error'; \ - elif [ -f $(DIR)/ocamltests ] && [ -z $(LEGACY) ] ; then \ - echo "Running tests from '$$DIR' ..."; \ - $(MAKE) exec-ocamltest DIR=$(DIR) \ - OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \ - OCAMLTESTFLAGS=""; \ fi .PHONY: exec-ocamltest exec-ocamltest: @if [ -z "$(DIR)" ]; then exit 1; fi @if [ ! -d "$(DIR)" ]; then exit 1; fi - @file=$(DIR)/ocamltests; \ - (IFS=$$(printf "\r\n"); while read testfile; do \ + @(IFS=$$(printf "\r\n"); \ + $(ocamltest) -list-tests $(DIR) | while read testfile; do \ TERM=dumb $(OCAMLTESTENV) \ $(ocamltest) $(OCAMLTESTFLAGS) $(DIR)/$$testfile || \ echo " ... testing '$$testfile' => unexpected error"; \ - done < $$file) || echo directory "$(DIR)" >>$(failstamp) + done) || echo directory "$(DIR)" >>$(failstamp) .PHONY: clean-one clean-one: @@ -258,7 +233,7 @@ promote: echo "Directory '$(DIR)' does not exist."; \ exit 1; \ fi - @if [ -f $(DIR)/ocamltests ]; then \ + @if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \ $(MAKE) exec-ocamltest DIR=$(DIR) \ OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \ OCAMLTESTFLAGS="-promote"; \ @@ -268,7 +243,7 @@ promote: .PHONY: lib lib: - @cd lib && $(MAKE) -s BASEDIR=$(BASEDIR) + @$(MAKE) -s -C lib .PHONY: tools tools: @@ -276,18 +251,15 @@ tools: .PHONY: clean clean: - @cd lib && $(MAKE) BASEDIR=$(BASEDIR) clean + @$(MAKE) -C lib clean @cd tools && $(MAKE) BASEDIR=$(BASEDIR) clean - @for file in `$(FIND) interactive tests -name Makefile`; do \ - (cd `dirname $$file` && $(MAKE) BASEDIR=$(BASEDIR) clean); \ - done $(FIND) . -name '*_ocamltest*' | xargs rm -rf rm -f $(failstamp) .PHONY: report report: @if [ ! -f $(TESTLOG) ]; then echo "No $(TESTLOG) file."; exit 1; fi - @awk -f makefiles/summarize.awk < $(TESTLOG) + @awk -f summarize.awk < $(TESTLOG) .PHONY: retry-list retry-list: @@ -303,7 +275,7 @@ retry-list: .PHONY: retries retries: @awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \ - -f makefiles/summarize.awk < $(TESTLOG) > _retries + -f summarize.awk < $(TESTLOG) > _retries @test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list @rm -f _retries diff --git a/testsuite/interactive/lib-gc/Makefile b/testsuite/interactive/lib-gc/Makefile deleted file mode 100644 index 9ad7bd74..00000000 --- a/testsuite/interactive/lib-gc/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Clerc, SED, INRIA Rocquencourt * -#* * -#* Copyright 2010 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -BASEDIR=../.. - -default: - @$(OCAMLC) -o program.byte alloc.ml - @./program.byte - @$(OCAMLOPT) -o program.native alloc.ml - @./program.native - -clean: defaultclean - @rm -fr program.* - -include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/interactive/lib-gc/alloc.ml b/testsuite/interactive/lib-gc/alloc.ml deleted file mode 100644 index cd10d2ed..00000000 --- a/testsuite/interactive/lib-gc/alloc.ml +++ /dev/null @@ -1,51 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Random allocation test *) - -(* - Allocate arrays of strings, of random sizes in [0..1000[, and put them - into an array of 32768. Replace a randomly-selected array with a new - random-length array. Reiterate ad infinitum. -*) - -let l = 32768;; -let m = 1000;; - -let ar = Array.make l "";; - -Random.init 1234;; - -let compact_flag = ref false;; - -let main () = - while true do - for i = 1 to 100000 do - ar.(Random.int l) <- String.create (Random.int m); - done; - if !compact_flag then Gc.compact () else Gc.full_major (); - print_newline (); - Gc.print_stat stdout; - flush stdout; - done -;; - -let argspecs = [ - "-c", Arg.Set compact_flag, "do heap compactions"; -];; - -Arg.parse argspecs (fun _ -> ()) "Usage: alloc [-c]";; - -main ();; diff --git a/testsuite/interactive/lib-signals/Makefile b/testsuite/interactive/lib-signals/Makefile deleted file mode 100644 index 659c2216..00000000 --- a/testsuite/interactive/lib-signals/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Clerc, SED, INRIA Rocquencourt * -#* * -#* Copyright 2010 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -BASEDIR=../.. - -default: - @$(OCAMLC) -o program.byte signals.ml - @./program.byte - @$(OCAMLOPT) -o program.native signals.ml - @./program.native - -clean: defaultclean - @rm -fr program.* - -include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/interactive/lib-signals/signals.ml b/testsuite/interactive/lib-signals/signals.ml deleted file mode 100644 index 0d737cca..00000000 --- a/testsuite/interactive/lib-signals/signals.ml +++ /dev/null @@ -1,47 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1995 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -let rec tak (x, y, z) = - if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y)) - else z - -let break_handler _ = - print_string "Thank you for pressing ctrl-C."; print_newline(); - print_string "Allocating a bit..."; flush stdout; - ignore (tak(18,12,6)); print_string "done."; print_newline() - -let stop_handler _ = - print_string "Thank you for pressing ctrl-Z."; print_newline(); - print_string "Now raising an exception..."; print_newline(); - raise Exit - -let _ = - ignore (Sys.signal Sys.sigint (Sys.Signal_handle break_handler)); - ignore (Sys.signal Sys.sigtstp (Sys.Signal_handle stop_handler)); - begin try - print_string "Computing like crazy..."; print_newline(); - for i = 1 to 1000 do ignore (tak(18,12,6)) done; - print_string "Reading on input..."; print_newline(); - for i = 1 to 5 do - try - let s = read_line () in - print_string ">> "; print_string s; print_newline() - with Exit -> - print_string "Got Exit, continuing."; print_newline() - done - with Exit -> - print_string "Got Exit, exiting."; print_newline() - end; - exit 0 diff --git a/testsuite/lib/Makefile b/testsuite/lib/Makefile index 8373eef9..982d021f 100644 --- a/testsuite/lib/Makefile +++ b/testsuite/lib/Makefile @@ -13,25 +13,38 @@ #* * #************************************************************************** -.PHONY: compile -compile: compile-targets +TOPDIR = ../.. +COMPFLAGS ?= +RUNTIME_VARIANT ?= -.PHONY: promote -promote: defaultpromote +include $(TOPDIR)/Makefile.tools -.PHONY: clean -clean: defaultclean +libraries := testing.cmi testing.cma lib.cmo -include ../makefiles/Makefile.common +# If the native compiler is enabled, then also compile testing.cmxa +ifeq "$(NATIVE_COMPILER)" "true" +libraries += testing.cmxa +endif -.PHONY: compile-targets -compile-targets: testing.cmi testing.cma lib.cmo - @if $(BYTECODE_ONLY); then : ; else \ - $(MAKE) testing.cmxa; \ - fi +all: $(libraries) testing.cma: testing.cmo - $(OCAMLC) -a -linkall $(ADD_COMPFLAGS) -o $@ $< + $(OCAMLC) -a -linkall -o $@ $< testing.cmxa: testing.cmx - $(OCAMLOPT) -a -linkall $(ADD_COMPFLAGS) -o $@ $< + $(OCAMLOPT) -a -linkall -o $@ $< + +testing.cmo : testing.cmi + +%.cmi: %.mli + $(OCAMLC) -c $< + +%.cmo: %.ml + $(OCAMLC) -c $< + +%.cmx: %.ml + $(OCAMLOPT) -c $< + +.PHONY: clean +clean: + rm -f *.cm* *.$(O) *.$(A) diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common deleted file mode 100644 index 34500493..00000000 --- a/testsuite/makefiles/Makefile.common +++ /dev/null @@ -1,84 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Clerc, SED, INRIA Rocquencourt * -#* * -#* Copyright 2010 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -TOPDIR=$(BASEDIR)/.. -include $(TOPDIR)/Makefile.tools - -codegen := $(OTOPDIR)/testsuite/tools/codegen - -.PHONY: defaultpromote -defaultpromote: - @for file in *.reference; do \ - cp `basename $$file reference`result $$file; \ - done - -.PHONY: defaultclean -defaultclean: - @rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.cmxs *.$(O) *.$(SO) *.$(A) *.exe - @rm -f *.exe.manifest - @for dsym in *.dSYM; do \ - if [ -d $$dsym ]; then \ - rm -fr $$dsym; \ - fi \ - done - -.SUFFIXES: -.SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .$(O) .so .c .f - -.mli.cmi: - @$(OCAMLC) -c $(ADD_COMPFLAGS) $< - -.ml.cmi: - @$(OCAMLC) -c $(ADD_COMPFLAGS) $< - -.ml.cmo: - @if [ -f $ /dev/null - -.mll.ml: - @$(OCAMLLEX) -q $< > /dev/null - -.cmm.s: - @$(OCAMLRUN) $(codegen) -S $*.cmm - -.cmm.obj: - @$(OCAMLRUN) $(codegen) $*.cmm > $*.s - @set -o pipefail ; \ - $(ASM) $*.obj $*.s | tail -n +2 - -.S.o: - @$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S - -.PRECIOUS: %.s -.s.o: - @$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -o $*.o $*.s - -.c.o: - @$(CC) $(OC_CFLAGS) -c -I$(CTOPDIR)/runtime $*.c -o $*.$(O) - -.f.o: - @$(FORTRAN_COMPILER) -c -I$(CTOPDIR)/runtime $*.f -o $*.$(O) diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one deleted file mode 100644 index c6b797f1..00000000 --- a/testsuite/makefiles/Makefile.one +++ /dev/null @@ -1,104 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Clerc, SED, INRIA Rocquencourt * -#* * -#* Copyright 2010 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -CMI_FILES=$(MODULES:=.cmi) -CMO_FILES=$(MODULES:=.cmo) -CMX_FILES=$(MODULES:=.cmx) -CMA_FILES=$(LIBRARIES:=.cma) -CMXA_FILES=$(LIBRARIES:=.cmxa) -ML_LEX_FILES=$(LEX_MODULES:=.ml) -ML_YACC_FILES=$(YACC_MODULES:=.ml) -MLI_YACC_FILES=$(YACC_MODULES:=.mli) -ML_FILES=$(ML_LEX_FILES) $(ML_YACC_FILES) -O_FILES=$(C_FILES:=.$(O)) -ADD_CMO_FILES=$(ADD_MODULES:=.cmo) -ADD_CMX_FILES=$(ADD_MODULES:=.cmx) - -GENERATED_SOURCES=$(ML_LEX_FILES) $(ML_YACC_FILES) $(MLI_YACC_FILES) - -CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi` -ADD_CFLAGS+=$(CUSTOM_FLAG) -MYRUNTIME=`if [ -z "$(C_FILES)$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi` - -C_INCLUDES+=-I $(CTOPDIR)/runtime - -.PHONY: default -default: - @$(MAKE) compile - @$(NATIVECODE_ONLY) && $(BYTECODE_ONLY) \ - && echo " ... testing => skipped" \ - || $(SET_LD_PATH) $(MAKE) run - -# See run-file in Makefile.several for the use of mktemp (included for -# completeness; should be unnecessary) -.PHONY: compile -compile: $(ML_FILES) - @for file in $(C_FILES); do \ - $(OCAMLC) -c $(C_INCLUDES) $$file.c; \ - done - @if $(NATIVECODE_ONLY); then : ; else \ - test -e program.byte.exe && { \ - T="`mktemp -p .`"; \ - mv -f program.byte.exe "$$T"; \ - rm -f "$$T"; \ - } ; \ - rm -f program.byte program.byte.exe; \ - $(MAKE) $(CMO_FILES) $(MAIN_MODULE).cmo; \ - $(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte$(EXE) \ - $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \ - $(MAIN_MODULE).cmo; \ - fi - @if $(BYTECODE_ONLY); then : ; else \ - test -e program.native.exe && { \ - T="`mktemp -p .`"; \ - mv -f program.native.exe "$$T"; \ - rm -f "$$T"; \ - } ; \ - rm -f program.native program.native.exe; \ - $(MAKE) $(CMX_FILES) $(MAIN_MODULE).cmx; \ - $(OCAMLOPT) $(ADD_COMPFLAGS) $(ADD_OPTCOMPFLAGS) \ - -o program.native$(EXE) $(O_FILES) \ - $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \ - $(MAIN_MODULE).cmx; \ - fi - -.PHONY: run -run: - @printf " ... testing with" - @if $(NATIVECODE_ONLY); then : ; else \ - printf " ocamlc"; \ - FLAMBDA=$(FLAMBDA) $(MYRUNTIME) ./program.byte$(EXE) $(EXEC_ARGS) \ - >$(MAIN_MODULE).result \ - && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \ - >/dev/null; \ - fi \ - && if $(BYTECODE_ONLY); then : ; else \ - printf " ocamlopt"; \ - FLAMBDA=$(FLAMBDA) ./program.native$(EXE) $(EXEC_ARGS) \ - > $(MAIN_MODULE).result \ - && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \ - >/dev/null; \ - fi \ - && echo " => passed" || echo " => failed" - - -.PHONY: promote -promote: defaultpromote - -.PHONY: clean -clean: defaultclean - @rm -f *.result program.byte program.byte.exe \ - program.native program.native.exe \ - $(GENERATED_SOURCES) $(O_FILES) $(TEST_TEMP_FILES) diff --git a/testsuite/makefiles/summarize.awk b/testsuite/makefiles/summarize.awk deleted file mode 100644 index b185c672..00000000 --- a/testsuite/makefiles/summarize.awk +++ /dev/null @@ -1,227 +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 GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -function check() { - if (!in_test){ - printf("error at line %d: found test result without test start\n", NR); - errored = 1; - } -} - -function clear() { - curfile = ""; - in_test = 0; -} - -function record_pass() { - check(); - if (!(key in RESULTS)) ++nresults; - RESULTS[key] = "p"; - delete SKIPPED[curdir]; - clear(); -} - -function record_skip() { - check(); - if (!(key in RESULTS)) ++nresults; - RESULTS[key] = "s"; - if (curdir in SKIPPED) SKIPPED[curdir] = 1; - clear(); -} - -function record_na() { - check(); - if (!(key in RESULTS)) ++nresults; - RESULTS[key] = "n"; - if (curdir in SKIPPED) SKIPPED[curdir] = 1; - 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(); - if (!(key in RESULTS) || RESULTS[key] == "s"){ - if (!(key in RESULTS)) ++nresults; - RESULTS[key] = "f"; - } - delete SKIPPED[curdir]; - clear(); -} - -function record_unexp() { - if (!(key in RESULTS) || RESULTS[key] == "s"){ - if (!(key in RESULTS)) ++nresults; - RESULTS[key] = "e"; - } - delete SKIPPED[curdir]; - clear(); -} - -/Running tests from '[^']*'/ { - if (in_test) record_unexp(); - match($0, /Running tests from '[^']*'/); - curdir = substr($0, RSTART+20, RLENGTH - 21); - # Use SKIPPED[curdir] as a sentinel to detect no output - SKIPPED[curdir] = 0; - key = curdir; - DIRS[key] = key; - curfile = ""; -} - -/ ... testing.* ... testing/ { - printf("error at line %d: found two test results on the same line\n", NR); - errored = 1; -} - -/^ ... testing '[^']*'/ { - if (in_test) record_unexp(); - match($0, /... testing '[^']*'/); - curfile = substr($0, RSTART+13, RLENGTH-14); - if (match($0, /... testing '[^']*' with [^:=]*/)){ - curfile = substr($0, RSTART+12, RLENGTH-12); - } - 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; -} - -/=> passed/ { - record_pass(); -} - -/=> skipped/ { - record_skip(); -} - -/=> n\/a/ { - record_na(); -} - -/=> failed/ { - record_fail(); -} - -/=> unexpected error/ { - 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; - } -} - -END { - if (errored){ - printf ("\n#### Some fatal error occurred during testing.\n\n"); - 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"){ - ++ passed; - }else if (r == "f"){ - ++ failed; - fail[failidx++] = key; - }else if (r == "e"){ - ++ unexped; - unexp[unexpidx++] = key; - }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; - } - }else if (r == "n"){ - ++ ignored; - } - } - printf("\n"); - if (skipped != 0){ - 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]); - } - 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"); - printf("Summary:\n"); - printf(" %3d tests passed\n", passed); - printf(" %3d tests skipped\n", skipped); - printf(" %3d tests failed\n", failed); - printf(" %3d tests not started (parent test skipped or failed)\n", - ignored); - printf(" %3d unexpected errors\n", unexped); - printf(" %3d tests considered", nresults); - if (nresults != passed + skipped + ignored + failed + unexped){ - printf (" (totals don't add up??)"); - } - printf ("\n"); - if (reran != 0){ - printf(" %3d test dir re-runs\n", reran); - } - if (failed || unexped){ - printf("#### Something 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); - } - } - } - } - } - } -} diff --git a/testsuite/summarize.awk b/testsuite/summarize.awk new file mode 100644 index 00000000..b185c672 --- /dev/null +++ b/testsuite/summarize.awk @@ -0,0 +1,227 @@ +#************************************************************************** +#* * +#* 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 GNU Lesser General Public License version 2.1, with the * +#* special exception on linking described in the file LICENSE. * +#* * +#************************************************************************** + +function check() { + if (!in_test){ + printf("error at line %d: found test result without test start\n", NR); + errored = 1; + } +} + +function clear() { + curfile = ""; + in_test = 0; +} + +function record_pass() { + check(); + if (!(key in RESULTS)) ++nresults; + RESULTS[key] = "p"; + delete SKIPPED[curdir]; + clear(); +} + +function record_skip() { + check(); + if (!(key in RESULTS)) ++nresults; + RESULTS[key] = "s"; + if (curdir in SKIPPED) SKIPPED[curdir] = 1; + clear(); +} + +function record_na() { + check(); + if (!(key in RESULTS)) ++nresults; + RESULTS[key] = "n"; + if (curdir in SKIPPED) SKIPPED[curdir] = 1; + 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(); + if (!(key in RESULTS) || RESULTS[key] == "s"){ + if (!(key in RESULTS)) ++nresults; + RESULTS[key] = "f"; + } + delete SKIPPED[curdir]; + clear(); +} + +function record_unexp() { + if (!(key in RESULTS) || RESULTS[key] == "s"){ + if (!(key in RESULTS)) ++nresults; + RESULTS[key] = "e"; + } + delete SKIPPED[curdir]; + clear(); +} + +/Running tests from '[^']*'/ { + if (in_test) record_unexp(); + match($0, /Running tests from '[^']*'/); + curdir = substr($0, RSTART+20, RLENGTH - 21); + # Use SKIPPED[curdir] as a sentinel to detect no output + SKIPPED[curdir] = 0; + key = curdir; + DIRS[key] = key; + curfile = ""; +} + +/ ... testing.* ... testing/ { + printf("error at line %d: found two test results on the same line\n", NR); + errored = 1; +} + +/^ ... testing '[^']*'/ { + if (in_test) record_unexp(); + match($0, /... testing '[^']*'/); + curfile = substr($0, RSTART+13, RLENGTH-14); + if (match($0, /... testing '[^']*' with [^:=]*/)){ + curfile = substr($0, RSTART+12, RLENGTH-12); + } + 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; +} + +/=> passed/ { + record_pass(); +} + +/=> skipped/ { + record_skip(); +} + +/=> n\/a/ { + record_na(); +} + +/=> failed/ { + record_fail(); +} + +/=> unexpected error/ { + 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; + } +} + +END { + if (errored){ + printf ("\n#### Some fatal error occurred during testing.\n\n"); + 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"){ + ++ passed; + }else if (r == "f"){ + ++ failed; + fail[failidx++] = key; + }else if (r == "e"){ + ++ unexped; + unexp[unexpidx++] = key; + }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; + } + }else if (r == "n"){ + ++ ignored; + } + } + printf("\n"); + if (skipped != 0){ + 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]); + } + 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"); + printf("Summary:\n"); + printf(" %3d tests passed\n", passed); + printf(" %3d tests skipped\n", skipped); + printf(" %3d tests failed\n", failed); + printf(" %3d tests not started (parent test skipped or failed)\n", + ignored); + printf(" %3d unexpected errors\n", unexped); + printf(" %3d tests considered", nresults); + if (nresults != passed + skipped + ignored + failed + unexped){ + printf (" (totals don't add up??)"); + } + printf ("\n"); + if (reran != 0){ + printf(" %3d test dir re-runs\n", reran); + } + if (failed || unexped){ + printf("#### Something 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); + } + } + } + } + } + } +} diff --git a/testsuite/tests/afl-instrumentation/ocamltests b/testsuite/tests/afl-instrumentation/ocamltests deleted file mode 100644 index 99ac64b6..00000000 --- a/testsuite/tests/afl-instrumentation/ocamltests +++ /dev/null @@ -1 +0,0 @@ -afltest.ml diff --git a/testsuite/tests/arch-power/ocamltests b/testsuite/tests/arch-power/ocamltests deleted file mode 100644 index 03fa29c9..00000000 --- a/testsuite/tests/arch-power/ocamltests +++ /dev/null @@ -1 +0,0 @@ -exn_raise.ml diff --git a/testsuite/tests/array-functions/ocamltests b/testsuite/tests/array-functions/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/array-functions/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/asmcomp/func_sections.arm.reference b/testsuite/tests/asmcomp/func_sections.arm.reference new file mode 100644 index 00000000..b6a7d89c --- /dev/null +++ b/testsuite/tests/asmcomp/func_sections.arm.reference @@ -0,0 +1 @@ +16 diff --git a/testsuite/tests/asmcomp/func_sections.ml b/testsuite/tests/asmcomp/func_sections.ml new file mode 100644 index 00000000..7a58afc6 --- /dev/null +++ b/testsuite/tests/asmcomp/func_sections.ml @@ -0,0 +1,73 @@ +(* TEST +* function_sections +flags = "-S -function-sections" +** arch_arm +*** native +reference = "${test_source_directory}/func_sections.arm.reference" +** arch_arm64 +*** native +reference = "${test_source_directory}/func_sections.arm.reference" +** arch_amd64 +*** native +reference = "${test_source_directory}/func_sections.reference" +** arch_i386 +*** native +reference = "${test_source_directory}/func_sections.reference" +*) + +(* We have a separate reference output for ARM because + it doesn't emit .text after jump tables. *) + +(* Test for anonymous functions which result in a mangled symbol *) +let f4 list = + List.map (fun s -> String.length s) list + +let test1 () = + f4 ["a";"asfda";"afda"] + +(* Test for jump tables*) + +let g1 s = s^"*" +let g2 s = "*"^s +let g3 s = "*"^s^"*" + +let f5 = function + | 1 -> g1 "a" + | 2 -> g2 "b" + | 3 -> g3 "c" + | 4 -> g1 "d" + | 5 -> g2 "e" + | 6 -> g3 "f" + | _ -> "x" + +let test2 () = + let list = [f5 5; + f5 7; + f5 15; + f5 26] + in + ignore list + +let iter = 1_000 + +let f0 x = x - 7; +[@@inline never] + +let f1 x = x + iter +[@@inline never] + +let f2 x = f1(x) +[@@inline never] + +let f3 x = f2(x)*f0(x) +[@@inline never] + +let test3 () = + f3 iter + + +let () = + ignore (test1 ()); + ignore (test2 ()); + ignore (test3 ()); + () diff --git a/testsuite/tests/asmcomp/func_sections.reference b/testsuite/tests/asmcomp/func_sections.reference new file mode 100644 index 00000000..98d9bcb7 --- /dev/null +++ b/testsuite/tests/asmcomp/func_sections.reference @@ -0,0 +1 @@ +17 diff --git a/testsuite/tests/asmcomp/func_sections.run b/testsuite/tests/asmcomp/func_sections.run new file mode 100755 index 00000000..a9323be0 --- /dev/null +++ b/testsuite/tests/asmcomp/func_sections.run @@ -0,0 +1,10 @@ +#!/bin/sh + +exec > "${output}" 2>&1 + +# first, run the program to make sure it doesn't crash +${program} + +# now check the assembly file produced during compilation +asm=${test_build_directory}/func_sections.s +grep ".section .text.caml.camlFunc_sections__" "$asm" | wc -l | tr -d ' ' | sed '/^$/d' diff --git a/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml b/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml new file mode 100644 index 00000000..8c8b017d --- /dev/null +++ b/testsuite/tests/asmcomp/lift_mutable_let_flambda.ml @@ -0,0 +1,29 @@ +(* TEST + * flambda + ** native +*) + +type t = T of { pos : int } + +let[@inline always] find_pos i = + let i = ref i in + let pos = !i in + T {pos} + +let[@inline always] use_pos i = + let (T {pos}) = find_pos i in + pos * 2 + + +let f () = + let x0 = Gc.allocated_bytes () in + let x1 = Gc.allocated_bytes () in + + let n : int = (Sys.opaque_identity use_pos) 10 in + + let x2 = Gc.allocated_bytes () in + assert (n = 20); + assert(x1 -. x0 = x2 -. x1) (* check no allocation between x1 and x2 *) + [@@inline never] + +let () = f () diff --git a/testsuite/tests/asmcomp/ocamltests b/testsuite/tests/asmcomp/ocamltests deleted file mode 100644 index bcd126df..00000000 --- a/testsuite/tests/asmcomp/ocamltests +++ /dev/null @@ -1,11 +0,0 @@ -bind_tuples.ml -is_static_flambda.ml -is_static.ml -optargs.ml -register_typing.ml -register_typing_switch.ml -staticalloc.ml -static_float_array_flambda.ml -static_float_array_flambda_opaque.ml -unrolling_flambda2.ml -unrolling_flambda.ml diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.cmm b/testsuite/tests/asmgen/catch-rec-deadhandler.cmm new file mode 100644 index 00000000..34dc8a26 --- /dev/null +++ b/testsuite/tests/asmgen/catch-rec-deadhandler.cmm @@ -0,0 +1,17 @@ +(* TEST +flags = "-dlive" +files = "main.c" +arguments = "-DUNIT_INT -DFUN=catch_rec_deadhandler main.c" +* asmgen +** run +*** check-program-output +*) + +(function "catch_rec_deadhandler" () + (let x + (catch + (exit one) + with (one) 1 + and (two) (exit three) + and (three) 3) + x)) diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.reference b/testsuite/tests/asmgen/catch-rec-deadhandler.reference new file mode 100644 index 00000000..6ac08fb0 --- /dev/null +++ b/testsuite/tests/asmgen/catch-rec-deadhandler.reference @@ -0,0 +1,6 @@ + catch rec + exit(1) + with(1) + catch rec + exit(1) + with(1) diff --git a/testsuite/tests/asmgen/catch-rec-deadhandler.run b/testsuite/tests/asmgen/catch-rec-deadhandler.run new file mode 100755 index 00000000..bad9f117 --- /dev/null +++ b/testsuite/tests/asmgen/catch-rec-deadhandler.run @@ -0,0 +1,5 @@ +#!/bin/sh + +exec > "${output}" 2>&1 + +grep -E "catch |with\(|and\(|exit\(" "${compiler_output}" diff --git a/testsuite/tests/asmgen/ocamltests b/testsuite/tests/asmgen/ocamltests deleted file mode 100644 index 06e3fe0a..00000000 --- a/testsuite/tests/asmgen/ocamltests +++ /dev/null @@ -1,21 +0,0 @@ -arith.cmm -catch-rec.cmm -catch-try.cmm -catch-float.cmm -catch-multiple.cmm -catch-try-float.cmm -checkbound.cmm -even-odd-spill.cmm -even-odd-spill-float.cmm -even-odd.cmm -fib.cmm -integr.cmm -pgcd.cmm -quicksort.cmm -quicksort2.cmm -soli.cmm -tagged-fib.cmm -tagged-integr.cmm -tagged-quicksort.cmm -tagged-tak.cmm -tak.cmm diff --git a/testsuite/tests/asmgen/quicksort.cmm b/testsuite/tests/asmgen/quicksort.cmm index 7779780f..80320505 100644 --- a/testsuite/tests/asmgen/quicksort.cmm +++ b/testsuite/tests/asmgen/quicksort.cmm @@ -27,16 +27,16 @@ arguments = "-DSORT -DFUN=quicksort main.c" (while (< i j) (catch (while 1 - (if (>= i hi) exit []) - (if (> (addraref a i) pivot) exit []) + (if (>= i hi) (exit n25) []) + (if (> (addraref a i) pivot) (exit n25) []) (assign i (+ i 1))) - with []) + with (n25) []) (catch (while 1 - (if (<= j lo) exit []) - (if (< (addraref a j) pivot) exit []) + (if (<= j lo) (exit n35) []) + (if (< (addraref a j) pivot) (exit n35) []) (assign j (- j 1))) - with []) + with (n35) []) (if (< i j) (let temp (addraref a i) (addraset a i (addraref a j)) diff --git a/testsuite/tests/asmgen/quicksort2.cmm b/testsuite/tests/asmgen/quicksort2.cmm index 2c6b278e..4e5a6c68 100644 --- a/testsuite/tests/asmgen/quicksort2.cmm +++ b/testsuite/tests/asmgen/quicksort2.cmm @@ -30,16 +30,16 @@ arguments = "-DSORT -DFUN=quicksort main.c" (while (< i j) (catch (while 1 - (if (>= i hi) exit []) - (if (> (app cmp (intaref a i) pivot int) 0) exit []) + (if (>= i hi) (exit n25) []) + (if (> (app cmp (intaref a i) pivot int) 0) (exit n25) []) (assign i (+ i 1))) - with []) + with (n25) []) (catch (while 1 - (if (<= j lo) exit []) - (if (< (app cmp (intaref a j) pivot int) 0) exit []) + (if (<= j lo) (exit n35) []) + (if (< (app cmp (intaref a j) pivot int) 0) (exit n35) []) (assign j (- j 1))) - with []) + with (n35) []) (if (< i j) (let temp (intaref a i) (intaset a i (intaref a j)) diff --git a/testsuite/tests/asmgen/tagged-quicksort.cmm b/testsuite/tests/asmgen/tagged-quicksort.cmm index 7c2ce6ef..f2255148 100644 --- a/testsuite/tests/asmgen/tagged-quicksort.cmm +++ b/testsuite/tests/asmgen/tagged-quicksort.cmm @@ -27,16 +27,16 @@ arguments = "-DSORT -DFUN=quicksort main.c" (while (< i j) (catch (while 1 - (if (>= i hi) exit []) - (if (> (addraref a (>>s i 1)) pivot) exit []) + (if (>= i hi) (exit n25) []) + (if (> (addraref a (>>s i 1)) pivot) (exit n25) []) (assign i (+ i 2))) - with []) + with (n25) []) (catch (while 1 - (if (<= j lo) exit []) - (if (< (addraref a (>>s j 1)) pivot) exit []) + (if (<= j lo) (exit n35) []) + (if (< (addraref a (>>s j 1)) pivot) (exit n35) []) (assign j (- j 2))) - with []) + with (n35) []) (if (< i j) (let temp (addraref a (>>s i 1)) (addraset a (>>s i 1) (addraref a (>>s j 1))) diff --git a/testsuite/tests/ast-invariants/ocamltests b/testsuite/tests/ast-invariants/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/ast-invariants/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/backtrace/backtrace2.byte.reference b/testsuite/tests/backtrace/backtrace2.byte.reference index 296d4328..635eb09a 100644 --- a/testsuite/tests/backtrace/backtrace2.byte.reference +++ b/testsuite/tests/backtrace/backtrace2.byte.reference @@ -35,7 +35,7 @@ Uncaught exception Invalid_argument("index out of bounds") Raised by primitive operation at file "backtrace2.ml", line 67, characters 14-22 test_Not_found Uncaught exception Not_found -Raised at file "hashtbl.ml", line 194, characters 19-28 +Raised at file "hashtbl.ml", line 537, characters 19-28 Called from file "backtrace2.ml", line 48, characters 9-42 Re-raised at file "backtrace2.ml", line 48, characters 67-70 Called from file "backtrace2.ml", line 67, characters 11-23 @@ -50,7 +50,7 @@ Called from file "camlinternalLazy.ml", line 31, characters 17-27 Re-raised at file "camlinternalLazy.ml", line 36, characters 10-11 Called from file "backtrace2.ml", line 67, characters 11-23 Uncaught exception Not_found -Raised at file "hashtbl.ml", line 194, characters 19-28 +Raised at file "hashtbl.ml", line 537, characters 19-28 Called from file "backtrace2.ml", line 55, characters 8-41 Re-raised at file "camlinternalLazy.ml", line 35, characters 62-63 Called from file "camlinternalLazy.ml", line 31, characters 17-27 diff --git a/testsuite/tests/backtrace/backtrace2.opt.reference b/testsuite/tests/backtrace/backtrace2.opt.reference index 2c246e2d..e81e2807 100644 --- a/testsuite/tests/backtrace/backtrace2.opt.reference +++ b/testsuite/tests/backtrace/backtrace2.opt.reference @@ -35,7 +35,7 @@ Uncaught exception Invalid_argument("index out of bounds") Raised by primitive operation at file "backtrace2.ml", line 67, characters 14-22 test_Not_found Uncaught exception Not_found -Raised at file "hashtbl.ml", line 194, characters 13-28 +Raised at file "hashtbl.ml", line 537, characters 13-28 Called from file "backtrace2.ml", line 48, characters 9-42 Re-raised at file "backtrace2.ml", line 48, characters 61-70 Called from file "backtrace2.ml", line 67, characters 11-23 @@ -50,7 +50,7 @@ Called from file "camlinternalLazy.ml", line 31, characters 17-27 Re-raised at file "camlinternalLazy.ml", line 36, characters 4-11 Called from file "backtrace2.ml", line 67, characters 11-23 Uncaught exception Not_found -Raised at file "hashtbl.ml", line 194, characters 13-28 +Raised at file "hashtbl.ml", line 537, characters 13-28 Called from file "backtrace2.ml", line 55, characters 8-41 Re-raised at file "camlinternalLazy.ml", line 35, characters 56-63 Called from file "camlinternalLazy.ml", line 31, characters 17-27 diff --git a/testsuite/tests/backtrace/callstack.ml b/testsuite/tests/backtrace/callstack.ml index 76bf9f96..a9311ab4 100644 --- a/testsuite/tests/backtrace/callstack.ml +++ b/testsuite/tests/backtrace/callstack.ml @@ -17,3 +17,8 @@ let () = Printf.printf "main thread:\n" let () = f3 () let () = Printf.printf "new thread:\n" let () = Thread.join (Thread.create f3 ()) + +let () = + Gc.finalise (fun _ -> f0 ()) [|1|]; + Gc.full_major (); + () diff --git a/testsuite/tests/backtrace/callstack.reference b/testsuite/tests/backtrace/callstack.reference index 33fa9a81..3f70887e 100644 --- a/testsuite/tests/backtrace/callstack.reference +++ b/testsuite/tests/backtrace/callstack.reference @@ -10,3 +10,5 @@ Called from file "callstack.ml", line 13, characters 27-32 Called from file "callstack.ml", line 14, characters 27-32 Called from file "callstack.ml", line 15, characters 27-32 Called from file "thread.ml", line 39, characters 8-14 +Raised by primitive operation at file "callstack.ml", line 12, characters 38-66 +Called from file "callstack.ml", line 23, characters 2-18 diff --git a/testsuite/tests/backtrace/ocamltests b/testsuite/tests/backtrace/ocamltests deleted file mode 100644 index 6d70aec2..00000000 --- a/testsuite/tests/backtrace/ocamltests +++ /dev/null @@ -1,13 +0,0 @@ -backtrace.ml -backtrace2.ml -backtrace3.ml -backtrace_deprecated.ml -backtrace_or_exception.ml -backtrace_slots.ml -backtraces_and_finalizers.ml -callstack.ml -inline_test.ml -inline_traversal_test.ml -pr6920_why_at.ml -pr6920_why_swallow.ml -raw_backtrace.ml diff --git a/testsuite/tests/basic-float/ocamltests b/testsuite/tests/basic-float/ocamltests deleted file mode 100644 index c2fc78d5..00000000 --- a/testsuite/tests/basic-float/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -tfloat_hex.ml -tfloat_record.ml -zero_sized_float_arrays.ml -float_literals.ml diff --git a/testsuite/tests/basic-io-2/ocamltests b/testsuite/tests/basic-io-2/ocamltests deleted file mode 100644 index 9ab7106a..00000000 --- a/testsuite/tests/basic-io-2/ocamltests +++ /dev/null @@ -1 +0,0 @@ -io.ml diff --git a/testsuite/tests/basic-io/ocamltests b/testsuite/tests/basic-io/ocamltests deleted file mode 100644 index 1a75b9a0..00000000 --- a/testsuite/tests/basic-io/ocamltests +++ /dev/null @@ -1 +0,0 @@ -wc.ml diff --git a/testsuite/tests/basic-manyargs/ocamltests b/testsuite/tests/basic-manyargs/ocamltests deleted file mode 100644 index b381a763..00000000 --- a/testsuite/tests/basic-manyargs/ocamltests +++ /dev/null @@ -1 +0,0 @@ -manyargs.ml diff --git a/testsuite/tests/basic-modules/anonymous.ml b/testsuite/tests/basic-modules/anonymous.ml new file mode 100644 index 00000000..dd8546c3 --- /dev/null +++ b/testsuite/tests/basic-modules/anonymous.ml @@ -0,0 +1,43 @@ +(* TEST +flags = "-c -nostdlib -nopervasives -dlambda -dno-unique-ids" +* setup-ocamlc.byte-build-env +** ocamlc.byte +*** check-ocamlc.byte-output +compiler_reference = "${test_source_directory}/anonymous.ocamlc.reference" + +* setup-ocamlopt.byte-build-env +** ocamlopt.byte +*** no-flambda +**** check-ocamlopt.byte-output +compiler_reference = "${test_source_directory}/anonymous.ocamlopt.reference" +*** flambda +**** check-ocamlc.byte-output +compiler_reference = + "${test_source_directory}/anonymous.ocamlopt.flambda.reference" +*) + +module _ = struct + let x = 13, 37 +end + +module rec A : sig + type t = B.t +end = A +and _ : sig + type t = A.t + val x : int * int +end = struct + type t = B.t + let x = 4, 2 +end +and B : sig + type t +end = struct + type t + + let x = "foo", "bar" +end + +module type S + +let f (module _ : S) = () diff --git a/testsuite/tests/basic-modules/anonymous.ocamlc.reference b/testsuite/tests/basic-modules/anonymous.ocamlc.reference new file mode 100644 index 00000000..f048af85 --- /dev/null +++ b/testsuite/tests/basic-modules/anonymous.ocamlc.reference @@ -0,0 +1,16 @@ +(setglobal Anonymous! + (seq (ignore (let (x = [0: 13 37]) (makeblock 0 x))) + (let + (A = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6] + [0: [0]]) + B = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6] + [0: [0]])) + (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x))) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] A + (module-defn(A) anonymous.ml(23):567-608 A)) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] B + (module-defn(B) anonymous.ml(33):703-773 + (let (x = [0: "foo" "bar"]) (makeblock 0)))) + (let (f = (function param 0a)) (makeblock 0 A B f)))))) diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference new file mode 100644 index 00000000..2d5daff4 --- /dev/null +++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference @@ -0,0 +1,15 @@ +(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x))) + (let + (A = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6] + [0: [0]]) + B = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6] + [0: [0]])) + (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x))) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] A + (module-defn(A) anonymous.ml(23):567-608 A)) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] B + (module-defn(B) anonymous.ml(33):703-773 + (let (x = [0: "foo" "bar"]) (makeblock 0)))) + (let (f = (function param 0a)) (makeblock 0 A B f))))) diff --git a/testsuite/tests/basic-modules/anonymous.ocamlopt.reference b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference new file mode 100644 index 00000000..5b12141e --- /dev/null +++ b/testsuite/tests/basic-modules/anonymous.ocamlopt.reference @@ -0,0 +1,17 @@ +(seq (ignore (let (x = [0: 13 37]) (makeblock 0 x))) + (let + (A = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 25 6] + [0: [0]]) + B = + (apply (field 0 (global CamlinternalMod!)) [0: "anonymous.ml" 35 6] + [0: [0]])) + (seq (ignore (let (x = [0: 4 2]) (makeblock 0 x))) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] A A) + (apply (field 1 (global CamlinternalMod!)) [0: [0]] B + (let (x = [0: "foo" "bar"]) (makeblock 0))) + (setfield_ptr(root-init) 0 (global Anonymous!) A) + (setfield_ptr(root-init) 1 (global Anonymous!) B) + (let (f = (function param 0a)) + (setfield_ptr(root-init) 2 (global Anonymous!) f)) + 0a))) diff --git a/testsuite/tests/basic-modules/ocamltests b/testsuite/tests/basic-modules/ocamltests deleted file mode 100644 index 57fba04f..00000000 --- a/testsuite/tests/basic-modules/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -main.ml -recursive_module_evaluation_errors.ml diff --git a/testsuite/tests/basic-more/ocamltests b/testsuite/tests/basic-more/ocamltests deleted file mode 100644 index 7c74cb79..00000000 --- a/testsuite/tests/basic-more/ocamltests +++ /dev/null @@ -1,17 +0,0 @@ -bounds.ml -div_by_zero.ml -function_in_ref.ml -if_in_if.ml -morematch.ml -opaque_prim.ml -pr1271.ml -pr2719.ml -pr6216.ml -record_evaluation_order.ml -robustmatch.ml -sequential_and_or.ml -structural_constants.ml -tbuffer.ml -testrandom.ml -top_level_patterns.ml -tprintf.ml diff --git a/testsuite/tests/basic-more/robustmatch.compilers.reference b/testsuite/tests/basic-more/robustmatch.compilers.reference index 06fa789b..fc580197 100644 --- a/testsuite/tests/basic-more/robustmatch.compilers.reference +++ b/testsuite/tests/basic-more/robustmatch.compilers.reference @@ -7,6 +7,15 @@ File "robustmatch.ml", lines 33-37, characters 6-23: Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (AB, MAB, A) +File "robustmatch.ml", lines 43-47, characters 4-21: +43 | ....match t1, t2, x with +44 | | AB, AB, A -> () +45 | | MAB, _, A -> () +46 | | _, AB, B -> () +47 | | _, MAB, B -> () +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +(AB, MAB, A) File "robustmatch.ml", lines 54-56, characters 4-27: 54 | ....match r1, r2, a with 55 | | R1, _, 0 -> () diff --git a/testsuite/tests/basic-multdef/ocamltests b/testsuite/tests/basic-multdef/ocamltests deleted file mode 100644 index 0b7c97db..00000000 --- a/testsuite/tests/basic-multdef/ocamltests +++ /dev/null @@ -1 +0,0 @@ -usemultdef.ml diff --git a/testsuite/tests/basic-private/ocamltests b/testsuite/tests/basic-private/ocamltests deleted file mode 100644 index dd926c3d..00000000 --- a/testsuite/tests/basic-private/ocamltests +++ /dev/null @@ -1 +0,0 @@ -tlength.ml diff --git a/testsuite/tests/basic/ocamltests b/testsuite/tests/basic/ocamltests deleted file mode 100644 index 8142a2b3..00000000 --- a/testsuite/tests/basic/ocamltests +++ /dev/null @@ -1,32 +0,0 @@ -arrays.ml -bigints.ml -boxedints.ml -constprop.ml.c -divint.ml -equality.ml -eval_order_1.ml -eval_order_2.ml -eval_order_3.ml -eval_order_4.ml -eval_order_6.ml -float.ml -float_physical_equality.ml -includestruct.ml -localexn.ml -localfunction.ml -maps.ml -min_int.ml -opt_variants.ml -patmatch.ml -patmatch_incoherence.ml -pr7253.ml -pr7533.ml -pr7657.ml -recvalues.ml -sets.ml -stringmatch.ml -switch_opts.ml -tailcalls.ml -trigraph.ml -unit_naming.ml -zero_divided_by_n.ml diff --git a/testsuite/tests/basic/patmatch_split_no_or.ml b/testsuite/tests/basic/patmatch_split_no_or.ml new file mode 100644 index 00000000..4f494656 --- /dev/null +++ b/testsuite/tests/basic/patmatch_split_no_or.ml @@ -0,0 +1,90 @@ +(* TEST + flags = "-nostdlib -nopervasives -dlambda" + * expect + *) + +(******************************************************************************) + +(* Check that the extra split indeed happens when the last row is made of + "variables" only *) + +let last_is_anys = function + | true, false -> 1 + | _, false -> 2 + | _, _ -> 3 +;; +[%%expect{| +(let + (last_is_anys/10 = + (function param/12 : int + (catch + (if (field 0 param/12) (if (field 1 param/12) (exit 1) 1) + (if (field 1 param/12) (exit 1) 2)) + with (1) 3))) + (apply (field 1 (global Toploop!)) "last_is_anys" last_is_anys/10)) +val last_is_anys : bool * bool -> int = +|}] + +let last_is_vars = function + | true, false -> 1 + | _, false -> 2 + | _x, _y -> 3 +;; +[%%expect{| +(let + (last_is_vars/17 = + (function param/21 : int + (catch + (if (field 0 param/21) (if (field 1 param/21) (exit 3) 1) + (if (field 1 param/21) (exit 3) 2)) + with (3) 3))) + (apply (field 1 (global Toploop!)) "last_is_vars" last_is_vars/17)) +val last_is_vars : bool * bool -> int = +|}] + +(******************************************************************************) + +(* Check that the [| _, false, true -> 12] gets raised. *) + +type t = .. +type t += A | B of unit | C of bool * int;; +[%%expect{| +0a +type t = .. +(let + (A/25 = (makeblock 248 "A" (caml_fresh_oo_id 0)) + B/26 = (makeblock 248 "B" (caml_fresh_oo_id 0)) + C/27 = (makeblock 248 "C" (caml_fresh_oo_id 0))) + (seq (apply (field 1 (global Toploop!)) "A/25" A/25) + (apply (field 1 (global Toploop!)) "B/26" B/26) + (apply (field 1 (global Toploop!)) "C/27" C/27))) +type t += A | B of unit | C of bool * int +|}] + +let f = function + | A, true, _ -> 1 + | _, false, false -> 11 + | B _, true, _ -> 2 + | C _, true, _ -> 3 + | _, false, true -> 12 + | _ -> 4 +;; +[%%expect{| +(let + (C/27 = (apply (field 0 (global Toploop!)) "C/27") + B/26 = (apply (field 0 (global Toploop!)) "B/26") + A/25 = (apply (field 0 (global Toploop!)) "A/25") + f/28 = + (function param/30 : int + (let (*match*/31 =a (field 0 param/30)) + (catch + (if (== *match*/31 A/25) (if (field 1 param/30) 1 (exit 8)) + (exit 8)) + with (8) + (if (field 1 param/30) + (if (== (field 0 *match*/31) B/26) 2 + (if (== (field 0 *match*/31) C/27) 3 4)) + (if (field 2 param/30) 12 11)))))) + (apply (field 1 (global Toploop!)) "f" f/28)) +val f : t * bool * bool -> int = +|}] diff --git a/testsuite/tests/c-api/alloc_async.ml b/testsuite/tests/c-api/alloc_async.ml new file mode 100644 index 00000000..0ed35acf --- /dev/null +++ b/testsuite/tests/c-api/alloc_async.ml @@ -0,0 +1,17 @@ +(* TEST + modules = "alloc_async_stubs.c" +*) + +external test : int ref -> unit = "stub" + +let f () = + let r = ref 42 in + Gc.finalise (fun s -> r := !s) (ref 17); + Printf.printf "OCaml, before: %d\n%!" !r; + test r; + Printf.printf "OCaml, after: %d\n%!" !r; + ignore (Sys.opaque_identity (ref 100)); + Printf.printf "OCaml, after alloc: %d\n%!" !r; + () + +let () = (f [@inlined never]) () diff --git a/testsuite/tests/c-api/alloc_async.reference b/testsuite/tests/c-api/alloc_async.reference new file mode 100644 index 00000000..839271f5 --- /dev/null +++ b/testsuite/tests/c-api/alloc_async.reference @@ -0,0 +1,5 @@ +OCaml, before: 42 +C, before: 42 +C, after: 42 +OCaml, after: 42 +OCaml, after alloc: 17 diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c new file mode 100644 index 00000000..7dec51ea --- /dev/null +++ b/testsuite/tests/c-api/alloc_async_stubs.c @@ -0,0 +1,54 @@ +#include +#include +#include "caml/alloc.h" +#include "caml/memory.h" + +const char* strs[] = { "foo", "bar", 0 }; +value stub(value ref) +{ + CAMLparam1(ref); + CAMLlocal2(x, y); + int i; char* s; intnat coll_before; + + printf("C, before: %d\n", Int_val(Field(ref, 0))); + + /* First, do enough major allocations to do a full major collection cycle */ + coll_before = Caml_state_field(stat_major_collections); + while (Caml_state_field(stat_major_collections) <= coll_before+1) { + caml_alloc(10000, 0); + } + + /* Now, call lots of allocation functions */ + + /* Small allocations */ + caml_alloc(10, 0); + x = caml_alloc_small(2, 0); + Field(x, 0) = Val_unit; + Field(x, 1) = Val_unit; + caml_alloc_tuple(3); + caml_alloc_float_array(10); + caml_alloc_string(42); + caml_alloc_initialized_string(10, "abcdeabcde"); + caml_copy_string("asoidjfa"); + caml_copy_string_array(strs); + caml_copy_double(42.0); + caml_copy_int32(100); + caml_copy_int64(100); + caml_alloc_array(caml_copy_string, strs); + caml_alloc_sprintf("[%d]", 42); + + /* Large allocations */ + caml_alloc(1000, 0); + caml_alloc_shr(1000, 0); + caml_alloc_tuple(1000); + caml_alloc_float_array(1000); + caml_alloc_string(10000); + s = calloc(10000, 1); + caml_alloc_initialized_string(10000, s); + free(s); + + + printf("C, after: %d\n", Int_val(Field(ref, 0))); + fflush(stdout); + CAMLreturn (Val_unit); +} diff --git a/testsuite/tests/callback/ocamltests b/testsuite/tests/callback/ocamltests deleted file mode 100644 index 0484d5ec..00000000 --- a/testsuite/tests/callback/ocamltests +++ /dev/null @@ -1 +0,0 @@ -tcallback.ml diff --git a/testsuite/tests/callback/signals_alloc.ml b/testsuite/tests/callback/signals_alloc.ml new file mode 100644 index 00000000..ae5f0d7f --- /dev/null +++ b/testsuite/tests/callback/signals_alloc.ml @@ -0,0 +1,31 @@ +(* TEST + include unix + * libunix + ** bytecode + ** native +*) + +let pid = Unix.getpid () + +let do_test () = + let seen_states = Array.make 5 (-1) in + let pos = ref 0 in + let sighandler signo = + (* These two instructions are duplicated everywhere, but we cannot + encapsulate them in a function, because function calls check + for signals in bytecode mode. *) + seen_states.(!pos) <- 3; pos := !pos + 1; + in + seen_states.(!pos) <- 0; pos := !pos + 1; + Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler); + seen_states.(!pos) <- 1; pos := !pos + 1; + Unix.kill pid Sys.sigusr1; + seen_states.(!pos) <- 2; pos := !pos + 1; + let _ = Sys.opaque_identity (ref 1) in + seen_states.(!pos) <- 4; pos := !pos + 1; + Sys.set_signal Sys.sigusr1 Sys.Signal_default; + assert (seen_states = [|0;1;2;3;4|]) + +let () = + for _ = 0 to 10 do do_test () done; + Printf.printf "OK\n" diff --git a/testsuite/tests/callback/signals_alloc.reference b/testsuite/tests/callback/signals_alloc.reference new file mode 100644 index 00000000..d86bac9d --- /dev/null +++ b/testsuite/tests/callback/signals_alloc.reference @@ -0,0 +1 @@ +OK diff --git a/testsuite/tests/compatibility/main.ml b/testsuite/tests/compatibility/main.ml new file mode 100644 index 00000000..c2e20712 --- /dev/null +++ b/testsuite/tests/compatibility/main.ml @@ -0,0 +1,16 @@ +(* TEST +modules = "stub.c" +* pass +** bytecode +** native +* pass +flags = "-ccopt -DCAML_NAME_SPACE" +** bytecode +** native +*) + +external retrieve_young_limit : 'a -> nativeint = "retrieve_young_limit" + +let bar = + let foo = Bytes.create 4 in + retrieve_young_limit foo diff --git a/testsuite/tests/compatibility/main.reference b/testsuite/tests/compatibility/main.reference new file mode 100644 index 00000000..3e18d56d --- /dev/null +++ b/testsuite/tests/compatibility/main.reference @@ -0,0 +1 @@ +v is young diff --git a/testsuite/tests/compatibility/stub.c b/testsuite/tests/compatibility/stub.c new file mode 100644 index 00000000..cbe39bb4 --- /dev/null +++ b/testsuite/tests/compatibility/stub.c @@ -0,0 +1,18 @@ +#include +#include +#include +#include +#include +/* see PR#8892 */ +typedef char * addr; + +CAMLprim value retrieve_young_limit(value v) +{ + CAMLparam1(v); + printf("v is%s young\n", (Is_young(v) ? "" : " not")); +#ifdef CAML_NAME_SPACE + CAMLreturn(caml_copy_nativeint((intnat)caml_young_limit)); +#else + CAMLreturn(copy_nativeint((intnat)young_limit)); +#endif +} diff --git a/testsuite/tests/compiler-libs/ocamltests b/testsuite/tests/compiler-libs/ocamltests deleted file mode 100644 index c2778632..00000000 --- a/testsuite/tests/compiler-libs/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test_longident.ml diff --git a/testsuite/tests/embedded/ocamltests b/testsuite/tests/embedded/ocamltests deleted file mode 100644 index b03fb35a..00000000 --- a/testsuite/tests/embedded/ocamltests +++ /dev/null @@ -1 +0,0 @@ -cmcaml.ml diff --git a/testsuite/tests/ephe-c-api/ocamltests b/testsuite/tests/ephe-c-api/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/ephe-c-api/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/exotic-syntax/ocamltests b/testsuite/tests/exotic-syntax/ocamltests deleted file mode 100644 index 7ba0519b..00000000 --- a/testsuite/tests/exotic-syntax/ocamltests +++ /dev/null @@ -1 +0,0 @@ -exotic.ml diff --git a/testsuite/tests/extension-constructor/ocamltests b/testsuite/tests/extension-constructor/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/extension-constructor/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/flambda/ocamltests b/testsuite/tests/flambda/ocamltests deleted file mode 100644 index 03b4913f..00000000 --- a/testsuite/tests/flambda/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -approx_meet.ml -gpr998.ml -specialise.ml -gpr2239.ml diff --git a/testsuite/tests/float-unboxing/ocamltests b/testsuite/tests/float-unboxing/ocamltests deleted file mode 100644 index 6ef80d51..00000000 --- a/testsuite/tests/float-unboxing/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -float_subst_boxed_number.ml -unbox_under_assign.ml diff --git a/testsuite/tests/fma/ocamltests b/testsuite/tests/fma/ocamltests deleted file mode 100644 index d51821f0..00000000 --- a/testsuite/tests/fma/ocamltests +++ /dev/null @@ -1 +0,0 @@ -fma.ml diff --git a/testsuite/tests/formats-transition/ocamltests b/testsuite/tests/formats-transition/ocamltests deleted file mode 100644 index a19e8ec2..00000000 --- a/testsuite/tests/formats-transition/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -deprecated_unsigned_printers.ml -ignored_scan_counters.ml -legacy_incompatible_flags.ml -legacy_unfinished_modifiers.ml diff --git a/testsuite/tests/formatting/ocamltests b/testsuite/tests/formatting/ocamltests deleted file mode 100644 index 6315a066..00000000 --- a/testsuite/tests/formatting/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -margins.ml -errors_batch.ml diff --git a/testsuite/tests/functors/ocamltests b/testsuite/tests/functors/ocamltests deleted file mode 100644 index d5835c07..00000000 --- a/testsuite/tests/functors/ocamltests +++ /dev/null @@ -1 +0,0 @@ -functors.ml diff --git a/testsuite/tests/gc-roots/ocamltests b/testsuite/tests/gc-roots/ocamltests deleted file mode 100644 index a199679f..00000000 --- a/testsuite/tests/gc-roots/ocamltests +++ /dev/null @@ -1 +0,0 @@ -globroots.ml diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml index a6747abd..112d5f29 100644 --- a/testsuite/tests/generalized-open/gpr1506.ml +++ b/testsuite/tests/generalized-open/gpr1506.ml @@ -77,7 +77,7 @@ Line 3, characters 7-20: 3 | open M(struct end) ^^^^^^^^^^^^^ Error: This module is not a structure; it has type - functor (X : sig end) -> sig end + functor (X : sig end) -> sig end |}] open struct @@ -100,9 +100,9 @@ include struct open struct type t = T end let x = T end Line 1, characters 15-41: 1 | include struct open struct type t = T end let x = T end ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The type t/143 introduced by this open appears in the signature +Error: The type t/149 introduced by this open appears in the signature Line 1, characters 46-47: - The value x has no valid type if t/143 is hidden + The value x has no valid type if t/149 is hidden |}];; module A = struct @@ -120,9 +120,9 @@ Lines 3-6, characters 4-7: 4 | type t = T 5 | let x = T 6 | end -Error: The type t/149 introduced by this open appears in the signature +Error: The type t/154 introduced by this open appears in the signature Line 7, characters 8-9: - The value y has no valid type if t/149 is hidden + The value y has no valid type if t/154 is hidden |}];; module A = struct @@ -139,9 +139,9 @@ Lines 3-5, characters 4-7: 3 | ....open struct 4 | type t = T 5 | end -Error: The type t/155 introduced by this open appears in the signature +Error: The type t/159 introduced by this open appears in the signature Line 6, characters 8-9: - The value y has no valid type if t/155 is hidden + The value y has no valid type if t/159 is hidden |}] (* It was decided to not allow this anymore. *) @@ -298,7 +298,7 @@ module N = struct assert(y = 1) end [%%expect{| -module N : sig end +module N : sig end |}] module M = struct @@ -314,7 +314,7 @@ module M = struct end end [%%expect{| -module M : sig end +module M : sig end |}] (* It was decided to not allow this anymore *) @@ -385,5 +385,5 @@ Line 1, characters 20-53: 1 | let f () = let open functor(X: sig end) -> struct end in ();; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This module is not a structure; it has type - functor (X : sig end) -> sig end + functor (X : sig end) -> sig end |}] diff --git a/testsuite/tests/generalized-open/ocamltests b/testsuite/tests/generalized-open/ocamltests deleted file mode 100644 index ec6f2cff..00000000 --- a/testsuite/tests/generalized-open/ocamltests +++ /dev/null @@ -1,7 +0,0 @@ -accepted_batch.ml -accepted_expect.ml -clambda_optim.ml -expansiveness.ml -funct_body.ml -gpr1506.ml -shadowing.ml diff --git a/testsuite/tests/int64-unboxing/ocamltests b/testsuite/tests/int64-unboxing/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/int64-unboxing/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lazy/ocamltests b/testsuite/tests/lazy/ocamltests deleted file mode 100644 index 0b1f5a93..00000000 --- a/testsuite/tests/lazy/ocamltests +++ /dev/null @@ -1 +0,0 @@ -lazy1.ml diff --git a/testsuite/tests/let-syntax/let_syntax.ml b/testsuite/tests/let-syntax/let_syntax.ml index b8d6673e..9f19e0e4 100644 --- a/testsuite/tests/let-syntax/let_syntax.ml +++ b/testsuite/tests/let-syntax/let_syntax.ml @@ -134,7 +134,7 @@ val bind_map : int list = [8; 9; 10; 9; 10; 11; 10; 11; 12] module Let_unbound = struct end;; [%%expect{| -module Let_unbound : sig end +module Let_unbound : sig end |}];; let let_unbound = diff --git a/testsuite/tests/let-syntax/ocamltests b/testsuite/tests/let-syntax/ocamltests deleted file mode 100644 index da15f631..00000000 --- a/testsuite/tests/let-syntax/ocamltests +++ /dev/null @@ -1 +0,0 @@ -let_syntax.ml diff --git a/testsuite/tests/letrec-check/modules.ml b/testsuite/tests/letrec-check/modules.ml index 6507d9a5..fc55f76b 100644 --- a/testsuite/tests/letrec-check/modules.ml +++ b/testsuite/tests/letrec-check/modules.ml @@ -15,6 +15,14 @@ Line 1, characters 12-76: Error: This kind of expression is not allowed as right-hand side of `let rec' |}];; +let rec x = let module _ = struct let _ = x () end in fun () -> ();; +[%%expect{| +Line 1, characters 12-66: +1 | let rec x = let module _ = struct let _ = x () end in fun () -> ();; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}];; + let rec x = let module M = struct let f = x () let g = x end in fun () -> ();; [%%expect{| Line 1, characters 12-76: @@ -72,7 +80,7 @@ let rec x = (module (val y : T) : T) and y = let module M = struct let x = x end in (module M : T) ;; [%%expect{| -module type T = sig end +module type T = sig end Line 2, characters 12-36: 2 | let rec x = (module (val y : T) : T) ^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/testsuite/tests/letrec-check/ocamltests b/testsuite/tests/letrec-check/ocamltests deleted file mode 100644 index 3cae2e71..00000000 --- a/testsuite/tests/letrec-check/ocamltests +++ /dev/null @@ -1,14 +0,0 @@ -basic.ml -extension_constructor.ml -flat_float_array.ml -no_flat_float_array.ml -float_unboxing.ml -records.ml -labels.ml -lazy_.ml -modules.ml -objects.ml -pr7215.ml -pr7231.ml -pr7706.ml -unboxed.ml diff --git a/testsuite/tests/letrec-compilation/ocamltests b/testsuite/tests/letrec-compilation/ocamltests deleted file mode 100644 index 5ac062fb..00000000 --- a/testsuite/tests/letrec-compilation/ocamltests +++ /dev/null @@ -1,19 +0,0 @@ -backreferences.ml -class_1.ml -class_2.ml -evaluation_order_1.ml -evaluation_order_2.ml -evaluation_order_3.ml -float_block_1.ml -generic_array.ml -labels.ml -lazy_.ml -lists.ml -mixing_value_closures_1.ml -mixing_value_closures_2.ml -mutual_functions.ml -nested.ml -pr4989.ml -pr8681.ml -record_with.ml -ref.ml diff --git a/testsuite/tests/lexing/comments.ml b/testsuite/tests/lexing/comments.ml new file mode 100644 index 00000000..a7c9f275 --- /dev/null +++ b/testsuite/tests/lexing/comments.ml @@ -0,0 +1,11 @@ +(* TEST + * toplevel +*) + +(* "*)" *) + +(* {|*)|} *) + +(* '"' *) + +(* f' '"' *) diff --git a/testsuite/tests/lexing/comments.ocaml.reference b/testsuite/tests/lexing/comments.ocaml.reference new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/testsuite/tests/lexing/comments.ocaml.reference @@ -0,0 +1 @@ + diff --git a/testsuite/tests/lexing/ocamltests b/testsuite/tests/lexing/ocamltests deleted file mode 100644 index 4b21c4a7..00000000 --- a/testsuite/tests/lexing/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -escape.ml -uchar_esc.ml diff --git a/testsuite/tests/lib-arg/ocamltests b/testsuite/tests/lib-arg/ocamltests deleted file mode 100644 index af4dd22c..00000000 --- a/testsuite/tests/lib-arg/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -testarg.ml -testerror.ml diff --git a/testsuite/tests/lib-arg/testarg.ml b/testsuite/tests/lib-arg/testarg.ml index 6458ce8d..5fb9f5b8 100644 --- a/testsuite/tests/lib-arg/testarg.ml +++ b/testsuite/tests/lib-arg/testarg.ml @@ -1,4 +1,5 @@ (* TEST + compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *) *) let current = ref 0;; diff --git a/testsuite/tests/lib-array/test_array.ml b/testsuite/tests/lib-array/test_array.ml new file mode 100644 index 00000000..5cd9c719 --- /dev/null +++ b/testsuite/tests/lib-array/test_array.ml @@ -0,0 +1,57 @@ +(* TEST + * expect +*) + +let a = Array.make 8 None;; +let _ = Array.fill a 2 3 (Some 42);; +a;; +[%%expect{| +val a : '_weak1 option array = + [|None; None; None; None; None; None; None; None|] +- : unit = () +- : int option array = +[|None; None; Some 42; Some 42; Some 42; None; None; None|] +|}] +let _ = Array.fill a 3 1 (Some 0);; +a;; +[%%expect{| +- : unit = () +- : int option array = +[|None; None; Some 42; Some 0; Some 42; None; None; None|] +|}] +let _ = Array.fill a 3 6 None;; +a;; +[%%expect{| +Exception: Invalid_argument "Array.fill". +|}] +let _ = Array.fill a (-1) 2 None;; +a;; +[%%expect{| +Exception: Invalid_argument "Array.fill". +|}] +let _ = Gc.compact ();; +let _ = Array.fill a 5 1 (Some (if Random.int 2 < 0 then 1 else 2));; +a;; +[%%expect{| +- : unit = () +- : unit = () +- : int option array = +[|None; None; Some 42; Some 0; Some 42; Some 2; None; None|] +|}] +let _ = Array.fill a 5 1 None;; +a;; +[%%expect{| +- : unit = () +- : int option array = +[|None; None; Some 42; Some 0; Some 42; None; None; None|] +|}] + + +let a = Array.make 8 0.;; +let _ = Array.fill a 2 3 42.;; +a;; +[%%expect{| +val a : float array = [|0.; 0.; 0.; 0.; 0.; 0.; 0.; 0.|] +- : unit = () +- : float array = [|0.; 0.; 42.; 42.; 42.; 0.; 0.; 0.|] +|}] diff --git a/testsuite/tests/lib-bigarray-2/ocamltests b/testsuite/tests/lib-bigarray-2/ocamltests deleted file mode 100644 index 133f99d6..00000000 --- a/testsuite/tests/lib-bigarray-2/ocamltests +++ /dev/null @@ -1 +0,0 @@ -bigarrfml.ml diff --git a/testsuite/tests/lib-bigarray-file/ocamltests b/testsuite/tests/lib-bigarray-file/ocamltests deleted file mode 100644 index 260c6b73..00000000 --- a/testsuite/tests/lib-bigarray-file/ocamltests +++ /dev/null @@ -1 +0,0 @@ -mapfile.ml diff --git a/testsuite/tests/lib-bigarray/change_layout.ml b/testsuite/tests/lib-bigarray/change_layout.ml index fcc0d1fb..2456cdc5 100644 --- a/testsuite/tests/lib-bigarray/change_layout.ml +++ b/testsuite/tests/lib-bigarray/change_layout.ml @@ -1,4 +1,5 @@ (* TEST + compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *) *) (** Test the various change_layout for Genarray and the various Array[n] *) diff --git a/testsuite/tests/lib-bigarray/ocamltests b/testsuite/tests/lib-bigarray/ocamltests deleted file mode 100644 index 8f13552d..00000000 --- a/testsuite/tests/lib-bigarray/ocamltests +++ /dev/null @@ -1,5 +0,0 @@ -bigarrays.ml -change_layout.ml -fftba.ml -pr5115.ml -weak_bigarray.ml diff --git a/testsuite/tests/lib-bool/ocamltests b/testsuite/tests/lib-bool/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-bool/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-buffer/ocamltests b/testsuite/tests/lib-buffer/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-buffer/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-bytes/ocamltests b/testsuite/tests/lib-bytes/ocamltests deleted file mode 100644 index 5f976f97..00000000 --- a/testsuite/tests/lib-bytes/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -binary.ml -test_bytes.ml diff --git a/testsuite/tests/lib-digest/ocamltests b/testsuite/tests/lib-digest/ocamltests deleted file mode 100644 index b2ebef4e..00000000 --- a/testsuite/tests/lib-digest/ocamltests +++ /dev/null @@ -1 +0,0 @@ -md5.ml diff --git a/testsuite/tests/lib-dynlink-bytecode/ocamltests b/testsuite/tests/lib-dynlink-bytecode/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/lib-dynlink-bytecode/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/lib-dynlink-csharp/ocamltests b/testsuite/tests/lib-dynlink-csharp/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/lib-dynlink-csharp/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/lib-dynlink-initializers/ocamltests b/testsuite/tests/lib-dynlink-initializers/ocamltests deleted file mode 100644 index 548f6b3c..00000000 --- a/testsuite/tests/lib-dynlink-initializers/ocamltests +++ /dev/null @@ -1,9 +0,0 @@ -test1_main.ml -test2_main.ml -test3_main.ml -test4_main.ml -test5_main.ml -test6_main.ml -test7_main.ml -test8_main.ml -test9_main.ml diff --git a/testsuite/tests/lib-dynlink-native/ocamltests b/testsuite/tests/lib-dynlink-native/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/lib-dynlink-native/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/lib-dynlink-packed/ocamltests b/testsuite/tests/lib-dynlink-packed/ocamltests deleted file mode 100644 index 0fe19df0..00000000 --- a/testsuite/tests/lib-dynlink-packed/ocamltests +++ /dev/null @@ -1 +0,0 @@ -loader.ml diff --git a/testsuite/tests/lib-dynlink-pr4229/main.ml b/testsuite/tests/lib-dynlink-pr4229/main.ml index 3c3c9779..8b3bbb5b 100644 --- a/testsuite/tests/lib-dynlink-pr4229/main.ml +++ b/testsuite/tests/lib-dynlink-pr4229/main.ml @@ -4,7 +4,7 @@ include dynlink files = "abstract.mli abstract.ml static.ml client.ml main.ml" -set sub = "${test_source_directory}/sub" +set src_sub = "${test_source_directory}/sub" libraries = "" @@ -13,9 +13,9 @@ libraries = "" *** script script = "mkdir sub" **** script -script = "cp ${sub}/abstract.mli ${sub}/abstract.ml sub" +script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub" ***** cd -cwd = "${sub}" +cwd = "sub" ****** ocamlc.byte module = "abstract.mli" ******* ocamlc.byte @@ -46,9 +46,9 @@ exit_status = "2" **** script script = "mkdir sub" ***** script -script = "cp ${sub}/abstract.mli ${sub}/abstract.ml sub" +script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub" ****** cd -cwd = "${sub}" +cwd = "sub" ******* ocamlopt.byte module = "abstract.mli" ******** ocamlopt.byte @@ -71,12 +71,12 @@ flags = "-shared" module = "" all_modules = "client.ml" ************* ocamlopt.byte -module = "main_native.ml" +module = "main.ml" ************** ocamlopt.byte program = "${test_build_directory}/main_native" libraries = "dynlink" module = "" -all_modules = "abstract.cmx static.cmx main_native.cmx" +all_modules = "abstract.cmx static.cmx main.cmx" *************** run exit_status = "2" **************** check-program-output @@ -85,10 +85,16 @@ exit_status = "2" (* PR#4229 *) let () = + let suffix = + match Sys.backend_type with + | Native -> "cmxs" + | Bytecode -> "cmo" + | Other _ -> assert false + in try (* Dynlink.init (); *) (* this function has been removed from the API *) - Dynlink.loadfile "client.cmo"; (* utilise abstract.cmo *) - Dynlink.loadfile "sub/abstract.cmo"; - Dynlink.loadfile "client.cmo" (* utilise sub/abstract.cmo *) + Dynlink.loadfile ("client."^suffix); (* utilise abstract.suffix *) + Dynlink.loadfile ("sub/abstract."^suffix); + Dynlink.loadfile ("client."^suffix) (* utilise sub/abstract.suffix *) with | Dynlink.Error (Dynlink.Module_already_loaded "Abstract") -> exit 2 diff --git a/testsuite/tests/lib-dynlink-pr4229/main.reference b/testsuite/tests/lib-dynlink-pr4229/main.reference index c2cc066e..81c00b92 100644 --- a/testsuite/tests/lib-dynlink-pr4229/main.reference +++ b/testsuite/tests/lib-dynlink-pr4229/main.reference @@ -1 +1 @@ -Abstract 10 \ No newline at end of file +Abstract 10 diff --git a/testsuite/tests/lib-dynlink-pr4229/main_native.ml b/testsuite/tests/lib-dynlink-pr4229/main_native.ml deleted file mode 100644 index 532858e0..00000000 --- a/testsuite/tests/lib-dynlink-pr4229/main_native.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* PR#4229 *) - -let () = - try - (* Dynlink.init (); *) (* this function has been removed from the API *) - Dynlink.loadfile "client.cmxs"; (* utilise abstract.cmx *) - Dynlink.loadfile "sub/abstract.cmxs"; - Dynlink.loadfile "client.cmxs" (* utilise sub/abstract.cmx *) - with - | Dynlink.Error (Dynlink.Module_already_loaded "Abstract") -> exit 2 diff --git a/testsuite/tests/lib-dynlink-pr4229/ocamltests b/testsuite/tests/lib-dynlink-pr4229/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/lib-dynlink-pr4229/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/lib-dynlink-pr4839/ocamltests b/testsuite/tests/lib-dynlink-pr4839/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-dynlink-pr4839/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-dynlink-pr6950/ocamltests b/testsuite/tests/lib-dynlink-pr6950/ocamltests deleted file mode 100644 index 0fe19df0..00000000 --- a/testsuite/tests/lib-dynlink-pr6950/ocamltests +++ /dev/null @@ -1 +0,0 @@ -loader.ml diff --git a/testsuite/tests/lib-dynlink-pr9209/dyn.ml b/testsuite/tests/lib-dynlink-pr9209/dyn.ml new file mode 100644 index 00000000..6477b719 --- /dev/null +++ b/testsuite/tests/lib-dynlink-pr9209/dyn.ml @@ -0,0 +1,63 @@ +(* TEST + +include dynlink +files = "lib.ml lib2.ml test.c" +ld_library_path += "${test_build_directory}" + +* shared-libraries +** setup-ocamlc.byte-build-env +*** ocamlc.byte +compile_only = "true" +all_modules = "lib.ml lib2.ml test.c dyn.ml" +**** ocamlmklib +program = "lib" +modules = "lib.cmo test.${objext}" +compile_only = "false" +***** ocamlc.byte +program = "lib2.cma" +libraries = "" +all_modules = "lib2.cmo" +compile_only = "false" +flags = "-a" +****** ocamlc.byte +libraries += "dynlink" +program = "${test_build_directory}/main.exe" +all_modules = "dyn.cmo" +flags = "" +******* run +output = "main.output" +******** check-program-output + +** native-dynlink +*** setup-ocamlopt.byte-build-env +**** ocamlopt.byte +compile_only = "true" +all_modules = "lib.ml lib2.ml test.c dyn.ml" +***** ocamlmklib +program = "test" +modules = "test.${objext}" +compile_only = "false" +****** ocamlopt.byte +program = "lib.cmxs" +libraries = "" +flags = "-shared -cclib -L. -cclib -ltest" +all_modules = "lib.cmx" +compile_only = "false" +******* ocamlopt.byte +program = "lib2.cmxs" +all_modules = "lib2.cmx" +compile_only = "false" +flags = "-shared" +******** ocamlopt.byte +libraries += "dynlink" +program = "${test_build_directory}/main.exe" +all_modules = "dyn.cmx" +flags = "" +********* run +output = "main.output" +********** check-program-output +*) +let () = + Dynlink.allow_unsafe_modules true; + Dynlink.adapt_filename "lib.cma" |> Dynlink.loadfile; + Dynlink.adapt_filename "lib2.cma" |> Dynlink.loadfile diff --git a/testsuite/tests/lib-dynlink-pr9209/lib.ml b/testsuite/tests/lib-dynlink-pr9209/lib.ml new file mode 100644 index 00000000..ba103759 --- /dev/null +++ b/testsuite/tests/lib-dynlink-pr9209/lib.ml @@ -0,0 +1 @@ +external test : unit -> unit = "testdynfail" diff --git a/testsuite/tests/lib-dynlink-pr9209/lib2.ml b/testsuite/tests/lib-dynlink-pr9209/lib2.ml new file mode 100644 index 00000000..fbb23b1f --- /dev/null +++ b/testsuite/tests/lib-dynlink-pr9209/lib2.ml @@ -0,0 +1 @@ +let test = Lib.test diff --git a/testsuite/tests/lib-dynlink-pr9209/main.reference b/testsuite/tests/lib-dynlink-pr9209/main.reference new file mode 100644 index 00000000..e69de29b diff --git a/testsuite/tests/lib-dynlink-pr9209/ocamltests b/testsuite/tests/lib-dynlink-pr9209/ocamltests new file mode 100644 index 00000000..f9f0d72f --- /dev/null +++ b/testsuite/tests/lib-dynlink-pr9209/ocamltests @@ -0,0 +1 @@ +dyn.ml diff --git a/testsuite/tests/lib-dynlink-pr9209/test.c b/testsuite/tests/lib-dynlink-pr9209/test.c new file mode 100644 index 00000000..8603be37 --- /dev/null +++ b/testsuite/tests/lib-dynlink-pr9209/test.c @@ -0,0 +1,3 @@ +int testdynfail() { + return 0; +} diff --git a/testsuite/tests/lib-dynlink-private/ocamltests b/testsuite/tests/lib-dynlink-private/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-dynlink-private/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-filename/myecho.ml b/testsuite/tests/lib-filename/myecho.ml new file mode 100644 index 00000000..977803f6 --- /dev/null +++ b/testsuite/tests/lib-filename/myecho.ml @@ -0,0 +1,20 @@ +open Printf + +let () = + let argc = Array.length Sys.argv in + let out = ref stdout in + if argc > 1 then begin + for i = 1 to argc - 1 do + match Sys.argv.(i) with + | "-err" -> flush !out; out := stderr + | "-out" -> flush !out; out := stdout + | arg -> fprintf !out "argv[%d] = {|%s|}\n" i arg + done + end else begin + try + while true do + let l = input_line stdin in + printf "%s\n" l + done + with End_of_file -> () + end diff --git a/testsuite/tests/lib-filename/null.ml b/testsuite/tests/lib-filename/null.ml new file mode 100644 index 00000000..048e3662 --- /dev/null +++ b/testsuite/tests/lib-filename/null.ml @@ -0,0 +1,8 @@ +(* TEST +*) + +let () = + let ic = open_in Filename.null in + match input_char ic with + | exception End_of_file -> close_in ic + | _ -> assert false diff --git a/testsuite/tests/lib-filename/ocamltests b/testsuite/tests/lib-filename/ocamltests deleted file mode 100644 index ed4fe5cb..00000000 --- a/testsuite/tests/lib-filename/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -extension.ml -suffix.ml diff --git a/testsuite/tests/lib-filename/quotecommand.ml b/testsuite/tests/lib-filename/quotecommand.ml new file mode 100644 index 00000000..45f53216 --- /dev/null +++ b/testsuite/tests/lib-filename/quotecommand.ml @@ -0,0 +1,104 @@ +(* TEST + +files = "myecho.ml" + +* setup-ocamlc.byte-build-env +program = "${test_build_directory}/quotecommand.byte" +** ocamlc.byte +program = "${test_build_directory}/myecho.exe" +all_modules = "myecho.ml" +*** ocamlc.byte +program = "${test_build_directory}/quotecommand.byte" +all_modules= "quotecommand.ml" +**** check-ocamlc.byte-output +***** run +****** check-program-output + +* setup-ocamlopt.byte-build-env +program = "${test_build_directory}/quotecommand.opt" +** ocamlopt.byte +program = "${test_build_directory}/myecho.exe" +all_modules = "myecho.ml" +*** ocamlopt.byte +include unix +program = "${test_build_directory}/quotecommand.opt" +all_modules= "quotecommand.ml" +**** check-ocamlopt.byte-output +***** run +****** check-program-output + +*) + +open Printf + +let copy_channels ic oc = + let sz = 1024 in + let buf = Bytes.create sz in + let rec copy () = + let n = input ic buf 0 sz in + if n > 0 then (output oc buf 0 n; copy()) in + copy() + +let copy_file src dst = + let ic = open_in_bin src in + let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] + 0o777 dst in + copy_channels ic oc; + close_in ic; + close_out oc + +let cat_file f = + let ic = open_in f in + copy_channels ic stdout; + close_in ic + +let myecho = + Filename.concat Filename.current_dir_name "my echo.exe" + +let run ?stdin ?stdout ?stderr args = + flush Stdlib.stdout; + let rc = + Sys.command (Filename.quote_command myecho ?stdin ?stdout ?stderr args) in + if rc > 0 then begin + printf "!!! my echo failed\n"; + exit 2 + end + +let _ = + copy_file "myecho.exe" "my echo.exe"; + printf "-------- Spaces\n"; + run ["Lorem ipsum dolor"; "sit amet,"; "consectetur adipiscing elit,"]; + printf "-------- All ASCII characters\n"; + run ["!\"#$%&'()*+,-./"; + "0123456789"; + ":;<=>?@"; + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + "[\\]^_`"; + "abcdefghijklmnopqrstuvwxyz"; + "{~|~}" + ]; + printf "-------- Output redirection\n"; + run ~stdout:"my 'file'.tmp" ["sed do eiusmod tempor incididunt"; + "ut labore et dolore magna aliqua."]; + printf "-------- Input redirection\n"; + run ~stdin:"my 'file'.tmp" []; + Sys.remove "my 'file'.tmp"; + printf "-------- Error redirection\n"; + run ~stderr:"my 'file'.tmp" + ["Exceptur sint"; "-err"; "occaecat"; "cupidatat"; + "-out"; "non proident"; "-err"; "sunt in culpa"]; + printf "-- stderr:\n"; + cat_file "my 'file'.tmp"; + Sys.remove "my 'file'.tmp"; + printf "-------- Output and error redirections (different files)\n"; + run ~stdout:"my stdout.tmp" ~stderr:"my stderr.tmp" + ["qui officia"; "-err"; "deserunt"; "mollit"; + "-out"; "anim id est"; "-err"; "laborum."]; + printf "-- stdout:\n"; cat_file "my stdout.tmp"; Sys.remove "my stdout.tmp"; + printf "-- stderr:\n"; cat_file "my stderr.tmp"; Sys.remove "my stderr.tmp"; + printf "-------- Output and error redirections (same file)\n"; + run ~stdout:"my file.tmp" ~stderr:"my file.tmp" + ["Duis aute"; "irure dolor"; "-err"; "in reprehenderit"; + "in voluptate"; "-out"; "velit esse cillum"; "-err"; "dolore"]; + cat_file "my file.tmp"; Sys.remove "my file.tmp"; + Sys.remove "my echo.exe" diff --git a/testsuite/tests/lib-filename/quotecommand.reference b/testsuite/tests/lib-filename/quotecommand.reference new file mode 100644 index 00000000..937c9fe6 --- /dev/null +++ b/testsuite/tests/lib-filename/quotecommand.reference @@ -0,0 +1,38 @@ +-------- Spaces +argv[1] = {|Lorem ipsum dolor|} +argv[2] = {|sit amet,|} +argv[3] = {|consectetur adipiscing elit,|} +-------- All ASCII characters +argv[1] = {|!"#$%&'()*+,-./|} +argv[2] = {|0123456789|} +argv[3] = {|:;<=>?@|} +argv[4] = {|ABCDEFGHIJKLMNOPQRSTUVWXYZ|} +argv[5] = {|[\]^_`|} +argv[6] = {|abcdefghijklmnopqrstuvwxyz|} +argv[7] = {|{~|~}|} +-------- Output redirection +-------- Input redirection +argv[1] = {|sed do eiusmod tempor incididunt|} +argv[2] = {|ut labore et dolore magna aliqua.|} +-------- Error redirection +argv[1] = {|Exceptur sint|} +argv[6] = {|non proident|} +-- stderr: +argv[3] = {|occaecat|} +argv[4] = {|cupidatat|} +argv[8] = {|sunt in culpa|} +-------- Output and error redirections (different files) +-- stdout: +argv[1] = {|qui officia|} +argv[6] = {|anim id est|} +-- stderr: +argv[3] = {|deserunt|} +argv[4] = {|mollit|} +argv[8] = {|laborum.|} +-------- Output and error redirections (same file) +argv[1] = {|Duis aute|} +argv[2] = {|irure dolor|} +argv[4] = {|in reprehenderit|} +argv[5] = {|in voluptate|} +argv[7] = {|velit esse cillum|} +argv[9] = {|dolore|} diff --git a/testsuite/tests/lib-float/ocamltests b/testsuite/tests/lib-float/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-float/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-floatarray/ocamltests b/testsuite/tests/lib-floatarray/ocamltests deleted file mode 100644 index abf19023..00000000 --- a/testsuite/tests/lib-floatarray/ocamltests +++ /dev/null @@ -1 +0,0 @@ -floatarray.ml diff --git a/testsuite/tests/lib-format/ocamltests b/testsuite/tests/lib-format/ocamltests deleted file mode 100644 index 414bc603..00000000 --- a/testsuite/tests/lib-format/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -pr6824.ml -tformat.ml -print_if_newline.ml -pp_print_custom_break.ml diff --git a/testsuite/tests/lib-fun/ocamltests b/testsuite/tests/lib-fun/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-fun/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-hashtbl/ocamltests b/testsuite/tests/lib-hashtbl/ocamltests deleted file mode 100644 index 904a9b55..00000000 --- a/testsuite/tests/lib-hashtbl/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -hfun.ml -htbl.ml diff --git a/testsuite/tests/lib-int/ocamltests b/testsuite/tests/lib-int/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-int/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-int64/ocamltests b/testsuite/tests/lib-int64/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-int64/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-internalformat/test.ml b/testsuite/tests/lib-internalformat/test.ml new file mode 100644 index 00000000..9f813353 --- /dev/null +++ b/testsuite/tests/lib-internalformat/test.ml @@ -0,0 +1,30 @@ +(* TEST + * expect +*) + +let inspect (format : _ format6) = + let (CamlinternalFormatBasics.Format (fmt, str)) = format in + (CamlinternalFormat.string_of_fmt fmt, str);; +[%%expect{| +val inspect : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string * string = +|}];; + +inspect "@[foo@]";; +[%%expect{| +- : string * string = ("@[foo@]", "@[foo@]") +|}];; + +inspect "@%%";; +[%%expect{| +- : string * string = ("@%%", "@%%") +|}];; + +inspect "@<";; +[%%expect{| +- : string * string = ("@<", "@<") +|}];; + +inspect "@[<%s>@]";; +[%%expect{| +- : string * string = ("@[<%s>@]", "@[<%s>@]") +|}];; diff --git a/testsuite/tests/lib-list/ocamltests b/testsuite/tests/lib-list/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-list/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml index 88b0a5be..5efdbccf 100644 --- a/testsuite/tests/lib-list/test.ml +++ b/testsuite/tests/lib-list/test.ml @@ -26,6 +26,13 @@ let () = assert (not (List.exists (fun a -> a > 9) l)); assert (List.exists (fun _ -> true) l); + begin + let f ~limit a = if a >= limit then Some (a, limit) else None in + assert (List.find_map (f ~limit:3) [] = None); + assert (List.find_map (f ~limit:3) l = Some (3, 3)); + assert (List.find_map (f ~limit:30) l = None); + end; + assert (List.compare_lengths [] [] = 0); assert (List.compare_lengths [1;2] ['a';'b'] = 0); assert (List.compare_lengths [] [1;2] < 0); @@ -42,6 +49,10 @@ let () = assert (List.compare_length_with ['1'] 1 = 0); assert (List.compare_length_with ['1'] 2 < 0); assert (List.filter_map string_of_even_opt l = ["0";"2";"4";"6";"8"]); + assert (List.concat_map (fun i -> [i; i+1]) [1; 5] = [1; 2; 5; 6]); + assert ( + let count = ref 0 in + List.concat_map (fun i -> incr count; [i; !count]) [1; 5] = [1; 1; 5; 2]); () ;; diff --git a/testsuite/tests/lib-marshal/intern_final.ml b/testsuite/tests/lib-marshal/intern_final.ml new file mode 100644 index 00000000..d50fb978 --- /dev/null +++ b/testsuite/tests/lib-marshal/intern_final.ml @@ -0,0 +1,30 @@ +(* TEST *) + +let t : int array = Array.make 200 42 +let c = open_out_bin "data42" +let () = Marshal.to_channel c t [] +let () = close_out c + +let t : int array = Array.make 200 0 +let c = open_out_bin "data0" +let () = Marshal.to_channel c t [] +let () = close_out c + +let rec fill_minor accu = function + | 0 -> accu + | n -> fill_minor (n::accu) (n-1) + +let () = + let c0 = open_in_bin "data0" in + let c42 = open_in_bin "data42" in + + ignore (Gc.create_alarm (fun () -> + seek_in c0 0; + ignore (Marshal.from_channel c0))); + + for i = 0 to 100000 do + seek_in c42 0; + let res : int array = Marshal.from_channel c42 in + Array.iter (fun n -> assert (n = 42)) res + done; + Printf.printf "OK!\n" diff --git a/testsuite/tests/lib-marshal/intern_final.reference b/testsuite/tests/lib-marshal/intern_final.reference new file mode 100644 index 00000000..d6406617 --- /dev/null +++ b/testsuite/tests/lib-marshal/intern_final.reference @@ -0,0 +1 @@ +OK! diff --git a/testsuite/tests/lib-marshal/ocamltests b/testsuite/tests/lib-marshal/ocamltests deleted file mode 100644 index edb5046c..00000000 --- a/testsuite/tests/lib-marshal/ocamltests +++ /dev/null @@ -1 +0,0 @@ -intext.ml diff --git a/testsuite/tests/lib-obj/ocamltests b/testsuite/tests/lib-obj/ocamltests deleted file mode 100644 index bdddfe9e..00000000 --- a/testsuite/tests/lib-obj/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -reachable_words.ml -with_tag.ml diff --git a/testsuite/tests/lib-option/ocamltests b/testsuite/tests/lib-option/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-option/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-printf/ocamltests b/testsuite/tests/lib-printf/ocamltests deleted file mode 100644 index 441725e4..00000000 --- a/testsuite/tests/lib-printf/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -pr6534.ml -pr6938.ml -tprintf.ml diff --git a/testsuite/tests/lib-printf/tprintf.ml b/testsuite/tests/lib-printf/tprintf.ml index 54799e12..542c93f4 100644 --- a/testsuite/tests/lib-printf/tprintf.ml +++ b/testsuite/tests/lib-printf/tprintf.ml @@ -290,6 +290,26 @@ try test (sprintf "%12.3F" 42.42e42 =* " 4.24e+43"); test (sprintf "%.3F" 42.00 = "42."); test (sprintf "%.3F" 0.0042 = "0.0042"); + test (sprintf "%F" nan = "nan"); + test (sprintf "%F" (-. nan) = "nan"); + test (sprintf "%F" infinity = "infinity"); + test (sprintf "%F" neg_infinity = "neg_infinity"); + + printf "\n#F\n%!"; + test (sprintf "%+#F" (+0.) = "+0x0p+0"); + test (sprintf "%+#F" (-0.) = "-0x0p+0"); + test (sprintf "%+#F" (+1.) = "+0x1p+0"); + test (sprintf "%+#F" (-1.) = "-0x1p+0"); + test (sprintf "%+#F" (+1024.) = "+0x1p+10"); + test (sprintf "% #F" (+1024.) = " 0x1p+10"); + test (sprintf "%+#F" (-1024.) = "-0x1p+10"); + test (sprintf "%#F" 0x123.456 = "0x1.23456p+8"); + test (sprintf "%#F" 0x123456789ABCDE. = "0x1.23456789abcdep+52"); + test (sprintf "%#F" epsilon_float = "0x1p-52"); + test (sprintf "%#F" nan = "nan"); + test (sprintf "%#F" (-. nan) = "nan"); + test (sprintf "%#F" infinity = "infinity"); + test (sprintf "%#F" neg_infinity = "neg_infinity"); printf "\nh\n%!"; test (sprintf "%+h" (+0.) = "+0x0p+0"); diff --git a/testsuite/tests/lib-printf/tprintf.reference b/testsuite/tests/lib-printf/tprintf.reference index a1b6b815..e728007e 100644 --- a/testsuite/tests/lib-printf/tprintf.reference +++ b/testsuite/tests/lib-printf/tprintf.reference @@ -29,71 +29,73 @@ C f 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 F - 107 108 109 110 111 112 113 114 115 116 117 118 + 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 +#F + 123 124 125 126 127 128 129 130 131 132 133 134 135 136 h - 119 120 121 122 123 124 125 126 127 128 129 130 131 + 137 138 139 140 141 142 143 144 145 146 147 148 149 H - 132 133 134 135 136 137 138 139 140 141 142 143 144 + 150 151 152 153 154 155 156 157 158 159 160 161 162 e - 145 146 147 148 149 150 151 152 153 154 155 156 157 158 + 163 164 165 166 167 168 169 170 171 172 173 174 175 176 E - 159 160 161 162 163 164 165 166 167 168 169 170 171 172 + 177 178 179 180 181 182 183 184 185 186 187 188 189 190 g - 173 174 175 176 177 178 179 180 181 + 191 192 193 194 195 196 197 198 199 G - 182 183 184 185 186 187 188 189 190 + 200 201 202 203 204 205 206 207 208 B - 191 192 193 194 + 209 210 211 212 ld/li positive - 195 196 197 198 199 200 201 + 213 214 215 216 217 218 219 ld/li negative - 202 203 204 205 206 207 208 + 220 221 222 223 224 225 226 lu positive - 209 210 211 212 213 + 227 228 229 230 231 lu negative - 214 + 232 lx positive - 215 216 217 218 219 220 + 233 234 235 236 237 238 lx negative - 221 + 239 lX positive - 222 223 224 225 226 227 + 240 241 242 243 244 245 lx negative - 228 + 246 lo positive - 229 230 231 232 233 234 + 247 248 249 250 251 252 lo negative - 235 + 253 Ld/Li positive - 236 237 238 239 240 + 254 255 256 257 258 Ld/Li negative - 241 242 243 244 245 + 259 260 261 262 263 Lu positive - 246 247 248 249 250 + 264 265 266 267 268 Lu negative - 251 + 269 Lx positive - 252 253 254 255 256 257 + 270 271 272 273 274 275 Lx negative - 258 + 276 LX positive - 259 260 261 262 263 264 + 277 278 279 280 281 282 Lx negative - 265 + 283 Lo positive - 266 267 268 269 270 271 + 284 285 286 287 288 289 Lo negative - 272 + 290 a - 273 + 291 t - 274 + 292 {...%} - 275 + 293 (...%) - 276 + 294 ! % @ , and constants - 277 278 279 280 281 282 283 + 295 296 297 298 299 300 301 end of tests All tests succeeded. diff --git a/testsuite/tests/lib-queue/ocamltests b/testsuite/tests/lib-queue/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-queue/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-random/ocamltests b/testsuite/tests/lib-random/ocamltests deleted file mode 100644 index 91c37c04..00000000 --- a/testsuite/tests/lib-random/ocamltests +++ /dev/null @@ -1 +0,0 @@ -rand.ml diff --git a/testsuite/tests/lib-result/ocamltests b/testsuite/tests/lib-result/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-result/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-scanf-2/ocamltests b/testsuite/tests/lib-scanf-2/ocamltests deleted file mode 100644 index 0260373e..00000000 --- a/testsuite/tests/lib-scanf-2/ocamltests +++ /dev/null @@ -1 +0,0 @@ -tscanf2_master.ml diff --git a/testsuite/tests/lib-scanf/ocamltests b/testsuite/tests/lib-scanf/ocamltests deleted file mode 100644 index 0618be9c..00000000 --- a/testsuite/tests/lib-scanf/ocamltests +++ /dev/null @@ -1 +0,0 @@ -tscanf.ml diff --git a/testsuite/tests/lib-scanf/tscanf.ml b/testsuite/tests/lib-scanf/tscanf.ml index e932f960..cebc76d4 100644 --- a/testsuite/tests/lib-scanf/tscanf.ml +++ b/testsuite/tests/lib-scanf/tscanf.ml @@ -1,5 +1,6 @@ (* TEST include testing + compare_programs = "false" (* See https://github.com/ocaml/ocaml/pull/8853 *) *) (* diff --git a/testsuite/tests/lib-seq/ocamltests b/testsuite/tests/lib-seq/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-seq/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-set/ocamltests b/testsuite/tests/lib-set/ocamltests deleted file mode 100644 index fdc3b400..00000000 --- a/testsuite/tests/lib-set/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -testmap.ml -testset.ml diff --git a/testsuite/tests/lib-stack/ocamltests b/testsuite/tests/lib-stack/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-stack/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-stdlabels/ocamltests b/testsuite/tests/lib-stdlabels/ocamltests deleted file mode 100644 index eb3b0ea4..00000000 --- a/testsuite/tests/lib-stdlabels/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test_stdlabels.ml diff --git a/testsuite/tests/lib-stdlib/ocamltests b/testsuite/tests/lib-stdlib/ocamltests deleted file mode 100644 index a1f50ef4..00000000 --- a/testsuite/tests/lib-stdlib/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pervasives_deprecated.ml diff --git a/testsuite/tests/lib-str/ocamltests b/testsuite/tests/lib-str/ocamltests deleted file mode 100644 index 13403709..00000000 --- a/testsuite/tests/lib-str/ocamltests +++ /dev/null @@ -1 +0,0 @@ -t01.ml diff --git a/testsuite/tests/lib-stream/ocamltests b/testsuite/tests/lib-stream/ocamltests deleted file mode 100644 index 5cfd70ad..00000000 --- a/testsuite/tests/lib-stream/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -count_concat_bug.ml -mpr7769.ml diff --git a/testsuite/tests/lib-string/ocamltests b/testsuite/tests/lib-string/ocamltests deleted file mode 100644 index 34e6691d..00000000 --- a/testsuite/tests/lib-string/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test_string.ml diff --git a/testsuite/tests/lib-sys/immediate64.ml b/testsuite/tests/lib-sys/immediate64.ml new file mode 100644 index 00000000..0f7dea7c --- /dev/null +++ b/testsuite/tests/lib-sys/immediate64.ml @@ -0,0 +1,32 @@ +(* TEST +*) + +module M : sig + type t [@@immediate64] + val zero : t + val one : t + val add : t -> t -> t +end = struct + + include Sys.Immediate64.Make(Int)(Int64) + + module type S = sig + val zero : t + val one : t + val add : t -> t -> t + end + + let impl : (module S) = + match repr with + | Immediate -> + (module Int : S) + | Non_immediate -> + (module Int64 : S) + + include (val impl : S) +end + +let () = + match Sys.word_size with + | 64 -> assert (Obj.is_int (Obj.repr M.zero)) + | _ -> assert (Obj.is_block (Obj.repr M.zero)) diff --git a/testsuite/tests/lib-sys/ocamltests b/testsuite/tests/lib-sys/ocamltests deleted file mode 100644 index cdb154ed..00000000 --- a/testsuite/tests/lib-sys/ocamltests +++ /dev/null @@ -1 +0,0 @@ -rename.ml diff --git a/testsuite/tests/lib-systhreads/ocamltests b/testsuite/tests/lib-systhreads/ocamltests deleted file mode 100644 index ccae4b47..00000000 --- a/testsuite/tests/lib-systhreads/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -testfork.ml -testpreempt.ml -testyield.ml -threadsigmask.ml diff --git a/testsuite/tests/lib-systhreads/testyield.ml b/testsuite/tests/lib-systhreads/testyield.ml index 30e70ce9..646dfe3e 100644 --- a/testsuite/tests/lib-systhreads/testyield.ml +++ b/testsuite/tests/lib-systhreads/testyield.ml @@ -1,10 +1,11 @@ (* TEST (* Test that yielding between busy threads reliably triggers a thread switch. *) + * hassysthreads include systhreads - * not-windows - ** bytecode - ** native + ** not-windows + *** bytecode + *** native *) let threads = 4 diff --git a/testsuite/tests/lib-threads/ocamltests b/testsuite/tests/lib-threads/ocamltests deleted file mode 100644 index 54350865..00000000 --- a/testsuite/tests/lib-threads/ocamltests +++ /dev/null @@ -1,18 +0,0 @@ -backtrace_threads.ml -bank.ml -beat.ml -bufchan.ml -close.ml -delayintr.ml -fileio.ml -pr4466.ml -pr5325.ml -pr7638.ml -prodcons.ml -prodcons2.ml -sieve.ml -signal.ml -sockets.ml -swapchan.ml -tls.ml -torture.ml diff --git a/testsuite/tests/lib-uchar/ocamltests b/testsuite/tests/lib-uchar/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-uchar/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-unix/common/fdstatus_aux.c b/testsuite/tests/lib-unix/common/fdstatus_aux.c index 199166e8..127bacd2 100644 --- a/testsuite/tests/lib-unix/common/fdstatus_aux.c +++ b/testsuite/tests/lib-unix/common/fdstatus_aux.c @@ -10,7 +10,7 @@ #include #include -void process_fd(char * s) +void process_fd(const char * s) { int fd; HANDLE h; @@ -39,7 +39,7 @@ void process_fd(char * s) #include #include -void process_fd(char * s) +void process_fd(const char * s) { long n; int fd; diff --git a/testsuite/tests/lib-unix/common/ocamltests b/testsuite/tests/lib-unix/common/ocamltests deleted file mode 100644 index 2e07ad64..00000000 --- a/testsuite/tests/lib-unix/common/ocamltests +++ /dev/null @@ -1,12 +0,0 @@ -channel_of.ml -cloexec.ml -dup2.ml -dup.ml -pipe_eof.ml -redirections.ml -rename.ml -test_unix_cmdline.ml -utimes.ml -wait_nohang.ml -getaddrinfo.ml -process_pid.ml diff --git a/testsuite/tests/lib-unix/common/process_pid.ml b/testsuite/tests/lib-unix/common/process_pid.ml index 6df536bf..8d8852f6 100644 --- a/testsuite/tests/lib-unix/common/process_pid.ml +++ b/testsuite/tests/lib-unix/common/process_pid.ml @@ -5,17 +5,11 @@ include unix ** native *) -let null = - if Sys.win32 then - "NUL" - else - "/dev/null" - let () = let ic, _ as process = (* Redirect to null to avoid "The process tried to write to a nonexistent pipe." on Windows *) - Printf.ksprintf Unix.open_process "echo toto > %s" null + Printf.ksprintf Unix.open_process "echo toto > %s" Filename.null in assert (Unix.process_pid process = Unix.process_pid process); diff --git a/testsuite/tests/lib-unix/common/truncate.ml b/testsuite/tests/lib-unix/common/truncate.ml new file mode 100644 index 00000000..a91cabcb --- /dev/null +++ b/testsuite/tests/lib-unix/common/truncate.ml @@ -0,0 +1,33 @@ +(* TEST +include unix +* hasunix +** bytecode +** native +*) + +let str = "Hello, OCaml!" +let txt = "truncate.txt" + +let test file openfile stat truncate delta close = + let () = + let c = open_out_bin file in + output_string c str; + close_out c + in + let size file = + (stat file).Unix.st_size + in + let file = openfile file in + Printf.printf "initial size: %d\n%!" (size file); + truncate file (size file - delta); + Printf.printf "new size: %d\n%!" (size file); + truncate file 0; + Printf.printf "final size: %d\n%!" (size file); + close file + +let () = + test "truncate.txt" (fun x -> x) Unix.stat Unix.truncate 2 ignore + +let () = + let open_it file = Unix.openfile file [O_RDWR] 0 in + test "ftruncate.txt" open_it Unix.fstat Unix.ftruncate 3 Unix.close diff --git a/testsuite/tests/lib-unix/common/truncate.reference b/testsuite/tests/lib-unix/common/truncate.reference new file mode 100644 index 00000000..07c37386 --- /dev/null +++ b/testsuite/tests/lib-unix/common/truncate.reference @@ -0,0 +1,6 @@ +initial size: 13 +new size: 11 +final size: 0 +initial size: 13 +new size: 10 +final size: 0 diff --git a/testsuite/tests/lib-unix/isatty/ocamltests b/testsuite/tests/lib-unix/isatty/ocamltests deleted file mode 100644 index 455ee0ea..00000000 --- a/testsuite/tests/lib-unix/isatty/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -isatty_std.ml -isatty_tty.ml diff --git a/testsuite/tests/lib-unix/unix-execvpe/ocamltests b/testsuite/tests/lib-unix/unix-execvpe/ocamltests deleted file mode 100644 index 5280ba49..00000000 --- a/testsuite/tests/lib-unix/unix-execvpe/ocamltests +++ /dev/null @@ -1 +0,0 @@ -exec.ml diff --git a/testsuite/tests/lib-unix/unix-socket/ocamltests b/testsuite/tests/lib-unix/unix-socket/ocamltests deleted file mode 100644 index 34b36e47..00000000 --- a/testsuite/tests/lib-unix/unix-socket/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -recvfrom_unix.ml -recvfrom_linux.ml diff --git a/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml index dc66b169..e584ff17 100644 --- a/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml +++ b/testsuite/tests/lib-unix/unix-socket/recvfrom_unix.ml @@ -1,9 +1,10 @@ (* TEST include unix modules = "recvfrom.ml" -* not-windows -** bytecode -** native +* hasunix +** not-windows +*** bytecode +*** native *) open Recvfrom diff --git a/testsuite/tests/lib-unix/win-env/ocamltests b/testsuite/tests/lib-unix/win-env/ocamltests deleted file mode 100644 index 515d330e..00000000 --- a/testsuite/tests/lib-unix/win-env/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test_env.ml diff --git a/testsuite/tests/lib-unix/win-stat/ocamltests b/testsuite/tests/lib-unix/win-stat/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-unix/win-stat/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/lib-unix/win-symlink/ocamltests b/testsuite/tests/lib-unix/win-symlink/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/lib-unix/win-symlink/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/link-test/ocamltests b/testsuite/tests/link-test/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/link-test/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/local-functions/ocamltests b/testsuite/tests/local-functions/ocamltests deleted file mode 100644 index 65f80369..00000000 --- a/testsuite/tests/local-functions/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -tupled.ml -tupled2.ml diff --git a/testsuite/tests/locale/ocamltests b/testsuite/tests/locale/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/locale/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/manual-intf-c/ocamltests b/testsuite/tests/manual-intf-c/ocamltests deleted file mode 100644 index a825cb25..00000000 --- a/testsuite/tests/manual-intf-c/ocamltests +++ /dev/null @@ -1 +0,0 @@ -prog.ml diff --git a/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml b/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml index 199f4758..225d5305 100644 --- a/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml +++ b/testsuite/tests/match-exception-warnings/no_mixing_under_guard.ml @@ -14,8 +14,8 @@ let guarded f = [%%expect{| exception Exit val r : string ref = {contents = ""} -Line _, characters 4-25: - | true | exception Exit when r := "hello"; true -> !r - ^^^^^^^^^^^^^^^^^^^^^ +Line 7, characters 4-25: +7 | | true | exception Exit when r := "hello"; true -> !r + ^^^^^^^^^^^^^^^^^^^^^ Error: Mixing value and exception patterns under when-guards is not supported. |}] diff --git a/testsuite/tests/match-exception-warnings/no_value_clauses.ml b/testsuite/tests/match-exception-warnings/no_value_clauses.ml index f301105b..77996e5b 100644 --- a/testsuite/tests/match-exception-warnings/no_value_clauses.ml +++ b/testsuite/tests/match-exception-warnings/no_value_clauses.ml @@ -7,9 +7,9 @@ let test f = ;; [%%expect{| -Line _, characters 2-43: - match f () with exception Not_found -> () - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Line 2, characters 2-43: +2 | match f () with exception Not_found -> () + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: None of the patterns in this 'match' expression match values. |}] ;; diff --git a/testsuite/tests/match-exception-warnings/ocamltests b/testsuite/tests/match-exception-warnings/ocamltests deleted file mode 100644 index 101da881..00000000 --- a/testsuite/tests/match-exception-warnings/ocamltests +++ /dev/null @@ -1 +0,0 @@ -exhaustiveness_warnings.ml diff --git a/testsuite/tests/match-exception-warnings/placement.ml b/testsuite/tests/match-exception-warnings/placement.ml index a8423f16..c93247e3 100644 --- a/testsuite/tests/match-exception-warnings/placement.ml +++ b/testsuite/tests/match-exception-warnings/placement.ml @@ -59,9 +59,9 @@ let f x = ;; [%%expect{| -Line _, characters 7-18: - with exception _ -> () - ^^^^^^^^^^^ +Line 3, characters 7-18: +3 | with exception _ -> () + ^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -73,9 +73,9 @@ let f x = ;; [%%expect{| -Line _, characters 4-17: - | (exception _) as _pat -> () - ^^^^^^^^^^^^^ +Line 3, characters 4-17: +3 | | (exception _) as _pat -> () + ^^^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -86,9 +86,9 @@ let f x = ;; [%%expect{| -Line _, characters 8-19: - | (_, exception _, _) -> () - ^^^^^^^^^^^ +Line 3, characters 8-19: +3 | | (_, exception _, _) -> () + ^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -100,9 +100,9 @@ let f x = ;; [%%expect{| -Line _, characters 9-22: - | lazy (exception _) -> () - ^^^^^^^^^^^^^ +Line 3, characters 9-22: +3 | | lazy (exception _) -> () + ^^^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -113,9 +113,9 @@ let f x = ;; [%%expect{| -Line _, characters 17-28: - | { contents = exception _ } -> () - ^^^^^^^^^^^ +Line 3, characters 17-28: +3 | | { contents = exception _ } -> () + ^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -126,9 +126,9 @@ let f x = ;; [%%expect{| -Line _, characters 7-18: - | [| exception _ |] -> () - ^^^^^^^^^^^ +Line 3, characters 7-18: +3 | | [| exception _ |] -> () + ^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -139,9 +139,9 @@ let f x = ;; [%%expect{| -Line _, characters 9-22: - | Some (exception _) -> () - ^^^^^^^^^^^^^ +Line 3, characters 9-22: +3 | | Some (exception _) -> () + ^^^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -152,9 +152,9 @@ let f x = ;; [%%expect{| -Line _, characters 7-20: - | `A (exception _) -> () - ^^^^^^^^^^^^^ +Line 3, characters 7-20: +3 | | `A (exception _) -> () + ^^^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] ;; @@ -165,8 +165,8 @@ let f = function ;; [%%expect{| -Line _, characters 4-15: - | exception _ -> () - ^^^^^^^^^^^ +Line 2, characters 4-15: +2 | | exception _ -> () + ^^^^^^^^^^^ Error: Exception patterns are not allowed in this position. |}] diff --git a/testsuite/tests/match-exception-warnings/reachability.ml b/testsuite/tests/match-exception-warnings/reachability.ml index 4a36dc55..7c56ca2f 100644 --- a/testsuite/tests/match-exception-warnings/reachability.ml +++ b/testsuite/tests/match-exception-warnings/reachability.ml @@ -9,9 +9,9 @@ let f x = ;; [%%expect{| -Line _, characters 14-15: - | exception _ -> . - ^ +Line 4, characters 14-15: +4 | | exception _ -> . + ^ Error: This match case could not be refuted. Here is an example of a value that would reach it: _ |}] @@ -24,9 +24,9 @@ let f x = ;; [%%expect{| -Line _, characters 21-22: - | None | exception _ -> . - ^ +Line 4, characters 21-22: +4 | | None | exception _ -> . + ^ Error: This match case could not be refuted. Here is an example of a value that would reach it: _ |}] @@ -41,9 +41,9 @@ let f x = [%%expect{| -Line _, characters 14-23: - | exception Not_found | None -> . - ^^^^^^^^^ +Line 4, characters 14-23: +4 | | exception Not_found | None -> . + ^^^^^^^^^ Error: This match case could not be refuted. Here is an example of a value that would reach it: Not_found |}] diff --git a/testsuite/tests/match-exception/ocamltests b/testsuite/tests/match-exception/ocamltests deleted file mode 100644 index 8494eb24..00000000 --- a/testsuite/tests/match-exception/ocamltests +++ /dev/null @@ -1,8 +0,0 @@ -allocation.ml -exception_propagation.ml -identifier_sharing.ml -match_failure.ml -nested_handlers.ml -raise_from_success_continuation.ml -streams.ml -tail_calls.ml diff --git a/testsuite/tests/messages/ocamltests b/testsuite/tests/messages/ocamltests deleted file mode 100644 index 83912757..00000000 --- a/testsuite/tests/messages/ocamltests +++ /dev/null @@ -1 +0,0 @@ -precise_locations.ml diff --git a/testsuite/tests/messages/precise_locations.ml b/testsuite/tests/messages/precise_locations.ml index 3b5612a3..efbc15a4 100644 --- a/testsuite/tests/messages/precise_locations.ml +++ b/testsuite/tests/messages/precise_locations.ml @@ -19,7 +19,7 @@ function (x : Line 2, characters 1-4: 2 | #bar) -> ();; ^^^ -Error: Unbound class bar +Error: Unbound class type bar |}];; function @@ -48,21 +48,21 @@ type t = #warnings "@3";; let x = Foo ();; -(* "Foo ()": the whole construct, with arguments, is deprecated *) + [%%expect{| type t = Foo of unit | Bar -Line 6, characters 0-6: +Line 6, characters 0-3: 6 | Foo ();; - ^^^^^^ + ^^^ Error (alert deprecated): Foo |}];; function Foo _ -> () | Bar -> ();; -(* "Foo _", the whole construct is deprecated *) + [%%expect{| -Line 2, characters 0-5: +Line 2, characters 0-3: 2 | Foo _ -> () | Bar -> ();; - ^^^^^ + ^^^ Error (alert deprecated): Foo |}];; diff --git a/testsuite/tests/misc-kb/ocamltests b/testsuite/tests/misc-kb/ocamltests deleted file mode 100644 index bc74409e..00000000 --- a/testsuite/tests/misc-kb/ocamltests +++ /dev/null @@ -1 +0,0 @@ -kbmain.ml diff --git a/testsuite/tests/misc-unsafe/ocamltests b/testsuite/tests/misc-unsafe/ocamltests deleted file mode 100644 index 8c3cf30a..00000000 --- a/testsuite/tests/misc-unsafe/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -almabench.ml -fft.ml -quicksort.ml -soli.ml diff --git a/testsuite/tests/misc/ocamltests b/testsuite/tests/misc/ocamltests deleted file mode 100644 index e76a5813..00000000 --- a/testsuite/tests/misc/ocamltests +++ /dev/null @@ -1,19 +0,0 @@ -bdd.ml -boyer.ml -ephetest.ml -ephetest2.ml -ephetest3.ml -fib.ml -finaliser.ml -gcwords.ml -gpr1370.ml -hamming.ml -nucleic.ml -pr7168.ml -sieve.ml -sorts.ml -takc.ml -taku.ml -weaklifetime.ml -weaklifetime2.ml -weaktest.ml diff --git a/testsuite/tests/no-alias-deps/ocamltests b/testsuite/tests/no-alias-deps/ocamltests deleted file mode 100644 index d107063d..00000000 --- a/testsuite/tests/no-alias-deps/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -aliases.ml -gpr2235.ml diff --git a/testsuite/tests/opaque/ocamltests b/testsuite/tests/opaque/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/opaque/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/output-complete-obj/ocamltests b/testsuite/tests/output-complete-obj/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/output-complete-obj/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/output-complete-obj/puts.c b/testsuite/tests/output-complete-obj/puts.c new file mode 100644 index 00000000..528cd946 --- /dev/null +++ b/testsuite/tests/output-complete-obj/puts.c @@ -0,0 +1,8 @@ +#include +#include + +value caml_puts(value s) +{ + puts(String_val(s)); + return Val_unit; +} diff --git a/testsuite/tests/output-complete-obj/test2.ml b/testsuite/tests/output-complete-obj/test2.ml new file mode 100644 index 00000000..5207823a --- /dev/null +++ b/testsuite/tests/output-complete-obj/test2.ml @@ -0,0 +1,21 @@ +(* TEST + +files = "puts.c" +use_runtime = "false" + +* hasunix +include unix +** setup-ocamlc.byte-build-env +*** ocamlc.byte +flags = "-w a -output-complete-exe puts.c -ccopt -I${ocamlsrcdir}/runtime" +program = "test2" +**** run +program = "./test2" +***** check-program-output +*) + +external puts: string -> unit = "caml_puts" + +let () = + Unix.putenv "FOO" "Hello OCaml!"; + puts (Unix.getenv "FOO") diff --git a/testsuite/tests/output-complete-obj/test2.reference b/testsuite/tests/output-complete-obj/test2.reference new file mode 100644 index 00000000..6a561060 --- /dev/null +++ b/testsuite/tests/output-complete-obj/test2.reference @@ -0,0 +1 @@ +Hello OCaml! diff --git a/testsuite/tests/parse-errors/ocamltests b/testsuite/tests/parse-errors/ocamltests deleted file mode 100644 index 314733ee..00000000 --- a/testsuite/tests/parse-errors/ocamltests +++ /dev/null @@ -1,18 +0,0 @@ -escape_error.ml -expecting.ml -pr7847.ml -unclosed_class_signature.mli -unclosed_class_simpl_expr1.ml -unclosed_class_simpl_expr2.ml -unclosed_class_simpl_expr3.ml -unclosed_object.ml -unclosed_paren_module_expr1.ml -unclosed_paren_module_expr2.ml -unclosed_paren_module_expr3.ml -unclosed_paren_module_expr4.ml -unclosed_paren_module_expr5.ml -unclosed_paren_module_type.mli -unclosed_sig.mli -unclosed_simple_expr.ml -unclosed_simple_pattern.ml -unclosed_struct.ml diff --git a/testsuite/tests/parsetree/ocamltests b/testsuite/tests/parsetree/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/parsetree/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/parsing/docstrings.ml b/testsuite/tests/parsing/docstrings.ml index 3cae459d..401fbd35 100644 --- a/testsuite/tests/parsing/docstrings.ml +++ b/testsuite/tests/parsing/docstrings.ml @@ -516,7 +516,7 @@ module M = struct (** foo *) end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct (** foo *) @@ -525,7 +525,7 @@ end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -534,7 +534,7 @@ module M = struct [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -543,7 +543,7 @@ end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -553,7 +553,7 @@ end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -563,7 +563,7 @@ end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -574,7 +574,7 @@ end;; [%%expect {| module M = struct [@@@ocaml.text " foo "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -588,7 +588,7 @@ end;; module M = struct [@@@ocaml.text " foo "] [@@@ocaml.text " bar "] end;; -module M : sig end +module M : sig end |}] module M = struct @@ -600,7 +600,7 @@ end;; module M = struct [@@@ocaml.text " foo "] [@@@ocaml.text " bar "] end;; -module M : sig end +module M : sig end |}] @@ -645,3 +645,26 @@ type var = [ `Foo [@ocaml.doc " foo "] | `Bar of (int * string) [@ocaml.doc " bar "]];; type var = [ `Bar of int * string | `Foo ] |}] + +module type S = sig + + val before : unit -> unit + (** docstring before *) + [@@@foo] + + [@@@foo] + (** docstring after *) + val after : unit -> unit + +end;; +[%%expect {| + +module type S = + sig + val before : unit -> unit[@@ocaml.doc " docstring before "] + [@@@foo ] + [@@@foo ] + val after : unit -> unit[@@ocaml.doc " docstring after "] + end;; +module type S = sig val before : unit -> unit val after : unit -> unit end +|}] diff --git a/testsuite/tests/parsing/extended_indexoperators.compilers.reference b/testsuite/tests/parsing/extended_indexoperators.compilers.reference deleted file mode 100644 index 783bbc2b..00000000 --- a/testsuite/tests/parsing/extended_indexoperators.compilers.reference +++ /dev/null @@ -1,327 +0,0 @@ -[ - structure_item (extended_indexoperators.ml[8,120+0]..[8,120+29]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[8,120+4]..[8,120+10]) - Ppat_var ".?[]" (extended_indexoperators.ml[8,120+4]..[8,120+10]) - expression (extended_indexoperators.ml[8,120+13]..[8,120+29]) - Pexp_ident "Hashtbl.find_opt" (extended_indexoperators.ml[8,120+13]..[8,120+29]) - ] - structure_item (extended_indexoperators.ml[9,150+0]..[9,150+25]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[9,150+4]..[9,150+10]) - Ppat_var ".@[]" (extended_indexoperators.ml[9,150+4]..[9,150+10]) - expression (extended_indexoperators.ml[9,150+13]..[9,150+25]) - Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[9,150+13]..[9,150+25]) - ] - structure_item (extended_indexoperators.ml[10,176+0]..[10,176+28]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[10,176+4]..[10,176+14]) - Ppat_var ".@[]<-" (extended_indexoperators.ml[10,176+4]..[10,176+14]) - expression (extended_indexoperators.ml[10,176+17]..[10,176+28]) - Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[10,176+17]..[10,176+28]) - ] - structure_item (extended_indexoperators.ml[11,205+0]..[11,205+25]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[11,205+4]..[11,205+10]) - Ppat_var ".@{}" (extended_indexoperators.ml[11,205+4]..[11,205+10]) - expression (extended_indexoperators.ml[11,205+13]..[11,205+25]) - Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[11,205+13]..[11,205+25]) - ] - structure_item (extended_indexoperators.ml[12,231+0]..[12,231+28]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[12,231+4]..[12,231+14]) - Ppat_var ".@{}<-" (extended_indexoperators.ml[12,231+4]..[12,231+14]) - expression (extended_indexoperators.ml[12,231+17]..[12,231+28]) - Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[12,231+17]..[12,231+28]) - ] - structure_item (extended_indexoperators.ml[13,260+0]..[13,260+25]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[13,260+4]..[13,260+10]) - Ppat_var ".@()" (extended_indexoperators.ml[13,260+4]..[13,260+10]) - expression (extended_indexoperators.ml[13,260+13]..[13,260+25]) - Pexp_ident "Hashtbl.find" (extended_indexoperators.ml[13,260+13]..[13,260+25]) - ] - structure_item (extended_indexoperators.ml[14,286+0]..[14,286+28]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[14,286+4]..[14,286+14]) - Ppat_var ".@()<-" (extended_indexoperators.ml[14,286+4]..[14,286+14]) - expression (extended_indexoperators.ml[14,286+17]..[14,286+28]) - Pexp_ident "Hashtbl.add" (extended_indexoperators.ml[14,286+17]..[14,286+28]) - ] - structure_item (extended_indexoperators.ml[16,316+0]..[16,316+25]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[16,316+4]..[16,316+5]) - Ppat_var "h" (extended_indexoperators.ml[16,316+4]..[16,316+5]) - expression (extended_indexoperators.ml[16,316+8]..[16,316+25]) - Pexp_apply - expression (extended_indexoperators.ml[16,316+8]..[16,316+22]) - Pexp_ident "Hashtbl.create" (extended_indexoperators.ml[16,316+8]..[16,316+22]) - [ - - Nolabel - expression (extended_indexoperators.ml[16,316+23]..[16,316+25]) - Pexp_constant PConst_int (17,None) - ] - ] - structure_item (extended_indexoperators.ml[19,346+2]..[22,413+28]) - Pstr_eval - expression (extended_indexoperators.ml[19,346+2]..[22,413+28]) - Pexp_sequence - expression (extended_indexoperators.ml[19,346+2]..[19,346+17]) - Pexp_apply - expression (extended_indexoperators.ml[19,346+2]..[19,346+17]) - Pexp_ident ".@()<-" (extended_indexoperators.ml[19,346+2]..[19,346+17]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[19,346+2]..[19,346+3]) - Pexp_ident "h" (extended_indexoperators.ml[19,346+2]..[19,346+3]) - - Nolabel - expression (extended_indexoperators.ml[19,346+6]..[19,346+11]) - Pexp_constant PConst_string("One",None) - - Nolabel - expression (extended_indexoperators.ml[19,346+16]..[19,346+17]) - Pexp_constant PConst_int (1,None) - ] - expression (extended_indexoperators.ml[20,364+2]..[22,413+28]) - Pexp_sequence - expression (extended_indexoperators.ml[20,364+2]..[20,364+25]) - Pexp_assert - expression (extended_indexoperators.ml[20,364+9]..[20,364+25]) - Pexp_apply - expression (extended_indexoperators.ml[20,364+21]..[20,364+22]) - Pexp_ident "=" (extended_indexoperators.ml[20,364+21]..[20,364+22]) - [ - - Nolabel - expression (extended_indexoperators.ml[20,364+10]..[20,364+20]) - Pexp_apply - expression (extended_indexoperators.ml[20,364+10]..[20,364+20]) - Pexp_ident ".@{}" (extended_indexoperators.ml[20,364+10]..[20,364+20]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[20,364+10]..[20,364+11]) - Pexp_ident "h" (extended_indexoperators.ml[20,364+10]..[20,364+11]) - - Nolabel - expression (extended_indexoperators.ml[20,364+14]..[20,364+19]) - Pexp_constant PConst_string("One",None) - ] - - Nolabel - expression (extended_indexoperators.ml[20,364+23]..[20,364+24]) - Pexp_constant PConst_int (1,None) - ] - expression (extended_indexoperators.ml[21,390+2]..[22,413+28]) - Pexp_sequence - expression (extended_indexoperators.ml[21,390+2]..[21,390+22]) - Pexp_apply - expression (extended_indexoperators.ml[21,390+2]..[21,390+11]) - Pexp_ident "print_int" (extended_indexoperators.ml[21,390+2]..[21,390+11]) - [ - - Nolabel - expression (extended_indexoperators.ml[21,390+12]..[21,390+22]) - Pexp_apply - expression (extended_indexoperators.ml[21,390+12]..[21,390+22]) - Pexp_ident ".@{}" (extended_indexoperators.ml[21,390+12]..[21,390+22]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[21,390+12]..[21,390+13]) - Pexp_ident "h" (extended_indexoperators.ml[21,390+12]..[21,390+13]) - - Nolabel - expression (extended_indexoperators.ml[21,390+16]..[21,390+21]) - Pexp_constant PConst_string("One",None) - ] - ] - expression (extended_indexoperators.ml[22,413+2]..[22,413+28]) - Pexp_assert - expression (extended_indexoperators.ml[22,413+9]..[22,413+28]) - Pexp_apply - expression (extended_indexoperators.ml[22,413+21]..[22,413+22]) - Pexp_ident "=" (extended_indexoperators.ml[22,413+21]..[22,413+22]) - [ - - Nolabel - expression (extended_indexoperators.ml[22,413+10]..[22,413+20]) - Pexp_apply - expression (extended_indexoperators.ml[22,413+10]..[22,413+20]) - Pexp_ident ".?[]" (extended_indexoperators.ml[22,413+10]..[22,413+20]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[22,413+10]..[22,413+11]) - Pexp_ident "h" (extended_indexoperators.ml[22,413+10]..[22,413+11]) - - Nolabel - expression (extended_indexoperators.ml[22,413+14]..[22,413+19]) - Pexp_constant PConst_string("Two",None) - ] - - Nolabel - expression (extended_indexoperators.ml[22,413+23]..[22,413+27]) - Pexp_construct "None" (extended_indexoperators.ml[22,413+23]..[22,413+27]) - None - ] - structure_item (extended_indexoperators.ml[26,464+0]..[26,464+23]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[26,464+4]..[26,464+10]) - Ppat_var "#?" (extended_indexoperators.ml[26,464+4]..[26,464+10]) - expression (extended_indexoperators.ml[26,464+11]..[26,464+23]) ghost - Pexp_fun - Nolabel - None - pattern (extended_indexoperators.ml[26,464+11]..[26,464+12]) - Ppat_var "x" (extended_indexoperators.ml[26,464+11]..[26,464+12]) - expression (extended_indexoperators.ml[26,464+13]..[26,464+23]) ghost - Pexp_fun - Nolabel - None - pattern (extended_indexoperators.ml[26,464+13]..[26,464+14]) - Ppat_var "y" (extended_indexoperators.ml[26,464+13]..[26,464+14]) - expression (extended_indexoperators.ml[26,464+17]..[26,464+23]) - Pexp_tuple - [ - expression (extended_indexoperators.ml[26,464+18]..[26,464+19]) - Pexp_ident "x" (extended_indexoperators.ml[26,464+18]..[26,464+19]) - expression (extended_indexoperators.ml[26,464+21]..[26,464+22]) - Pexp_ident "y" (extended_indexoperators.ml[26,464+21]..[26,464+22]) - ] - ] - structure_item (extended_indexoperators.ml[27,490+0]..[27,490+24]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[27,490+4]..[27,490+12]) - Ppat_var ".%()" (extended_indexoperators.ml[27,490+4]..[27,490+12]) - expression (extended_indexoperators.ml[27,490+13]..[27,490+24]) ghost - Pexp_fun - Nolabel - None - pattern (extended_indexoperators.ml[27,490+13]..[27,490+14]) - Ppat_var "x" (extended_indexoperators.ml[27,490+13]..[27,490+14]) - expression (extended_indexoperators.ml[27,490+15]..[27,490+24]) ghost - Pexp_fun - Nolabel - None - pattern (extended_indexoperators.ml[27,490+15]..[27,490+16]) - Ppat_var "y" (extended_indexoperators.ml[27,490+15]..[27,490+16]) - expression (extended_indexoperators.ml[27,490+19]..[27,490+24]) - Pexp_apply - expression (extended_indexoperators.ml[27,490+19]..[27,490+24]) ghost - Pexp_ident "Array.get" (extended_indexoperators.ml[27,490+19]..[27,490+24]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[27,490+19]..[27,490+20]) - Pexp_ident "x" (extended_indexoperators.ml[27,490+19]..[27,490+20]) - - Nolabel - expression (extended_indexoperators.ml[27,490+22]..[27,490+23]) - Pexp_ident "y" (extended_indexoperators.ml[27,490+22]..[27,490+23]) - ] - ] - structure_item (extended_indexoperators.ml[28,517+0]..[28,517+15]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[28,517+4]..[28,517+5]) - Ppat_var "x" (extended_indexoperators.ml[28,517+4]..[28,517+5]) - expression (extended_indexoperators.ml[28,517+8]..[28,517+15]) - Pexp_array - [ - expression (extended_indexoperators.ml[28,517+11]..[28,517+12]) - Pexp_constant PConst_int (0,None) - ] - ] - structure_item (extended_indexoperators.ml[29,535+0]..[29,535+18]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[29,535+4]..[29,535+5]) - Ppat_any - expression (extended_indexoperators.ml[29,535+8]..[29,535+18]) - Pexp_apply - expression (extended_indexoperators.ml[29,535+10]..[29,535+12]) - Pexp_ident "#?" (extended_indexoperators.ml[29,535+10]..[29,535+12]) - [ - - Nolabel - expression (extended_indexoperators.ml[29,535+8]..[29,535+9]) - Pexp_constant PConst_int (1,None) - - Nolabel - expression (extended_indexoperators.ml[29,535+13]..[29,535+18]) - Pexp_apply - expression (extended_indexoperators.ml[29,535+13]..[29,535+18]) ghost - Pexp_ident "Array.get" (extended_indexoperators.ml[29,535+13]..[29,535+18]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[29,535+13]..[29,535+14]) - Pexp_ident "x" (extended_indexoperators.ml[29,535+13]..[29,535+14]) - - Nolabel - expression (extended_indexoperators.ml[29,535+16]..[29,535+17]) - Pexp_constant PConst_int (0,None) - ] - ] - ] - structure_item (extended_indexoperators.ml[30,556+0]..[30,556+19]) - Pstr_value Nonrec - [ - - pattern (extended_indexoperators.ml[30,556+4]..[30,556+5]) - Ppat_any - expression (extended_indexoperators.ml[30,556+8]..[30,556+19]) - Pexp_apply - expression (extended_indexoperators.ml[30,556+10]..[30,556+12]) - Pexp_ident "#?" (extended_indexoperators.ml[30,556+10]..[30,556+12]) - [ - - Nolabel - expression (extended_indexoperators.ml[30,556+8]..[30,556+9]) - Pexp_constant PConst_int (1,None) - - Nolabel - expression (extended_indexoperators.ml[30,556+13]..[30,556+19]) - Pexp_apply - expression (extended_indexoperators.ml[30,556+13]..[30,556+19]) - Pexp_ident ".%()" (extended_indexoperators.ml[30,556+13]..[30,556+19]) ghost - [ - - Nolabel - expression (extended_indexoperators.ml[30,556+13]..[30,556+14]) - Pexp_ident "x" (extended_indexoperators.ml[30,556+13]..[30,556+14]) - - Nolabel - expression (extended_indexoperators.ml[30,556+17]..[30,556+18]) - Pexp_constant PConst_int (0,None) - ] - ] - ] -] - diff --git a/testsuite/tests/parsing/extended_indexoperators.ml b/testsuite/tests/parsing/extended_indexoperators.ml index e4ddc7a6..bb5fec23 100644 --- a/testsuite/tests/parsing/extended_indexoperators.ml +++ b/testsuite/tests/parsing/extended_indexoperators.ml @@ -1,8 +1,6 @@ (* TEST - flags = "-dparsetree" - * setup-ocamlc.byte-build-env - ** ocamlc.byte - *** check-ocamlc.byte-output + * expect + flags = "-dsource" *) let (.?[]) = Hashtbl.find_opt @@ -11,20 +9,86 @@ let ( .@[]<- ) = Hashtbl.add let (.@{}) = Hashtbl.find let ( .@{}<- ) = Hashtbl.add let (.@()) = Hashtbl.find -let ( .@()<- ) = Hashtbl.add +let ( .@()<- ) = Hashtbl.add ;; +[%%expect {| -let h = Hashtbl.create 17 +let (.?[]) = Hashtbl.find_opt;; +val ( .?[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b option = -;; - h.@("One") <- 1 +let (.@[]) = Hashtbl.find;; +val ( .@[] ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = + +let (.@[]<-) = Hashtbl.add;; +val ( .@[]<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = + +let (.@{}) = Hashtbl.find;; +val ( .@{} ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = + +let (.@{}<-) = Hashtbl.add;; +val ( .@{}<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = + +let (.@()) = Hashtbl.find;; +val ( .@() ) : ('a, 'b) Hashtbl.t -> 'a -> 'b = + +let (.@()<-) = Hashtbl.add;; +val ( .@()<- ) : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit = +|}] + +let h: (string,int) Hashtbl.t = Hashtbl.create 17;; +[%%expect {| + +let h : (string, int) Hashtbl.t = Hashtbl.create 17;; +val h : (string, int) Hashtbl.t = +|}] + +let () = + h .@ ("One") <- 1 ; assert (h.@{"One"} = 1) -; print_int h.@{"One"} +; Format.printf "%d" h.@{"One"} ; assert (h.?["Two"] = None) +[%%expect {| + +let () = + h.@("One") <- 1; + assert ((h.@{"One"}) = 1); + Format.printf "%d" (h.@{"One"}); + assert ((h.?["Two"]) = None);; +|}] (* from GPR#1392 *) -let ( #? ) x y = (x, y);; -let ( .%() ) x y = x.(y);; -let x = [| 0 |];; -let _ = 1 #? x.(0);; +let ( #? ) x y = (x, y) +let ( .%() ) x y = x.(y) +let x = [| 0 |] +let _ = 1 #? x.(0) let _ = 1 #? x.%(0);; +[%%expect {| + +let (#?) x y = (x, y);; +val ( #? ) : 'a -> 'b -> 'a * 'b = + +let (.%()) x y = x.(y);; +val ( .%() ) : 'a array -> int -> 'a = + +let x = [|0|];; +val x : int array = [|0|] + +let _ = 1 #? (x.(0));; +- : int * int = (1, 0) + +let _ = 1 #? (x.%(0));; +- : int * int = (1, 0) +|}] + + +(* from GPR#1467 *) +let _ = x.%(((); (); 0)) +let _ = x.%((Format.printf "hello"; 0)) +[%%expect {| + +let _ = x.%(((); (); 0));; +- : int = 0 + +let _ = x.%((Format.printf "hello"; 0));; +- : int = 0 +|}] diff --git a/testsuite/tests/parsing/multi_indices.ml b/testsuite/tests/parsing/multi_indices.ml new file mode 100644 index 00000000..8b67bd91 --- /dev/null +++ b/testsuite/tests/parsing/multi_indices.ml @@ -0,0 +1,170 @@ +(* TEST + flags = "-dsource" + * expect +*) + +module A = Bigarray.Genarray +[%%expect {| + +module A = Bigarray.Genarray;; +module A = Bigarray.Genarray +|}] + +let (.%{;..}<-) = A.set +let (.%{;..}) = A.get +[%%expect {| + +let (.%{;..}<-) = A.set;; +val ( .%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = + +let (.%{;..}) = A.get;; +val ( .%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a = +|}] + +let (.![;..]<-) = A.set +let (.![;..]) a n = + (* Check the ordering of indices *) + Format.printf "indices: @[[|%a|]@]@." + (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ") + Format.pp_print_int) (Array.to_list n); + A.get a n +[%%expect {| + +let (.![;..]<-) = A.set;; +val ( .![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = + +let (.![;..]) a n = + Format.printf "indices: @[[|%a|]@]@." + (Format.pp_print_list + ~pp_sep:(fun ppf -> fun () -> Format.fprintf ppf ";@ ") + Format.pp_print_int) (Array.to_list n); + A.get a n;; +val ( .![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a = +|}] + +let (.?(;..)<-) = A.set +let (.?(;..)) = A.get +[%%expect {| + +let (.?(;..)<-) = A.set;; +val ( .?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit = + +let (.?(;..)) = A.get;; +val ( .?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a = +|}] + +let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|] +[%%expect {| + +let a = A.create Bigarray.float64 Bigarray.c_layout [|3;3;3|];; +val a : (float, Bigarray.float64_elt, Bigarray.c_layout) A.t = +|}] + +;; a.![1;0;0] <- 2. +[%%expect {| + +;;a.![1;0;0] <- 2.;; +- : unit = () +|}] +;; a.?(0;1;0) <- 3. +[%%expect {| + +;;a.?(0;1;0) <- 3.;; +- : unit = () +|}] +;; a.%{0;0;1} <- 5. +[%%expect {| + +;;a.%{0;0;1} <- 5.;; +- : unit = () +|}] + +;; a.![0;1;2] <- 7.; + a.![0;1;2] +[%%expect {| + +;;a.![0;1;2] <- 7.; a.![0;1;2];; +indices: [|0; 1; 2|] +- : float = 7. +|}] + + +let (#+) = ( +. ) +[%%expect {| + +let (#+) = (+.);; +val ( #+ ) : float -> float -> float = +|}] + +;; a.?(1;0;0) #+ a.%{0;1;0} #+ a.![0;0;1] +[%%expect {| + +;;((a.?(1;0;0)) #+ (a.%{0;1;0})) #+ (a.![0;0;1]);; +indices: [|0; 0; 1|] +- : float = 10. +|}] + +let (.??[]) () () = () +;; ().??[(();())] + [%%expect {| + +let (.??[]) () () = ();; +val ( .??[] ) : unit -> unit -> unit = + +;;().??[((); ())];; +- : unit = () +|}] + +module M = struct + let (.%?(;..)) = A.get + let (.%?(;..)<-) = A.set + let (.%![;..]) = A.get + let (.%![;..]<-) = A.set + let (.%%{;..}) = A.get + let (.%%{;..}<-) = A.set +end + +;; a.M.%![1;0;0] <- 7. +[%%expect {| + +module M = + struct + let (.%?(;..)) = A.get + let (.%?(;..)<-) = A.set + let (.%![;..]) = A.get + let (.%![;..]<-) = A.set + let (.%%{;..}) = A.get + let (.%%{;..}<-) = A.set + end;; +module M : + sig + val ( .%?(;..) ) : ('a, 'b, 'c) A.t -> int array -> 'a + val ( .%?(;..)<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit + val ( .%![;..] ) : ('a, 'b, 'c) A.t -> int array -> 'a + val ( .%![;..]<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit + val ( .%%{;..} ) : ('a, 'b, 'c) A.t -> int array -> 'a + val ( .%%{;..}<- ) : ('a, 'b, 'c) A.t -> int array -> 'a -> unit + end + +;;a.M.%![1;0;0] <- 7.;; +- : unit = () +|}] +;; a.M.%?(0;1;0) <- 11. +[%%expect {| + +;;a.M.%?(0;1;0) <- 11.;; +- : unit = () +|}] +;; a.M.%%{0;0;1} <- 13. +[%%expect {| + +;;a.M.%%{0;0;1} <- 13.;; +- : unit = () +|}] + +;; a.M.%?(1;0;0) #+ a.M.%%{0;1;0} #+ a.M.%![0;0;1] +[%%expect {| + +;;((a.M.%?(1;0;0)) #+ (a.M.%%{0;1;0})) #+ (a.M.%![0;0;1]);; +- : float = 31. +|}] diff --git a/testsuite/tests/parsing/ocamltests b/testsuite/tests/parsing/ocamltests deleted file mode 100644 index 8879838c..00000000 --- a/testsuite/tests/parsing/ocamltests +++ /dev/null @@ -1,17 +0,0 @@ -anonymous_class_parameter.ml -arrow_ambiguity.ml -attributes.ml -broken_invariants.ml -constructor_declarations.ml -docstrings.ml -extended_indexoperators.ml -extensions.ml -hash_ambiguity.ml -int_and_float_with_modifier.ml -pr6604_2.ml -pr6604_3.ml -pr6604.ml -pr6865.ml -pr7165.ml -reloc.ml -shortcut_ext_attr.ml diff --git a/testsuite/tests/ppx-attributes/ocamltests b/testsuite/tests/ppx-attributes/ocamltests deleted file mode 100644 index b49aabbf..00000000 --- a/testsuite/tests/ppx-attributes/ocamltests +++ /dev/null @@ -1 +0,0 @@ -warning.ml diff --git a/testsuite/tests/ppx-contexts/myppx.ml b/testsuite/tests/ppx-contexts/myppx.ml index 76c80d64..c1945d20 100644 --- a/testsuite/tests/ppx-contexts/myppx.ml +++ b/testsuite/tests/ppx-contexts/myppx.ml @@ -36,8 +36,6 @@ let () = !Clflags.transparent_modules; Printf.eprintf "unboxed_types: %B\n" !Clflags.unboxed_types; - Printf.eprintf "unsafe_string: %B\n" - !Clflags.unsafe_string; Printf.eprintf "\n"; flush stderr; default_mapper); diff --git a/testsuite/tests/ppx-contexts/ocamltests b/testsuite/tests/ppx-contexts/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/ppx-contexts/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/ppx-contexts/test.compilers.reference b/testsuite/tests/ppx-contexts/test.compilers.reference index b3486e40..e28c8597 100644 --- a/testsuite/tests/ppx-contexts/test.compilers.reference +++ b/testsuite/tests/ppx-contexts/test.compilers.reference @@ -8,7 +8,6 @@ recursive_types: true principal: true transparent_modules: false unboxed_types: true -unsafe_string: false tool_name: "ocamlc" @@ -20,5 +19,4 @@ recursive_types: false principal: false transparent_modules: true unboxed_types: false -unsafe_string: true diff --git a/testsuite/tests/ppx-contexts/test.ml b/testsuite/tests/ppx-contexts/test.ml index e61840c4..f348e460 100644 --- a/testsuite/tests/ppx-contexts/test.ml +++ b/testsuite/tests/ppx-contexts/test.ml @@ -14,14 +14,12 @@ flags = "-thread \ -principal \ -alias-deps \ -unboxed-types \ - -safe-string \ -ppx ${program}" **** ocamlc.byte module = "test.ml" flags = "-g \ -no-alias-deps \ -no-unboxed-types \ - -unsafe-string \ -ppx ${program}" ***** check-ocamlc.byte-output *) diff --git a/testsuite/tests/prim-bigstring/ocamltests b/testsuite/tests/prim-bigstring/ocamltests deleted file mode 100644 index 5167a3dd..00000000 --- a/testsuite/tests/prim-bigstring/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -bigstring_access.ml -string_access.ml diff --git a/testsuite/tests/prim-bswap/ocamltests b/testsuite/tests/prim-bswap/ocamltests deleted file mode 100644 index d5028fc5..00000000 --- a/testsuite/tests/prim-bswap/ocamltests +++ /dev/null @@ -1 +0,0 @@ -bswap.ml diff --git a/testsuite/tests/prim-revapply/ocamltests b/testsuite/tests/prim-revapply/ocamltests deleted file mode 100644 index d0c7d623..00000000 --- a/testsuite/tests/prim-revapply/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -apply.ml -revapply.ml diff --git a/testsuite/tests/printing-types/ocamltests b/testsuite/tests/printing-types/ocamltests deleted file mode 100644 index a97308a9..00000000 --- a/testsuite/tests/printing-types/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -disambiguation.ml -pr248.ml diff --git a/testsuite/tests/raise-counts/ocamltests b/testsuite/tests/raise-counts/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/raise-counts/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/regression/gpr1623/ocamltests b/testsuite/tests/regression/gpr1623/ocamltests deleted file mode 100644 index 19223ca2..00000000 --- a/testsuite/tests/regression/gpr1623/ocamltests +++ /dev/null @@ -1 +0,0 @@ -gpr1623.ml diff --git a/testsuite/tests/regression/missing_set_of_closures/ocamltests b/testsuite/tests/regression/missing_set_of_closures/ocamltests deleted file mode 100644 index 3695f1c8..00000000 --- a/testsuite/tests/regression/missing_set_of_closures/ocamltests +++ /dev/null @@ -1 +0,0 @@ -missing_set_of_closures.ml diff --git a/testsuite/tests/regression/pr3612/ocamltests b/testsuite/tests/regression/pr3612/ocamltests deleted file mode 100644 index 69b5ac81..00000000 --- a/testsuite/tests/regression/pr3612/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr3612.ml diff --git a/testsuite/tests/regression/pr5233/ocamltests b/testsuite/tests/regression/pr5233/ocamltests deleted file mode 100644 index 19c4be2b..00000000 --- a/testsuite/tests/regression/pr5233/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr5233.ml diff --git a/testsuite/tests/regression/pr5757/ocamltests b/testsuite/tests/regression/pr5757/ocamltests deleted file mode 100644 index c3910e3e..00000000 --- a/testsuite/tests/regression/pr5757/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr5757.ml diff --git a/testsuite/tests/regression/pr6024/ocamltests b/testsuite/tests/regression/pr6024/ocamltests deleted file mode 100644 index fa733320..00000000 --- a/testsuite/tests/regression/pr6024/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr6024.ml diff --git a/testsuite/tests/regression/pr7042/ocamltests b/testsuite/tests/regression/pr7042/ocamltests deleted file mode 100644 index 6cace61a..00000000 --- a/testsuite/tests/regression/pr7042/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr7042.ml diff --git a/testsuite/tests/regression/pr7426/ocamltests b/testsuite/tests/regression/pr7426/ocamltests deleted file mode 100644 index 5b4841e4..00000000 --- a/testsuite/tests/regression/pr7426/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr7426.ml diff --git a/testsuite/tests/regression/pr7798/pr7798.ml b/testsuite/tests/regression/pr7798/pr7798.ml new file mode 100644 index 00000000..a91b4dc2 --- /dev/null +++ b/testsuite/tests/regression/pr7798/pr7798.ml @@ -0,0 +1,57 @@ +(* TEST + * bytecode + * native + * native + ocamlopt_flags = "-compact" +*) + +type mut2 = { mutable p: int; mutable q:int } +type mut3 = { mutable s: int; mutable t:int; mutable u:int } + +type mut_record = + { mutable a : int; + mutable b : int; + mutable c : int; + mutable d : int; + mutable e : int; + mutable f : int; } + +let go () = + let pre_before = Gc.minor_words () in + let before = Gc.minor_words () in + let alloc_per_minor_words = int_of_float (before -. pre_before) in + if Sys.backend_type = Sys.Native then assert (alloc_per_minor_words = 0); + let allocs = ref alloc_per_minor_words in + let n = 1_000_000 in + for i = 1 to n do + Sys.opaque_identity (ref i) + |> ignore; + allocs := !allocs + 2; + done; + for i = 1 to n do + Sys.opaque_identity { p = i; q = i } + |> ignore; + allocs := !allocs + 3; + done; + for i = 1 to n do + Sys.opaque_identity { s = i; t = i; u = i } + |> ignore; + allocs := !allocs + 4; + done; + for i = 1 to n do + Sys.opaque_identity { a = i; b = i; c = i; d = i; e = i; f = i } + |> ignore; + allocs := !allocs + 7; + if i mod (n/3) == 0 then Gc.full_major (); + done; + for i = 1 to n do + Sys.opaque_identity (Array.make 8 i) + |> ignore; + allocs := !allocs + 9; + if i mod (n/3) == 0 then Gc.compact (); + done; + let after = Gc.minor_words () in + let measured_allocs = int_of_float (after -. before) - alloc_per_minor_words in + Printf.printf "%d\n" (measured_allocs - !allocs) + +let () = go () diff --git a/testsuite/tests/regression/pr7798/pr7798.reference b/testsuite/tests/regression/pr7798/pr7798.reference new file mode 100644 index 00000000..573541ac --- /dev/null +++ b/testsuite/tests/regression/pr7798/pr7798.reference @@ -0,0 +1 @@ +0 diff --git a/testsuite/tests/regression/pr7920/ocamltests b/testsuite/tests/regression/pr7920/ocamltests deleted file mode 100644 index 2272069c..00000000 --- a/testsuite/tests/regression/pr7920/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr7920.ml diff --git a/testsuite/tests/regression/pr8769/ocamltests b/testsuite/tests/regression/pr8769/ocamltests deleted file mode 100644 index 195f6bcd..00000000 --- a/testsuite/tests/regression/pr8769/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr8769.ml diff --git a/testsuite/tests/regression/pr9028/pr9028.ml b/testsuite/tests/regression/pr9028/pr9028.ml new file mode 100644 index 00000000..df28383f --- /dev/null +++ b/testsuite/tests/regression/pr9028/pr9028.ml @@ -0,0 +1,10 @@ +(* TEST *) + +let f n = ((n lsl 1) + 1) / 2 +let g n = (n lsl 1) / 2 +let h n = Int64.of_int (n * 2 + 1) +let i n = Int64.of_int (Int64.to_int n) + +let r = Sys.opaque_identity max_int +let s = Sys.opaque_identity Int64.max_int +let () = Printf.printf "%d\n%d\n%Ld\n%Ld\n" (f r) (g r) (h r) (i s) diff --git a/testsuite/tests/regression/pr9028/pr9028.reference b/testsuite/tests/regression/pr9028/pr9028.reference new file mode 100644 index 00000000..78ea705a --- /dev/null +++ b/testsuite/tests/regression/pr9028/pr9028.reference @@ -0,0 +1,4 @@ +0 +-1 +-1 +-1 diff --git a/testsuite/tests/regression/pr9292/pr9292.ml b/testsuite/tests/regression/pr9292/pr9292.ml new file mode 100644 index 00000000..cf6a3df9 --- /dev/null +++ b/testsuite/tests/regression/pr9292/pr9292.ml @@ -0,0 +1,6 @@ +(* TEST *) + +let () = + Gc.set { (Gc.get ()) with allocation_policy = 2 }; + ignore (Array.init 5_000 (fun _ -> Array.make 10_000 0)); + Gc.full_major () diff --git a/testsuite/tests/required-external/ocamltests b/testsuite/tests/required-external/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/required-external/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/runtime-C-exceptions/ocamltests b/testsuite/tests/runtime-C-exceptions/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/runtime-C-exceptions/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/runtime-errors/ocamltests b/testsuite/tests/runtime-errors/ocamltests deleted file mode 100644 index c4a51b5c..00000000 --- a/testsuite/tests/runtime-errors/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -stackoverflow.ml -syserror.ml diff --git a/testsuite/tests/runtime-objects/Tests.ml b/testsuite/tests/runtime-objects/Tests.ml new file mode 100644 index 00000000..70478f5d --- /dev/null +++ b/testsuite/tests/runtime-objects/Tests.ml @@ -0,0 +1,37 @@ +(* TEST *) + +(* Marshaling (cf. PR#5436) *) + +(* Note: this test must *not* be made a toplevel or expect-style test, + because then the Obj.id counter of the compiler implementation + (called by the bytecode read-eval-print loop) would be the same as + the Obj.id counter of the test code below. In particular, any + change to the compiler implementation to use more objects or + exceptions would change the numbers below, making the test very + fragile. *) + +let r = ref 0;; +let id o = Oo.id o - !r;; +r := Oo.id (object end);; + +assert (id (object end) = 1);; +assert (id (object end) = 2);; +let o = object end in + let s = Marshal.to_string o [] in + let o' : < > = Marshal.from_string s 0 in + let o'' : < > = Marshal.from_string s 0 in + assert ((id o, id o', id o'') = (3, 4, 5)); + +let o = object val x = 33 method m = x end in + let s = Marshal.to_string o [Marshal.Closures] in + let o' : = Marshal.from_string s 0 in + let o'' : = Marshal.from_string s 0 in + assert ((id o, id o', id o'', o#m, o'#m) + = (6, 7, 8, 33, 33));; + +let o = object val x = 33 val y = 44 method m = x end in + let s = Marshal.to_string (o,o) [Marshal.Closures] in + let (o1, o2) : ( * ) = Marshal.from_string s 0 in + let (o3, o4) : ( * ) = Marshal.from_string s 0 in + assert ((id o, id o1, id o2, id o3, id o4, o#m, o1#m) + = (9, 10, 10, 11, 11, 33, 33));; diff --git a/testsuite/tests/self-contained-toplevel/ocamltests b/testsuite/tests/self-contained-toplevel/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/self-contained-toplevel/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/shadow_include/ocamltests b/testsuite/tests/shadow_include/ocamltests deleted file mode 100644 index d972079f..00000000 --- a/testsuite/tests/shadow_include/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -artificial.ml -cannot_shadow_error.ml -shadow_all.ml diff --git a/testsuite/tests/shadow_include/shadow_all.ml b/testsuite/tests/shadow_include/shadow_all.ml index 7e31cad2..443541c1 100644 --- a/testsuite/tests/shadow_include/shadow_all.ml +++ b/testsuite/tests/shadow_include/shadow_all.ml @@ -181,7 +181,7 @@ end Line 4, characters 2-11: 4 | include S ^^^^^^^^^ -Error: Illegal shadowing of included module type T/317 by T/335 +Error: Illegal shadowing of included module type T/317 by T/334 Line 2, characters 2-11: Module type T/317 came from this include Line 3, characters 2-39: @@ -198,11 +198,11 @@ end Line 4, characters 2-11: 4 | include S ^^^^^^^^^ -Error: Illegal shadowing of included type ext/353 by ext/370 +Error: Illegal shadowing of included type ext/352 by ext/369 Line 2, characters 2-11: - Type ext/353 came from this include + Type ext/352 came from this include Line 3, characters 14-16: - The extension constructor C2 has no valid type if ext/353 is shadowed + The extension constructor C2 has no valid type if ext/352 is shadowed |}] module type Class = sig @@ -282,8 +282,8 @@ module N : type t val unit : unit external e : unit -> unit = "%identity" - module M : sig end - module type T = sig end + module M : sig end + module type T = sig end exception E type ext = .. type ext += C @@ -304,7 +304,7 @@ module NN : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -329,7 +329,7 @@ module Type : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -352,7 +352,7 @@ module Module : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -370,12 +370,12 @@ end [%%expect{| module Module_type : sig - module type U = sig end + module type U = sig end type t = N.t val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -398,7 +398,7 @@ module Exception : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -421,7 +421,7 @@ module Extension : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -444,7 +444,7 @@ module Class : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C @@ -467,7 +467,7 @@ module Class_type : val unit : unit external e : unit -> unit = "%identity" module M = N.M - module type T = sig end + module type T = sig end exception E type ext = N.ext = .. type ext += C diff --git a/testsuite/tests/tool-caml-tex/ellipses.input b/testsuite/tests/tool-caml-tex/ellipses.input new file mode 100644 index 00000000..c230fd2e --- /dev/null +++ b/testsuite/tests/tool-caml-tex/ellipses.input @@ -0,0 +1,48 @@ +\begin{caml_example*}{verbatim} +let start = 0 +[@@@ellipsis.start] +let hidden = succ start +[@@@ellipsis.stop] +let mid = succ hidden +let[@ellipsis] statement = succ mid + +module E = struct end +include E[@@ellipsis] + +let expr = succ statement[@ellipsis] + +let pat = match start with + | 0[@ellipsis] | 1 -> succ expr + | _ -> succ expr + +let case = match start with + | 0 -> succ pat + | _[@ellipsis.start] -> succ pat[@ellipsis.stop] + + +let annot: int[@ellipsis] = succ case + +let subexpr = succ annot + (2[@ellipsis.stop] - 1[@ellipsis.start] * 2) - 2 + +class[@ellipsis] c = object val x = succ subexpr end + +class c2 = object + val[@ellipsis] x = 0 + val y = 1 + method[@ellipsis] m = 2 + method n = 3 + [@@@ellipsis.start] + method l = 4 + [@@@ellipsis.stop] +end + +type t = A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F +type arrow = int -> (int -> int[@ellipsis]) +type record = { a:int; b:int[@ellipsis]; c:int; + d:int[@ellipsis.start]; e:int; f:int[@ellipsis.stop]; + g:int } +type polyvar = [`A|`B[@ellipsis] |`C + |`D[@ellipsis.start] | `E | `F [@ellipsis.stop] + | `G ] +type exn += A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F +\end{caml_example*} diff --git a/testsuite/tests/tool-caml-tex/ellipses.ml b/testsuite/tests/tool-caml-tex/ellipses.ml index 474873a0..b360bfa6 100644 --- a/testsuite/tests/tool-caml-tex/ellipses.ml +++ b/testsuite/tests/tool-caml-tex/ellipses.ml @@ -1,60 +1,12 @@ (* TEST reference="${test_source_directory}/ellipses.reference" output="ellipses.output" + files="${test_source_directory}/ellipses.input" script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" + -repo-root ${ocamlsrcdir} ${files} -o ${output}" * hasstr ** native-compiler *** shared-libraries **** script with unix,str ***** check-program-output *) - -\begin{caml_example*}{verbatim} -let start = 0 -[@@@ellipsis.start] -let hidden = succ start -[@@@ellipsis.stop] -let mid = succ hidden -let[@ellipsis] statement = succ mid - -module E = struct end -include E[@@ellipsis] - -let expr = succ statement[@ellipsis] - -let pat = match start with - | 0[@ellipsis] | 1 -> succ expr - | _ -> succ expr - -let case = match start with - | 0 -> succ pat - | _[@ellipsis.start] -> succ pat[@ellipsis.stop] - - -let annot: int[@ellipsis] = succ case - -let subexpr = succ annot + (2[@ellipsis.stop] - 1[@ellipsis.start] * 2) - 2 - -class[@ellipsis] c = object val x = succ subexpr end - -class c2 = object - val[@ellipsis] x = 0 - val y = 1 - method[@ellipsis] m = 2 - method n = 3 - [@@@ellipsis.start] - method l = 4 - [@@@ellipsis.stop] -end - -type t = A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F -type arrow = int -> (int -> int[@ellipsis]) -type record = { a:int; b:int[@ellipsis]; c:int; - d:int[@ellipsis.start]; e:int; f:int[@ellipsis.stop]; - g:int } -type polyvar = [`A|`B[@ellipsis] |`C - |`D[@ellipsis.start] | `E | `F [@ellipsis.stop] - | `G ] -type exn += A[@ellipsis] | B |C[@ellipsis.start] | D | E [@ellipsis.stop] | F -\end{caml_example*} diff --git a/testsuite/tests/tool-caml-tex/ellipses.reference b/testsuite/tests/tool-caml-tex/ellipses.reference index b4c4ccb0..35c6b849 100644 --- a/testsuite/tests/tool-caml-tex/ellipses.reference +++ b/testsuite/tests/tool-caml-tex/ellipses.reference @@ -1,58 +1,48 @@ -(* TEST - reference="${test_source_directory}/ellipses.reference" - output="ellipses.output" - script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" - * hasstr - ** native-compiler - *** shared-libraries - **** script with unix,str - ***** check-program-output -*) - -\camlexample{verbatim} -\caml\camlinput\?let start = 0 -\?\ldots -\?let mid = succ hidden -\?\ldots - -\?module E = struct end -\?\ldots - -\?let expr = \ldots - -\?let pat = match start with -\? | \ldots | 1 -> succ expr -\? | _ -> succ expr - -\?let case = match start with -\? | 0 -> succ pat -\? | \ldots - - -\?let annot: \ldots = succ case - -\?let subexpr = succ annot + (\ldots * 2) - 2 - -\?\ldots - -\?class c2 = object -\? \ldots -\? val y = 1 -\? \ldots -\? method n = 3 -\? \ldots -\?end - -\?type t = \ldots | B \ldots | F -\?type arrow = int -> (\ldots) -\?type record = { a:int; \ldots c:int; -\? \ldots -\? g:int } -\?type polyvar = [\textasciigrave\-A|\ldots |\textasciigrave\-C -\? |\ldots -\? | \textasciigrave\-G ] -\?type exn += \ldots | B \ldots | F -\endcamlinput -\endcaml -\endcamlexample +\begin{camlexample}{verbatim} +\begin{caml} +\begin{camlinput} +$\?$let start = 0 +$\?$$\ldots$ +$\?$let mid = succ hidden +$\?$$\ldots$ + +$\?$module E = struct end +$\?$$\ldots$ + +$\?$let expr = $\ldots$ + +$\?$let pat = match start with +$\?$ | $\ldots$ | 1 -> succ expr +$\?$ | _ -> succ expr + +$\?$let case = match start with +$\?$ | 0 -> succ pat +$\?$ | $\ldots$ + + +$\?$let annot: $\ldots$ = succ case + +$\?$let subexpr = succ annot + ($\ldots$ * 2) - 2 + +$\?$$\ldots$ + +$\?$class c2 = object +$\?$ $\ldots$ +$\?$ val y = 1 +$\?$ $\ldots$ +$\?$ method n = 3 +$\?$ $\ldots$ +$\?$end + +$\?$type t = $\ldots$ | B $\ldots$ | F +$\?$type arrow = int -> ($\ldots$) +$\?$type record = { a:int; $\ldots$ c:int; +$\?$ $\ldots$ +$\?$ g:int } +$\?$type polyvar = [`A|$\ldots$ |`C +$\?$ |$\ldots$ +$\?$ | `G ] +$\?$type exn += $\ldots$ | B $\ldots$ | F +\end{camlinput} +\end{caml} +\end{camlexample} diff --git a/testsuite/tests/tool-caml-tex/ocamltests b/testsuite/tests/tool-caml-tex/ocamltests deleted file mode 100644 index e543110f..00000000 --- a/testsuite/tests/tool-caml-tex/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -ellipses.ml -redirections.ml diff --git a/testsuite/tests/tool-caml-tex/redirections.input b/testsuite/tests/tool-caml-tex/redirections.input new file mode 100644 index 00000000..77ad0ab1 --- /dev/null +++ b/testsuite/tests/tool-caml-tex/redirections.input @@ -0,0 +1,10 @@ +\begin{caml_example}{toplevel} +[@@@warning "+A"];; +1 + 2. [@@expect error];; +let f x = () [@@expect warning 27];; +\end{caml_example} + +\begin{caml_example}{toplevel} +Format.printf "Hello@."; +print_endline "world";; +\end{caml_example} diff --git a/testsuite/tests/tool-caml-tex/redirections.ml b/testsuite/tests/tool-caml-tex/redirections.ml index 1e2fe992..9980e451 100644 --- a/testsuite/tests/tool-caml-tex/redirections.ml +++ b/testsuite/tests/tool-caml-tex/redirections.ml @@ -1,8 +1,9 @@ (* TEST reference="${test_source_directory}/redirections.reference" output="redirections.output" + files="${test_source_directory}/redirections.input" script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" + -repo-root ${ocamlsrcdir} ${files} -o ${output}" * hasstr ** native-compiler *** shared-libraries @@ -11,17 +12,6 @@ *** no-shared-libraries **** script with unix,str script = "${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" + -repo-root ${ocamlsrcdir} ${files} -o ${output}" ***** check-program-output *) - -\begin{caml_example}{toplevel} -[@@@warning "+A"];; -1 + 2. [@@expect error];; -let f x = () [@@expect warning 27];; -\end{caml_example} - -\begin{caml_example}{toplevel} -Format.printf "Hello@."; -print_endline "world";; -\end{caml_example} diff --git a/testsuite/tests/tool-caml-tex/redirections.reference b/testsuite/tests/tool-caml-tex/redirections.reference index 242209c7..538b45f9 100644 --- a/testsuite/tests/tool-caml-tex/redirections.reference +++ b/testsuite/tests/tool-caml-tex/redirections.reference @@ -1,38 +1,39 @@ -(* TEST - reference="${test_source_directory}/redirections.reference" - output="redirections.output" - script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" - * hasstr - ** native-compiler - *** shared-libraries - **** script with unix,str - ***** check-program-output - *** no-shared-libraries - **** script with unix,str - script = "${ocamlsrcdir}/tools/caml-tex \ - -repo-root ${ocamlsrcdir} ${test_source_directory}/${test_file} -o ${output}" - ***** check-program-output -*) +\begin{camlexample}{toplevel} +\begin{caml} +\begin{camlinput} +$\?$[@@@warning "+A"];; +\end{camlinput} +\end{caml} +\begin{caml} +\begin{camlinput} +$\?$1 + <<2.>> ;; +\end{camlinput} +\begin{camlerror} +$\:$Error: This expression has type float but an expression was expected of type +$\:$ int +\end{camlerror} +\end{caml} +\begin{caml} +\begin{camlinput} +$\?$let f <> = () ;; +\end{camlinput} +\begin{camlwarn} +$\:$Warning 27: unused variable x. +$\:$val f : 'a -> unit = +\end{camlwarn} +\end{caml} +\end{camlexample} -\camlexample{toplevel} -\caml\camlinput\?[@@@warning "+A"];; -\endcamlinput\endcaml -\caml\camlinput\?1 + \<2.\> ;; -\endcamlinput\camlerror\:Error: This expression has type float but an expression was expected of type -\: int -\endcamlerror\endcaml -\caml\camlinput\?let f \ = () ;; -\endcamlinput\camlwarn\:Warning 27: unused variable x. -\:val f : \textquotesingle\-a -> unit = -\endcamlwarn\endcaml -\endcamlexample - -\camlexample{toplevel} -\caml\camlinput\?Format.printf "Hello@."; -\?print_endline "world";; -\endcamlinput\camloutput\:Hello -\:world -\:- : unit = () -\endcamloutput\endcaml -\endcamlexample +\begin{camlexample}{toplevel} +\begin{caml} +\begin{camlinput} +$\?$Format.printf "Hello@."; +$\?$print_endline "world";; +\end{camlinput} +\begin{camloutput} +$\:$Hello +$\:$world +$\:$- : unit = () +\end{camloutput} +\end{caml} +\end{camlexample} diff --git a/testsuite/tests/tool-command-line/ocamltests b/testsuite/tests/tool-command-line/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/tool-command-line/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/tool-debugger/basic/ocamltests b/testsuite/tests/tool-debugger/basic/ocamltests deleted file mode 100644 index 4f8025c7..00000000 --- a/testsuite/tests/tool-debugger/basic/ocamltests +++ /dev/null @@ -1 +0,0 @@ -debuggee.ml diff --git a/testsuite/tests/tool-debugger/dynlink/host.debug.reference b/testsuite/tests/tool-debugger/dynlink/host.debug.reference new file mode 100644 index 00000000..2c3438ce --- /dev/null +++ b/testsuite/tests/tool-debugger/dynlink/host.debug.reference @@ -0,0 +1,11 @@ +Loading program... done. +hello host + +Module(s) Plugin loaded. +Breakpoint: 1 +2 <|b|>print_endline "hello plugin" +Backtrace: +#0 Plugin plugin.ml:2:3 +#1 Plugin plugin.ml:4:10 +hello plugin +Program exit. diff --git a/testsuite/tests/tool-debugger/dynlink/host.ml b/testsuite/tests/tool-debugger/dynlink/host.ml new file mode 100644 index 00000000..3f9a9d0e --- /dev/null +++ b/testsuite/tests/tool-debugger/dynlink/host.ml @@ -0,0 +1,35 @@ +(* TEST + +include dynlink +files = "host.ml plugin.ml" +libraries = "" + +flags += " -g " +ocamldebug_script = "${test_source_directory}/input_script" + +* debugger +** shared-libraries +*** setup-ocamlc.byte-build-env +**** ocamlc.byte +module = "host.ml" +***** ocamlc.byte +module = "plugin.ml" +****** ocamlc.byte +module = "" +all_modules = "host.cmo" +program = "${test_build_directory}/host.byte" +libraries = "dynlink" + +******* run +output = "host.output" +******** check-program-output +reference = "${test_source_directory}/host.reference" + +******** ocamldebug +output = "host.debug.output" +********* check-program-output +reference = "${test_source_directory}/host.debug.reference" + +*) + +let () = print_endline "hello host"; Dynlink.loadfile "plugin.cmo" diff --git a/testsuite/tests/tool-debugger/dynlink/host.reference b/testsuite/tests/tool-debugger/dynlink/host.reference new file mode 100644 index 00000000..87d1fa92 --- /dev/null +++ b/testsuite/tests/tool-debugger/dynlink/host.reference @@ -0,0 +1,2 @@ +hello host +hello plugin diff --git a/testsuite/tests/tool-debugger/dynlink/input_script b/testsuite/tests/tool-debugger/dynlink/input_script new file mode 100644 index 00000000..7f317811 --- /dev/null +++ b/testsuite/tests/tool-debugger/dynlink/input_script @@ -0,0 +1,5 @@ +r +br @ Plugin 2 +r +bt +r diff --git a/testsuite/tests/tool-debugger/dynlink/plugin.ml b/testsuite/tests/tool-debugger/dynlink/plugin.ml new file mode 100644 index 00000000..44160161 --- /dev/null +++ b/testsuite/tests/tool-debugger/dynlink/plugin.ml @@ -0,0 +1,4 @@ +let do_plugin () = + print_endline "hello plugin" + +let () = do_plugin () diff --git a/testsuite/tests/tool-debugger/find-artifacts/ocamltests b/testsuite/tests/tool-debugger/find-artifacts/ocamltests deleted file mode 100644 index 4f8025c7..00000000 --- a/testsuite/tests/tool-debugger/find-artifacts/ocamltests +++ /dev/null @@ -1 +0,0 @@ -debuggee.ml diff --git a/testsuite/tests/tool-debugger/no_debug_event/ocamltests b/testsuite/tests/tool-debugger/no_debug_event/ocamltests deleted file mode 100644 index 33175c28..00000000 --- a/testsuite/tests/tool-debugger/no_debug_event/ocamltests +++ /dev/null @@ -1 +0,0 @@ -noev.ml diff --git a/testsuite/tests/tool-debugger/printer/ocamltests b/testsuite/tests/tool-debugger/printer/ocamltests deleted file mode 100644 index 4f8025c7..00000000 --- a/testsuite/tests/tool-debugger/printer/ocamltests +++ /dev/null @@ -1 +0,0 @@ -debuggee.ml diff --git a/testsuite/tests/tool-expect-test/ocamltests b/testsuite/tests/tool-expect-test/ocamltests deleted file mode 100644 index c7e19b87..00000000 --- a/testsuite/tests/tool-expect-test/ocamltests +++ /dev/null @@ -1 +0,0 @@ -clean_typer.ml diff --git a/testsuite/tests/tool-lexyacc/grammar.mly b/testsuite/tests/tool-lexyacc/grammar.mly index 00821d51..24a06c5e 100644 --- a/testsuite/tests/tool-lexyacc/grammar.mly +++ b/testsuite/tests/tool-lexyacc/grammar.mly @@ -3,6 +3,11 @@ %{ open Syntax open Gram_aux + +(* test f' '"' *) +let () = + let f' = ignore in + f' '"' %} %token Tident diff --git a/testsuite/tests/tool-lexyacc/ocamltests b/testsuite/tests/tool-lexyacc/ocamltests deleted file mode 100644 index 69c655f2..00000000 --- a/testsuite/tests/tool-lexyacc/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -main.ml -mpr7760.mll -chars.mll diff --git a/testsuite/tests/tool-ocaml-annot/ocamltests b/testsuite/tests/tool-ocaml-annot/ocamltests deleted file mode 100644 index 156c866d..00000000 --- a/testsuite/tests/tool-ocaml-annot/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -success.ml -failure.ml -typeonly.ml diff --git a/testsuite/tests/tool-ocaml/ocamltests b/testsuite/tests/tool-ocaml/ocamltests deleted file mode 100644 index de7fc74f..00000000 --- a/testsuite/tests/tool-ocaml/ocamltests +++ /dev/null @@ -1,157 +0,0 @@ -t000.ml -t010-const0.ml -t010-const1.ml -t010-const2.ml -t010-const3.ml -t011-constint.ml -t020.ml -t021-pushconst1.ml -t021-pushconst2.ml -t021-pushconst3.ml -t022-pushconstint.ml -t040-makeblock1.ml -t040-makeblock2.ml -t040-makeblock3.ml -t041-makeblock.ml -t050-getglobal.ml -t050-pushgetglobal.ml -t051-getglobalfield.ml -t051-pushgetglobalfield.ml -t060-raise.ml -t070-branchif.ml -t070-branchifnot.ml -t070-branch.ml -t071-boolnot.ml -t080-eq.ml -t080-geint.ml -t080-gtint.ml -t080-leint.ml -t080-ltint.ml -t080-neq.ml -t090-acc0.ml -t090-acc1.ml -t090-acc2.ml -t090-acc3.ml -t090-acc4.ml -t090-acc5.ml -t090-acc6.ml -t090-acc7.ml -t091-acc.ml -t092-pushacc0.ml -t092-pushacc1.ml -t092-pushacc2.ml -t092-pushacc3.ml -t092-pushacc4.ml -t092-pushacc5.ml -t092-pushacc6.ml -t092-pushacc7.ml -t092-pushacc.ml -t093-pushacc.ml -t100-pushtrap.ml -t101-poptrap.ml -t110-addint.ml -t110-andint.ml -t110-asrint-1.ml -t110-asrint-2.ml -t110-divint-1.ml -t110-divint-2.ml -t110-divint-3.ml -t110-lslint.ml -t110-lsrint.ml -t110-modint-1.ml -t110-modint-2.ml -t110-mulint.ml -t110-negint.ml -t110-offsetint.ml -t110-orint.ml -t110-subint.ml -t110-xorint.ml -t120-getstringchar.ml -t121-setstringchar.ml -t130-getvectitem.ml -t130-vectlength.ml -t131-setvectitem.ml -t140-switch-1.ml -t140-switch-2.ml -t140-switch-3.ml -t140-switch-4.ml -t141-switch-5.ml -t141-switch-6.ml -t141-switch-7.ml -t142-switch-8.ml -t142-switch-9.ml -t142-switch-A.ml -t150-push-1.ml -t150-push-2.ml -t160-closure.ml -t161-apply1.ml -t162-return.ml -t163.ml -t164-apply2.ml -t164-apply3.ml -t165-apply.ml -t170-envacc2.ml -t170-envacc3.ml -t170-envacc4.ml -t171-envacc.ml -t172-pushenvacc1.ml -t172-pushenvacc2.ml -t172-pushenvacc3.ml -t172-pushenvacc4.ml -t173-pushenvacc.ml -t180-appterm1.ml -t180-appterm2.ml -t180-appterm3.ml -t181-appterm.ml -t190-makefloatblock-1.ml -t190-makefloatblock-2.ml -t190-makefloatblock-3.ml -t191-vectlength.ml -t192-getfloatfield-1.ml -t192-getfloatfield-2.ml -t193-setfloatfield-1.ml -t193-setfloatfield-2.ml -t200-getfield0.ml -t200-getfield1.ml -t200-getfield2.ml -t200-getfield3.ml -t201-getfield.ml -t210-setfield0.ml -t210-setfield1.ml -t210-setfield2.ml -t210-setfield3.ml -t211-setfield.ml -t220-assign.ml -t230-check_signals.ml -t240-c_call1.ml -t240-c_call2.ml -t240-c_call3.ml -t240-c_call4.ml -t240-c_call5.ml -t250-closurerec-1.ml -t250-closurerec-2.ml -t251-pushoffsetclosure0.ml -t251-pushoffsetclosure2.ml -t251-pushoffsetclosurem2.ml -t252-pushoffsetclosure.ml -t253-offsetclosure0.ml -t253-offsetclosure2.ml -t253-offsetclosurem2.ml -t254-offsetclosure.ml -t260-offsetref.ml -t270-push_retaddr.ml -t300-getmethod.ml -t301-object.ml -t310-alloc-1.ml -t310-alloc-2.ml -t320-gc-1.ml -t320-gc-2.ml -t320-gc-3.ml -t330-compact-1.ml -t330-compact-2.ml -t330-compact-3.ml -t330-compact-4.ml -t340-weak.ml -t350-heapcheck.ml -t360-stacks-1.ml -t360-stacks-2.ml diff --git a/testsuite/tests/tool-ocamlc-compat32/ocamltests b/testsuite/tests/tool-ocamlc-compat32/ocamltests deleted file mode 100644 index 3f712ba6..00000000 --- a/testsuite/tests/tool-ocamlc-compat32/ocamltests +++ /dev/null @@ -1 +0,0 @@ -compat32.ml diff --git a/testsuite/tests/tool-ocamlc-error-cleanup/ocamltests b/testsuite/tests/tool-ocamlc-error-cleanup/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/tool-ocamlc-error-cleanup/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/tool-ocamlc-open/ocamltests b/testsuite/tests/tool-ocamlc-open/ocamltests deleted file mode 100644 index 8f3a918d..00000000 --- a/testsuite/tests/tool-ocamlc-open/ocamltests +++ /dev/null @@ -1 +0,0 @@ -tool-ocamlc-open.ml diff --git a/testsuite/tests/tool-ocamlc-stop-after/ocamltests b/testsuite/tests/tool-ocamlc-stop-after/ocamltests deleted file mode 100644 index ebd7d56f..00000000 --- a/testsuite/tests/tool-ocamlc-stop-after/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -stop_after_parsing_impl.ml -stop_after_parsing_intf.mli -stop_after_typing_impl.ml diff --git a/testsuite/tests/tool-ocamldep-modalias/ocamltests b/testsuite/tests/tool-ocamldep-modalias/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/tool-ocamldep-modalias/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/tool-ocamldep-shadowing/ocamltests b/testsuite/tests/tool-ocamldep-shadowing/ocamltests deleted file mode 100644 index c2790eaf..00000000 --- a/testsuite/tests/tool-ocamldep-shadowing/ocamltests +++ /dev/null @@ -1 +0,0 @@ -a.ml diff --git a/testsuite/tests/tool-ocamldoc-open/ocamltests b/testsuite/tests/tool-ocamldoc-open/ocamltests deleted file mode 100644 index d389d156..00000000 --- a/testsuite/tests/tool-ocamldoc-open/ocamltests +++ /dev/null @@ -1 +0,0 @@ -main.ml diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference index d41a6676..07f7ed18 100644 --- a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference +++ b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference @@ -72,7 +72,7 @@ *) -} +}
@@ -111,7 +111,7 @@
*) -} +} (*
@@ -158,7 +158,7 @@
*) -} +} (*
@@ -196,7 +196,7 @@
*) -} +} (*
@@ -231,7 +231,7 @@
*) -} +} -> any (*
@@ -261,7 +261,7 @@
*) -} +} 
type ext +=
@@ -281,7 +281,7 @@
*)
-} +} (*
@@ -307,7 +307,7 @@
*) -} +} (*
@@ -333,7 +333,7 @@
*) -} +} (*
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.man.reference b/testsuite/tests/tool-ocamldoc/Inline_records.man.reference index a2890e40..e3a6b08f 100644 --- a/testsuite/tests/tool-ocamldoc/Inline_records.man.reference +++ b/testsuite/tests/tool-ocamldoc/Inline_records.man.reference @@ -7,7 +7,7 @@ Module Inline_records Module .BI "Inline_records" : -.B sig end +.B sig end .sp This test focuses on the printing of documentation for inline record @@ -45,13 +45,17 @@ An open sum type lbl : .B int ; (* Field documentation for non\-inline, -.B lbl : int +.ft B +lbl : int +.ft R *) more : .B int list ; (* More documentation for r, -.B more : int list +.ft B +more : int list +.ft R *) } @@ -67,13 +71,17 @@ A simple record type for reference lbl : .B int ; (* -.B A +.ft B +A +.ft R field documentation *) more : .B int list ; (* More -.B A +.ft B +A +.ft R field documentation *) } @@ -92,13 +100,17 @@ A sum type with one inline record a_label_for_B : .B int ; (* -.B B +.ft B +B +.ft R field documentation *) more_label_for_B : .B int list ; (* More -.B B +.ft B +B +.ft R field documentation *) } @@ -110,7 +122,9 @@ field documentation c_has_label_too : .B float ; (* -.B C +.ft B +C +.ft R field documentation *) more_than_one : @@ -133,13 +147,21 @@ A sum type with two inline records any : .B 'a ; (* -.B A +.ft B +A +.ft R field -.B any:\&'a +.ft B +any:\&'a +.ft R for -.B D +.ft B +D +.ft R in -.B any +.ft B +any +.ft R \&. *) } @@ -159,7 +181,9 @@ A gadt constructor name : .B string ; (* Error field documentation -.B name:string +.ft B +name:string +.ft R *) } @@ -174,7 +198,9 @@ A gadt constructor yet_another_field : .B unit ; (* Field documentation for -.B E +.ft B +E +.ft R in ext *) } @@ -186,7 +212,9 @@ in ext even_more : .B int -> int ; (* Some field documentations for -.B F +.ft B +F +.ft R *) } diff --git a/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference index 026e26df..58ad73e6 100644 --- a/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference +++ b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference @@ -69,7 +69,7 @@ field : 'a; -} +} @@ -109,7 +109,7 @@ inline : int; -} +}

type_Linebreaks.html should contain

diff --git a/testsuite/tests/tool-ocamldoc/Variants.html.reference b/testsuite/tests/tool-ocamldoc/Variants.html.reference index 38e3ebf7..0858bde1 100644 --- a/testsuite/tests/tool-ocamldoc/Variants.html.reference +++ b/testsuite/tests/tool-ocamldoc/Variants.html.reference @@ -128,7 +128,7 @@ x : int; -} +} (*
@@ -149,7 +149,7 @@ y : int; -} +} (*
diff --git a/testsuite/tests/tool-ocamldoc/ocamltests b/testsuite/tests/tool-ocamldoc/ocamltests deleted file mode 100644 index b9fbde78..00000000 --- a/testsuite/tests/tool-ocamldoc/ocamltests +++ /dev/null @@ -1,21 +0,0 @@ -Documentation_tags.mli -Extensible_variant.ml -Include_module_type_of.mli -Inline_records.mli -Inline_records_bis.ml -Item_ids.mli -Paragraph.mli -Module_whitespace.ml -No_preamble.mli -latex_ref.mli -Level_0.mli -Linebreaks.mli -Loop.ml -Short_description.txt -t01.ml -t02.ml -t03.ml -t04.ml -t05.ml -Test.mli -Variants.mli diff --git a/testsuite/tests/tool-ocamldoc/t01.reference b/testsuite/tests/tool-ocamldoc/t01.reference index 0802c273..1c2e0a77 100644 --- a/testsuite/tests/tool-ocamldoc/t01.reference +++ b/testsuite/tests/tool-ocamldoc/t01.reference @@ -1,19 +1,19 @@ # # module T01: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : -<[sig end]> +<[sig end]> # # module T01.M: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : <[sig val y : int end]> # # module type T01.MT: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : <[sig type t = diff --git a/testsuite/tests/tool-ocamldoc/t04.reference b/testsuite/tests/tool-ocamldoc/t04.reference index 924503ea..fc3c5f65 100644 --- a/testsuite/tests/tool-ocamldoc/t04.reference +++ b/testsuite/tests/tool-ocamldoc/t04.reference @@ -1,13 +1,13 @@ # # module T04: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : -<[sig end]> +<[sig end]> # # module T04.A: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : <[sig type a = A of { lbl : int; } end]> # type T04.A.a: @@ -16,12 +16,12 @@ # # module type T04.E: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : <[sig exception E of { lbl : int; } end]> # # module T04.E_bis: # Odoc_info.string_of_module_type: -<[sig end]> +<[sig end]> # Odoc_info.string_of_module_type ~complete: true : <[sig exception E of { lbl : int; } end]> diff --git a/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference index f3df279a..86bd8646 100644 --- a/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference +++ b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference @@ -20,8 +20,8 @@   type s = ..
  type s += B
  val x : Linebreaks.a
-  module S : sig module I : sig  end end
-  module type s = sig  end
+  module S : sig module I : sig end end
+  module type s = sig end
  class type d = object  end
  exception E of { inline : int; }
end diff --git a/testsuite/tests/tool-ocamlobjinfo/ocamltests b/testsuite/tests/tool-ocamlobjinfo/ocamltests deleted file mode 100644 index ccd381fe..00000000 --- a/testsuite/tests/tool-ocamlobjinfo/ocamltests +++ /dev/null @@ -1 +0,0 @@ -question.ml diff --git a/testsuite/tests/tool-toplevel-invocation/ocamltests b/testsuite/tests/tool-toplevel-invocation/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/tool-toplevel-invocation/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference index c0edb9c5..fe6ac39a 100644 --- a/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference +++ b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference @@ -39,6 +39,11 @@ Lines 2-4, characters 8-2: 4 | 2)... Error: This expression has type int but an expression was expected of type float +Line 2, characters 12-17: +2 | let x = 1 + "abc" in + ^^^^^ +Error: This expression has type string but an expression was expected of type + int File "error_highlighting_use1.ml", line 1, characters 8-15: 1 | let x = (1 + 2) +. 3. in ();; ^^^^^^^ diff --git a/testsuite/tests/tool-toplevel/error_highlighting.ml b/testsuite/tests/tool-toplevel/error_highlighting.ml index 832b55da..5716a7ac 100644 --- a/testsuite/tests/tool-toplevel/error_highlighting.ml +++ b/testsuite/tests/tool-toplevel/error_highlighting.ml @@ -26,6 +26,85 @@ let x = (1 2) +. 3. in ();; +let x = 1 + "abc" in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in +let x = 1 in ();; + #use "error_highlighting_use1.ml";; #use "error_highlighting_use2.ml";; #use "error_highlighting_use3.ml";; diff --git a/testsuite/tests/tool-toplevel/ocamltests b/testsuite/tests/tool-toplevel/ocamltests deleted file mode 100644 index b8c2470b..00000000 --- a/testsuite/tests/tool-toplevel/ocamltests +++ /dev/null @@ -1,8 +0,0 @@ -exotic_lists.ml -pr6468.ml -pr7060.ml -pr7751.ml -strings.ml -tracing.ml -error_highlighting.ml -uncaught_exceptions.ml diff --git a/testsuite/tests/tool-toplevel/pr6468.compilers.reference b/testsuite/tests/tool-toplevel/pr6468.compilers.reference index a63d008d..a716651e 100644 --- a/testsuite/tests/tool-toplevel/pr6468.compilers.reference +++ b/testsuite/tests/tool-toplevel/pr6468.compilers.reference @@ -8,5 +8,5 @@ val g : unit -> int = Exception: Not_found. Raised at file "//toplevel//", line 2, characters 17-26 Called from file "//toplevel//", line 1, characters 11-15 -Called from file "toplevel/toploop.ml", line 208, characters 17-27 +Called from file "toplevel/toploop.ml", line 212, characters 17-27 diff --git a/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference new file mode 100644 index 00000000..4fc85aae --- /dev/null +++ b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference @@ -0,0 +1,40 @@ +module Empty : sig end +type u = A +type v = B +module type S = sig end +val m : (module S) = +module M : sig type 'a t = X of 'a end +val x : (u * v * (module S)) M.t = M.X (A, B, ) +module type S = sig end +val m : (module S) = +type u = A +type v = B +module M : sig type 'a t = X of 'a end +val y : (u * v * (module S)) M.t = M.X (A, B, ) +Line 2, characters 4-5: +2 | x = y;; + ^ +Error: This expression has type (u/1 * v/1 * (module S/1)) M/1.t + but an expression was expected of type + (u/2 * v/2 * (module S/2)) M/2.t + Hint: The types v and u have been defined multiple times in this + toplevel session. Some toplevel values still refer to old versions + of those types. Did you try to redefine them? + Hint: The module M has been defined multiple times in this toplevel + session. Some toplevel values still refer to old versions of this + module. Did you try to redefine them? + Hint: The module type S has been defined multiple times in this + toplevel session. Some toplevel values still refer to old versions + of this module type. Did you try to redefine them? +type a = A +val a : a = A +type a = A +val b : a = A +Line 2, characters 4-5: +2 | a = b;; + ^ +Error: This expression has type a/1 but an expression was expected of type + a/2 + Hint: The type a has been defined multiple times in this toplevel + session. Some toplevel values still refer to old versions of this + type. Did you try to redefine them? diff --git a/testsuite/tests/tool-toplevel/redefinition_hints.ml b/testsuite/tests/tool-toplevel/redefinition_hints.ml new file mode 100644 index 00000000..d5c4bdf3 --- /dev/null +++ b/testsuite/tests/tool-toplevel/redefinition_hints.ml @@ -0,0 +1,40 @@ +(* TEST + * toplevel +*) + +(* This is a toplevel test to trigger toplevel specific hints *) + + +module Empty = struct end + + +type u = A +type v = B +module type S = sig end +let m = (module Empty:S) + +module M = struct + type 'a t = X of 'a +end +let x =M.X (A,B,m);; + +module type S = sig end +let m = (module Empty:S) + +type u = A +type v = B +module M = struct + type 'a t = X of 'a +end +let y = M.X (A,B,m);; + +x = y;; + +type a = A +let a = A;; + +type a = A +let b = A;; + +a = b;; +exit 0;; diff --git a/testsuite/tests/translprim/ocamltests b/testsuite/tests/translprim/ocamltests deleted file mode 100644 index 2c3151aa..00000000 --- a/testsuite/tests/translprim/ocamltests +++ /dev/null @@ -1,5 +0,0 @@ -array_spec.ml -comparison_table.ml -module_coercion.ml -ref_spec.ml -locs.ml diff --git a/testsuite/tests/typing-core-bugs/ocamltests b/testsuite/tests/typing-core-bugs/ocamltests deleted file mode 100644 index 02cb7e3e..00000000 --- a/testsuite/tests/typing-core-bugs/ocamltests +++ /dev/null @@ -1,5 +0,0 @@ -missing_rec_hint.ml -unit_fun_hints.ml -type_expected_explanation.ml -repeated_did_you_mean.ml -const_int_hint.ml diff --git a/testsuite/tests/typing-deprecated/deprecated.ml b/testsuite/tests/typing-deprecated/deprecated.ml index 18adcb99..8429df43 100644 --- a/testsuite/tests/typing-deprecated/deprecated.ml +++ b/testsuite/tests/typing-deprecated/deprecated.ml @@ -384,7 +384,7 @@ module D = struct end[@@ocaml.deprecated] open D ;; [%%expect{| -module D : sig end +module D : sig end Line 3, characters 5-6: 3 | open D ^ @@ -575,7 +575,7 @@ Line 8, characters 22-36: 8 | [@@@ocaml.ppwarning "Pp warning2!"] ^^^^^^^^^^^^^^ Warning 22: Pp warning2! -module X : sig end +module X : sig end |}] let x = diff --git a/testsuite/tests/typing-deprecated/ocamltests b/testsuite/tests/typing-deprecated/ocamltests deleted file mode 100644 index c38985ee..00000000 --- a/testsuite/tests/typing-deprecated/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -deprecated.ml -alerts.ml diff --git a/testsuite/tests/typing-extension-constructor/ocamltests b/testsuite/tests/typing-extension-constructor/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/typing-extension-constructor/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/typing-extensions/extensions.ml b/testsuite/tests/typing-extensions/extensions.ml index bdd0ff3b..c7c82467 100644 --- a/testsuite/tests/typing-extensions/extensions.ml +++ b/testsuite/tests/typing-extensions/extensions.ml @@ -296,7 +296,11 @@ Error: Signature mismatch: type ('a, 'b) bar += A of float is not included in type ('a, 'b) bar += A of int - The types for field A are not equal. + Constructors do not match: + A of float + is not compatible with: + A of int + The types are not equal. |}] module M : sig @@ -318,9 +322,40 @@ Error: Signature mismatch: type ('a, 'b) bar += A of 'b is not included in type ('a, 'b) bar += A of 'a - The types for field A are not equal. + Constructors do not match: + A of 'b + is not compatible with: + A of 'a + The types are not equal. |}] +module M : sig + type ('a, 'b) bar = A of 'a +end = struct + type ('b, 'a) bar = A of 'a +end;; +[%%expect {| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type ('b, 'a) bar = A of 'a +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type ('b, 'a) bar = A of 'a end + is not included in + sig type ('a, 'b) bar = A of 'a end + Type declarations do not match: + type ('b, 'a) bar = A of 'a + is not included in + type ('a, 'b) bar = A of 'a + Constructors do not match: + A of 'a + is not compatible with: + A of 'a + The types are not equal. +|}];; + + module M : sig type ('a, 'b) bar += A : 'c -> ('c, 'd) bar end = struct @@ -340,7 +375,11 @@ Error: Signature mismatch: type ('a, 'b) bar += A : 'd -> ('c, 'd) bar is not included in type ('a, 'b) bar += A : 'c -> ('c, 'd) bar - The types for field A are not equal. + Constructors do not match: + A : 'd -> ('c, 'd) bar + is not compatible with: + A : 'c -> ('c, 'd) bar + The types are not equal. |}] (* Extensions can be rebound *) diff --git a/testsuite/tests/typing-extensions/ocamltests b/testsuite/tests/typing-extensions/ocamltests deleted file mode 100644 index 24414ead..00000000 --- a/testsuite/tests/typing-extensions/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -cast.ml -extensions.ml -msg.ml -open_types.ml diff --git a/testsuite/tests/typing-fstclassmod/ocamltests b/testsuite/tests/typing-fstclassmod/ocamltests deleted file mode 100644 index c5ee22bd..00000000 --- a/testsuite/tests/typing-fstclassmod/ocamltests +++ /dev/null @@ -1 +0,0 @@ -fstclassmod.ml diff --git a/testsuite/tests/typing-gadts/ambiguity.ml b/testsuite/tests/typing-gadts/ambiguity.ml index b576b2bf..d43f3384 100644 --- a/testsuite/tests/typing-gadts/ambiguity.ml +++ b/testsuite/tests/typing-gadts/ambiguity.ml @@ -104,7 +104,7 @@ Error: This expression has type b = a but an expression was expected of type representative for an ambivalent type escaping its scope. The commit that was implemented poses problems of its own: we are now unifying the type of the patterns in the environment of each pattern, instead - of the outter one. The code discussed in PR#7617 passes because each branch + of the outer one. The code discussed in PR#7617 passes because each branch contains the same equation, but consider the following cases: *) let f (type a b) (x : (a, b) eq) = diff --git a/testsuite/tests/typing-gadts/ocamltests b/testsuite/tests/typing-gadts/ocamltests deleted file mode 100644 index 83d75ab1..00000000 --- a/testsuite/tests/typing-gadts/ocamltests +++ /dev/null @@ -1,50 +0,0 @@ -ambiguity.ml -didier.ml -dynamic_frisch.ml -nested_equations.ml -omega07.ml -or_patterns.ml -pr5332.ml -pr5689.ml -pr5785.ml -pr5848.ml -pr5906.ml -pr5948.ml -pr5981.ml -pr5985.ml -pr5989.ml -pr5997.ml -pr6158.ml -pr6163.ml -pr6174.ml -pr6241.ml -pr6690.ml -pr6817.ml -pr6934.ml -pr6980.ml -pr6993_bad.ml -pr7016.ml -pr7160.ml -pr7214.ml -pr7222.ml -pr7230.ml -pr7234.ml -pr7260.ml -pr7269.ml -pr7298.ml -pr7374.ml -pr7378.ml -pr7381.ml -pr7390.ml -pr7391.ml -pr7397.ml -pr7421.ml -pr7432.ml -pr7618.ml -pr7747.ml -term-conv.ml -test.ml -unexpected_existentials.ml -unify_mb.ml -variables_in_mcomp.ml -yallop_bugs.ml diff --git a/testsuite/tests/typing-gadts/pr5689.ml b/testsuite/tests/typing-gadts/pr5689.ml index 172ea5b2..acbb195c 100644 --- a/testsuite/tests/typing-gadts/pr5689.ml +++ b/testsuite/tests/typing-gadts/pr5689.ml @@ -107,5 +107,6 @@ Error: This expression has type ([< inkind > `Nonlink ] as 'a) inline_t but an expression was expected of type a inline_t Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type a = [< `Link | `Nonlink ] - Types for tag `Nonlink are incompatible + The second variant type is bound to $'a, + it may not allow the tag(s) `Nonlink |}];; diff --git a/testsuite/tests/typing-gadts/pr6241.ml b/testsuite/tests/typing-gadts/pr6241.ml index 3a778144..330965f7 100644 --- a/testsuite/tests/typing-gadts/pr6241.ml +++ b/testsuite/tests/typing-gadts/pr6241.ml @@ -30,7 +30,7 @@ A module M : functor (A : sig module type T end) (B : sig module type T end) -> sig val f : ((module A.T), (module B.T)) t -> string end -module A : sig module type T = sig end end +module A : sig module type T = sig end end module N : sig val f : ((module A.T), (module A.T)) t -> string end Exception: Match_failure ("", 8, 52). |}];; diff --git a/testsuite/tests/typing-gadts/pr6980.ml b/testsuite/tests/typing-gadts/pr6980.ml index f4d53bfe..75a302e3 100644 --- a/testsuite/tests/typing-gadts/pr6980.ml +++ b/testsuite/tests/typing-gadts/pr6980.ml @@ -26,5 +26,6 @@ Line 11, characters 27-29: ^^ Error: This expression has type [< `Bar | `Foo > `Bar ] but an expression was expected of type [< `Bar | `Foo ] - Types for tag `Bar are incompatible + The second variant type is bound to $Aux, + it may not allow the tag(s) `Bar |}];; diff --git a/testsuite/tests/typing-gadts/pr7160.ml b/testsuite/tests/typing-gadts/pr7160.ml index 8af9de8c..a615a462 100644 --- a/testsuite/tests/typing-gadts/pr7160.ml +++ b/testsuite/tests/typing-gadts/pr7160.ml @@ -18,5 +18,9 @@ Lines 4-5, characters 0-77: 4 | type 'a tt = 'a t = 5 | Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt.. Error: This variant or record definition does not match that of type 'a t - The types for field Same are not equal. + Constructors do not match: + Same : 'l t -> 'l t + is not compatible with: + Same : 'l1 t -> 'l2 t + The types are not equal. |}];; diff --git a/testsuite/tests/typing-gadts/pr7378.ml b/testsuite/tests/typing-gadts/pr7378.ml index 956094d7..9252b43d 100644 --- a/testsuite/tests/typing-gadts/pr7378.ml +++ b/testsuite/tests/typing-gadts/pr7378.ml @@ -19,7 +19,11 @@ Lines 2-3, characters 2-37: 2 | ..type t = X.t = 3 | | A : 'a * 'b * ('b -> unit) -> t Error: This variant or record definition does not match that of type X.t - The types for field A are not equal. + Constructors do not match: + A : 'a * 'b * ('a -> unit) -> X.t + is not compatible with: + A : 'a * 'b * ('b -> unit) -> X.t + The types are not equal. |}] (* would segfault diff --git a/testsuite/tests/typing-gadts/pr9019.ml b/testsuite/tests/typing-gadts/pr9019.ml new file mode 100644 index 00000000..7a946bfb --- /dev/null +++ b/testsuite/tests/typing-gadts/pr9019.ml @@ -0,0 +1,236 @@ +(* TEST + * expect +*) + +(* #9012 by Thomas Refis *) + +type ab = A | B + +module M : sig + type mab = A | B + type _ t = AB : ab t | MAB : mab t + val ab : mab t +end = struct + type mab = ab = A | B + type _ t = AB : ab t | MAB : mab t + let ab = AB +end +[%%expect{| +type ab = A | B +module M : + sig type mab = A | B type _ t = AB : ab t | MAB : mab t val ab : mab t end +|}] + +open M + +let f (type x) (t1 : x t) (t2 : x t) (x : x) = + match t1, t2, x with + | AB, AB, A -> 1 + | MAB, _, A -> 2 + | _, AB, B -> 3 + | _, MAB, B -> 4 +[%%expect{| +Lines 4-8, characters 2-18: +4 | ..match t1, t2, x with +5 | | AB, AB, A -> 1 +6 | | MAB, _, A -> 2 +7 | | _, AB, B -> 3 +8 | | _, MAB, B -> 4 +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +(AB, MAB, A) +val f : 'x M.t -> 'x M.t -> 'x -> int = +|}] + +let () = ignore (f M.ab MAB A) +[%%expect{| +Exception: Match_failure ("", 4, 2). +|}] + +(* variant *) + +type _ ab = A | B + +module M : sig + type _ mab + type _ t = AB : unit ab t | MAB : unit mab t + val ab : unit mab t + val a : 'a mab + val b : 'a mab +end = struct + type 'a mab = 'a ab = A | B + type _ t = AB : unit ab t | MAB : unit mab t + let ab = AB + let a = A + let b = B +end;; +[%%expect{| +type _ ab = A | B +module M : + sig + type _ mab + type _ t = AB : unit ab t | MAB : unit mab t + val ab : unit mab t + val a : 'a mab + val b : 'a mab + end +|}] + +open M + +(* The second clause isn't redundant *) +let f (type x) (t1 : x t) (t2 : x t) (x : x) = + match t1, t2, x with + | AB, AB, A -> 1 + | _, AB, A -> 2 + | _, AB, B -> 3 + | _, MAB, _ -> 4;; +[%%expect{| +val f : 'x M.t -> 'x M.t -> 'x -> int = +|}] + +(* the answer shouldn't be 3 *) +let x = f MAB M.ab M.a;; +[%%expect{| +val x : int = 2 +|}] + +(* using records *) + +type ab = { a : int } + +module M : sig + type mab = { a : int } + + type _ t = AB : ab t | MAB : mab t + + val a : mab + val ab : mab t +end = struct + type mab = ab = { a : int } + + type _ t = AB : ab t | MAB : mab t + + let a = { a = 42 } + let ab = AB +end;; +[%%expect{| +type ab = { a : int; } +module M : + sig + type mab = { a : int; } + type _ t = AB : ab t | MAB : mab t + val a : mab + val ab : mab t + end +|}] + +open M + +let f (type x) (t1 : x t) (t2 : x t) (x : x) = + match t1, t2, x with + | AB, AB, { a = _ } -> 1 + | MAB, _, { a = _ } -> 2 + | _, AB, { a = _ } -> 3 + | _, MAB, { a = _ } -> 4;; +[%%expect{| +Line 7, characters 4-22: +7 | | _, AB, { a = _ } -> 3 + ^^^^^^^^^^^^^^^^^^ +Warning 11: this match case is unused. +val f : 'x M.t -> 'x M.t -> 'x -> int = +|}] + +let p = f M.ab MAB { a = 42 };; +[%%expect{| +val p : int = 4 +|}] + + +(* #9019 by Leo White *) + +type _ a_or_b = + A_or_B : [< `A of string | `B of int] a_or_b + +type _ a = + | A : [> `A of string] a + | Not_A : _ a + +let f (type x) (a : x a) (a_or_b : x a_or_b) (x : x) = + match a, a_or_b, x with + | Not_A, A_or_B, `B i -> print_int i + | _, A_or_B, `A s -> print_string s +[%%expect{| +type _ a_or_b = A_or_B : [< `A of string | `B of int ] a_or_b +type _ a = A : [> `A of string ] a | Not_A : 'a a +Lines 9-11, characters 2-37: + 9 | ..match a, a_or_b, x with +10 | | Not_A, A_or_B, `B i -> print_int i +11 | | _, A_or_B, `A s -> print_string s +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +(A, A_or_B, `B _) +val f : 'x a -> 'x a_or_b -> 'x -> unit = +|}] + +let segfault = f A A_or_B (`B 0) +[%%expect{| +Exception: Match_failure ("", 9, 2). +|}] + + +(* Another example *) +type (_, _) b = + | A : ([< `A ], 'a) b + | B : ([< `B of 'a], 'a) b + +type _ ty = + | String_option : string option ty + +let f (type x) (type y) (b : (x, y ty) b) (x : x) (y : y) = + match b, x, y with + | B, `B String_option, Some s -> print_string s + | A, `A, _ -> () +[%%expect{| +type (_, _) b = A : ([< `A ], 'a) b | B : ([< `B of 'a ], 'a) b +type _ ty = String_option : string option ty +Lines 9-11, characters 2-18: + 9 | ..match b, x, y with +10 | | B, `B String_option, Some s -> print_string s +11 | | A, `A, _ -> () +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +(B, `B String_option, None) +val f : ('x, 'y ty) b -> 'x -> 'y -> unit = +|}] + +let segfault = f B (`B String_option) None +[%%expect{| +Exception: Match_failure ("", 9, 2). +|}] + +(* More polymorphic variants *) + +type 'a a = private [< `A of 'a];; +let f (x : _ a) = match x with `A None -> ();; +[%%expect{| +type 'a a = private [< `A of 'a ] +Line 2, characters 18-44: +2 | let f (x : _ a) = match x with `A None -> ();; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +`A (Some _) +val f : 'a option a -> unit = +|}] + +let f (x : [> `A] a) = match x with `A `B -> ();; +[%%expect{| +Line 1, characters 23-47: +1 | let f (x : [> `A] a) = match x with `A `B -> ();; + ^^^^^^^^^^^^^^^^^^^^^^^^ +Warning 8: this pattern-matching is not exhaustive. +Here is an example of a case that is not matched: +`A `A +val f : [< `A | `B > `A ] a -> unit = +|}] diff --git a/testsuite/tests/typing-immediate/immediate.ml b/testsuite/tests/typing-immediate/immediate.ml index c55c9374..74575aa7 100644 --- a/testsuite/tests/typing-immediate/immediate.ml +++ b/testsuite/tests/typing-immediate/immediate.ml @@ -109,8 +109,8 @@ end;; Line 2, characters 2-31: 2 | type t = string [@@immediate] ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool +Error: Types marked with the immediate attribute must be non-pointer types + like int or bool. |}];; (* Not guaranteed that t is immediate, so this is an invalid declaration *) @@ -122,8 +122,8 @@ end;; Line 3, characters 2-26: 3 | type s = t [@@immediate] ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool +Error: Types marked with the immediate attribute must be non-pointer types + like int or bool. |}];; (* Can't ascribe to an immediate type signature with a non-immediate type *) @@ -144,7 +144,7 @@ Error: Signature mismatch: type t = string is not included in type t [@@immediate] - the first is not an immediate type. + The first is not an immediate type. |}];; (* Same as above but with explicit signature *) @@ -160,7 +160,7 @@ Error: Signature mismatch: type t = string is not included in type t [@@immediate] - the first is not an immediate type. + The first is not an immediate type. |}];; (* Can't use a non-immediate type even if mutually recursive *) @@ -172,6 +172,6 @@ end;; Line 2, characters 2-26: 2 | type t = s [@@immediate] ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Types marked with the immediate attribute must be - non-pointer types like int or bool +Error: Types marked with the immediate attribute must be non-pointer types + like int or bool. |}];; diff --git a/testsuite/tests/typing-immediate/ocamltests b/testsuite/tests/typing-immediate/ocamltests deleted file mode 100644 index d3670297..00000000 --- a/testsuite/tests/typing-immediate/ocamltests +++ /dev/null @@ -1 +0,0 @@ -immediate.ml diff --git a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml index e503ee73..bd256f2c 100644 --- a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml +++ b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml @@ -1,5 +1,5 @@ (* TEST - * toplevel + * expect *) (* @@ -17,53 +17,178 @@ (* Use a module pattern *) let sort (type s) (module Set : Set.S with type elt = s) l = Set.elements (List.fold_right Set.add l Set.empty) +;; +[%%expect{| +val sort : (module Set.S with type elt = 's) -> 's list -> 's list = +|}];; (* No real improvement here? *) let make_set (type s) cmp : (module Set.S with type elt = s) = (module Set.Make (struct type t = s let compare = cmp end)) +;; +[%%expect{| +val make_set : ('s -> 's -> int) -> (module Set.S with type elt = 's) = +|}];; (* No type annotation here *) let sort_cmp (type s) cmp = sort (module Set.Make (struct type t = s let compare = cmp end)) +;; +[%%expect{| +val sort_cmp : ('s -> 's -> int) -> 's list -> 's list = +|}];; module type S = sig type t val x : t end;; +[%%expect{| +module type S = sig type t val x : t end +|}];; + let f (module M : S with type t = int) = M.x;; +[%%expect{| +val f : (module S with type t = int) -> int = +|}];; + let f (module M : S with type t = 'a) = M.x;; (* Error *) +[%%expect{| +Line 1, characters 6-37: +1 | let f (module M : S with type t = 'a) = M.x;; (* Error *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The type of this packed module contains variables: + (module S with type t = 'a) +|}];; + let f (type a) (module M : S with type t = a) = M.x;; f (module struct type t = int let x = 1 end);; +[%%expect{| +val f : (module S with type t = 'a) -> 'a = +- : int = 1 +|}];; + +(***) type 'a s = {s: (module S with type t = 'a)};; +[%%expect{| +type 'a s = { s : (module S with type t = 'a); } +|}];; + {s=(module struct type t = int let x = 1 end)};; +[%%expect{| +- : int s = {s = } +|}];; + let f {s=(module M)} = M.x;; (* Error *) +[%%expect{| +Line 1, characters 9-19: +1 | let f {s=(module M)} = M.x;; (* Error *) + ^^^^^^^^^^ +Error: The type of this packed module contains variables: + (module S with type t = 'a) +|}];; + let f (type a) ({s=(module M)} : a s) = M.x;; +[%%expect{| +val f : 'a s -> 'a = +|}];; type s = {s: (module S with type t = int)};; let f {s=(module M)} = M.x;; let f {s=(module M)} {s=(module N)} = M.x + N.x;; +[%%expect{| +type s = { s : (module S with type t = int); } +val f : s -> int = +val f : s -> s -> int = +|}];; + +(***) module type S = sig val x : int end;; +[%%expect{| +module type S = sig val x : int end +|}];; + let f (module M : S) y (module N : S) = M.x + y + N.x;; +[%%expect{| +val f : (module S) -> int -> (module S) -> int = +|}];; + let m = (module struct let x = 3 end);; (* Error *) +[%%expect{| +Line 1, characters 8-37: +1 | let m = (module struct let x = 3 end);; (* Error *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The signature for this packaged module couldn't be inferred. +|}];; + let m = (module struct let x = 3 end : S);; +[%%expect{| +val m : (module S) = +|}];; + f m 1 m;; +[%%expect{| +- : int = 7 +|}];; f m 1 (module struct let x = 2 end);; +[%%expect{| +- : int = 6 +|}];; + +(***) let (module M) = m in M.x;; +[%%expect{| +- : int = 3 +|}];; + let (module M) = m;; (* Error: only allowed in [let .. in] *) +[%%expect{| +Line 1, characters 4-14: +1 | let (module M) = m;; (* Error: only allowed in [let .. in] *) + ^^^^^^^^^^ +Error: Modules are not allowed in this pattern. +|}];; + class c = let (module M) = m in object end;; (* Error again *) +[%%expect{| +Line 1, characters 14-24: +1 | class c = let (module M) = m in object end;; (* Error again *) + ^^^^^^^^^^ +Error: Modules are not allowed in this pattern. +|}];; + module M = (val m);; +[%%expect{| +module M : S +|}];; + +(***) module type S' = sig val f : int -> int end;; +[%%expect{| +module type S' = sig val f : int -> int end +|}];; + (* Even works with recursion, but must be fully explicit *) let rec (module M : S') = (module struct let f n = if n <= 0 then 1 else n * M.f (n-1) end : S') in M.f 3;; +[%%expect{| +- : int = 6 +|}];; (* Subtyping *) module type S = sig type t type u val x : t * u end + let f (l : (module S with type t = int and type u = bool) list) = (l :> (module S with type u = bool) list) +;; +[%%expect{| +module type S = sig type t type u val x : t * u end +val f : + (module S with type t = int and type u = bool) list -> + (module S with type u = bool) list = +|}];; (* GADTs from the manual *) (* the only modification is in to_string *) @@ -118,6 +243,36 @@ let rec to_string: 'a. 'a Typ.typ -> 'a -> string = | Pair (module P) -> let (x1, x2) = TypEq.apply P.eq x in Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2) +;; +[%%expect{| +module TypEq : + sig + type ('a, 'b) t + val apply : ('a, 'b) t -> 'a -> 'b + val refl : ('a, 'a) t + val sym : ('a, 'b) t -> ('b, 'a) t + end +module rec Typ : + sig + module type PAIR = + sig + type t + and t1 + and t2 + val eq : (t, t1 * t2) TypEq.t + val t1 : t1 Typ.typ + val t2 : t2 Typ.typ + end + type 'a typ = + Int of ('a, int) TypEq.t + | String of ('a, string) TypEq.t + | Pair of (module PAIR with type t = 'a) + end +val int : int Typ.typ = Typ.Int +val str : string Typ.typ = Typ.String +val pair : 's1 Typ.typ -> 's2 Typ.typ -> ('s1 * 's2) Typ.typ = +val to_string : 'a Typ.typ -> 'a -> string = +|}];; (* Wrapping maps *) module type MapT = sig @@ -143,27 +298,204 @@ module SSMap = struct let of_t x = x let to_t x = x end +;; +[%%expect{| +module type MapT = + sig + type key + type +'a t + val empty : 'a t + val is_empty : 'a t -> bool + val mem : key -> 'a t -> bool + val add : key -> 'a -> 'a t -> 'a t + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t + val singleton : key -> 'a -> 'a t + val remove : key -> 'a t -> 'a t + val merge : + (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val for_all : (key -> 'a -> bool) -> 'a t -> bool + val exists : (key -> 'a -> bool) -> 'a t -> bool + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal : 'a t -> int + val bindings : 'a t -> (key * 'a) list + val min_binding : 'a t -> key * 'a + val min_binding_opt : 'a t -> (key * 'a) option + val max_binding : 'a t -> key * 'a + val max_binding_opt : 'a t -> (key * 'a) option + val choose : 'a t -> key * 'a + val choose_opt : 'a t -> (key * 'a) option + val split : key -> 'a t -> 'a t * 'a option * 'a t + val find : key -> 'a t -> 'a + val find_opt : key -> 'a t -> 'a option + val find_first : (key -> bool) -> 'a t -> key * 'a + val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option + val find_last : (key -> bool) -> 'a t -> key * 'a + val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option + val map : ('a -> 'b) -> 'a t -> 'b t + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + val to_seq : 'a t -> (key * 'a) Seq.t + val to_seq_from : key -> 'a t -> (key * 'a) Seq.t + val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t + val of_seq : (key * 'a) Seq.t -> 'a t + type data + type map + val of_t : data t -> map + val to_t : map -> data t + end +type ('k, 'd, 'm) map = + (module MapT with type data = 'd and type key = 'k and type map = 'm) +val add : ('k, 'd, 'm) map -> 'k -> 'd -> 'm -> 'm = +module SSMap : + sig + type key = String.t + type 'a t = 'a Map.Make(String).t + val empty : 'a t + val is_empty : 'a t -> bool + val mem : key -> 'a t -> bool + val add : key -> 'a -> 'a t -> 'a t + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t + val singleton : key -> 'a -> 'a t + val remove : key -> 'a t -> 'a t + val merge : + (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val for_all : (key -> 'a -> bool) -> 'a t -> bool + val exists : (key -> 'a -> bool) -> 'a t -> bool + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal : 'a t -> int + val bindings : 'a t -> (key * 'a) list + val min_binding : 'a t -> key * 'a + val min_binding_opt : 'a t -> (key * 'a) option + val max_binding : 'a t -> key * 'a + val max_binding_opt : 'a t -> (key * 'a) option + val choose : 'a t -> key * 'a + val choose_opt : 'a t -> (key * 'a) option + val split : key -> 'a t -> 'a t * 'a option * 'a t + val find : key -> 'a t -> 'a + val find_opt : key -> 'a t -> 'a option + val find_first : (key -> bool) -> 'a t -> key * 'a + val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option + val find_last : (key -> bool) -> 'a t -> key * 'a + val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option + val map : ('a -> 'b) -> 'a t -> 'b t + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + val to_seq : 'a t -> (key * 'a) Seq.t + val to_seq_from : key -> 'a t -> (key * 'a) Seq.t + val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t + val of_seq : (key * 'a) Seq.t -> 'a t + type data = string + type map = data t + val of_t : 'a -> 'a + val to_t : 'a -> 'a + end +|}];; let ssmap = (module SSMap: MapT with type key = string and type data = string and type map = SSMap.map) ;; +[%%expect{| +val ssmap : + (module MapT with type data = string and type key = string and type map = + SSMap.map) = + +|}];; let ssmap = (module struct include SSMap end : MapT with type key = string and type data = string and type map = SSMap.map) ;; +[%%expect{| +val ssmap : + (module MapT with type data = string and type key = string and type map = + SSMap.map) = + +|}];; let ssmap = (let module S = struct include SSMap end in (module S) : (module MapT with type key = string and type data = string and type map = SSMap.map)) ;; +[%%expect{| +val ssmap : + (module MapT with type data = string and type key = string and type map = + SSMap.map) = + +|}];; let ssmap = (module SSMap: MapT with type key = _ and type data = _ and type map = _) ;; +[%%expect{| +val ssmap : + (module MapT with type data = SSMap.data and type key = SSMap.key and type map = + SSMap.map) = + +|}];; let ssmap : (_,_,_) map = (module SSMap);; +[%%expect{| +val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = +|}];; add ssmap;; +[%%expect{| +- : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = +|}];; + +(*****) + +module type S = sig type t end + +let x = + (module struct type elt = A type t = elt list end : S with type t = _ list) +;; +[%%expect{| +module type S = sig type t end +Line 4, characters 10-51: +4 | (module struct type elt = A type t = elt list end : S with type t = _ list) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The type t in this module cannot be exported. + Its type contains local dependencies: elt list +|}];; + +type 'a s = (module S with type t = 'a);; +[%%expect{| +type 'a s = (module S with type t = 'a) +|}];; + +let x : 'a s = (module struct type t = int end);; +[%%expect{| +val x : int s = +|}];; + +let x : 'a s = (module struct type t = A end);; +[%%expect{| +Line 1, characters 23-44: +1 | let x : 'a s = (module struct type t = A end);; + ^^^^^^^^^^^^^^^^^^^^^ +Error: The type t in this module cannot be exported. + Its type contains local dependencies: t +|}];; + +let x : 'a s = (module struct end);; +[%%expect{| +Line 1, characters 23-33: +1 | let x : 'a s = (module struct end);; + ^^^^^^^^^^ +Error: Signature mismatch: + Modules do not match: sig end is not included in S + The type `t' is required but not provided +|}];; diff --git a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ocaml.reference b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ocaml.reference deleted file mode 100644 index da8efa70..00000000 --- a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ocaml.reference +++ /dev/null @@ -1,193 +0,0 @@ -val sort : (module Set.S with type elt = 's) -> 's list -> 's list = -val make_set : ('s -> 's -> int) -> (module Set.S with type elt = 's) = -val sort_cmp : ('s -> 's -> int) -> 's list -> 's list = -module type S = sig type t val x : t end -val f : (module S with type t = int) -> int = -Line 1, characters 6-37: -1 | let f (module M : S with type t = 'a) = M.x;; (* Error *) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The type of this packed module contains variables: - (module S with type t = 'a) -val f : (module S with type t = 'a) -> 'a = -- : int = 1 -type 'a s = { s : (module S with type t = 'a); } -- : int s = {s = } -Line 1, characters 9-19: -1 | let f {s=(module M)} = M.x;; (* Error *) - ^^^^^^^^^^ -Error: The type of this packed module contains variables: - (module S with type t = 'a) -val f : 'a s -> 'a = -type s = { s : (module S with type t = int); } -val f : s -> int = -val f : s -> s -> int = -module type S = sig val x : int end -val f : (module S) -> int -> (module S) -> int = -Line 1, characters 8-37: -1 | let m = (module struct let x = 3 end);; (* Error *) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The signature for this packaged module couldn't be inferred. -val m : (module S) = -- : int = 7 -- : int = 6 -- : int = 3 -Line 1, characters 4-14: -1 | let (module M) = m;; (* Error: only allowed in [let .. in] *) - ^^^^^^^^^^ -Error: Modules are not allowed in this pattern. -Line 1, characters 14-24: -1 | class c = let (module M) = m in object end;; (* Error again *) - ^^^^^^^^^^ -Error: Modules are not allowed in this pattern. -module M : S -module type S' = sig val f : int -> int end -- : int = 6 -module type S = sig type t type u val x : t * u end -val f : - (module S with type t = int and type u = bool) list -> - (module S with type u = bool) list = -module TypEq : - sig - type ('a, 'b) t - val apply : ('a, 'b) t -> 'a -> 'b - val refl : ('a, 'a) t - val sym : ('a, 'b) t -> ('b, 'a) t - end -module rec Typ : - sig - module type PAIR = - sig - type t - and t1 - and t2 - val eq : (t, t1 * t2) TypEq.t - val t1 : t1 Typ.typ - val t2 : t2 Typ.typ - end - type 'a typ = - Int of ('a, int) TypEq.t - | String of ('a, string) TypEq.t - | Pair of (module PAIR with type t = 'a) - end -val int : int Typ.typ = Typ.Int -val str : string Typ.typ = Typ.String -val pair : 's1 Typ.typ -> 's2 Typ.typ -> ('s1 * 's2) Typ.typ = -val to_string : 'a Typ.typ -> 'a -> string = -module type MapT = - sig - type key - type +'a t - val empty : 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool - val add : key -> 'a -> 'a t -> 'a t - val update : key -> ('a option -> 'a option) -> 'a t -> 'a t - val singleton : key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge : - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal : 'a t -> int - val bindings : 'a t -> (key * 'a) list - val min_binding : 'a t -> key * 'a - val min_binding_opt : 'a t -> (key * 'a) option - val max_binding : 'a t -> key * 'a - val max_binding_opt : 'a t -> (key * 'a) option - val choose : 'a t -> key * 'a - val choose_opt : 'a t -> (key * 'a) option - val split : key -> 'a t -> 'a t * 'a option * 'a t - val find : key -> 'a t -> 'a - val find_opt : key -> 'a t -> 'a option - val find_first : (key -> bool) -> 'a t -> key * 'a - val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option - val find_last : (key -> bool) -> 'a t -> key * 'a - val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val to_seq : 'a t -> (key * 'a) Seq.t - val to_seq_from : key -> 'a t -> (key * 'a) Seq.t - val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t - val of_seq : (key * 'a) Seq.t -> 'a t - type data - type map - val of_t : data t -> map - val to_t : map -> data t - end -type ('k, 'd, 'm) map = - (module MapT with type data = 'd and type key = 'k and type map = 'm) -val add : ('k, 'd, 'm) map -> 'k -> 'd -> 'm -> 'm = -module SSMap : - sig - type key = String.t - type 'a t = 'a Map.Make(String).t - val empty : 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool - val add : key -> 'a -> 'a t -> 'a t - val update : key -> ('a option -> 'a option) -> 'a t -> 'a t - val singleton : key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge : - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal : 'a t -> int - val bindings : 'a t -> (key * 'a) list - val min_binding : 'a t -> key * 'a - val min_binding_opt : 'a t -> (key * 'a) option - val max_binding : 'a t -> key * 'a - val max_binding_opt : 'a t -> (key * 'a) option - val choose : 'a t -> key * 'a - val choose_opt : 'a t -> (key * 'a) option - val split : key -> 'a t -> 'a t * 'a option * 'a t - val find : key -> 'a t -> 'a - val find_opt : key -> 'a t -> 'a option - val find_first : (key -> bool) -> 'a t -> key * 'a - val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option - val find_last : (key -> bool) -> 'a t -> key * 'a - val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val to_seq : 'a t -> (key * 'a) Seq.t - val to_seq_from : key -> 'a t -> (key * 'a) Seq.t - val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t - val of_seq : (key * 'a) Seq.t -> 'a t - type data = string - type map = data t - val of_t : 'a -> 'a - val to_t : 'a -> 'a - end -val ssmap : - (module MapT with type data = string and type key = string and type map = - SSMap.map) = - -val ssmap : - (module MapT with type data = string and type key = string and type map = - SSMap.map) = - -val ssmap : - (module MapT with type data = string and type key = string and type map = - SSMap.map) = - -val ssmap : - (module MapT with type data = SSMap.data and type key = SSMap.key and type map = - SSMap.map) = - -val ssmap : (SSMap.key, SSMap.data, SSMap.map) map = -- : SSMap.key -> SSMap.data -> SSMap.map -> SSMap.map = - diff --git a/testsuite/tests/typing-implicit_unpack/ocamltests b/testsuite/tests/typing-implicit_unpack/ocamltests deleted file mode 100644 index 3629d6f5..00000000 --- a/testsuite/tests/typing-implicit_unpack/ocamltests +++ /dev/null @@ -1 +0,0 @@ -implicit_unpack.ml diff --git a/testsuite/tests/typing-labels/ocamltests b/testsuite/tests/typing-labels/ocamltests deleted file mode 100644 index b73143b2..00000000 --- a/testsuite/tests/typing-labels/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -mixin2.ml -mixin3.ml -mixin.ml diff --git a/testsuite/tests/typing-misc-bugs/ocamltests b/testsuite/tests/typing-misc-bugs/ocamltests deleted file mode 100644 index cae9a8a8..00000000 --- a/testsuite/tests/typing-misc-bugs/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -core_array_reduced_ok.ml -pr6303_bad.ml -pr6946_bad.ml diff --git a/testsuite/tests/typing-misc/enrich_typedecl.ml b/testsuite/tests/typing-misc/enrich_typedecl.ml index e1eadbbf..295cab1e 100644 --- a/testsuite/tests/typing-misc/enrich_typedecl.ml +++ b/testsuite/tests/typing-misc/enrich_typedecl.ml @@ -13,15 +13,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-97: - ......struct - type t = A | B - - let f (x : t) = - match x with - | A -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type t = A | B + 5 | + 6 | let f (x : t) = + 7 | match x with + 8 | | A -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type t = A.t = A | B val f : t -> unit end @@ -44,15 +44,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a B.t = A of 'a | B val f : 'a t -> unit end @@ -75,15 +75,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a C.t = A of 'a | B val f : 'a t -> unit end @@ -108,15 +108,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a D.t = A of 'a | B val f : 'a t -> unit end @@ -139,15 +139,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a E.t = A of 'a | B val f : 'a t -> unit end @@ -170,15 +170,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a E2.t = A of 'a | B val f : 'a t -> unit end @@ -201,15 +201,15 @@ end = struct | B -> () end;; [%%expect{| -Line _, characters 6-110: - ......struct - type 'a t = A of 'a | B - - let f (x : _ t) = - match x with - | A _ -> () - | B -> () - end.. +Lines 3-10, characters 6-3: + 3 | ......struct + 4 | type 'a t = A of 'a | B + 5 | + 6 | let f (x : _ t) = + 7 | match x with + 8 | | A _ -> () + 9 | | B -> () +10 | end.. Error: Signature mismatch: Modules do not match: sig type 'a t = 'a E3.t = A of 'a | B val f : 'a t -> unit end @@ -232,14 +232,14 @@ end = struct let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x end;; [%%expect{| -Line _, characters 6-201: - ......struct - type ('a, 'b) t = Foo of 'b - - (* this function typechecks properly, which means that we've added the - manisfest. *) - let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x - end.. +Lines 3-9, characters 6-3: +3 | ......struct +4 | type ('a, 'b) t = Foo of 'b +5 | +6 | (* this function typechecks properly, which means that we've added the +7 | manisfest. *) +8 | let coerce : 'a 'b. ('a, 'b) t -> ('a, 'b) F.t = fun x -> x +9 | end.. Error: Signature mismatch: Modules do not match: sig @@ -252,5 +252,9 @@ Error: Signature mismatch: type ('a, 'b) t = ('a, 'b) F.t = Foo of 'b is not included in type ('a, 'b) t = Foo of 'a - The types for field Foo are not equal. + Constructors do not match: + Foo of 'b + is not compatible with: + Foo of 'a + The types are not equal. |}];; diff --git a/testsuite/tests/typing-misc/includeclass_errors.ml b/testsuite/tests/typing-misc/includeclass_errors.ml new file mode 100644 index 00000000..9d1b8be4 --- /dev/null +++ b/testsuite/tests/typing-misc/includeclass_errors.ml @@ -0,0 +1,253 @@ +(* TEST + * expect +*) + +class type foo_t = + object + method foo: string + end + +module M: sig + class type ct = object val m: string end +end = struct + class type ct = object end +end + +[%%expect{| +class type foo_t = object method foo : string end +Lines 8-10, characters 6-3: + 8 | ......struct + 9 | class type ct = object end +10 | end +Error: Signature mismatch: + Modules do not match: + sig class type ct = object end end + is not included in + sig class type ct = object val m : string end end + Class type declarations do not match: + class type ct = object end + does not match + class type ct = object val m : string end + The first class type has no instance variable m +|}] + +module M: sig + class c : object + method a: string + end +end = struct + class virtual c = object + method virtual a: string + end +end +;; +[%%expect{| +Lines 5-9, characters 6-3: +5 | ......struct +6 | class virtual c = object +7 | method virtual a: string +8 | end +9 | end +Error: Signature mismatch: + Modules do not match: + sig class virtual c : object method virtual a : string end end + is not included in + sig class c : object method a : string end end + Class declarations do not match: + class virtual c : object method virtual a : string end + does not match + class c : object method a : string end + A class cannot be changed from virtual to concrete +|}] + +class type ['a] ct = object val x: 'a end + +module M: sig + class type ['a] c = object end +end = struct + class type c = object end +end +;; + +[%%expect{| +class type ['a] ct = object val x : 'a end +Lines 5-7, characters 6-3: +5 | ......struct +6 | class type c = object end +7 | end +Error: Signature mismatch: + Modules do not match: + sig class type c = object end end + is not included in + sig class type ['a] c = object end end + Class type declarations do not match: + class type c = object end + does not match + class type ['a] c = object end + The classes do not have the same number of type parameters +|}] + +module M: sig + class ['a] c: object constraint 'a = int end +end = struct + class ['a] c = object end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class ['a] c = object end +5 | end +Error: Signature mismatch: + Modules do not match: + sig class ['a] c : object end end + is not included in + sig class ['a] c : object constraint 'a = int end end + Class declarations do not match: + class ['a] c : object end + does not match + class ['a] c : object constraint 'a = int end + A type parameter has type 'a but is expected to have type int +|}] + +module M: sig + class c : int -> object end +end = struct + class c (x : float) = object end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class c (x : float) = object end +5 | end +Error: Signature mismatch: + Modules do not match: + sig class c : float -> object end end + is not included in + sig class c : int -> object end end + Class declarations do not match: + class c : float -> object end + does not match + class c : int -> object end + A parameter has type float but is expected to have type int +|}] + +class virtual foo: foo_t = + object + method foo = "foo" + method private virtual cast: int + end +;; + +[%%expect{| +Lines 2-5, characters 4-7: +2 | ....object +3 | method foo = "foo" +4 | method private virtual cast: int +5 | end +Error: The class type object method foo : string end + is not matched by the class type foo_t + The virtual method cast cannot be hidden +|}] + +class type foo_t2 = + object + method private foo: string + end + +class foo: foo_t2 = + object + method foo = "foo" + end +;; +[%%expect{| +class type foo_t2 = object method private foo : string end +Lines 7-9, characters 4-7: +7 | ....object +8 | method foo = "foo" +9 | end +Error: The class type object method foo : string end + is not matched by the class type foo_t2 + The public method foo cannot become private +|}] + +class virtual foo: foo_t = + object + method virtual foo: string + end +;; +[%%expect{| +Lines 2-4, characters 4-7: +2 | ....object +3 | method virtual foo: string +4 | end +Error: The class type object method virtual foo : string end + is not matched by the class type foo_t + The virtual method foo cannot become concrete +|}] + +class type foo_t3 = + object + val mutable x : int + end + +class foo: foo_t3 = + object + val x = 1 + end +;; +[%%expect{| +class type foo_t3 = object val mutable x : int end +Lines 7-9, characters 4-7: +7 | ....object +8 | val x = 1 +9 | end +Error: The class type object val x : int end is not matched by the class type + foo_t3 + The non-mutable instance variable x cannot become mutable +|}] + +class type foo_t4 = + object + val x : int + end + +class virtual foo: foo_t4 = + object + val virtual x : int + end +;; +[%%expect{| +class type foo_t4 = object val x : int end +Lines 7-9, characters 4-7: +7 | ....object +8 | val virtual x : int +9 | end +Error: The class type object val virtual x : int end + is not matched by the class type foo_t4 + The virtual instance variable x cannot become concrete +|}] + +module M: sig + class type c = object method m: string end +end = struct + class type c = object method private m: string end +end +;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | class type c = object method private m: string end +5 | end +Error: Signature mismatch: + Modules do not match: + sig class type c = object method private m : string end end + is not included in + sig class type c = object method m : string end end + Class type declarations do not match: + class type c = object method private m : string end + does not match + class type c = object method m : string end + The private method m cannot become public +|}] diff --git a/testsuite/tests/typing-misc/ocamltests b/testsuite/tests/typing-misc/ocamltests deleted file mode 100644 index 6d4e684a..00000000 --- a/testsuite/tests/typing-misc/ocamltests +++ /dev/null @@ -1,33 +0,0 @@ -constraints.ml -disambiguate_principality.ml -exotic_unifications.ml -inside_out.ml -is_expansive.ml -labels.ml -occur_check.ml -pat_type_sharing.ml -pattern_open.ml -polyvars.ml -pr6416.ml -pr6634.ml -pr6939-flat-float-array.ml -pr6939-no-flat-float-array.ml -pr7103.ml -pr7228.ml -pr7668_bad.ml -pr7937.ml -pr8548.ml -pr8548_split.ml -gpr2277.ml -printing.ml -records.ml -scope_escape.ml -unique_names_in_unification.ml -variant.ml -wellfounded.ml -empty_variant.ml -typecore_errors.ml -typecore_nolabel_errors.ml -typecore_empty_polyvariant_error.ml -typetexp_errors.ml -external_arity.ml diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml index 4ef27cb0..3f287b3f 100644 --- a/testsuite/tests/typing-misc/polyvars.ml +++ b/testsuite/tests/typing-misc/polyvars.ml @@ -164,3 +164,15 @@ Error: This alias is bound to type [ `B ] but is used as an instance of type [ `A ] These two variant types have no intersection |}] + +type t = private [< `A] +let f: t -> [ `A ] = fun x -> x +[%%expect {| +type t = private [< `A ] +Line 2, characters 30-31: +2 | let f: t -> [ `A ] = fun x -> x + ^ +Error: This expression has type t but an expression was expected of type + [ `A ] + The first variant type is private, it may not allow the tag(s) `A +|}] diff --git a/testsuite/tests/typing-misc/pr6416.ml b/testsuite/tests/typing-misc/pr6416.ml index 4fb01c64..bda17f1d 100644 --- a/testsuite/tests/typing-misc/pr6416.ml +++ b/testsuite/tests/typing-misc/pr6416.ml @@ -50,7 +50,11 @@ Error: Signature mismatch: type u = A of t/1 is not included in type u = A of t/2 - The types for field A are not equal. + Constructors do not match: + A of t/1 + is not compatible with: + A of t/2 + The types are not equal. Line 4, characters 9-19: Definition of type t/1 Line 2, characters 2-11: @@ -74,14 +78,14 @@ Lines 4-7, characters 4-7: 7 | end Error: Signature mismatch: Modules do not match: - sig module type s module A : functor (X : s) -> sig end end + sig module type s module A : functor (X : s) -> sig end end is not included in - sig module A : functor (X : s) -> sig end end + sig module A : functor (X : s) -> sig end end In module A: Modules do not match: - functor (X : s/1) -> sig end + functor (X : s/1) -> sig end is not included in - functor (X : s/2) -> sig end + functor (X : s/2) -> sig end At position module A(X : ) : ... Modules do not match: s/2 is not included in s/1 Line 5, characters 6-19: @@ -113,7 +117,11 @@ Error: Signature mismatch: type t = A of T/1.t is not included in type t = A of T/2.t - The types for field A are not equal. + Constructors do not match: + A of T/1.t + is not compatible with: + A of T/2.t + The types are not equal. Line 5, characters 6-34: Definition of module T/1 Line 2, characters 2-30: @@ -395,7 +403,7 @@ let add_extra_info arg = arg.Foo.info.doc [%%expect{| module Bar : sig type info = { doc : unit; } end module Foo : sig type t = { info : Bar.info; } end -module Bar : sig end +module Bar : sig end Line 8, characters 38-41: 8 | let add_extra_info arg = arg.Foo.info.doc ^^^ diff --git a/testsuite/tests/typing-misc/pr8548.ml b/testsuite/tests/typing-misc/pr8548.ml index c50809af..7053ed68 100644 --- a/testsuite/tests/typing-misc/pr8548.ml +++ b/testsuite/tests/typing-misc/pr8548.ml @@ -112,7 +112,8 @@ module Assume : range -> 'a end end - end) -> + end) + -> sig module Point : sig type t end module Test_range : diff --git a/testsuite/tests/typing-misc/printing.ml b/testsuite/tests/typing-misc/printing.ml index 9108b55a..911ba30e 100644 --- a/testsuite/tests/typing-misc/printing.ml +++ b/testsuite/tests/typing-misc/printing.ml @@ -51,3 +51,51 @@ type (+' a', -' a'b, 'cd') t = ' a'b -> ' a' * 'cd';; [%%expect{| type (' a', ' a'b, 'cd') t = ' a'b -> ' a' * 'cd' |}];; + + +(* #8856: cycles in types expressions could trigger stack overflows + when printing subpart of error messages *) + +type 'a t = private X of 'a +let zeros = object(self) method next = 0, self end +let x = X zeros;; +[%%expect {| +type 'a t = private X of 'a +val zeros : < next : int * 'a > as 'a = +Line 3, characters 8-15: +3 | let x = X zeros;; + ^^^^^^^ +Error: Cannot create values of the private type (< next : int * 'a > as 'a) t +|}] + + +type ('a,'b) eq = Refl: ('a,'a) eq +type t = as 't +let f (x:t) (type a) (y:a) (witness:(a,t) eq) = match witness with + | Refl -> if true then x else y +[%%expect {| +type ('a, 'b) eq = Refl : ('a, 'a) eq +type t = < m : int * 'a > as 'a +Line 4, characters 32-33: +4 | | Refl -> if true then x else y + ^ +Error: This expression has type a but an expression was expected of type t + This instance of < m : int * 'a > as 'a is ambiguous: + it would escape the scope of its equation +|}] + + +type t1 = as 'bar)> +type t2 = as 'foo +let f (x : t1) : t2 = x;; +[%%expect {| +type t1 = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > +type t2 = < m : 'a. 'a * ('a * 'b) > as 'b +Line 3, characters 22-23: +3 | let f (x : t1) : t2 = x;; + ^ +Error: This expression has type t1 but an expression was expected of type t2 + The method m has type 'c. 'c * ('a * < m : 'c. 'b >) as 'b, + but the expected method type was 'a. 'a * ('a * < m : 'a. 'b >) as 'b + The universal variable 'a would escape its scope +|}] diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml index 79f4c0af..a5a9f7b1 100644 --- a/testsuite/tests/typing-misc/records.ml +++ b/testsuite/tests/typing-misc/records.ml @@ -208,7 +208,11 @@ Line 2, characters 0-37: 2 | type mut = d = {x:int; mutable y:int} ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type d - The mutability of field y is different. + Fields do not match: + y : int; + is not compatible with: + mutable y : int; + This is mutable and the original is not. |}] type missing = d = { x:int } @@ -226,7 +230,11 @@ Line 1, characters 0-31: 1 | type wrong_type = d = {x:float} ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type d - The types for field x are not equal. + Fields do not match: + x : int; + is not compatible with: + x : float; + The types are not equal. |}] type unboxed = d = {x:float} [@@unboxed] diff --git a/testsuite/tests/typing-misc/typecore_errors.ml b/testsuite/tests/typing-misc/typecore_errors.ml index 3d62f3f6..9b00a4f6 100644 --- a/testsuite/tests/typing-misc/typecore_errors.ml +++ b/testsuite/tests/typing-misc/typecore_errors.ml @@ -91,17 +91,6 @@ Error: This expression has type 'a * 'b |}] -(** Masked instance variable *) -let c = object val x= 0 val y = x end -[%%expect{| -Line 1, characters 32-33: -1 | let c = object val x= 0 val y = x end - ^ -Error: The instance variable x - cannot be accessed from the definition of another instance variable -|}] - - (** No value clause *) let f x = match x with exception Not_found -> ();; @@ -235,7 +224,7 @@ module type empty = sig end let f (x:int) = () let x = f (module struct end) [%%expect {| -module type empty = sig end +module type empty = sig end val f : int -> unit = Line 3, characters 10-29: 3 | let x = f (module struct end) diff --git a/testsuite/tests/typing-misc/typetexp_errors.ml b/testsuite/tests/typing-misc/typetexp_errors.ml index 8bbd9cbb..986d8585 100644 --- a/testsuite/tests/typing-misc/typetexp_errors.ml +++ b/testsuite/tests/typing-misc/typetexp_errors.ml @@ -23,3 +23,11 @@ Error: The constructor C is missing from the upper bound (between '<' Hint: Either add `C in the upper bound, or remove it from the lower bound. |}] + +type ('_a) underscored = A of '_a +[%%expect {| +Line 1, characters 6-9: +1 | type ('_a) underscored = A of '_a + ^^^ +Error: The type variable name '_a is not allowed in programs +|}] diff --git a/testsuite/tests/typing-misc/variance.ml b/testsuite/tests/typing-misc/variance.ml new file mode 100644 index 00000000..8ba7530f --- /dev/null +++ b/testsuite/tests/typing-misc/variance.ml @@ -0,0 +1,13 @@ +(* TEST + * expect +*) + +(* #8698 *) + +(* Actually, this is not a bug *) +type +'a t = [> `Foo of 'a -> unit] as 'a;; +[%%expect{| +type 'a t = 'a constraint 'a = [> `Foo of 'a -> unit ] +|}, Principal{| +type +'a t = 'a constraint 'a = [> `Foo of 'a -> unit ] +|}] diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml index 40a4aac4..d8356cd8 100644 --- a/testsuite/tests/typing-misc/variant.ml +++ b/testsuite/tests/typing-misc/variant.ml @@ -87,7 +87,7 @@ Line 3, characters 0-27: 3 | type missing = d = X of int ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type d - The field Y is only present in the original definition. + The constructor Y is only present in the original definition. |}] type wrong_type = d = X of float @@ -96,7 +96,11 @@ Line 1, characters 0-32: 1 | type wrong_type = d = X of float ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type d - The types for field X are not equal. + Constructors do not match: + X of int + is not compatible with: + X of float + The types are not equal. |}] type unboxed = d = X of float [@@unboxed] @@ -115,5 +119,31 @@ Line 1, characters 0-35: 1 | type perm = d = Y of int | X of int ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type d - Fields number 1 have different names, X and Y. + Constructors number 1 have different names, X and Y. +|}] + +module M : sig + type t = Foo of int +end = struct + type t = Foo : int -> t +end;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type t = Foo : int -> t +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = Foo : int -> t end + is not included in + sig type t = Foo of int end + Type declarations do not match: + type t = Foo : int -> t + is not included in + type t = Foo of int + Constructors do not match: + Foo : int -> t + is not compatible with: + Foo of int + The first has explicit return type and the second doesn't. |}] diff --git a/testsuite/tests/typing-missing-cmi-2/ocamltests b/testsuite/tests/typing-missing-cmi-2/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/typing-missing-cmi-2/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/typing-missing-cmi/ocamltests b/testsuite/tests/typing-missing-cmi/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/typing-missing-cmi/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/typing-modules-bugs/ocamltests b/testsuite/tests/typing-modules-bugs/ocamltests deleted file mode 100644 index a2fed3e8..00000000 --- a/testsuite/tests/typing-modules-bugs/ocamltests +++ /dev/null @@ -1,36 +0,0 @@ -gatien_baron_20131019_ok.ml -pr5164_ok.ml -pr51_ok.ml -pr5663_ok.ml -pr5914_ok.ml -pr6240_ok.ml -pr6293_bad.ml -pr6427_bad.ml -pr6485_ok.ml -pr6513_ok.ml -pr6572_ok.ml -pr6651_ok.ml -pr6752_bad.ml -pr6752_ok.ml -pr6899_first_bad.ml -pr6899_ok.ml -pr6899_second_bad.ml -pr6944_ok.ml -pr6954_ok.ml -pr6981_ok.ml -pr6982_ok.ml -pr6985_ok.ml -pr6992_bad.ml -pr7036_ok.ml -pr7082_ok.ml -pr7112_bad.ml -pr7112_ok.ml -pr7152_ok.ml -pr7182_ok.ml -pr7305_principal.ml -pr7321_ok.ml -pr7414_bad.ml -pr7414_2_bad.ml -pr7519_ok.ml -pr7601_ok.ml -pr7601a_ok.ml diff --git a/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference index 580fa93e..de6d9079 100644 --- a/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference +++ b/testsuite/tests/typing-modules-bugs/pr6293_bad.compilers.reference @@ -7,6 +7,6 @@ Error: In this `with' constraint, the new definition of t type t is not included in type t = { a : int; b : int; } + Their kinds differ. File "pr6293_bad.ml", line 9, characters 20-50: Expected declaration File "pr6293_bad.ml", line 10, characters 18-37: Actual declaration - Their kinds differ. diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml index 684351ea..6287a6e6 100644 --- a/testsuite/tests/typing-modules/Test.ml +++ b/testsuite/tests/typing-modules/Test.ml @@ -14,8 +14,8 @@ module type S' = sig type s = int end module type S = sig module rec M : sig end and N : sig end end;; module type S' = S with module M := String;; [%%expect{| -module type S = sig module rec M : sig end and N : sig end end -module type S' = sig module rec N : sig end end +module type S = sig module rec M : sig end and N : sig end end +module type S' = sig module rec N : sig end end |}];; (* with module type *) @@ -95,7 +95,11 @@ Line 3, characters 23-33: 3 | module type B = A with type t = u;; (* fail *) ^^^^^^^^^^ Error: This variant or record definition does not match that of type u - The types for field X are not equal. + Constructors do not match: + X of bool + is not compatible with: + X of int + The types are not equal. |}];; (* PR#5815 *) @@ -115,7 +119,7 @@ Error: Multiple definition of the extension constructor name Foo. module F(X : sig end) = struct let x = 3 end;; F.x;; (* fail *) [%%expect{| -module F : functor (X : sig end) -> sig val x : int end +module F : functor (X : sig end) -> sig val x : int end Line 2, characters 0-3: 2 | F.x;; (* fail *) ^^^ @@ -141,7 +145,11 @@ Error: Signature mismatch: type t += E of int is not included in type t += E - The arities for field E differ. + Constructors do not match: + E of int + is not compatible with: + E + They have different arities. |}];; module M : sig type t += E of char end = struct type t += E of int end;; @@ -158,7 +166,11 @@ Error: Signature mismatch: type t += E of int is not included in type t += E of char - The types for field E are not equal. + Constructors do not match: + E of int + is not compatible with: + E of char + The types are not equal. |}];; module M : sig type t += C of int end = struct type t += E of int end;; @@ -193,5 +205,9 @@ Error: Signature mismatch: type t += E of int is not included in type t += E of { x : int; } - The types for field E are not equal. + Constructors do not match: + E of int + is not compatible with: + E of { x : int; } + The second uses inline records and the first doesn't. |}];; diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml index 40727eb7..2f2cfd24 100644 --- a/testsuite/tests/typing-modules/aliases.ml +++ b/testsuite/tests/typing-modules/aliases.ml @@ -57,7 +57,7 @@ module C4 = F(struct end);; C4.chr 66;; [%%expect{| module F : - functor (X : sig end) -> + functor (X : sig end) -> sig external code : char -> int = "%identity" val chr : int -> char @@ -91,8 +91,8 @@ module C4 : module G(X:sig end) = struct module M = X end;; (* does not alias X *) module M = G(struct end);; [%%expect{| -module G : functor (X : sig end) -> sig module M : sig end end -module M : sig module M : sig end end +module G : functor (X : sig end) -> sig module M : sig end end +module M : sig module M : sig end end |}];; module M' = struct @@ -141,9 +141,9 @@ module M5 = G(struct end);; M5.N'.x;; [%%expect{| module F : - functor (X : sig end) -> + functor (X : sig end) -> sig module N : sig val x : int end module N' = N end -module G : functor (X : sig end) -> sig module N' : sig val x : int end end +module G : functor (X : sig end) -> sig module N' : sig val x : int end end module M5 : sig module N' : sig val x : int end end - : int = 1 |}];; @@ -377,8 +377,8 @@ end;; include T;; let f (x : t) : T.t = x ;; [%%expect{| -module F : functor (M : sig end) -> sig type t end -module T : sig module M : sig end type t = F(M).t end +module F : functor (M : sig end) -> sig type t end +module T : sig module M : sig end type t = F(M).t end module M = T.M type t = F(M).t val f : t -> T.t = @@ -462,16 +462,11 @@ module G = F (M.Y);; (*module N = G (M);; module N = F (M.Y) (M);;*) [%%expect{| -module FF : functor (X : sig end) -> sig type t end +module FF : functor (X : sig end) -> sig type t end module M : - sig - module X : sig end - module Y : sig type t = FF(X).t end - type t = Y.t - end -module F : - functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end -module G : functor (M : sig type t = M.Y.t end) -> sig end + sig module X : sig end module Y : sig type t = FF(X).t end type t = Y.t end +module F : functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end +module G : functor (M : sig type t = M.Y.t end) -> sig end |}];; (* PR#6307 *) @@ -486,13 +481,13 @@ module F (L : (module type of L1 [@remove_aliases])) = struct end;; module F1 = F(L1);; (* ok *) module F2 = F(L2);; (* should succeed too *) [%%expect{| -module A1 : sig end -module A2 : sig end +module A1 : sig end +module A2 : sig end module L1 : sig module X = A1 end module L2 : sig module X = A2 end -module F : functor (L : sig module X : sig end end) -> sig end -module F1 : sig end -module F2 : sig end +module F : functor (L : sig module X : sig end end) -> sig end +module F1 : sig end +module F2 : sig end |}];; (* Counter example: why we need to be careful with PR#6307 *) @@ -663,8 +658,8 @@ module F (X : sig end) = struct type t end;; module type A = Alias with module N := F(List);; module rec Bad : A = Bad;; [%%expect{| -module type Alias = sig module N : sig end module M = N end -module F : functor (X : sig end) -> sig type t end +module type Alias = sig module N : sig end module M = N end +module F : functor (X : sig end) -> sig type t end Line 1: Error: Module type declarations do not match: module type A = sig module M = F(List) end @@ -716,7 +711,7 @@ module type S = sig module Q = M end;; [%%expect{| -module type S = sig module M : sig module P : sig end end module Q = M end +module type S = sig module M : sig module P : sig end end module Q = M end |}];; module type S = sig module M : sig module N : sig end module P : sig end end @@ -730,12 +725,12 @@ module R' : S = R;; [%%expect{| module type S = sig - module M : sig module N : sig end module P : sig end end + module M : sig module N : sig end module P : sig end end module Q : sig module N = M.N module P = M.P end end module R : sig - module M : sig module N : sig end module P : sig end end + module M : sig module N : sig end module P : sig end end module Q = M end module R' : S @@ -756,9 +751,9 @@ end = struct type a = Foo.b end;; [%%expect{| -module F : functor (X : sig end) -> sig type t end +module F : functor (X : sig end) -> sig type t end module M : - sig type a module Foo : sig module Bar : sig end type b = a end end + sig type a module Foo : sig module Bar : sig end type b = a end end |}];; (* PR#6578 *) @@ -796,7 +791,7 @@ end = struct module type S = module type of struct include X end end;; [%%expect{| -module X : sig module N : sig end end +module X : sig module N : sig end end module Y : sig module type S = sig module N = X.N end end |}];; @@ -819,7 +814,7 @@ let s : string = Bar.N.x [%%expect {| module type S = sig - module M : sig module A : sig end module B : sig end end + module M : sig module A : sig end module B : sig end end module N = M.A end module Foo : diff --git a/testsuite/tests/typing-modules/anonymous.ml b/testsuite/tests/typing-modules/anonymous.ml new file mode 100644 index 00000000..c250e922 --- /dev/null +++ b/testsuite/tests/typing-modules/anonymous.ml @@ -0,0 +1,39 @@ +(* TEST + * expect +*) + +module _ = struct end;; +[%%expect{| +|}];; + +module rec A : sig + type t = B.t +end = A +and _ : sig type t = A.t end = struct type t = A.t end +and B : sig type t end = B +;; +[%%expect{| +module rec A : sig type t = B.t end +and B : sig type t end +|}] + +module type S = sig + module _ : sig end + + module rec A : sig + type t = B.t + end + and _ : sig type t = A.t end + and B : sig type t end +end +;; +[%%expect{| +module type S = + sig module rec A : sig type t = B/2.t end and B : sig type t end end +|}] + +let f (module _ : S) = () +;; +[%%expect{| +val f : (module S) -> unit = +|}] diff --git a/testsuite/tests/typing-modules/extension_constructors_errors_test.ml b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml new file mode 100644 index 00000000..fb4b914f --- /dev/null +++ b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml @@ -0,0 +1,44 @@ +(* TEST + * expect +*) + +type t = ..;; + +module M : sig type t += E | F end = struct type t += E | F of int end;; +[%%expect{| +type t = .. +Line 3, characters 37-70: +3 | module M : sig type t += E | F end = struct type t += E | F of int end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Signature mismatch: + Modules do not match: + sig type t += E | F of int end + is not included in + sig type t += E | F end + Extension declarations do not match: + type t += F of int + is not included in + type t += F + Constructors do not match: + F of int + is not compatible with: + F + They have different arities. +|}];; + +module M1 : sig type t += A end = struct type t += private A end;; +[%%expect{| +Line 1, characters 34-64: +1 | module M1 : sig type t += A end = struct type t += private A end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Signature mismatch: + Modules do not match: + sig type t += private A end + is not included in + sig type t += A end + Extension declarations do not match: + type t += private A + is not included in + type t += A + A private type would be revealed. +|}];; diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml index f490f075..c9411da3 100644 --- a/testsuite/tests/typing-modules/generative.ml +++ b/testsuite/tests/typing-modules/generative.ml @@ -14,8 +14,8 @@ module H (X : sig end) = (val v);; (* ok *) module type S = sig val x : int end val v : (module S) = module F : functor () -> S -module G : functor (X : sig end) -> S -module H : functor (X : sig end) -> S +module G : functor (X : sig end) -> S +module H : functor (X : sig end) -> S |}];; (* With type *) @@ -44,7 +44,7 @@ module H : functor () -> S module U = struct end;; module M = F(struct end);; (* ok *) [%%expect{| -module U : sig end +module U : sig end module M : S |}];; module M = F(U);; (* fail *) @@ -59,28 +59,28 @@ Error: This is a generative functor. It can only be applied to () module F1 (X : sig end) = struct end;; module F2 : functor () -> sig end = F1;; (* fail *) [%%expect{| -module F1 : functor (X : sig end) -> sig end +module F1 : functor (X : sig end) -> sig end Line 2, characters 36-38: 2 | module F2 : functor () -> sig end = F1;; (* fail *) ^^ Error: Signature mismatch: Modules do not match: - functor (X : sig end) -> sig end + functor (X : sig end) -> sig end is not included in - functor () -> sig end + functor () -> sig end |}];; module F3 () = struct end;; module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) [%%expect{| -module F3 : functor () -> sig end +module F3 : functor () -> sig end Line 2, characters 47-49: 2 | module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) ^^ Error: Signature mismatch: Modules do not match: - functor () -> sig end + functor () -> sig end is not included in - functor (X : sig end) -> sig end + functor (X : sig end) -> sig end |}];; (* tests for shortened functor notation () *) @@ -91,8 +91,8 @@ module Z = functor (_: sig end) (_:sig end) (_: sig end) -> struct end;; module GZ : functor (X: sig end) () (Z: sig end) -> sig end = functor (X: sig end) () (Z: sig end) -> struct end;; [%%expect{| -module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end -module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end -module Z : sig end -> sig end -> sig end -> sig end -module GZ : functor (X : sig end) () (Z : sig end) -> sig end +module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end +module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end +module Z : sig end -> sig end -> sig end -> sig end +module GZ : functor (X : sig end) () (Z : sig end) -> sig end |}];; diff --git a/testsuite/tests/typing-modules/illegal_permutation.ml b/testsuite/tests/typing-modules/illegal_permutation.ml index 12eff936..66ebb251 100644 --- a/testsuite/tests/typing-modules/illegal_permutation.ml +++ b/testsuite/tests/typing-modules/illegal_permutation.ml @@ -503,29 +503,23 @@ Error: Signature mismatch: module B : sig module C : - functor - (X : sig end) (Y : sig end) (Z : sig - module D : - sig - module E : - sig - module F : - functor - (X : - sig - - end) (Arg : - sig - val two : - int - val one : - int - end) -> - sig end - end - end - end) -> - sig end + functor (X : sig end) (Y : sig end) + (Z : sig + module D : + sig + module E : + sig + module F : + functor (X : sig end) + (Arg : sig + val two : int + val one : int + end) + -> sig end + end + end + end) + -> sig end end end end @@ -539,29 +533,23 @@ Error: Signature mismatch: module B : sig module C : - functor - (X : sig end) (Y : sig end) (Z : sig - module D : - sig - module E : - sig - module F : - functor - (X : - sig - - end) (Arg : - sig - val one : - int - val two : - int - end) -> - sig end - end - end - end) -> - sig end + functor (X : sig end) (Y : sig end) + (Z : sig + module D : + sig + module E : + sig + module F : + functor (X : sig end) + (Arg : sig + val one : int + val two : int + end) + -> sig end + end + end + end) + -> sig end end end end @@ -574,29 +562,23 @@ Error: Signature mismatch: module B : sig module C : - functor - (X : sig end) (Y : sig end) (Z : sig - module D : - sig - module E : - sig - module F : - functor - (X : - sig - - end) (Arg : - sig - val two : - int - val one : - int - end) -> - sig end - end - end - end) -> - sig end + functor (X : sig end) (Y : sig end) + (Z : sig + module D : + sig + module E : + sig + module F : + functor (X : sig end) + (Arg : sig + val two : int + val one : int + end) + -> sig end + end + end + end) + -> sig end end end end @@ -608,29 +590,23 @@ Error: Signature mismatch: module B : sig module C : - functor - (X : sig end) (Y : sig end) (Z : sig - module D : - sig - module E : - sig - module F : - functor - (X : - sig - - end) (Arg : - sig - val one : - int - val two : - int - end) -> - sig end - end - end - end) -> - sig end + functor (X : sig end) (Y : sig end) + (Z : sig + module D : + sig + module E : + sig + module F : + functor (X : sig end) + (Arg : sig + val one : int + val two : int + end) + -> sig end + end + end + end) + -> sig end end end end diff --git a/testsuite/tests/typing-modules/nondep_private_abbrev.ml b/testsuite/tests/typing-modules/nondep_private_abbrev.ml index 886fcfc5..4c8e4e1e 100644 --- a/testsuite/tests/typing-modules/nondep_private_abbrev.ml +++ b/testsuite/tests/typing-modules/nondep_private_abbrev.ml @@ -8,7 +8,7 @@ end = struct type t = int end;; [%%expect{| -module F : sig end -> sig type t = private int end +module F : sig end -> sig type t = private int end |}] module Direct = F(struct end);; @@ -20,7 +20,7 @@ module G(X : sig end) : sig type t = F(X).t end = F(X);; [%%expect{| -module G : functor (X : sig end) -> sig type t = F(X).t end +module G : functor (X : sig end) -> sig type t = F(X).t end |}] module Indirect = G(struct end);; @@ -34,14 +34,14 @@ module Pub(_ : sig end) = struct type t = [ `Foo of t ] end;; [%%expect{| -module Pub : sig end -> sig type t = [ `Foo of t ] end +module Pub : sig end -> sig type t = [ `Foo of t ] end |}] module Priv(_ : sig end) = struct type t = private [ `Foo of t ] end;; [%%expect{| -module Priv : sig end -> sig type t = private [ `Foo of t ] end +module Priv : sig end -> sig type t = private [ `Foo of t ] end |}] module DirectPub = Pub(struct end);; @@ -58,14 +58,14 @@ module H(X : sig end) : sig type t = Pub(X).t end = Pub(X);; [%%expect{| -module H : functor (X : sig end) -> sig type t = Pub(X).t end +module H : functor (X : sig end) -> sig type t = Pub(X).t end |}] module I(X : sig end) : sig type t = Priv(X).t end = Priv(X);; [%%expect{| -module I : functor (X : sig end) -> sig type t = Priv(X).t end +module I : functor (X : sig end) -> sig type t = Priv(X).t end |}] module IndirectPub = H(struct end);; @@ -121,14 +121,14 @@ module Priv(_ : sig end) = struct end;; [%%expect{| module Priv : - sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] end + sig end -> sig type t = private [ `Bar of int | `Foo of t -> int ] end |}] module I(X : sig end) : sig type t = Priv(X).t end = Priv(X);; [%%expect{| -module I : functor (X : sig end) -> sig type t = Priv(X).t end +module I : functor (X : sig end) -> sig type t = Priv(X).t end |}] module IndirectPriv = I(struct end);; diff --git a/testsuite/tests/typing-modules/ocamltests b/testsuite/tests/typing-modules/ocamltests deleted file mode 100644 index e9784a25..00000000 --- a/testsuite/tests/typing-modules/ocamltests +++ /dev/null @@ -1,21 +0,0 @@ -aliases.ml -applicative_functor_type.ml -firstclass.ml -generative.ml -illegal_permutation.ml -nondep.ml -nondep_private_abbrev.ml -normalize_path.ml -pr5911.ml -pr6394.ml -pr7207.ml -pr7348.ml -pr7726.ml -pr7787.ml -pr7818.ml -pr7851.ml -pr8810.ml -printing.ml -recursive.ml -Test.ml -unroll_private_abbrev.ml diff --git a/testsuite/tests/typing-modules/pr5911.ml b/testsuite/tests/typing-modules/pr5911.ml index 2d8b557f..1c08b37a 100644 --- a/testsuite/tests/typing-modules/pr5911.ml +++ b/testsuite/tests/typing-modules/pr5911.ml @@ -12,7 +12,7 @@ module Good (X : S with type t := unit) = struct end;; [%%expect{| module type S = sig type t val x : t end -module Good : functor (X : sig val x : unit end) -> sig end +module Good : functor (X : sig val x : unit end) -> sig end |}];; module type T = sig module M : S end;; @@ -23,6 +23,5 @@ end;; [%%expect{| module type T = sig module M : S end module Bad : - functor (X : sig module M : sig type t = unit val x : t end end) -> - sig end + functor (X : sig module M : sig type t = unit val x : t end end) -> sig end |}];; diff --git a/testsuite/tests/typing-modules/pr7207.ml b/testsuite/tests/typing-modules/pr7207.ml index 81000648..a061a34d 100644 --- a/testsuite/tests/typing-modules/pr7207.ml +++ b/testsuite/tests/typing-modules/pr7207.ml @@ -5,7 +5,7 @@ module F (X : sig end) = struct type t = int end;; type t = F(Does_not_exist).t;; [%%expect{| -module F : functor (X : sig end) -> sig type t = int end +module F : functor (X : sig end) -> sig type t = int end Line 2, characters 9-28: 2 | type t = F(Does_not_exist).t;; ^^^^^^^^^^^^^^^^^^^ diff --git a/testsuite/tests/typing-modules/pr7348.ml b/testsuite/tests/typing-modules/pr7348.ml index e24d529f..dc0cf405 100644 --- a/testsuite/tests/typing-modules/pr7348.ml +++ b/testsuite/tests/typing-modules/pr7348.ml @@ -37,5 +37,5 @@ module A : sig end = struct let _ = (N.x = M.x) end;; [%%expect{| -module A : sig end +module A : sig end |}] diff --git a/testsuite/tests/typing-modules/pr7726.ml b/testsuite/tests/typing-modules/pr7726.ml index edc64080..c404983f 100644 --- a/testsuite/tests/typing-modules/pr7726.ml +++ b/testsuite/tests/typing-modules/pr7726.ml @@ -122,7 +122,7 @@ module M = struct end;; type t = F(M).t;; [%%expect{| module F : functor () -> sig type t end -module M : sig end +module M : sig end Line 3, characters 9-15: 3 | type t = F(M).t;; ^^^^^^ @@ -139,7 +139,7 @@ module Fix2 : functor (F : T -> T) -> sig module rec Fixed : sig type t = F(Fixed).t end - module R : functor (X : sig end) -> sig type t = Fixed.t end + module R : functor (X : sig end) -> sig type t = Fixed.t end end Line 5, characters 11-26: 5 | let f (x : Fix2(Id).R(M).t) = x;; diff --git a/testsuite/tests/typing-modules/pr7818.ml b/testsuite/tests/typing-modules/pr7818.ml index 75ba000f..0fafb581 100644 --- a/testsuite/tests/typing-modules/pr7818.ml +++ b/testsuite/tests/typing-modules/pr7818.ml @@ -19,7 +19,7 @@ end;; [%%expect{| module Termsig : sig - module Term0 : sig module type S = sig module Id : sig end end end + module Term0 : sig module type S = sig module Id : sig end end end module Term : sig module type S = sig module Term0 : Term0.S module T = Term0 end end end @@ -36,9 +36,9 @@ module Make1 : functor (T' : sig module Term0 : Termsig.Term0.S - module T : sig module Id : sig end end - end) -> - sig module T : sig module Id : sig end val u : int end end + module T : sig module Id : sig end end + end) + -> sig module T : sig module Id : sig end val u : int end end |}] module Make2 (T' : Termsig.Term.S) = struct @@ -53,10 +53,11 @@ module Make2 : functor (T' : sig module Term0 : Termsig.Term0.S - module T : sig module Id : sig end end - end) -> + module T : sig module Id : sig end end + end) + -> sig - module T : sig module Id : sig end module Id2 = Id val u : int end + module T : sig module Id : sig end module Id2 = Id val u : int end end |}] @@ -73,10 +74,11 @@ module Make3 : functor (T' : sig module Term0 : Termsig.Term0.S - module T : sig module Id : sig end end - end) -> + module T : sig module Id : sig end end + end) + -> sig - module T : sig module Id : sig end module Id2 = Id val u : int end + module T : sig module Id : sig end module Id2 = Id val u : int end end |}] @@ -92,14 +94,14 @@ module Make1 (T' : S) = struct end;; [%%expect{| module type S = - sig module Term0 : sig module Id : sig end end module T = Term0 end + sig module Term0 : sig module Id : sig end end module T = Term0 end module Make1 : functor (T' : sig - module Term0 : sig module Id : sig end end - module T : sig module Id : sig end end - end) -> - sig module Id : sig end module Id2 = Id end + module Term0 : sig module Id : sig end end + module T : sig module Id : sig end end + end) + -> sig module Id : sig end module Id2 = Id end |}] module Make2 (T' : S) : sig module Id : sig end module Id2 = Id end @@ -115,7 +117,7 @@ Lines 2-5, characters 57-3: 5 | end.. Error: Signature mismatch: Modules do not match: - sig module Id : sig end module Id2 = Id end + sig module Id : sig end module Id2 = Id end is not included in sig module Id2 = T'.Term0.Id end In module Id2: @@ -134,11 +136,12 @@ end;; module Make3 : functor (T' : sig - module Term0 : sig module Id : sig end end - module T : sig module Id : sig end end - end) -> + module Term0 : sig module Id : sig end end + module T : sig module Id : sig end end + end) + -> sig - module T : sig module Id : sig end module Id2 = Id val u : int end + module T : sig module Id : sig end module Id2 = Id val u : int end end |}] @@ -147,7 +150,7 @@ module M = Make1 (struct module Term0 = struct module Id = struct let x = "a" end end module T = Term0 end);; M.Id.x;; [%%expect{| -module M : sig module Id : sig end module Id2 = Id end +module M : sig module Id : sig end module Id2 = Id end Line 3, characters 0-6: 3 | M.Id.x;; ^^^^^^ @@ -177,28 +180,28 @@ end;; module M = Make1(IS);; [%%expect{| -module MkT : functor (X : sig end) -> sig type t end +module MkT : functor (X : sig end) -> sig type t end module type S = sig - module Term0 : sig module Id : sig end end + module Term0 : sig module Id : sig end end module T = Term0 type t = MkT(T).t end module Make1 : functor (T' : sig - module Term0 : sig module Id : sig end end - module T : sig module Id : sig end end + module Term0 : sig module Id : sig end end + module T : sig module Id : sig end end type t = MkT(T).t - end) -> - sig module Id : sig end module Id2 = Id type t = T'.t end + end) + -> sig module Id : sig end module Id2 = Id type t = T'.t end module IS : sig module Term0 : sig module Id : sig val x : string end end module T = Term0 type t = MkT(T).t end -module M : sig module Id : sig end module Id2 = Id type t = IS.t end +module M : sig module Id : sig end module Id2 = Id type t = IS.t end |}] @@ -287,7 +290,8 @@ module F : module T : sig type t = int val compare : t -> t -> int end type t = E of (MkT(T).t, MkT(T).t) eq type u = t = E of (MkT(Term0).t, MkT(T).t) eq - end) -> + end) + -> sig module Term0 : sig type t = int val compare : t -> t -> int end module T : sig type t = int val compare : t -> t -> int end @@ -315,5 +319,9 @@ Line 15, characters 16-64: 15 | module rec M1 : S' with module Term0 := Asc and module T := Desc = M1;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type M.t - The types for field E are not equal. + Constructors do not match: + E of (MkT(M.T).t, MkT(M.T).t) eq + is not compatible with: + E of (MkT(Desc).t, MkT(Desc).t) eq + The types are not equal. |}] diff --git a/testsuite/tests/typing-modules/pr7851.ml b/testsuite/tests/typing-modules/pr7851.ml index 72a03871..856fb0b7 100644 --- a/testsuite/tests/typing-modules/pr7851.ml +++ b/testsuite/tests/typing-modules/pr7851.ml @@ -27,7 +27,11 @@ Line 1, characters 16-53: 1 | module rec M1 : S with type x = int and type y = bool = M1;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type M1.t - The types for field E are not equal. + Constructors do not match: + E of M1.x + is not compatible with: + E of M1.y + The types are not equal. |}] let bool_of_int x = @@ -75,5 +79,9 @@ Line 1, characters 16-53: 1 | module rec M1 : S with type x = int and type y = bool = M1;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This variant or record definition does not match that of type M1.t - The types for field E are not equal. + Constructors do not match: + E of (M1.x, M1.x) eq + is not compatible with: + E of (M1.x, M1.y) eq + The types are not equal. |}] diff --git a/testsuite/tests/typing-modules/printing.ml b/testsuite/tests/typing-modules/printing.ml index f6792ba8..79643150 100644 --- a/testsuite/tests/typing-modules/printing.ml +++ b/testsuite/tests/typing-modules/printing.ml @@ -28,3 +28,31 @@ module M = struct module N = struct let x = 1 end end;; module M : sig module N : sig val x : int end end module M : sig module N : sig ... end end |}];; + +(* Shortcut notation for functors *) +module type A +module type B +module type C +module type D +module type E +module type F +module Test(X: ((A->(B->C)->D) -> (E -> F))) = struct end +[%%expect {| +module type A +module type B +module type C +module type D +module type E +module type F +module Test : functor (X : (A -> (B -> C) -> D) -> E -> F) -> sig end +|}] + +(* test reprinting of functors *) +module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end +[%%expect {| +module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end +|}] +module type LongFunctor2 = functor (_ : A) () (_ : B) () -> C -> D -> sig end +[%%expect {| +module type LongFunctor2 = A -> functor () (_ : B) () -> C -> D -> sig end +|}] diff --git a/testsuite/tests/typing-modules/records_errors_test.ml b/testsuite/tests/typing-modules/records_errors_test.ml new file mode 100644 index 00000000..f85c1e7d --- /dev/null +++ b/testsuite/tests/typing-modules/records_errors_test.ml @@ -0,0 +1,138 @@ +(* TEST + * expect +*) + +module M1 : sig + type t = {f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit} +end = struct + type t = {f0 : unit * unit * unit * float* unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit} +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = {f0 : unit * unit * unit * float* unit * unit * unit; +6 | f1 : unit * unit * unit * string * unit * unit * unit} +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig + type t = { + f0 : unit * unit * unit * float * unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit; + } + end + is not included in + sig + type t = { + f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit; + } + end + Type declarations do not match: + type t = { + f0 : unit * unit * unit * float * unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit; + } + is not included in + type t = { + f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit; + } + Fields do not match: + f0 : unit * unit * unit * float * unit * unit * unit; + is not compatible with: + f0 : unit * unit * unit * int * unit * unit * unit; + The types are not equal. +|}];; + + +module M2 : sig + type t = {mutable f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit} +end = struct + type t = {f0 : unit * unit * unit * float* unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit} +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = {f0 : unit * unit * unit * float* unit * unit * unit; +6 | f1 : unit * unit * unit * string * unit * unit * unit} +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig + type t = { + f0 : unit * unit * unit * float * unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit; + } + end + is not included in + sig + type t = { + mutable f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit; + } + end + Type declarations do not match: + type t = { + f0 : unit * unit * unit * float * unit * unit * unit; + f1 : unit * unit * unit * string * unit * unit * unit; + } + is not included in + type t = { + mutable f0 : unit * unit * unit * int * unit * unit * unit; + f1 : unit * unit * unit * int * unit * unit * unit; + } + Fields do not match: + f0 : unit * unit * unit * float * unit * unit * unit; + is not compatible with: + mutable f0 : unit * unit * unit * int * unit * unit * unit; + The second is mutable and the first is not. +|}];; + +module M3 : sig + type t = {f0 : unit} +end = struct + type t = {f1 : unit} +end;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type t = {f1 : unit} +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = { f1 : unit; } end + is not included in + sig type t = { f0 : unit; } end + Type declarations do not match: + type t = { f1 : unit; } + is not included in + type t = { f0 : unit; } + Fields number 1 have different names, f1 and f0. +|}];; + +module M4 : sig + type t = {f0 : unit; f1 : unit} +end = struct + type t = {f0 : unit} +end;; +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type t = {f0 : unit} +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = { f0 : unit; } end + is not included in + sig type t = { f0 : unit; f1 : unit; } end + Type declarations do not match: + type t = { f0 : unit; } + is not included in + type t = { f0 : unit; f1 : unit; } + The field f1 is only present in the second declaration. +|}];; diff --git a/testsuite/tests/typing-modules/unroll_private_abbrev.ml b/testsuite/tests/typing-modules/unroll_private_abbrev.ml index 3bc65dd7..4fa7f7da 100644 --- a/testsuite/tests/typing-modules/unroll_private_abbrev.ml +++ b/testsuite/tests/typing-modules/unroll_private_abbrev.ml @@ -48,7 +48,7 @@ end = struct end;; [%%expect{| module F : - functor (X : sig end) -> + functor (X : sig end) -> sig type s = private [ `Bar of 'a | `Foo ] as 'a val from : M.t -> s diff --git a/testsuite/tests/typing-modules/variants_errors_test.ml b/testsuite/tests/typing-modules/variants_errors_test.ml new file mode 100644 index 00000000..a923ebcf --- /dev/null +++ b/testsuite/tests/typing-modules/variants_errors_test.ml @@ -0,0 +1,204 @@ +(* TEST + * expect + *) + +module M1 : sig + type t = + | Foo of int * int +end = struct + type t = + | Foo of float * int +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = +6 | | Foo of float * int +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = Foo of float * int end + is not included in + sig type t = Foo of int * int end + Type declarations do not match: + type t = Foo of float * int + is not included in + type t = Foo of int * int + Constructors do not match: + Foo of float * int + is not compatible with: + Foo of int * int + The types are not equal. +|}];; + +module M2 : sig + type t = + | Foo of int * int +end = struct + type t = + | Foo of float +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = +6 | | Foo of float +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = Foo of float end + is not included in + sig type t = Foo of int * int end + Type declarations do not match: + type t = Foo of float + is not included in + type t = Foo of int * int + Constructors do not match: + Foo of float + is not compatible with: + Foo of int * int + They have different arities. +|}];; + +module M3 : sig + type t = + | Foo of {x : int; y : int} +end = struct + type t = + | Foo of {x : float; y : int} +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = +6 | | Foo of {x : float; y : int} +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = Foo of { x : float; y : int; } end + is not included in + sig type t = Foo of { x : int; y : int; } end + Type declarations do not match: + type t = Foo of { x : float; y : int; } + is not included in + type t = Foo of { x : int; y : int; } + Constructors do not match: + Foo of { x : float; y : int; } + is not compatible with: + Foo of { x : int; y : int; } + Fields do not match: + x : float; + is not compatible with: + x : int; + The types are not equal. +|}];; + +module M4 : sig + type t = + | Foo of {x : int; y : int} +end = struct + type t = + | Foo of float +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type t = +6 | | Foo of float +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig type t = Foo of float end + is not included in + sig type t = Foo of { x : int; y : int; } end + Type declarations do not match: + type t = Foo of float + is not included in + type t = Foo of { x : int; y : int; } + Constructors do not match: + Foo of float + is not compatible with: + Foo of { x : int; y : int; } + The second uses inline records and the first doesn't. +|}];; + +module M5 : sig + type 'a t = + | Foo : int -> int t +end = struct + type 'a t = + | Foo of 'a +end;; +[%%expect{| +Lines 4-7, characters 6-3: +4 | ......struct +5 | type 'a t = +6 | | Foo of 'a +7 | end.. +Error: Signature mismatch: + Modules do not match: + sig type 'a t = Foo of 'a end + is not included in + sig type 'a t = Foo : int -> int t end + Type declarations do not match: + type 'a t = Foo of 'a + is not included in + type 'a t = Foo : int -> int t + Constructors do not match: + Foo of 'a + is not compatible with: + Foo : int -> int t + The second has explicit return type and the first doesn't. +|}];; + +module M : sig + type ('a, 'b) t = A of 'a +end = struct + type ('a, 'b) t = A of 'b +end;; +[%%expect {| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type ('a, 'b) t = A of 'b +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type ('a, 'b) t = A of 'b end + is not included in + sig type ('a, 'b) t = A of 'a end + Type declarations do not match: + type ('a, 'b) t = A of 'b + is not included in + type ('a, 'b) t = A of 'a + Constructors do not match: + A of 'b + is not compatible with: + A of 'a + The types are not equal. +|}];; + +module M : sig + type ('a, 'b) t = A of 'a +end = struct + type ('b, 'a) t = A of 'a +end;; +[%%expect {| +Lines 3-5, characters 6-3: +3 | ......struct +4 | type ('b, 'a) t = A of 'a +5 | end.. +Error: Signature mismatch: + Modules do not match: + sig type ('b, 'a) t = A of 'a end + is not included in + sig type ('a, 'b) t = A of 'a end + Type declarations do not match: + type ('b, 'a) t = A of 'a + is not included in + type ('a, 'b) t = A of 'a + Constructors do not match: + A of 'a + is not compatible with: + A of 'a + The types are not equal. +|}];; diff --git a/testsuite/tests/typing-multifile/ocamltests b/testsuite/tests/typing-multifile/ocamltests deleted file mode 100644 index af8a34d4..00000000 --- a/testsuite/tests/typing-multifile/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -pr6372.ml -pr7325.ml -pr7563.ml diff --git a/testsuite/tests/typing-multifile/pr9218.ml b/testsuite/tests/typing-multifile/pr9218.ml new file mode 100644 index 00000000..3c025aff --- /dev/null +++ b/testsuite/tests/typing-multifile/pr9218.ml @@ -0,0 +1,9 @@ +(* TEST + flags="-annot" + modules="a.ml" + *) + +(* Test interference between inline record path + [a.A] and the [a.ml] compilation unit *) +type 'x a = A of { x: int } +let v = A { x = 0 } diff --git a/testsuite/tests/typing-objects-bugs/ocamltests b/testsuite/tests/typing-objects-bugs/ocamltests deleted file mode 100644 index 7b3c8ec4..00000000 --- a/testsuite/tests/typing-objects-bugs/ocamltests +++ /dev/null @@ -1,11 +0,0 @@ -pr3968_bad.ml -pr4018_bad.ml -pr4435_bad.ml -pr4766_ok.ml -pr4824_ok.ml -pr4824a_bad.ml -pr5156_ok.ml -pr7284_bad.ml -pr7293_ok.ml -woodyatt_ok.ml -yamagata021012_ok.ml diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml index b045c058..45e1ab8d 100644 --- a/testsuite/tests/typing-objects/Tests.ml +++ b/testsuite/tests/typing-objects/Tests.ml @@ -728,7 +728,7 @@ val x : '_weak2 list ref = {contents = []} module F(X : sig end) = struct type t = int let _ = (x : < m : t> list ref) end;; [%%expect{| -module F : functor (X : sig end) -> sig type t = int end +module F : functor (X : sig end) -> sig type t = int end |}];; x;; [%%expect{| @@ -819,55 +819,6 @@ class c () = object method virtual m : int method private m = 1 end;; class c : unit -> object method m : int end |}];; -(* Marshaling (cf. PR#5436) *) - -let r = ref 0;; -[%%expect{| -val r : int ref = {contents = 0} -|}];; -let id o = Oo.id o - !r;; -[%%expect{| -val id : < .. > -> int = -|}];; -r := Oo.id (object end);; -[%%expect{| -- : unit = () -|}];; -id (object end);; -[%%expect{| -- : int = 1 -|}];; -id (object end);; -[%%expect{| -- : int = 2 -|}];; -let o = object end in - let s = Marshal.to_string o [] in - let o' : < > = Marshal.from_string s 0 in - let o'' : < > = Marshal.from_string s 0 in - (id o, id o', id o'');; -[%%expect{| -- : int * int * int = (3, 4, 5) -|}];; - -let o = object val x = 33 method m = x end in - let s = Marshal.to_string o [Marshal.Closures] in - let o' : = Marshal.from_string s 0 in - let o'' : = Marshal.from_string s 0 in - (id o, id o', id o'', o#m, o'#m);; -[%%expect{| -- : int * int * int * int * int = (6, 7, 8, 33, 33) -|}];; - -let o = object val x = 33 val y = 44 method m = x end in - let s = Marshal.to_string (o,o) [Marshal.Closures] in - let (o1, o2) : ( * ) = Marshal.from_string s 0 in - let (o3, o4) : ( * ) = Marshal.from_string s 0 in - (id o, id o1, id o2, id o3, id o4, o#m, o1#m);; -[%%expect{| -- : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33) -|}];; - (* Recursion (cf. PR#5291) *) class a = let _ = new b in object end @@ -916,3 +867,32 @@ Line 2, characters 8-52: ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This kind of recursive class expression is not allowed |}];; + +class a = object val x = 3 val y = x + 2 end;; +[%%expect{| +Line 1, characters 35-36: +1 | class a = object val x = 3 val y = x + 2 end;; + ^ +Error: The instance variable x + cannot be accessed from the definition of another instance variable +|}];; + +class a = object (self) val x = self#m method m = 3 end;; +[%%expect{| +Line 1, characters 32-36: +1 | class a = object (self) val x = self#m method m = 3 end;; + ^^^^ +Error: The self variable self + cannot be accessed from the definition of an instance variable +|}];; + +class a = object method m = 3 end +class b = object inherit a as super val x = super#m end;; +[%%expect{| +class a : object method m : int end +Line 2, characters 44-49: +2 | class b = object inherit a as super val x = super#m end;; + ^^^^^ +Error: The ancestor variable super + cannot be accessed from the definition of an instance variable +|}];; diff --git a/testsuite/tests/typing-objects/ocamltests b/testsuite/tests/typing-objects/ocamltests deleted file mode 100644 index cd995e9c..00000000 --- a/testsuite/tests/typing-objects/ocamltests +++ /dev/null @@ -1,13 +0,0 @@ -abstract_rows.ml -dummy.ml -errors.ml -Exemples.ml -open_in_classes.ml -pr5545.ml -pr5619_bad.ml -pr5858.ml -pr6123_bad.ml -pr6383.ml -pr6907_bad.ml -self_cannot_be_closed.ml -Tests.ml diff --git a/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml b/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml new file mode 100644 index 00000000..d350fbb5 --- /dev/null +++ b/testsuite/tests/typing-objects/self_cannot_escape_pr7865.ml @@ -0,0 +1,21 @@ +(* TEST + * expect +*) + +class c = +object (o) + method foo = o +end;; +[%%expect {| +class c : object ('a) method foo : 'a end +|}] + +class d = +object (o) inherit c + method bar = fun () -> + let o = List.fold_right (fun _ o -> o#foo) [] o in + let o = match () with () -> o in o +end;; +[%%expect {| +class d : object ('a) method bar : unit -> 'a method foo : 'a end +|}] diff --git a/testsuite/tests/typing-ocamlc-i/ocamltests b/testsuite/tests/typing-ocamlc-i/ocamltests deleted file mode 100644 index 5855e551..00000000 --- a/testsuite/tests/typing-ocamlc-i/ocamltests +++ /dev/null @@ -1,5 +0,0 @@ -pervasives_leitmotiv.ml -pr4791.ml -pr6323.ml -pr7402.ml -pr7620_bad.ml diff --git a/testsuite/tests/typing-poly-bugs/ocamltests b/testsuite/tests/typing-poly-bugs/ocamltests deleted file mode 100644 index 1e05cf5d..00000000 --- a/testsuite/tests/typing-poly-bugs/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -pr5322_ok.ml -pr5673_bad.ml -pr5673_ok.ml diff --git a/testsuite/tests/typing-poly-bugs/pr5673_bad.compilers.reference b/testsuite/tests/typing-poly-bugs/pr5673_bad.compilers.reference deleted file mode 100644 index c4984037..00000000 --- a/testsuite/tests/typing-poly-bugs/pr5673_bad.compilers.reference +++ /dev/null @@ -1,14 +0,0 @@ -File "pr5673_bad.ml", line 31, characters 22-23: -31 | let f (x : refer1) = (x : refer2) - ^ -Error: This expression has type - refer1 = < poly : 'a 'b 'c. ('b, 'c) #Classdef.cl2 as 'a > - but an expression was expected of type - refer2 = < poly : 'd 'b 'c. ('b, 'c) #Classdef.cl2 as 'd > - Type ('b, 'c, ('b, 'c) Classdef.cl1) Classdef.cl0 = < > - is not compatible with type - ('b0, 'c0, ('b0, 'c0) Classdef.cl1) Classdef.cl0 - Type < m : 'b -> 'c -> int; .. > is not compatible with type - ('b, 'c) Classdef.cl1 = - < m : 'b -> 'c -> int; raise_trouble : int -> 'b > - The universal variable 'b would escape its scope diff --git a/testsuite/tests/typing-poly-bugs/pr5673_bad.ml b/testsuite/tests/typing-poly-bugs/pr5673_bad.ml deleted file mode 100644 index cddd0932..00000000 --- a/testsuite/tests/typing-poly-bugs/pr5673_bad.ml +++ /dev/null @@ -1,31 +0,0 @@ -(* TEST -flags = " -w a " -ocamlc_byte_exit_status = "2" -* setup-ocamlc.byte-build-env -** ocamlc.byte -*** check-ocamlc.byte-output -*) - -module Classdef = struct - class virtual ['a, 'b, 'c] cl0 = - object - constraint 'c = < m : 'a -> 'b -> int; .. > - end - - class virtual ['a, 'b] cl1 = - object - method virtual raise_trouble : int -> 'a - method virtual m : 'a -> 'b -> int - end - - class virtual ['a, 'b] cl2 = - object - method virtual as_cl0 : ('a, 'b, ('a, 'b) cl1) cl0 - end -end - -type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > -type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > - -(* Actually this should succeed ... *) -let f (x : refer1) = (x : refer2) diff --git a/testsuite/tests/typing-poly-bugs/pr5673_ok.ml b/testsuite/tests/typing-poly-bugs/pr5673_ok.ml index 535ced53..f5a5cec7 100644 --- a/testsuite/tests/typing-poly-bugs/pr5673_ok.ml +++ b/testsuite/tests/typing-poly-bugs/pr5673_ok.ml @@ -28,3 +28,9 @@ module M : sig end = struct type refer = { poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) } end + +type refer1 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > +type refer2 = < poly : 'a 'b 'c . (('b, 'c) #Classdef.cl2 as 'a) > + +(* Now this works too *) +let f (x : refer1) = (x : refer2) diff --git a/testsuite/tests/typing-poly-bugs/pr6922_ok.ml b/testsuite/tests/typing-poly-bugs/pr6922_ok.ml new file mode 100644 index 00000000..0e8b7a4a --- /dev/null +++ b/testsuite/tests/typing-poly-bugs/pr6922_ok.ml @@ -0,0 +1,216 @@ +(* TEST +flags = " -w a " +* setup-ocamlc.byte-build-env +** ocamlc.byte +*** check-ocamlc.byte-output +*) + +module Order = struct + module type Total = sig + type t + val compare: t -> t -> int + end +end + +module type Profile = sig + module Priority: Order.Total + + class type ['level] prioritizer = object + method code: 'level -> Priority.t + method tag: 'level -> string + end + + class ['level] event: + 'level #prioritizer -> 'level -> string -> + object + method prioritizer: 'level prioritizer + method level: 'level + method message: string + end + + class type ['event] archiver = object + constraint 'event = 'level #event + method emit: 'event -> unit + end + + class virtual ['archiver] agent: + 'level #prioritizer -> 'level -> 'archiver list -> + object + constraint 'event = 'level #event + constraint 'archiver = 'event #archiver + val mutable archivers_: 'archiver list + val mutable limit_: Priority.t + method virtual private event: 'level -> string -> 'event + method setlimit: 'level -> unit + method enabled: 'level -> bool + method private put: 'a 'b. 'level -> ('event -> 'b) -> ('a, unit, string, string, string, 'b) format6 -> 'a + end +end + +module Create(P: Order.Total) = struct + module Priority = P + + class type ['level] prioritizer = object + method code: 'level -> Priority.t + method tag: 'level -> string + end + + class ['level] event prioritizer level message = + let prioritizer = (prioritizer :> 'level prioritizer) in + object + method prioritizer = prioritizer + method level: 'level = level + method message: string = message + end + + class type ['event] archiver = object + constraint 'event = 'level #event + method emit: 'event -> unit + end + + class virtual ['archiver] agent prioritizer limit archivers = + let _ = (prioritizer :> 'level prioritizer) in + let _ = (archivers :> 'archiver list) in + object(self:'self) + constraint 'event = 'level #event + constraint 'archiver = 'event #archiver + + val mutable archivers_ = archivers + val mutable limit_ = prioritizer#code limit + + method virtual private event: 'level -> string -> 'event + + method setlimit limit = limit_ <- prioritizer#code limit + method enabled limit = prioritizer#code limit >= limit_ + + method private put: + type a b. 'level -> ('event -> b) -> + (a, unit, string, string, string, b) format6 -> a + = fun level cont -> + let f message = + let e = self#event level message in + if self#enabled level then + List.iter (fun j -> j#emit e) archivers_; + cont e + in + Printf.kprintf f + end +end + +module Basic = struct + include Create(struct type t = int let compare a b = b - a end) + + type invalid = [ `Invalid ] + type fail = [ `Fail ] + type error = [ `Error ] + type warn = [ `Warn ] + type notice = [ `Notice ] + type info = [ `Info ] + type debug = [ `Debug ] + + type basic = [ invalid | fail | error | warn | notice | info | debug ] + type enable = [ `None | `All ] + type level = [ basic | enable ] +end + +class ['level] basic_prioritizer = + object(_:'self) + constraint 'self = 'level #Basic.prioritizer + constraint 'level = [> Basic.level ] + + method code = function + | `All -> max_int + | `Invalid -> 7000 + | `Fail -> 6000 + | `Error -> 5000 + | `Warn -> 4000 + | `Notice -> 3000 + | `Info -> 2000 + | `Debug -> 1000 + | `None -> min_int + | _ -> invalid_arg "Oni_cf_journal: no code defined for priority!" + + method tag = + let invalid_ = "INVALID" in + let fail_ = "FAIL" in + let error_ = "ERROR" in + let warn_ = "WARN" in + let notice_ = "NOTICE" in + let info_ = "INFO" in + let debug_ = "DEBUG" in + function + | `Invalid -> invalid_ + | `Fail -> fail_ + | `Error -> error_ + | `Warn -> warn_ + | `Notice -> notice_ + | `Info -> info_ + | `Debug -> debug_ + | _ -> invalid_arg "Oni_cf_journal: no tag defined for priority!" + end + +class ['event] basic_channel_archiver channel = object + constraint 'self = 'event #Basic.archiver + constraint 'level = [> Basic.level ] + constraint 'event = 'level #Basic.event + + method channel = channel + + method emit e = + let _ = (e :> 'event) in + let n = e#level in + let p = e#prioritizer in + if (p#code `Fail) - (p#code e#level) > 0 then begin + let tag = p#tag n in + let m = e#message in + Printf.fprintf channel "%s: %s\n" tag m; + flush channel + end +end + +class virtual ['archiver] basic_agent prioritizer limit archivers = + let _ = (prioritizer :> 'level basic_prioritizer) in + (* + let _ = (limit : 'level) in + let _ = (archivers : 'archiver list) in + *) + object(self) + constraint 'level = [> Basic.level ] + constraint 'event = 'level #Basic.event + constraint 'archiver = 'event #Basic.archiver + inherit ['archiver] Basic.agent prioritizer limit archivers (* as super *) + + (* + method! private put: + 'a 'b. 'level -> ('event -> 'b) -> + ('a, unit, string, 'b) format4 -> 'a = super#put + *) + + method invalid: + 'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a = + self#put `Invalid (fun x -> invalid_arg x#message) + + method fail: + 'a 'b. ('a, unit, string, string, string, 'b) format6 -> 'a = + self#put `Fail (fun x -> failwith x#message) + + method error: + 'a. ('a, unit, string, string, string, unit) format6 -> 'a = + self#put `Error ignore + + method warn: + 'a. ('a, unit, string, string, string, unit) format6 -> 'a = + self#put `Warn ignore + + method notice: + 'a. ('a, unit, string, string, string, unit) format6 -> 'a = + self#put `Notice ignore + + method info: + 'a. ('a, unit, string, string, string, unit) format6 -> 'a = + self#put `Info ignore + + method debug: + 'a. ('a, unit, string, string, string, bool) format6 -> 'a = + self#put `Debug (fun _ -> true) + end diff --git a/testsuite/tests/typing-poly/error_messages.ml b/testsuite/tests/typing-poly/error_messages.ml index 989c6ceb..eb26a7f9 100644 --- a/testsuite/tests/typing-poly/error_messages.ml +++ b/testsuite/tests/typing-poly/error_messages.ml @@ -38,8 +38,8 @@ Line 4, characters 49-50: ^ Error: This expression has type < a : 'a; b : 'a > but an expression was expected of type < a : 'a; b : 'a0. 'a0 > - The method b has type 'a, but the expected method type was 'a0. 'a0 - The universal variable 'a0 would escape its scope + The method b has type 'a, but the expected method type was 'a. 'a + The universal variable 'a would escape its scope |}] @@ -61,8 +61,8 @@ Lines 5-7, characters 10-5: Error: This expression has type < f : 'a -> int > but an expression was expected of type t_a The method f has type 'a -> int, but the expected method type was - 'a0. 'a0 -> int - The universal variable 'a0 would escape its scope + 'a. 'a -> int + The universal variable 'a would escape its scope |} ] @@ -80,6 +80,54 @@ Line 4, characters 11-49: Error: This expression has type 'a v but an expression was expected of type uv The method f has type 'a -> int, but the expected method type was - 'a0. 'a0 -> int - The universal variable 'a0 would escape its scope + 'a. 'a -> int + The universal variable 'a would escape its scope +|}] + +(* Issue #8702: row types unified with universally quantified types*) + +let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x +[%%expect {| +Line 1, characters 48-49: +1 | let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x + ^ +Error: This expression has type [> `A ] + but an expression was expected of type [ `A ] + The first variant type is bound to the universal type variable 'a, + it cannot be closed +|}] + +let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x +[%%expect {| +Line 1, characters 48-49: +1 | let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x + ^ +Error: This expression has type [ `A ] but an expression was expected of type + [> `A ] + The second variant type is bound to the universal type variable 'a, + it cannot be closed +|}] + + +let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x +[%%expect {| +Line 1, characters 53-54: +1 | let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x + ^ +Error: This expression has type [ `A | `B ] + but an expression was expected of type [> `A ] + The second variant type is bound to the universal type variable 'a, + it cannot be closed +|}] + + +let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x +[%%expect {| +Line 1, characters 59-60: +1 | let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x + ^ +Error: This expression has type [> `A | `B | `C ] + but an expression was expected of type [> `A ] + The second variant type is bound to the universal type variable 'a, + it may not allow the tag(s) `B, `C |}] diff --git a/testsuite/tests/typing-poly/ocamltests b/testsuite/tests/typing-poly/ocamltests deleted file mode 100644 index 050266c6..00000000 --- a/testsuite/tests/typing-poly/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -error_messages.ml -poly.ml diff --git a/testsuite/tests/typing-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml index 36002adc..00310526 100644 --- a/testsuite/tests/typing-poly/poly.ml +++ b/testsuite/tests/typing-poly/poly.ml @@ -778,7 +778,7 @@ class o = object method x : 'a. ([> `A] as 'a) t -> unit = fun _ -> () end ;; [%%expect {| type 'a t = unit -class o : object method x : [> `A ] t -> unit end +class o : object method x : unit -> unit end |}];; class c = object method m = new d () end and d ?(x=0) () = object end;; @@ -1109,8 +1109,10 @@ Line 2, characters 3-4: Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b but an expression was expected of type < m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) > - The method m has type 'a. 'a * 'd, but the expected method type was - 'c. 'c * 'd + The method m has type + 'a. 'a * (< m : 'a * < m : 'c. 'c * 'b > > as 'b), + but the expected method type was + 'c. 'c * < m : 'a * < m : 'c. 'b > > as 'b The universal variable 'a would escape its scope |}];; @@ -1357,7 +1359,8 @@ Line 4, characters 16-22: ^^^^^^ Error: This expression has type [> `Int of int ] but an expression was expected of type [< `Int of int ] - Types for tag `Int are incompatible + The second variant type is bound to the universal type variable 'a, + it may not allow the tag(s) `Int |}];; (* Yet another example *) @@ -1578,7 +1581,7 @@ let c (f : u -> u) = [%%expect{| type u type 'a t = u -val c : (u -> u) -> < apply : 'a. 'a t -> 'a t > = +val c : (u -> u) -> < apply : 'a. u -> u > = |}] (* PR#7496 *) @@ -1753,3 +1756,13 @@ let x : [ `Foo of 'a t | `Foo of _ s ] = id (`Foo []);; [%%expect{| val x : [ `Foo of 'a list t ] = `Foo [] |}] + +(* generalize spine of inherited methods too *) + +class c = object (self) method m ?(x=0) () = x method n = self#m () end;; +class d = object (self) inherit c method n' = self#m () end;; +[%%expect{| +class c : object method m : ?x:int -> unit -> int method n : int end +class d : + object method m : ?x:int -> unit -> int method n : int method n' : int end +|}] diff --git a/testsuite/tests/typing-poly/pr7636.ml b/testsuite/tests/typing-poly/pr7636.ml new file mode 100644 index 00000000..16074ab5 --- /dev/null +++ b/testsuite/tests/typing-poly/pr7636.ml @@ -0,0 +1,37 @@ +(* TEST + * expect +*) + +module M = struct + type ('a, 'b) elt = 'a + + type 'a iter = { f : 'b.('a, 'b) elt -> unit } + + let promote (f : 'a -> unit) = + let f : 'b.('a, 'b) elt -> unit = fun x -> f x in + { f } +end +[%%expect{| +module M : + sig + type ('a, 'b) elt = 'a + type 'a iter = { f : 'b. 'a -> unit; } + val promote : ('a -> unit) -> 'a iter + end +|}] + +module M' : sig + type ('a, 'b) elt + type 'a iter = { f : 'b.('a, 'b) elt -> unit } +end = M +[%%expect{| +module M' : + sig type ('a, 'b) elt type 'a iter = { f : 'b. ('a, 'b) elt -> unit; } end +|}] + +type 'a t = int +let test : 'a. int -> 'a t = fun i -> i;; +[%%expect{| +type 'a t = int +val test : int -> int = +|}] diff --git a/testsuite/tests/typing-polyvariants-bugs-2/ocamltests b/testsuite/tests/typing-polyvariants-bugs-2/ocamltests deleted file mode 100644 index 740258ee..00000000 --- a/testsuite/tests/typing-polyvariants-bugs-2/ocamltests +++ /dev/null @@ -1 +0,0 @@ -pr3918c.ml diff --git a/testsuite/tests/typing-polyvariants-bugs/ocamltests b/testsuite/tests/typing-polyvariants-bugs/ocamltests deleted file mode 100644 index 5ea661d0..00000000 --- a/testsuite/tests/typing-polyvariants-bugs/ocamltests +++ /dev/null @@ -1,7 +0,0 @@ -pr4775_ok.ml -pr4933_ok.ml -pr5057_ok.ml -pr5057a_bad.ml -pr7199_ok.ml -pr7824.ml -privrowsabate_ok.ml diff --git a/testsuite/tests/typing-private-bugs/ocamltests b/testsuite/tests/typing-private-bugs/ocamltests deleted file mode 100644 index d9326a59..00000000 --- a/testsuite/tests/typing-private-bugs/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -pr5026_bad.ml -pr5469_ok.ml diff --git a/testsuite/tests/typing-private/ocamltests b/testsuite/tests/typing-private/ocamltests deleted file mode 100644 index 8f13acc4..00000000 --- a/testsuite/tests/typing-private/ocamltests +++ /dev/null @@ -1 +0,0 @@ -private.ml diff --git a/testsuite/tests/typing-recmod/gpr1626.ml b/testsuite/tests/typing-recmod/gpr1626.ml index ab956355..9629f2c6 100644 --- a/testsuite/tests/typing-recmod/gpr1626.ml +++ b/testsuite/tests/typing-recmod/gpr1626.ml @@ -4,7 +4,7 @@ module type S = sig module M : sig end module N = M end;; [%%expect{| -module type S = sig module M : sig end module N = M end +module type S = sig module M : sig end module N = M end |}];; module rec M : S with module M := M = M;; diff --git a/testsuite/tests/typing-recmod/ocamltests b/testsuite/tests/typing-recmod/ocamltests deleted file mode 100644 index 23289273..00000000 --- a/testsuite/tests/typing-recmod/ocamltests +++ /dev/null @@ -1,22 +0,0 @@ -t01bad.ml -t02bad.ml -t03ok.ml -t04bad.ml -t05bad.ml -t06ok.ml -t07bad.ml -t08bad.ml -t09bad.ml -t10ok.ml -t11bad.ml -t12bad.ml -t13ok.ml -t14bad.ml -t15bad.ml -t16ok.ml -t17ok.ml -t18ok.ml -t20ok.ml -t21ok.ml -t22ok.ml -gpr1626.ml diff --git a/testsuite/tests/typing-recordarg/ocamltests b/testsuite/tests/typing-recordarg/ocamltests deleted file mode 100644 index 793492cf..00000000 --- a/testsuite/tests/typing-recordarg/ocamltests +++ /dev/null @@ -1 +0,0 @@ -recordarg.ml diff --git a/testsuite/tests/typing-rectypes-bugs/ocamltests b/testsuite/tests/typing-rectypes-bugs/ocamltests deleted file mode 100644 index 3ad748d0..00000000 --- a/testsuite/tests/typing-rectypes-bugs/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -pr5343_bad.ml -pr6174_bad.ml -pr6870_bad.ml diff --git a/testsuite/tests/typing-safe-linking/ocamltests b/testsuite/tests/typing-safe-linking/ocamltests deleted file mode 100644 index da0c8356..00000000 --- a/testsuite/tests/typing-safe-linking/ocamltests +++ /dev/null @@ -1 +0,0 @@ -b_bad.ml diff --git a/testsuite/tests/typing-shadowing-of-pervasives-submodules/ocamltests b/testsuite/tests/typing-shadowing-of-pervasives-submodules/ocamltests deleted file mode 100644 index 658495ef..00000000 --- a/testsuite/tests/typing-shadowing-of-pervasives-submodules/ocamltests +++ /dev/null @@ -1,2 +0,0 @@ -redefine_largefile.ml -redefine_largefile_top.ml diff --git a/testsuite/tests/typing-short-paths/ocamltests b/testsuite/tests/typing-short-paths/ocamltests deleted file mode 100644 index 227e7697..00000000 --- a/testsuite/tests/typing-short-paths/ocamltests +++ /dev/null @@ -1,5 +0,0 @@ -gpr1223.ml -pr5918.ml -pr6836.ml -pr7543.ml -short-paths.ml diff --git a/testsuite/tests/typing-short-paths/pr7543.compilers.reference b/testsuite/tests/typing-short-paths/pr7543.compilers.reference index ee55eef1..67c42e5c 100644 --- a/testsuite/tests/typing-short-paths/pr7543.compilers.reference +++ b/testsuite/tests/typing-short-paths/pr7543.compilers.reference @@ -5,13 +5,10 @@ Line 1, characters 19-20: 1 | let () = f (module N);; ^ Error: Signature mismatch: - Modules do not match: - sig type 'a t = 'a end - is not included in - sig type t = N.t end + Modules do not match: sig type 'a t = 'a end is not included in S Type declarations do not match: type 'a t = 'a is not included in - type t = N.t + type t They have different arities. diff --git a/testsuite/tests/typing-signatures/els.ocaml.reference b/testsuite/tests/typing-signatures/els.ocaml.reference index 5254b22b..678b88e7 100644 --- a/testsuite/tests/typing-signatures/els.ocaml.reference +++ b/testsuite/tests/typing-signatures/els.ocaml.reference @@ -71,8 +71,8 @@ module USERCODE : sig type value type state type usert = X.combined end val setglobal : V.state -> string -> V.value -> unit val apply : V.value -> V.state -> V.value list -> V.value - end) -> - sig val init : C.V.state -> unit end + end) + -> sig val init : C.V.state -> unit end end module Weapon : sig type t end module type WEAPON_LIB = @@ -86,8 +86,8 @@ module type WEAPON_LIB = type combined type t = t val map : (combined -> t) * (t -> combined) - end) -> - USERCODE(TV).F + end) + -> USERCODE(TV).F end module type X = functor (X : CORE) -> BARECODE module type X = CORE -> BARECODE diff --git a/testsuite/tests/typing-signatures/ocamltests b/testsuite/tests/typing-signatures/ocamltests deleted file mode 100644 index c209fe4c..00000000 --- a/testsuite/tests/typing-signatures/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -els.ml -pr6371.ml -pr6672.ml diff --git a/testsuite/tests/typing-sigsubst/ocamltests b/testsuite/tests/typing-sigsubst/ocamltests deleted file mode 100644 index ca30f86e..00000000 --- a/testsuite/tests/typing-sigsubst/ocamltests +++ /dev/null @@ -1,4 +0,0 @@ -sig_local_aliases.ml -sig_local_aliases_syntax_errors.ml -sigsubst.ml -test_locations.ml diff --git a/testsuite/tests/typing-sigsubst/sig_local_aliases.ml b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml index 0427ad25..3142a6aa 100644 --- a/testsuite/tests/typing-sigsubst/sig_local_aliases.ml +++ b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml @@ -88,7 +88,7 @@ module type AcceptAnd = sig and u := int * int end;; [%%expect{| -module type AcceptAnd = sig end +module type AcceptAnd = sig end |}] module type RejectAnd = sig diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index 1e333a05..6f9da636 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/testsuite/tests/typing-sigsubst/sigsubst.ml @@ -122,7 +122,7 @@ module type S' = sig val f : M.exp -> M.arg end module type S = sig type 'a t end with type 'a t := unit [%%expect {| -module type S = sig end +module type S = sig end |}] module type S = sig @@ -336,7 +336,7 @@ Lines 2-5, characters 17-25: 5 | end with type M2.t := int Error: This `with' constraint on M2.t makes the applicative functor type Id(M2).t ill-typed in the constrained signature: - Modules do not match: sig end is not included in sig type t end + Modules do not match: sig end is not included in sig type t end The type `t' is required but not provided |}] @@ -356,7 +356,7 @@ module type S = sig end with module M.N := A [%%expect {| module A : sig module P : sig type t val x : int end end -module type S = sig module M : sig end type t = A.P.t end +module type S = sig module M : sig end type t = A.P.t end |}] (* Same as for types, not all substitutions are accepted *) diff --git a/testsuite/tests/typing-typeparam/ocamltests b/testsuite/tests/typing-typeparam/ocamltests deleted file mode 100644 index cbf31880..00000000 --- a/testsuite/tests/typing-typeparam/ocamltests +++ /dev/null @@ -1 +0,0 @@ -newtype.ml diff --git a/testsuite/tests/typing-unboxed-types/ocamltests b/testsuite/tests/typing-unboxed-types/ocamltests deleted file mode 100644 index 6fde39d7..00000000 --- a/testsuite/tests/typing-unboxed-types/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -test.ml -test_flat.ml -test_no_flat.ml diff --git a/testsuite/tests/typing-unboxed/ocamltests b/testsuite/tests/typing-unboxed/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/typing-unboxed/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml index 3ac3e27a..03edd525 100644 --- a/testsuite/tests/typing-unboxed/test.ml +++ b/testsuite/tests/typing-unboxed/test.ml @@ -413,10 +413,14 @@ type i = I of int Line 2, characters 0-34: 2 | external id : i -> i = "%identity";; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Warning 61: This primitive declaration uses type i, which is unannotated and -unboxable. The representation of such types may change in future -versions. You should annotate the declaration of i with [@@boxed] -or [@@unboxed]. +Warning 61: This primitive declaration uses type i, whose representation +may be either boxed or unboxed. Without an annotation to indicate +which representation is intended, the boxed representation has been +selected by default. This default choice may change in future +versions of the compiler, breaking the primitive implementation. +You should explicitly annotate the declaration of i +with [@@boxed] or [@@unboxed], so that its external interface +remains stable in the future. external id : i -> i = "%identity" |}];; @@ -429,17 +433,25 @@ type j = J of int Line 3, characters 0-34: 3 | external id : i -> j = "%identity";; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Warning 61: This primitive declaration uses type i, which is unannotated and -unboxable. The representation of such types may change in future -versions. You should annotate the declaration of i with [@@boxed] -or [@@unboxed]. +Warning 61: This primitive declaration uses type i, whose representation +may be either boxed or unboxed. Without an annotation to indicate +which representation is intended, the boxed representation has been +selected by default. This default choice may change in future +versions of the compiler, breaking the primitive implementation. +You should explicitly annotate the declaration of i +with [@@boxed] or [@@unboxed], so that its external interface +remains stable in the future. Line 3, characters 0-34: 3 | external id : i -> j = "%identity";; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Warning 61: This primitive declaration uses type j, which is unannotated and -unboxable. The representation of such types may change in future -versions. You should annotate the declaration of j with [@@boxed] -or [@@unboxed]. +Warning 61: This primitive declaration uses type j, whose representation +may be either boxed or unboxed. Without an annotation to indicate +which representation is intended, the boxed representation has been +selected by default. This default choice may change in future +versions of the compiler, breaking the primitive implementation. +You should explicitly annotate the declaration of j +with [@@boxed] or [@@unboxed], so that its external interface +remains stable in the future. external id : i -> j = "%identity" |}];; diff --git a/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml index 66c6f389..27b12920 100644 --- a/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml +++ b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml @@ -343,6 +343,10 @@ let not_ambiguous__module_variable x b = match x with | _ -> 2 ;; [%%expect {| +Line 2, characters 12-13: +2 | | (module M:S),_,(1,_) + ^ +Warning 60: unused module M. val not_ambiguous__module_variable : (module S) * (module S) * (int * int) -> bool -> int = |}] diff --git a/testsuite/tests/typing-warnings/never_returns.ml b/testsuite/tests/typing-warnings/never_returns.ml new file mode 100644 index 00000000..6b5aac60 --- /dev/null +++ b/testsuite/tests/typing-warnings/never_returns.ml @@ -0,0 +1,37 @@ +(* TEST + flags = " -w -a+21 " + * expect +*) + +let () = (let module L = List in raise Exit); () ;; +[%%expect {| +Line 1, characters 33-43: +1 | let () = (let module L = List in raise Exit); () ;; + ^^^^^^^^^^ +Warning 21: this statement never returns (or has an unsound type.) +Exception: Stdlib.Exit. +|}] +let () = (let exception E in raise Exit); ();; +[%%expect {| +Line 1, characters 29-39: +1 | let () = (let exception E in raise Exit); ();; + ^^^^^^^^^^ +Warning 21: this statement never returns (or has an unsound type.) +Exception: Stdlib.Exit. +|}] +let () = (raise Exit : _); ();; +[%%expect {| +Line 1, characters 10-20: +1 | let () = (raise Exit : _); ();; + ^^^^^^^^^^ +Warning 21: this statement never returns (or has an unsound type.) +Exception: Stdlib.Exit. +|}] +let () = (let open Stdlib in raise Exit); ();; +[%%expect {| +Line 1, characters 29-39: +1 | let () = (let open Stdlib in raise Exit); ();; + ^^^^^^^^^^ +Warning 21: this statement never returns (or has an unsound type.) +Exception: Stdlib.Exit. +|}] diff --git a/testsuite/tests/typing-warnings/ocamltests b/testsuite/tests/typing-warnings/ocamltests deleted file mode 100644 index 0a148d9e..00000000 --- a/testsuite/tests/typing-warnings/ocamltests +++ /dev/null @@ -1,16 +0,0 @@ -ambiguous_guarded_disjunction.ml -application.ml -coercions.ml -exhaustiveness.ml -pr5892.ml -pr6587.ml -pr6872.ml -pr7085.ml -pr7115.ml -pr7261.ml -pr7297.ml -pr7553.ml -records.ml -unused_rec.ml -unused_types.ml -open_warnings.ml diff --git a/testsuite/tests/typing-warnings/open_warnings.ml b/testsuite/tests/typing-warnings/open_warnings.ml index d0778c4d..e6c65691 100644 --- a/testsuite/tests/typing-warnings/open_warnings.ml +++ b/testsuite/tests/typing-warnings/open_warnings.ml @@ -15,7 +15,7 @@ Line 3, characters 2-8: 3 | open M (* unused open *) ^^^^^^ Warning 33: unused open M. -module T1 : sig end +module T1 : sig end |}] @@ -43,11 +43,11 @@ Line 2, characters 2-13: 2 | type t0 = A (* unused type and constructor *) ^^^^^^^^^^^ Warning 34: unused type t0. -Line 2, characters 2-13: +Line 2, characters 12-13: 2 | type t0 = A (* unused type and constructor *) - ^^^^^^^^^^^ + ^ Warning 37: unused constructor A. -module T3 : sig end +module T3 : sig end |}] module T4 : sig end = struct @@ -61,15 +61,15 @@ Line 3, characters 20-30: 3 | module M = struct type t = A end (* unused type and constructor *) ^^^^^^^^^^ Warning 34: unused type t. -Line 3, characters 20-30: +Line 3, characters 29-30: 3 | module M = struct type t = A end (* unused type and constructor *) - ^^^^^^^^^^ + ^ Warning 37: unused constructor A. Line 4, characters 2-8: 4 | open M (* unused open; no shadowing (A below refers to the one in t0) *) ^^^^^^ Warning 33: unused open M. -module T4 : sig end +module T4 : sig end |}] module T5 : sig end = struct @@ -87,11 +87,11 @@ Line 2, characters 2-13: 2 | type t0 = A (* unused type and constructor *) ^^^^^^^^^^^ Warning 34: unused type t0. -Line 2, characters 2-13: +Line 2, characters 12-13: 2 | type t0 = A (* unused type and constructor *) - ^^^^^^^^^^^ + ^ Warning 37: unused constructor A. -module T5 : sig end +module T5 : sig end |}] @@ -108,7 +108,7 @@ Line 3, characters 2-9: 3 | open! M (* unused open *) ^^^^^^^ Warning 66: unused open! M. -module T1_bis : sig end +module T1_bis : sig end |}] module T2_bis : sig type s end = struct @@ -131,11 +131,11 @@ Line 2, characters 2-13: 2 | type t0 = A (* unused type and constructor *) ^^^^^^^^^^^ Warning 34: unused type t0. -Line 2, characters 2-13: +Line 2, characters 12-13: 2 | type t0 = A (* unused type and constructor *) - ^^^^^^^^^^^ + ^ Warning 37: unused constructor A. -module T3_bis : sig end +module T3_bis : sig end |}] module T4_bis : sig end = struct @@ -149,15 +149,15 @@ Line 3, characters 20-30: 3 | module M = struct type t = A end (* unused type and constructor *) ^^^^^^^^^^ Warning 34: unused type t. -Line 3, characters 20-30: +Line 3, characters 29-30: 3 | module M = struct type t = A end (* unused type and constructor *) - ^^^^^^^^^^ + ^ Warning 37: unused constructor A. Line 4, characters 2-9: 4 | open! M (* unused open; no shadowing (A below refers to the one in t0) *) ^^^^^^^ Warning 66: unused open! M. -module T4_bis : sig end +module T4_bis : sig end |}] module T5_bis : sig end = struct @@ -171,9 +171,59 @@ Line 2, characters 2-13: 2 | type t0 = A (* unused type and constructor *) ^^^^^^^^^^^ Warning 34: unused type t0. -Line 2, characters 2-13: +Line 2, characters 12-13: 2 | type t0 = A (* unused type and constructor *) - ^^^^^^^^^^^ + ^ Warning 37: unused constructor A. -module T5_bis : sig end +module T5_bis : sig end +|}] + + +module T6 : sig end = struct + (* GPR9170 *) + module M = struct + type t = [`A | `B] + end + module type S = sig + open M + val f: #t -> unit + end + let _ = fun ((module S : S)) -> S.f `A +end;; +[%%expect {| +Line 8, characters 11-13: +8 | val f: #t -> unit + ^^ +Alert deprecated: old syntax for polymorphic variant type +module T6 : sig end +|}] + +module T7 : sig end = struct + (* GPR9170 *) + module M = struct + class type t = object end + end + module type S = sig + open M + val f: #t -> unit + end + let _ = fun ((module S : S)) -> S.f (object end) +end;; +[%%expect {| +module T7 : sig end +|}] + +module T8 : sig end = struct + (* GPR9170 *) + module M = struct + class t = object end + end + module type S = sig + open M + val f: #t -> unit + end + let _ = fun ((module S : S)) -> S.f (object end) +end;; +[%%expect {| +module T8 : sig end |}] diff --git a/testsuite/tests/typing-warnings/pr7115.ml b/testsuite/tests/typing-warnings/pr7115.ml index ed6f5535..f4f5c35b 100644 --- a/testsuite/tests/typing-warnings/pr7115.ml +++ b/testsuite/tests/typing-warnings/pr7115.ml @@ -17,7 +17,7 @@ Line 2, characters 10-11: 2 | let _f ~x (* x unused argument *) = function ^ Warning 27: unused variable x. -module X1 : sig end +module X1 : sig end |}] module X2 : sig end = struct @@ -30,7 +30,7 @@ Line 2, characters 6-7: 2 | let x = 42 (* unused value *) ^ Warning 32: unused value x. -module X2 : sig end +module X2 : sig end |}] module X3 : sig end = struct @@ -49,5 +49,5 @@ Line 3, characters 2-8: 3 | open O (* unused open *) ^^^^^^ Warning 33: unused open O. -module X3 : sig end +module X3 : sig end |}] diff --git a/testsuite/tests/typing-warnings/pr7553.ml b/testsuite/tests/typing-warnings/pr7553.ml index 1b3ac74d..d479c419 100644 --- a/testsuite/tests/typing-warnings/pr7553.ml +++ b/testsuite/tests/typing-warnings/pr7553.ml @@ -24,7 +24,7 @@ Line 2, characters 2-8: 2 | open A ^^^^^^ Warning 33: unused open A. -module rec C : sig end +module rec C : sig end |}] module rec D : sig @@ -46,5 +46,5 @@ Line 4, characters 6-12: 4 | open A ^^^^^^ Warning 33: unused open A. -module rec D : sig module M : sig module X : sig end end end +module rec D : sig module M : sig module X : sig end end end |}] diff --git a/testsuite/tests/typing-warnings/unused_functor_parameter.ml b/testsuite/tests/typing-warnings/unused_functor_parameter.ml new file mode 100644 index 00000000..c8691af9 --- /dev/null +++ b/testsuite/tests/typing-warnings/unused_functor_parameter.ml @@ -0,0 +1,33 @@ +(* TEST + flags = " -w A " + * expect +*) + +module Foo(Unused : sig end) = struct end;; +[%%expect {| +Line 1, characters 11-17: +1 | module Foo(Unused : sig end) = struct end;; + ^^^^^^ +Warning 60: unused module Unused. +module Foo : functor (Unused : sig end) -> sig end +|}] + +module type S = functor (Unused : sig end) -> sig end;; +[%%expect {| +Line 1, characters 25-31: +1 | module type S = functor (Unused : sig end) -> sig end;; + ^^^^^^ +Warning 67: unused functor parameter Unused. +module type S = functor (Unused : sig end) -> sig end +|}] + +module type S = sig + module M (Unused : sig end) : sig end +end;; +[%%expect{| +Line 2, characters 12-18: +2 | module M (Unused : sig end) : sig end + ^^^^^^ +Warning 67: unused functor parameter Unused. +module type S = sig module M : functor (Unused : sig end) -> sig end end +|}] diff --git a/testsuite/tests/typing-warnings/unused_types.ml b/testsuite/tests/typing-warnings/unused_types.ml index cb1fc65f..a7385e76 100644 --- a/testsuite/tests/typing-warnings/unused_types.ml +++ b/testsuite/tests/typing-warnings/unused_types.ml @@ -13,7 +13,7 @@ Line 3, characters 2-19: 3 | type unused = int ^^^^^^^^^^^^^^^^^ Warning 34: unused type unused. -module Unused : sig end +module Unused : sig end |}] module Unused_nonrec : sig @@ -27,7 +27,7 @@ Line 4, characters 2-27: 4 | type nonrec unused = used ^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 34: unused type unused. -module Unused_nonrec : sig end +module Unused_nonrec : sig end |}] module Unused_rec : sig @@ -40,11 +40,132 @@ Line 3, characters 2-27: 3 | type unused = A of unused ^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 34: unused type unused. -Line 3, characters 2-27: +Line 3, characters 16-27: 3 | type unused = A of unused - ^^^^^^^^^^^^^^^^^^^^^^^^^ + ^^^^^^^^^^^ Warning 37: unused constructor A. -module Unused_rec : sig end +module Unused_rec : sig end +|}] + +module Used_constructor : sig + type t + val t : t +end = struct + type t = T + let t = T +end +;; +[%%expect {| +module Used_constructor : sig type t val t : t end +|}] + +module Unused_constructor : sig + type t +end = struct + type t = T +end +;; +[%%expect {| +Line 4, characters 11-12: +4 | type t = T + ^ +Warning 37: unused constructor T. +module Unused_constructor : sig type t end +|}] + +module Unused_constructor_outside_patterns : sig + type t + val nothing : t -> unit +end = struct + type t = T + let nothing = function + | T -> () +end +;; +[%%expect {| +Line 5, characters 11-12: +5 | type t = T + ^ +Warning 37: constructor T is never used to build values. +(However, this constructor appears in patterns.) +module Unused_constructor_outside_patterns : + sig type t val nothing : t -> unit end +|}] + +module Unused_constructor_exported_private : sig + type t = private T +end = struct + type t = T +end +;; +[%%expect {| +Line 4, characters 11-12: +4 | type t = T + ^ +Warning 37: constructor T is never used to build values. +Its type is exported as a private type. +module Unused_constructor_exported_private : sig type t = private T end +|}] + +module Used_private_constructor : sig + type t + val nothing : t -> unit +end = struct + type t = private T + let nothing = function + | T -> () +end +;; +[%%expect {| +module Used_private_constructor : sig type t val nothing : t -> unit end +|}] + +module Unused_private_constructor : sig + type t +end = struct + type t = private T +end +;; +[%%expect {| +Line 4, characters 19-20: +4 | type t = private T + ^ +Warning 37: unused constructor T. +module Unused_private_constructor : sig type t end +|}] + +module Exported_private_constructor : sig + type t = private T +end = struct + type t = private T +end +;; +[%%expect {| +module Exported_private_constructor : sig type t = private T end +|}] + +module Used_exception : sig + val e : exn +end = struct + exception Somebody_uses_me + let e = Somebody_uses_me +end +;; +[%%expect {| +module Used_exception : sig val e : exn end +|}] + +module Used_extension_constructor : sig + type t + val t : t +end = struct + type t = .. + type t += Somebody_uses_me + let t = Somebody_uses_me +end +;; +[%%expect {| +module Used_extension_constructor : sig type t val t : t end |}] module Unused_exception : sig @@ -57,7 +178,7 @@ Line 3, characters 2-26: 3 | exception Nobody_uses_me ^^^^^^^^^^^^^^^^^^^^^^^^ Warning 38: unused exception Nobody_uses_me -module Unused_exception : sig end +module Unused_exception : sig end |}] module Unused_extension_constructor : sig @@ -114,7 +235,7 @@ module Unused_extension_outside_patterns : sig type t = .. val falsity : t -> bool end |}] -module Unused_private_exception : sig +module Unused_exception_exported_private : sig type exn += private Private_exn end = struct exception Private_exn @@ -126,10 +247,11 @@ Line 4, characters 2-23: ^^^^^^^^^^^^^^^^^^^^^ Warning 38: exception Private_exn is never used to build values. It is exported or rebound as a private extension. -module Unused_private_exception : sig type exn += private Private_exn end +module Unused_exception_exported_private : + sig type exn += private Private_exn end |}] -module Unused_private_extension : sig +module Unused_extension_exported_private : sig type t = .. type t += private Private_ext end = struct @@ -143,10 +265,53 @@ Line 6, characters 12-23: ^^^^^^^^^^^ Warning 38: extension constructor Private_ext is never used to build values. It is exported or rebound as a private extension. -module Unused_private_extension : +module Unused_extension_exported_private : sig type t = .. type t += private Private_ext end |}] +module Used_private_extension : sig + type t + val nothing : t -> unit +end = struct + type t = .. + type t += private Private_ext + let nothing = function + | Private_ext | _ -> () +end +;; +[%%expect {| +module Used_private_extension : sig type t val nothing : t -> unit end +|}] + +module Unused_private_extension : sig + type t +end = struct + type t = .. + type t += private Private_ext +end +;; +[%%expect {| +Line 5, characters 20-31: +5 | type t += private Private_ext + ^^^^^^^^^^^ +Warning 38: unused extension constructor Private_ext +module Unused_private_extension : sig type t end +|}] + +module Exported_private_extension : sig + type t = .. + type t += private Private_ext +end = struct + type t = .. + type t += private Private_ext +end +;; +[%%expect {| +module Exported_private_extension : + sig type t = .. type t += private Private_ext end +|}] + + module Pr7438 : sig end = struct module type S = sig type t = private [> `Foo] end @@ -154,7 +319,7 @@ end = struct sig type t = private [> `Foo | `Bar] include S with type t := t end end;; [%%expect {| -module Pr7438 : sig end +module Pr7438 : sig end |}] module Unused_type_disable_warning : sig @@ -162,11 +327,11 @@ end = struct type t = A [@@warning "-34"] end;; [%%expect {| -Line 3, characters 2-30: +Line 3, characters 11-12: 3 | type t = A [@@warning "-34"] - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + ^ Warning 37: unused constructor A. -module Unused_type_disable_warning : sig end +module Unused_type_disable_warning : sig end |}] module Unused_constructor_disable_warning : sig @@ -178,5 +343,5 @@ Line 3, characters 2-30: 3 | type t = A [@@warning "-37"] ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 34: unused type t. -module Unused_constructor_disable_warning : sig end +module Unused_constructor_disable_warning : sig end |}] diff --git a/testsuite/tests/unboxed-primitive-args/ocamltests b/testsuite/tests/unboxed-primitive-args/ocamltests deleted file mode 100644 index 31c13b44..00000000 --- a/testsuite/tests/unboxed-primitive-args/ocamltests +++ /dev/null @@ -1 +0,0 @@ -test.ml diff --git a/testsuite/tests/unwind/ocamltests b/testsuite/tests/unwind/ocamltests deleted file mode 100644 index 6550b8e3..00000000 --- a/testsuite/tests/unwind/ocamltests +++ /dev/null @@ -1 +0,0 @@ -driver.ml diff --git a/testsuite/tests/utils/ocamltests b/testsuite/tests/utils/ocamltests deleted file mode 100644 index 571dfa47..00000000 --- a/testsuite/tests/utils/ocamltests +++ /dev/null @@ -1,3 +0,0 @@ -edit_distance.ml -overflow_detection.ml -test_strongly_connected_components.ml diff --git a/testsuite/tests/warnings/ocamltests b/testsuite/tests/warnings/ocamltests deleted file mode 100644 index fa3318d2..00000000 --- a/testsuite/tests/warnings/ocamltests +++ /dev/null @@ -1,23 +0,0 @@ -deprecated_module_assigment.ml -deprecated_module.ml -deprecated_module_use.ml -w01.ml -w03.ml -w04_failure.ml -w04.ml -w06.ml -w32b.ml -w32.ml -w33.ml -w45.ml -w47_inline.ml -w50.ml -w51_bis.ml -w51.ml -w52.ml -w53.ml -w54.ml -w55.ml -w58.ml -w59.ml -w60.ml diff --git a/testsuite/tests/warnings/w32.compilers.reference b/testsuite/tests/warnings/w32.compilers.reference index 6b4abe2b..6cf44b0b 100644 --- a/testsuite/tests/warnings/w32.compilers.reference +++ b/testsuite/tests/warnings/w32.compilers.reference @@ -1,3 +1,15 @@ +File "w32.mli", line 12, characters 10-11: +12 | module F (X : sig val x : int end) : sig end + ^ +Warning 67: unused functor parameter X. +File "w32.mli", line 14, characters 10-11: +14 | module G (X : sig val x : int end) : sig end + ^ +Warning 67: unused functor parameter X. +File "w32.mli", line 16, characters 10-11: +16 | module H (X : sig val x : int end) : sig val x : int end + ^ +Warning 67: unused functor parameter X. File "w32.ml", line 40, characters 24-25: 40 | let[@warning "-32"] rec q x = x ^ @@ -61,6 +73,10 @@ File "w32.ml", line 63, characters 18-29: 63 | module F (X : sig val x : int end) = struct end ^^^^^^^^^^^ Warning 32: unused value x. +File "w32.ml", line 63, characters 10-11: +63 | module F (X : sig val x : int end) = struct end + ^ +Warning 60: unused module X. File "w32.ml", line 65, characters 18-29: 65 | module G (X : sig val x : int end) = X ^^^^^^^^^^^ diff --git a/testsuite/tests/warnings/w32b.compilers.reference b/testsuite/tests/warnings/w32b.compilers.reference index 5266ba18..79ba5c85 100644 --- a/testsuite/tests/warnings/w32b.compilers.reference +++ b/testsuite/tests/warnings/w32b.compilers.reference @@ -2,3 +2,7 @@ File "w32b.ml", line 13, characters 18-24: 13 | module Q (M : sig type t end) = struct end ^^^^^^ Warning 34: unused type t. +File "w32b.ml", line 13, characters 10-11: +13 | module Q (M : sig type t end) = struct end + ^ +Warning 60: unused module M. diff --git a/testsuite/tests/warnings/w53.ml b/testsuite/tests/warnings/w53.ml index 4efdc2ab..63a0a83b 100644 --- a/testsuite/tests/warnings/w53.ml +++ b/testsuite/tests/warnings/w53.ml @@ -1,6 +1,6 @@ (* TEST -flags = "-w A" +flags = "-w A-60" * setup-ocamlc.byte-build-env ** ocamlc.byte diff --git a/testsuite/tests/warnings/w60.compilers.reference b/testsuite/tests/warnings/w60.compilers.reference new file mode 100644 index 00000000..9eec5d1e --- /dev/null +++ b/testsuite/tests/warnings/w60.compilers.reference @@ -0,0 +1,4 @@ +File "w60.ml", line 40, characters 13-14: +40 | let module M = struct end in + ^ +Warning 60: unused module M. diff --git a/testsuite/tests/warnings/w60.ml b/testsuite/tests/warnings/w60.ml index c7007afa..2e59615c 100644 --- a/testsuite/tests/warnings/w60.ml +++ b/testsuite/tests/warnings/w60.ml @@ -1,6 +1,6 @@ (* TEST -flags = "-w A" +flags = "-w A-67" * setup-ocamlc.byte-build-env ** ocamlc.byte @@ -32,3 +32,10 @@ module M = struct end module O = M.N + +(***************) + +let () = + (* M is unused, but no warning was emitted before 4.10. *) + let module M = struct end in + () diff --git a/testsuite/tests/win-unicode/ocamltests b/testsuite/tests/win-unicode/ocamltests deleted file mode 100644 index 681ef54c..00000000 --- a/testsuite/tests/win-unicode/ocamltests +++ /dev/null @@ -1 +0,0 @@ -mltest.ml diff --git a/testsuite/tools/Makefile b/testsuite/tools/Makefile index 6e6370d7..7166c2dc 100644 --- a/testsuite/tools/Makefile +++ b/testsuite/tools/Makefile @@ -12,73 +12,87 @@ #* * #************************************************************************** -BASEDIR = .. +TOPDIR = ../.. -ROOTDIR = ../.. +COMPILERLIBSDIR = $(TOPDIR)/compilerlibs + +RUNTIME_VARIANT ?= +ASPPFLAGS ?= + +include $(TOPDIR)/Makefile.tools -include $(ROOTDIR)/Makefile.config expect_MAIN=expect_test expect_PROG=$(expect_MAIN)$(EXE) -expect_COMPFLAGS=-I $(OTOPDIR)/parsing -I $(OTOPDIR)/utils \ - -I $(OTOPDIR)/driver -I $(OTOPDIR)/typing -I $(OTOPDIR)/toplevel -expect_LIBRARIES := $(addprefix $(ROOTDIR)/compilerlibs/,\ +expect_DIRS = parsing utils driver typing toplevel +expect_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/,$(expect_DIRS)) +expect_LIBS := $(addprefix $(COMPILERLIBSDIR)/,\ ocamlcommon ocamlbytecomp ocamltoplevel) -codegen_INCLUDES=\ - -I $(OTOPDIR)/parsing \ - -I $(OTOPDIR)/utils \ - -I $(OTOPDIR)/typing \ - -I $(OTOPDIR)/middle_end \ - -I $(OTOPDIR)/bytecomp \ - -I $(OTOPDIR)/lambda \ - -I $(OTOPDIR)/asmcomp +codegen_PROG = codegen$(EXE) +codegen_DIRS = parsing utils typing middle_end bytecomp lambda asmcomp +codegen_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/, $(codegen_DIRS)) -w +40 -g -codegen_OTHEROBJECTS=\ - $(OTOPDIR)/compilerlibs/ocamlcommon.cma \ - $(OTOPDIR)/compilerlibs/ocamloptcomp.cma +codegen_LIBS = $(addprefix $(COMPILERLIBSDIR)/,\ + ocamlcommon ocamloptcomp) -codegen_OBJECTS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo codegen_main.cmo +codegen_OBJECTS = $(addsuffix .cmo,\ + parsecmmaux parsecmm lexcmm codegen_main) -codegen_ADD_COMPFLAGS=$(codegen_INCLUDES) -w -40 -g +tools := $(expect_PROG) -targets := $(expect_PROG) - -ifneq "$(ARCH)" "none" -targets += codegen +ifeq "$(NATIVE_COMPILER)" "true" +tools += $(codegen_PROG) ifneq "$(CCOMPTYPE)-$(ARCH)" "msvc-amd64" # The asmgen tests are not ported to MSVC64 yet # so do not compile any arch-specific module -targets += asmgen_$(ARCH).$(O) +tools += asmgen_$(ARCH).$(O) endif endif -all: $(targets) - -$(expect_PROG): $(expect_LIBRARIES:=.cma) $(expect_MAIN).cmo - @$(OCAMLC) -linkall -o $@ $^ +all: $(tools) -include $(BASEDIR)/makefiles/Makefile.common +$(expect_PROG): $(expect_LIBS:=.cma) $(expect_MAIN).cmo + $(OCAMLC) -linkall -o $@ $^ -.PHONY: clean -clean: defaultclean - rm -f $(expect_PROG) - rm -f codegen parsecmm.ml parsecmm.mli lexcmm.ml - -expect_test.cmo: COMPFLAGS=$(expect_COMPFLAGS) +$(expect_PROG): COMPFLAGS = $(expect_OCAMLFLAGS) -$(codegen_OBJECTS): ADD_COMPFLAGS = $(codegen_ADD_COMPFLAGS) +$(codegen_PROG): COMPFLAGS = $(codegen_OCAMLFLAGS) codegen_main.cmo: parsecmm.cmo -codegen: $(codegen_OBJECTS) - @$(OCAMLC) $(LINKFLAGS) -o $@ $(codegen_OTHEROBJECTS) $^ +$(codegen_PROG): $(codegen_OBJECTS) + $(OCAMLC) -o $@ $(codegen_LIBS:=.cma) $^ parsecmm.mli parsecmm.ml: parsecmm.mly - @$(OCAMLYACC) -q parsecmm.mly + $(OCAMLYACC) -q parsecmm.mly lexcmm.ml: lexcmm.mll - @$(OCAMLLEX) -q lexcmm.mll + $(OCAMLLEX) -q lexcmm.mll + +parsecmmaux.cmo: parsecmmaux.cmi + +lexcmm.cmo: lexcmm.cmi + +parsecmm.cmo: parsecmm.cmi asmgen_i386.obj: asmgen_i386nt.asm @set -o pipefail ; \ $(ASM) $@ $^ | tail -n +2 + +%.cmi: %.mli + $(OCAMLC) -c $< + +%.cmo: %.ml + $(OCAMLC) -c $< + +%.cmx: %.ml + $(OCAMLOPT) -c $< + +%.$(O): %.S + $(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $< + +.PHONY: clean +clean: + rm -f *.cm* *.$(O) + rm -f $(tools) + rm -f parsecmm.ml parsecmm.mli lexcmm.ml diff --git a/testsuite/tools/asmgen_i386.S b/testsuite/tools/asmgen_i386.S index 5878395a..1d16b72d 100644 --- a/testsuite/tools/asmgen_i386.S +++ b/testsuite/tools/asmgen_i386.S @@ -49,9 +49,7 @@ G(call_gen_code): G(caml_c_call): jmp *%eax - .comm G(caml_exception_pointer), 4 - .comm G(young_ptr), 4 - .comm G(young_start), 4 + .comm G(Caml_state), 4 /* Some tests are designed to cause registers to spill; on * x86 we require the caml_extra_params symbol from the RTS. */ diff --git a/testsuite/tools/asmgen_i386nt.asm b/testsuite/tools/asmgen_i386nt.asm index 281f34ec..68ba9b7d 100644 --- a/testsuite/tools/asmgen_i386nt.asm +++ b/testsuite/tools/asmgen_i386nt.asm @@ -61,11 +61,7 @@ _caml_raise_exn: int 3 .DATA - PUBLIC _caml_exception_pointer -_caml_exception_pointer dword 0 - PUBLIC _caml_young_ptr -_caml_young_ptr dword 0 - PUBLIC _caml_young_limit -_caml_young_limit dword 0 + PUBLIC _Caml_state +_Caml_state dword 0 END diff --git a/testsuite/tools/codegen_main.ml b/testsuite/tools/codegen_main.ml index 52aa0c37..d0b3d404 100644 --- a/testsuite/tools/codegen_main.ml +++ b/testsuite/tools/codegen_main.ml @@ -25,7 +25,7 @@ let compile_file filename = Emit.begin_assembly(); let ic = open_in filename in let lb = Lexing.from_channel ic in - lb.Lexing.lex_curr_p <- { lb.Lexing.lex_curr_p with pos_fname = filename }; + lb.Lexing.lex_curr_p <- Lexing.{ lb.lex_curr_p with pos_fname = filename }; try while true do Asmgen.compile_phrase ~ppf_dump:Format.std_formatter @@ -62,8 +62,7 @@ let main() = "-dcmm", Arg.Set dump_cmm, ""; "-dcse", Arg.Set dump_cse, ""; "-dsel", Arg.Set dump_selection, ""; - "-dlive", Arg.Unit(fun () -> dump_live := true; - Printmach.print_live := true), ""; + "-dlive", Arg.Unit(fun () -> dump_live := true ), ""; "-dspill", Arg.Set dump_spill, ""; "-dsplit", Arg.Set dump_split, ""; "-dinterf", Arg.Set dump_interf, ""; diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml index 84813889..2f180247 100644 --- a/testsuite/tools/expect_test.ml +++ b/testsuite/tools/expect_test.ml @@ -341,66 +341,10 @@ let main fname = exit 0 module Options = Main_args.Make_bytetop_options (struct - let set r () = r := true - let clear r () = r := false - open Clflags - let _absname = set absname - let _alert = Warnings.parse_alert_option - let _I dir = include_dirs := dir :: !include_dirs - let _init s = init_file := Some s - let _noinit = set noinit - let _labels = clear classic - let _alias_deps = clear transparent_modules - let _no_alias_deps = set transparent_modules - let _app_funct = set applicative_functors - let _no_app_funct = clear applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noprompt = set noprompt - let _nopromptcont = set nopromptcont - let _nostdlib = set no_std_include - let _nopervasives = set nopervasives - let _open s = open_modules := s :: !open_modules - let _ppx _s = (* disabled *) () - let _principal = set principal - let _no_principal = clear principal - let _rectypes = set recursive_types - let _no_rectypes = clear recursive_types - let _safe_string = clear unsafe_string - let _short_paths = clear real_paths + include Main_args.Default.Topmain let _stdin () = (* disabled *) () - let _strict_sequence = set strict_sequence - let _no_strict_sequence = clear strict_sequence - let _strict_formats = set strict_formats - let _no_strict_formats = clear strict_formats - let _unboxed_types = set unboxed_types - let _no_unboxed_types = clear unboxed_types - let _unsafe = set unsafe - let _unsafe_string = set unsafe_string - let _version () = (* disabled *) () - let _vnum () = (* disabled *) () - let _no_version = set noversion - let _w s = Warnings.parse_options false s - let _warn_error s = Warnings.parse_options true s - let _warn_help = Warnings.help_warnings - let _dparsetree = set dump_parsetree - let _dtypedtree = set dump_typedtree - let _dno_unique_ids = clear unique_ids - let _dunique_ids = set unique_ids - let _dsource = set dump_source - let _drawlambda = set dump_rawlambda - let _dlambda = set dump_lambda - let _dflambda = set dump_flambda - let _dtimings () = profile_columns := [ `Time ] - let _dprofile () = profile_columns := Profile.all_columns - let _dinstr = set dump_instr - let _dcamlprimc = set keep_camlprimc_file - let _color = Misc.set_or_ignore color_reader.parse color - let _error_style = Misc.set_or_ignore error_style_reader.parse error_style - let _args = Arg.read_arg let _args0 = Arg.read_arg0 - let anonymous s = main s end);; diff --git a/testsuite/tools/lexcmm.mll b/testsuite/tools/lexcmm.mll index 77ea888a..5cfbe5a5 100644 --- a/testsuite/tools/lexcmm.mll +++ b/testsuite/tools/lexcmm.mll @@ -63,8 +63,9 @@ let keyword_table = "mulh", MULH; "or", OR; "proj", PROJ; - "raise_withtrace", RAISE Cmm.Raise_withtrace; - "raise_notrace", RAISE Cmm.Raise_notrace; + "raise", RAISE Lambda.Raise_regular; + "reraise", RAISE Lambda.Raise_reraise; + "raise_notrace", RAISE Lambda.Raise_notrace; "seq", SEQ; "signed", SIGNED; "skip", SKIP; diff --git a/testsuite/tools/parsecmm.mly b/testsuite/tools/parsecmm.mly index d85cb59a..bb24f512 100644 --- a/testsuite/tools/parsecmm.mly +++ b/testsuite/tools/parsecmm.mly @@ -127,7 +127,7 @@ let access_array base numelt size = %token OR %token POINTER %token PROJ -%token RAISE +%token RAISE %token RBRACKET %token RPAREN %token SEQ @@ -222,15 +222,19 @@ expr: { Cifthenelse($3, debuginfo (), $4, debuginfo (), $5, debuginfo ()) } | LPAREN SWITCH INTCONST expr caselist RPAREN { make_switch $3 $4 $5 } | LPAREN WHILE expr sequence RPAREN - { let body = + { + let lbl0 = Lambda.next_raise_count () in + let lbl1 = Lambda.next_raise_count () in + let body = match $3 with Cconst_int (x, _) when x <> 0 -> $4 - | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (), (Cexit(0,[])), + | _ -> Cifthenelse($3, debuginfo (), $4, debuginfo (), + (Cexit(lbl0,[])), debuginfo ()) in - Ccatch(Nonrecursive, [0, [], + Ccatch(Nonrecursive, [lbl0, [], Ctuple [], debuginfo ()], Ccatch(Recursive, - [1, [], Csequence(body, Cexit(1, [])), debuginfo ()], - Cexit(1, [])), debuginfo ()], Ctuple []) } + [lbl1, [], Csequence(body, Cexit(lbl1, [])), debuginfo ()], + Cexit(lbl1, []))) } | LPAREN EXIT IDENT exprlist RPAREN { Cexit(find_label $3, List.rev $4) } | LPAREN CATCH sequence WITH catch_handlers RPAREN @@ -242,25 +246,32 @@ expr: | LPAREN TRY sequence WITH bind_ident sequence RPAREN { unbind_ident $5; Ctrywith($3, $5, $6, debuginfo ()) } | LPAREN VAL expr expr RPAREN - { Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr], + { let open Asttypes in + Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr], debuginfo ()) } | LPAREN ADDRAREF expr expr RPAREN - { Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr], + { let open Asttypes in + Cop(Cload (Word_val, Mutable), [access_array $3 $4 Arch.size_addr], Debuginfo.none) } | LPAREN INTAREF expr expr RPAREN - { Cop(Cload (Word_int, Mutable), [access_array $3 $4 Arch.size_int], + { let open Asttypes in + Cop(Cload (Word_int, Mutable), [access_array $3 $4 Arch.size_int], Debuginfo.none) } | LPAREN FLOATAREF expr expr RPAREN - { Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float], + { let open Asttypes in + Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float], Debuginfo.none) } | LPAREN ADDRASET expr expr expr RPAREN - { Cop(Cstore (Word_val, Assignment), + { let open Lambda in + Cop(Cstore (Word_val, Assignment), [access_array $3 $4 Arch.size_addr; $5], Debuginfo.none) } | LPAREN INTASET expr expr expr RPAREN - { Cop(Cstore (Word_int, Assignment), + { let open Lambda in + Cop(Cstore (Word_int, Assignment), [access_array $3 $4 Arch.size_int; $5], Debuginfo.none) } | LPAREN FLOATASET expr expr expr RPAREN - { Cop(Cstore (Double_u, Assignment), + { let open Lambda in + Cop(Cstore (Double_u, Assignment), [access_array $3 $4 Arch.size_float; $5], Debuginfo.none) } ; exprlist: @@ -293,14 +304,14 @@ chunk: | VAL { Word_val } ; unaryop: - LOAD chunk { Cload ($2, Mutable) } + LOAD chunk { Cload ($2, Asttypes.Mutable) } | FLOATOFINT { Cfloatofint } | INTOFFLOAT { Cintoffloat } | RAISE { Craise $1 } | ABSF { Cabsf } ; binaryop: - STORE chunk { Cstore ($2, Assignment) } + STORE chunk { Cstore ($2, Lambda.Assignment) } | ADDI { Caddi } | SUBI { Csubi } | STAR { Cmuli } diff --git a/testsuite/typing b/testsuite/typing deleted file mode 100644 index 3fbfcec1..00000000 --- a/testsuite/typing +++ /dev/null @@ -1,40 +0,0 @@ -tests/basic -tests/basic-float -tests/basic-io -tests/basic-io-2 -tests/basic-manyargs -tests/basic-modules -tests/basic-more -tests/basic-multdef -tests/basic-private -tests/typing-extension-constructor -tests/typing-extensions -tests/typing-fstclassmod -tests/typing-gadts -tests/typing-immediate -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 -tests/typing-objects-bugs -tests/typing-poly -tests/typing-poly-bugs -tests/typing-polyvariants-bugs -tests/typing-polyvariants-bugs-2 -tests/typing-private -tests/typing-private-bugs -tests/typing-recmod -tests/typing-recordarg -tests/typing-rectypes-bugs -tests/typing-safe-linking -tests/typing-short-paths -tests/typing-signatures -tests/typing-sigsubst -tests/typing-typeparam -tests/typing-unboxed -tests/typing-warnings -tests/warnings diff --git a/tools/.depend b/tools/.depend index 0a471a1b..a4d18f4b 100644 --- a/tools/.depend +++ b/tools/.depend @@ -1,15 +1,3 @@ -addlabels.cmo : \ - ../parsing/parsetree.cmi \ - ../parsing/parse.cmi \ - ../parsing/longident.cmi \ - ../parsing/location.cmi \ - ../parsing/asttypes.cmi -addlabels.cmx : \ - ../parsing/parsetree.cmi \ - ../parsing/parse.cmx \ - ../parsing/longident.cmx \ - ../parsing/location.cmx \ - ../parsing/asttypes.cmi caml_tex.cmo : \ ../toplevel/toploop.cmi \ ../parsing/syntaxerr.cmi \ @@ -44,7 +32,7 @@ cmt2annot.cmo : \ ../typing/untypeast.cmi \ ../typing/types.cmi \ ../typing/typedtree.cmi \ - ../typing/tast_mapper.cmi \ + ../typing/tast_iterator.cmi \ ../typing/stypes.cmi \ ../parsing/pprintast.cmi \ ../typing/path.cmi \ @@ -61,7 +49,7 @@ cmt2annot.cmx : \ ../typing/untypeast.cmx \ ../typing/types.cmx \ ../typing/typedtree.cmx \ - ../typing/tast_mapper.cmx \ + ../typing/tast_iterator.cmx \ ../typing/stypes.cmx \ ../parsing/pprintast.cmx \ ../typing/path.cmx \ @@ -162,8 +150,6 @@ objinfo.cmx : \ ../file_formats/cmo_format.cmi \ ../file_formats/cmi_format.cmx \ ../bytecomp/bytesections.cmx -ocaml299to3.cmo : -ocaml299to3.cmx : ocamlcp.cmo : \ ../driver/main_args.cmi ocamlcp.cmx : \ @@ -227,8 +213,6 @@ read_cmt.cmx : \ ../file_formats/cmt_format.cmx \ cmt2annot.cmx \ ../utils/clflags.cmx -scrapelabels.cmo : -scrapelabels.cmx : stripdebug.cmo : \ ../utils/misc.cmi \ ../bytecomp/bytesections.cmi diff --git a/tools/Makefile b/tools/Makefile index 663961f6..18aead93 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -81,12 +81,10 @@ INCLUDES = $(addprefix -I $(ROOTDIR)/,utils parsing typing bytecomp \ middle_end/flambda/base_types driver toplevel \ file_formats lambda) COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -strict-sequence -warn-error A \ - -safe-string -strict-formats -bin-annot $(INCLUDES) + -principal -safe-string -strict-formats -bin-annot $(INCLUDES) LINKFLAGS = $(INCLUDES) VPATH := $(filter-out -I,$(INCLUDES)) -# scrapelabels addlabels - .PHONY: all allopt opt.opt # allopt and opt.opt are synonyms allopt: opt.opt @@ -123,7 +121,9 @@ $(call byte_and_opt,ocamlprof,$(CSLPROF_IMPORTS) profiling.cmo $(CSLPROF),) ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \ warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \ - clflags.cmo main_args.cmo + clflags.cmo \ + terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \ + main_args.cmo $(call byte_and_opt,ocamlcp,$(ocamlcp_cmos) ocamlcp.cmo,) @@ -168,57 +168,14 @@ clean:: OCAMLMKTOP=ocamlmktop.cmo OCAMLMKTOP_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo \ identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \ - load_path.cmo ccomp.cmo + load_path.cmo profile.cmo ccomp.cmo $(call byte_and_opt,ocamlmktop,$(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP),) # Converter olabl/ocaml 2.99 to ocaml 3 -OCAML299TO3=lexer299.cmo ocaml299to3.cmo LIBRARY3=config.cmo build_path_prefix_map.cmo misc.cmo warnings.cmo location.cmo -ocaml299to3: $(OCAML299TO3) - $(CAMLC) $(LINKFLAGS) -o ocaml299to3 $(LIBRARY3) $(OCAML299TO3) - -lexer299.ml: lexer299.mll - $(CAMLLEX) lexer299.mll - -#install:: -# $(INSTALL_PROG) ocaml299to3 "$(INSTALL_BINDIR)/ocaml299to3$(EXE)" - -clean:: - rm -f ocaml299to3 lexer299.ml - -# Label remover for interface files (upgrade 3.02 to 3.03) - -SCRAPELABELS= lexer301.cmo scrapelabels.cmo - -scrapelabels: $(SCRAPELABELS) - $(CAMLC) $(LINKFLAGS) -o scrapelabels $(LIBRARY3) $(SCRAPELABELS) - -lexer301.ml: lexer301.mll - $(CAMLLEX) lexer301.mll - -#install:: -# $(INSTALL_PROG) scrapelabels "$(INSTALL_LIBDIR)" - -clean:: - rm -f scrapelabels lexer301.ml - -# Insert labels following an interface file (upgrade 3.02 to 3.03) - -ADDLABELS_IMPORTS=config.cmo build_path_prefix_map.cmo misc.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 - -addlabels: addlabels.cmo - $(CAMLC) $(LINKFLAGS) -w sl -o addlabels \ - $(ADDLABELS_IMPORTS) addlabels.cmo - -#install:: -# $(INSTALL_PROG) addlabels "$(INSTALL_LIBDIR)" - ifeq ($(UNIX_OR_WIN32),unix) LN := ln -sf else @@ -247,9 +204,6 @@ else done endif -clean:: - rm -f addlabels - # The preprocessor for asm generators CVT_EMIT=cvt_emit.cmo @@ -263,9 +217,6 @@ cvt_emit: $(CVT_EMIT) clean:: if test -f cvt_emit; then mv -f cvt_emit cvt_emit.bak; else :; fi -cvt_emit.ml: cvt_emit.mll - $(CAMLLEX) cvt_emit.mll - clean:: rm -f cvt_emit.ml @@ -300,9 +251,6 @@ DUMPOBJ= \ $(call byte_and_opt,dumpobj,$(DUMPOBJ),) -make_opcodes.ml: make_opcodes.mll - $(CAMLLEX) make_opcodes.mll - make_opcodes: make_opcodes.ml $(CAMLC) make_opcodes.ml -o $@ @@ -316,10 +264,14 @@ beforedepend:: opnames.ml # Display info on compiled files +DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""' + ifeq "$(SYSTEM)" "macosx" DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"' -else -DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""' +endif + +ifeq "$(SYSTEM)" "cygwin" +DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"' endif objinfo_helper$(EXE): objinfo_helper.$(O) @@ -413,7 +365,8 @@ clean:: # Common stuff -.SUFFIXES: +%.ml: %.mll + $(CAMLLEX) $(OCAMLLEX_FLAGS) $< %.cmo: %.ml $(CAMLC) -c $(COMPFLAGS) - $< diff --git a/tools/addlabels.ml b/tools/addlabels.ml deleted file mode 100644 index 2153b37c..00000000 --- a/tools/addlabels.ml +++ /dev/null @@ -1,469 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jacques Garrigue, Kyoto University RIMS *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* Copyright 2001 Kyoto University *) -(* *) -(* 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 StdLabels -open Asttypes -open Parsetree - -let norec = ref false - -let input_file file = - let ic = try open_in file with _ -> failwith ("input_file : " ^ file) in - let b = Buffer.create 1024 in - let buf = String.create 1024 and len = ref 0 in - while len := input ic buf 0 1024; !len > 0 do - Buffer.add_substring b buf 0 !len - done; - close_in ic; - Buffer.contents b - -module SMap = struct - include Map.Make(struct type t = string let compare = compare end) - let rec removes l m = - match l with [] -> m - | k::l -> - let m = try remove k m with Not_found -> m in - removes l m -end - -let rec labels_of_sty sty = - match sty.ptyp_desc with - Ptyp_arrow (lab, _, rem) -> lab :: labels_of_sty rem - | Ptyp_alias (rem, _) -> labels_of_sty rem - | _ -> [] - -let rec labels_of_cty cty = - match cty.pcty_desc with - Pcty_arrow (lab, _, rem) -> - let (labs, meths) = labels_of_cty rem in - (lab :: labs, meths) - | Pcty_signature { pcsig_fields = fields } -> - ([], - List.fold_left fields ~init:[] ~f: - begin fun meths -> function - { pctf_desc = Pctf_meth (s, _, sty) } -> (s, labels_of_sty sty)::meths - | _ -> meths - end) - | _ -> - ([],[]) - -let rec pattern_vars pat = - match pat.ppat_desc with - Ppat_var s -> [s.txt] - | Ppat_alias (pat, s) -> - s.txt :: pattern_vars pat - | Ppat_tuple l - | Ppat_array l -> - List.concat (List.map pattern_vars l) - | Ppat_construct (_, Some pat) - | Ppat_variant (_, Some pat) - | Ppat_constraint (pat, _) -> - pattern_vars pat - | Ppat_record(l, _) -> - List.concat (List.map l ~f:(fun (_,p) -> pattern_vars p)) - | Ppat_or (pat1, pat2) -> - pattern_vars pat1 @ pattern_vars pat2 - | Ppat_lazy pat -> pattern_vars pat - | Ppat_any | Ppat_constant _ | Ppat_construct _ | Ppat_variant _ - | Ppat_type _ | Ppat_unpack _ -> - [] - -let pattern_name pat = - match pat.ppat_desc with - Ppat_var s -> Some s - | Ppat_constraint ({ppat_desc = Ppat_var s}, _) -> Some s - | _ -> None - -let insertions = ref [] -let add_insertion pos s = insertions := (pos,s) :: !insertions -let sort_insertions () = - List.sort !insertions ~cmp:(fun (pos1,_) (pos2,_) -> pos1 - pos2) - -let is_space = function ' '|'\t'|'\n'|'\r' -> true | _ -> false -let is_alphanum = function 'A'..'Z'|'a'..'z'|'_'|'\192'..'\214'|'\216'..'\246' - | '\248'..'\255'|'\''|'0'..'9' -> true - | _ -> false - -(* Remove "(" or "begin" before a pattern *) -let rec insertion_point pos ~text = - let pos' = ref (pos-1) in - while is_space text.[!pos'] do decr pos' done; - if text.[!pos'] = '(' then insertion_point !pos' ~text else - if !pos' >= 5 && String.sub text ~pos:(!pos'-4) ~len:5 = "begin" - && not (is_alphanum text.[!pos'-5]) then insertion_point (!pos'-4) ~text - else pos - -(* Search "=" or "->" before "function" *) -let rec insertion_point2 pos ~text = - let pos' = ref (pos-1) in - while is_space text.[!pos'] do decr pos' done; - if text.[!pos'] = '(' then insertion_point2 !pos' ~text else - if !pos' >= 5 && String.sub text ~pos:(!pos'-4) ~len:5 = "begin" - && not (is_alphanum text.[!pos'-5]) then insertion_point2 (!pos'-4) ~text - else if text.[!pos'] = '=' then Some !pos' else - if !pos' >= 1 && text.[!pos'-1] = '-' && text.[!pos'] = '>' - then Some (!pos' - 1) - else None - -let rec insert_labels ~labels ~text expr = - match labels, expr.pexp_desc with - l::labels, Pexp_function(l', _, [pat, rem]) -> - if l <> "" && l.[0] <> '?' && l' = "" then begin - let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in - let pos = insertion_point start_c ~text in - match pattern_name pat with - | Some name when l = name.txt -> add_insertion pos "~" - | _ -> add_insertion pos ("~" ^ l ^ ":") - end; - insert_labels ~labels ~text rem - | l::labels, Pexp_function(l', _, lst) -> - let pos = expr.pexp_loc.Location.loc_start.Lexing.pos_cnum in - if l <> "" && l.[0] <> '?' && l' = "" - && String.sub text ~pos ~len:8 = "function" then begin - String.blit ~src:"match th" ~src_pos:0 ~dst:text - ~dst_pos:pos ~len:8; - add_insertion (pos+6) (l ^ " wi"); - match insertion_point2 pos ~text with - Some pos' -> - add_insertion pos' ("~" ^ l ^ " ") - | None -> - add_insertion pos ("fun ~" ^ l ^ " -> ") - end; - List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e) - | _, Pexp_match( _, lst) -> - List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e) - | _, Pexp_try(expr, lst) -> - insert_labels ~labels ~text expr; - List.iter lst ~f:(fun (p,e) -> insert_labels ~labels ~text e) - | _, ( Pexp_let(_,_,e) | Pexp_sequence(_,e) | Pexp_when(_,e) - | Pexp_constraint(e,_,_) | Pexp_letmodule(_,_,e) - | Pexp_ifthenelse(_,e,None) ) -> - insert_labels ~labels ~text e - | _, Pexp_ifthenelse (_, e1, Some e2) -> - insert_labels ~labels ~text e1; - insert_labels ~labels ~text e2 - | _ -> - () - -let rec insert_labels_class ~labels ~text expr = - match labels, expr.pcl_desc with - l::labels, Pcl_fun(l', _, pat, rem) -> - if l <> "" && l.[0] <> '?' && l' = "" then begin - let start_c = pat.ppat_loc.Location.loc_start.Lexing.pos_cnum in - let pos = insertion_point start_c ~text in - match pattern_name pat with - | Some name when l = name.txt -> add_insertion pos "~" - | _ -> add_insertion pos ("~" ^ l ^ ":") - end; - insert_labels_class ~labels ~text rem - | labels, (Pcl_constraint (expr, _) | Pcl_let (_, _, expr)) -> - insert_labels_class ~labels ~text expr - | _ -> - () - -let rec insert_labels_type ~labels ~text ty = - match labels, ty.ptyp_desc with - l::labels, Ptyp_arrow(l', _, rem) -> - if l <> "" && l.[0] <> '?' && l' = "" then begin - let start_c = ty.ptyp_loc.Location.loc_start.Lexing.pos_cnum in - let pos = insertion_point start_c ~text in - add_insertion pos (l ^ ":") - end; - insert_labels_type ~labels ~text rem - | _ -> - () - -let rec insert_labels_app ~labels ~text args = - match labels, args with - l::labels, (l',arg)::args -> - if l <> "" && l.[0] <> '?' && l' = "" then begin - let pos0 = arg.pexp_loc.Location.loc_start.Lexing.pos_cnum in - let pos = insertion_point pos0 ~text in - match arg.pexp_desc with - | Pexp_ident({ txt = Longident.Lident name }) - when l = name && pos = pos0 -> - add_insertion pos "~" - | _ -> add_insertion pos ("~" ^ l ^ ":") - end; - insert_labels_app ~labels ~text args - | _ -> - () - -let insert_labels_app ~labels ~text args = - let labels, opt_labels = - List.partition labels ~f:(fun l -> l = "" || l.[0] <> '?') in - let nopt_labels = - List.map opt_labels - ~f:(fun l -> String.sub l ~pos:1 ~len:(String.length l - 1)) in - (* avoid ambiguous labels *) - if List.exists labels ~f:(List.mem ~set:nopt_labels) then () else - let aopt_labels = opt_labels @ nopt_labels in - let args, lab_args = List.partition args ~f:(fun (l,_) -> l = "") in - (* only optional arguments are labeled *) - if List.for_all lab_args ~f:(fun (l,_) -> List.mem l ~set:aopt_labels) - then insert_labels_app ~labels ~text args - -let rec add_labels_expr ~text ~values ~classes expr = - let add_labels_rec ?(values=values) expr = - add_labels_expr ~text ~values ~classes expr in - match expr.pexp_desc with - Pexp_apply ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })}, args) -> - begin try - let labels = SMap.find s values in - insert_labels_app ~labels ~text args - with Not_found -> () - end; - List.iter args ~f:(fun (_,e) -> add_labels_rec e) - | Pexp_apply ({pexp_desc=Pexp_send - ({pexp_desc=Pexp_ident({ txt = Longident.Lident s })}, - meth)}, - args) -> - begin try - if SMap.find s values = [""] then - let labels = SMap.find (s ^ "#" ^ meth) values in - insert_labels_app ~labels ~text args - with Not_found -> () - end - | Pexp_apply ({pexp_desc=Pexp_new ({ txt = Longident.Lident s })}, args) -> - begin try - let labels = SMap.find s classes in - insert_labels_app ~labels ~text args - with Not_found -> () - end - | Pexp_let (recp, lst, expr) -> - let vars = List.concat (List.map lst ~f:(fun (p,_) -> pattern_vars p)) in - let vals = SMap.removes vars values in - List.iter lst ~f: - begin fun (_,e) -> - add_labels_rec e ~values:(if recp = Recursive then vals else values) - end; - add_labels_rec expr ~values:vals - | Pexp_function (_, None, lst) -> - List.iter lst ~f: - (fun (p,e) -> - add_labels_rec e ~values:(SMap.removes (pattern_vars p) values)) - | Pexp_function (_, Some e, lst) - | Pexp_match (e, lst) - | Pexp_try (e, lst) -> - add_labels_rec e; - List.iter lst ~f: - (fun (p,e) -> - add_labels_rec e ~values:(SMap.removes (pattern_vars p) values)) - | Pexp_apply (e, args) -> - List.iter add_labels_rec (e :: List.map snd args) - | Pexp_tuple l | Pexp_array l -> - List.iter add_labels_rec l - | Pexp_construct (_, Some e) - | Pexp_variant (_, Some e) - | Pexp_field (e, _) - | Pexp_constraint (e, _, _) - | Pexp_send (e, _) - | Pexp_setinstvar (_, e) - | Pexp_letmodule (_, _, e) - | Pexp_assert e - | Pexp_lazy e - | Pexp_poly (e, _) - | Pexp_newtype (_, e) - | Pexp_open (_, e) -> - add_labels_rec e - | Pexp_record (lst, opt) -> - List.iter lst ~f:(fun (_,e) -> add_labels_rec e); - begin match opt with Some e -> add_labels_rec e | None -> () end - | Pexp_setfield (e1, _, e2) - | Pexp_ifthenelse (e1, e2, None) - | Pexp_sequence (e1, e2) - | Pexp_while (e1, e2) - | Pexp_when (e1, e2) -> - add_labels_rec e1; add_labels_rec e2 - | Pexp_ifthenelse (e1, e2, Some e3) -> - add_labels_rec e1; add_labels_rec e2; add_labels_rec e3 - | Pexp_for (s, e1, e2, _, e3) -> - add_labels_rec e1; add_labels_rec e2; - add_labels_rec e3 ~values:(SMap.removes [s.txt] values) - | Pexp_override lst -> - List.iter lst ~f:(fun (_,e) -> add_labels_rec e) - | Pexp_ident _ | Pexp_constant _ | Pexp_construct _ | Pexp_variant _ - | Pexp_new _ | Pexp_object _ | Pexp_pack _ -> - () - -let rec add_labels_class ~text ~classes ~values ~methods cl = - match cl.pcl_desc with - Pcl_constr _ -> () - | Pcl_structure { pcstr_self = p; pcstr_fields = l } -> - let values = SMap.removes (pattern_vars p) values in - let values = - match pattern_name p with None -> values - | Some s -> - List.fold_left methods - ~init:(SMap.add s.txt [""] values) - ~f:(fun m (k,l) -> SMap.add (s.txt^"#"^k) l m) - in - ignore (List.fold_left l ~init:values ~f: - begin fun values -> function e -> match e.pcf_desc with - | Pcf_val (s, _, _, e) -> - add_labels_expr ~text ~classes ~values e; - SMap.removes [s.txt] values - | Pcf_meth (s, _, _, e) -> - begin try - let labels = List.assoc s.txt methods in - insert_labels ~labels ~text e - with Not_found -> () - end; - add_labels_expr ~text ~classes ~values e; - values - | Pcf_init e -> - add_labels_expr ~text ~classes ~values e; - values - | Pcf_inher _ | Pcf_valvirt _ | Pcf_virt _ | Pcf_constr _ -> values - end) - | Pcl_fun (_, opt, pat, cl) -> - begin match opt with None -> () - | Some e -> add_labels_expr ~text ~classes ~values e - end; - let values = SMap.removes (pattern_vars pat) values in - add_labels_class ~text ~classes ~values ~methods cl - | Pcl_apply (cl, args) -> - List.iter args ~f:(fun (_,e) -> add_labels_expr ~text ~classes ~values e); - add_labels_class ~text ~classes ~values ~methods cl - | Pcl_let (recp, lst, cl) -> - let vars = List.concat (List.map lst ~f:(fun (p,_) -> pattern_vars p)) in - let vals = SMap.removes vars values in - List.iter lst ~f: - begin fun (_,e) -> - add_labels_expr e ~text ~classes - ~values:(if recp = Recursive then vals else values) - end; - add_labels_class cl ~text ~classes ~values:vals ~methods - | Pcl_constraint (cl, _) -> - add_labels_class ~text ~classes ~values ~methods cl - -let add_labels ~intf ~impl ~file = - insertions := []; - let values, classes = - List.fold_left intf ~init:(SMap.empty, SMap.empty) ~f: - begin fun (values, classes as acc) item -> - match item.psig_desc with - Psig_value (name, {pval_type = sty}) -> - (SMap.add name.txt (labels_of_sty sty) values, classes) - | Psig_class l -> - (values, - List.fold_left l ~init:classes ~f: - begin fun classes {pci_name=name; pci_expr=cty} -> - SMap.add name.txt (labels_of_cty cty) classes - end) - | _ -> - acc - end - in - let text = input_file file in - ignore (List.fold_right impl ~init:(values, classes) ~f: - begin fun item (values, classes as acc) -> - match item.pstr_desc with - Pstr_value (recp, l) -> - let names = - List.concat (List.map l ~f:(fun (p,_) -> pattern_vars p)) in - List.iter l ~f: - begin fun (pat, expr) -> - begin match pattern_name pat with - | Some s -> - begin try - let labels = SMap.find s.txt values in - insert_labels ~labels ~text expr; - if !norec then () else - let values = - SMap.fold - (fun s l m -> - if List.mem s names then SMap.add s l m else m) - values SMap.empty in - add_labels_expr expr ~text ~values ~classes:SMap.empty - with Not_found -> () - end - | None -> () - end; - end; - (SMap.removes names values, classes) - | Pstr_primitive (s, {pval_type=sty}) -> - begin try - let labels = SMap.find s.txt values in - insert_labels_type ~labels ~text sty; - (SMap.removes [s.txt] values, classes) - with Not_found -> acc - end - | Pstr_class l -> - let names = List.map l ~f:(fun pci -> pci.pci_name.txt) in - List.iter l ~f: - begin fun {pci_name=name; pci_expr=expr} -> - try - let (labels, methods) = SMap.find name.txt classes in - insert_labels_class ~labels ~text expr; - if !norec then () else - let classes = - SMap.fold - (fun s (l,_) m -> - if List.mem s names then SMap.add s l m else m) - classes SMap.empty in - add_labels_class expr ~text ~classes ~methods - ~values:SMap.empty - with Not_found -> () - end; - (values, SMap.removes names classes) - | _ -> - acc - end); - if !insertions <> [] then begin - let backup = file ^ ".bak" in - if Sys.file_exists backup then Sys.remove file - else Sys.rename file backup; - let oc = open_out file in - let last_pos = - List.fold_left (sort_insertions ()) ~init:0 ~f: - begin fun pos (pos', s) -> - output oc text pos (pos'-pos); - output_string oc s; - pos' - end in - if last_pos < String.length text then - output oc text last_pos (String.length text - last_pos); - close_out oc - end - else prerr_endline ("No labels to insert in " ^ file) - -let process_file file = - prerr_endline ("Processing " ^ file); - if Filename.check_suffix file ".ml" then - let intf = Filename.chop_suffix file ".ml" ^ ".mli" in - let ic = open_in intf in - let lexbuf = Lexing.from_channel ic in - Location.init lexbuf intf; - let intf = Parse.interface lexbuf in - close_in ic; - let ic = open_in file in - let lexbuf = Lexing.from_channel ic in - Location.init lexbuf file; - let impl = Parse.implementation lexbuf in - close_in ic; - add_labels ~intf ~impl ~file - else prerr_endline (file ^ " is not an implementation") - -let main () = - let files = ref [] in - Arg.parse ["-norec", Arg.Set norec, "do not labelize recursive calls"] - (fun f -> files := f :: !files) - "addlabels [-norec] "; - let files = List.rev !files in - List.iter files ~f:process_file - -let () = main () diff --git a/tools/caml_tex.ml b/tools/caml_tex.ml index d003171d..ae89477d 100644 --- a/tools/caml_tex.ml +++ b/tools/caml_tex.ml @@ -19,39 +19,46 @@ open StdLabels open Str -let camlbegin = "\\caml" -let camlend = "\\endcaml" -let camlin = {|\\?\1|} -let camlout = {|\\:\1|} -let camlbunderline = "\\<" -let camleunderline = "\\>" - -let start newline out s args = - Format.fprintf out "%s%s" camlbegin s; +let camlprefix = "caml" + +let latex_escape s = String.concat "" ["$"; s; "$"] +let camlin = latex_escape {|\\?|} ^ {|\1|} +let camlout = latex_escape {|\\:|} ^ {|\1|} +let camlbunderline = "<<" +let camleunderline = ">>" + + +(** Restrict the number of latex environment *) +type env = Env of string +let main = Env "example" +let input_env = Env "input" +let ok_output = Env "output" +let error = Env "error" +let warning = Env "warn" +let phrase_env = Env "" + +let start out (Env s) args = + Format.fprintf out "\\begin{%s%s}" camlprefix s; List.iter (Format.fprintf out "{%s}") args; - if newline then Format.fprintf out "\n" + Format.fprintf out "\n" -let stop newline out s = - Format.fprintf out "%s%s" camlend s; - if newline then Format.fprintf out "\n" +let stop out (Env s) = + Format.fprintf out "\\end{%s%s}" camlprefix s; + Format.fprintf out "\n" -let code_env ?(newline=true) env out s = +let code_env env out s = let sep = if s.[String.length s - 1] = '\n' then "" else "\n" in Format.fprintf out "%a%s%s%a" - (fun ppf env -> start false ppf env []) env s sep (stop newline) env + (fun ppf env -> start ppf env []) + env s sep stop env + -let main = "example" type example_mode = Toplevel | Verbatim | Signature let string_of_mode = function | Toplevel -> "toplevel" | Verbatim -> "verbatim" | Signature -> "signature" -let input_env = "input" -let ok_output ="output" -let error ="error" -let warning ="warn" -let phrase_env = "" let verbose = ref true let linelen = ref 72 @@ -417,25 +424,23 @@ module Text_transform = struct let ellipsis start stop = { kind = Ellipsis; start; stop } let escape_specials s = - let s1 = global_replace ~!"\\\\" "\\\\\\\\" s in - let s2 = global_replace ~!"'" "\\\\textquotesingle\\\\-" s1 in - let s3 = global_replace ~!"`" "\\\\textasciigrave\\\\-" s2 in - s3 + s + |> global_replace ~!{|\$|} {|$\textdollar$|} let rec apply_transform input (pos,underline_stop,out) t = if pos >= String.length input then pos, underline_stop, out else match underline_stop with | Some stop when stop <= t.start -> let f = escape_specials (String.sub input ~pos ~len:(stop - pos)) in - let out = {|\>|} :: f :: out in + let out = camleunderline :: f :: out in apply_transform input (stop,None,out) t | _ -> let out = escape_specials (String.sub input ~pos ~len:(t.start - pos))::out in match t.kind with - | Ellipsis -> t.stop, underline_stop, {|\ldots|} :: out + | Ellipsis -> t.stop, underline_stop, latex_escape {|\ldots|} :: out | Underline -> - t.start, Some t.stop, {|\<|} :: out + t.start, Some t.stop, camlbunderline :: out (** Check that all ellipsis are strictly nested inside underline transform and that otherwise no transform starts before the end of the previous @@ -483,7 +488,7 @@ module Text_transform = struct | None -> last, ls | Some stop -> let f = escape_specials (String.sub s ~pos:last ~len:(stop - last)) in - stop, {|\>|} :: f :: ls in + stop, camleunderline :: f :: ls in let ls = let n = String.length s in if last = n then ls else @@ -614,7 +619,7 @@ let process_file file = | Toplevel -> true in let global_expected = try Output.expected @@ matched_group 4 !input with Not_found -> Output.Ok in - start true tex_fmt main [string_of_mode mode]; + start tex_fmt main [string_of_mode mode]; let first = ref true in let read_phrase () = let phrase = Buffer.create 256 in @@ -692,16 +697,16 @@ let process_file file = global_replace ~!{|^\(.\)|} camlout error_msgs else if omit_answer then "" else output in - start false tex_fmt phrase_env []; - code_env ~newline:omit_answer input_env tex_fmt phrase; + start tex_fmt phrase_env []; + code_env input_env tex_fmt phrase; if String.length final_output > 0 then - code_env ~newline:false (Output.env status) tex_fmt final_output; - stop true tex_fmt phrase_env; + code_env (Output.env status) tex_fmt final_output; + stop tex_fmt phrase_env; flush oc; first := false; if implicit_stop then raise End_of_file done - with End_of_file -> phrase_start:= !phrase_stop; stop true tex_fmt main + with End_of_file -> phrase_start:= !phrase_stop; stop tex_fmt main end else if string_match ~!"\\\\begin{caml_eval}[ \t]*$" !input 0 then begin diff --git a/tools/check-parser-uptodate-or-warn.sh b/tools/check-parser-uptodate-or-warn.sh index 2f07619a..32c8e745 100755 --- a/tools/check-parser-uptodate-or-warn.sh +++ b/tools/check-parser-uptodate-or-warn.sh @@ -46,7 +46,7 @@ fi mtime() { if test -z "$MTIME" then echo 0 - else $MTIME $1 + else $MTIME "$1" fi } diff --git a/tools/ci/appveyor/appveyor_build.cmd b/tools/ci/appveyor/appveyor_build.cmd index bed57e6f..1c3d3078 100644 --- a/tools/ci/appveyor/appveyor_build.cmd +++ b/tools/ci/appveyor/appveyor_build.cmd @@ -85,7 +85,7 @@ set CYGWIN_UPGRADE_REQUIRED=0 for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P call :UpgradeCygwin -"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1 +"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1 goto :EOF @@ -95,18 +95,18 @@ if "%PORT%" equ "msvc64" ( call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat" ) rem Do the main build (either msvc64 or mingw32) -"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1 +"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1 if "%PORT%" neq "msvc64" goto :EOF rem Reconfigure the environment and run the msvc32 partial build endlocal call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x86 -"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1 +"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1 goto :EOF :test rem Reconfigure the environment for the msvc64 build call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat" -"%CYG_ROOT%\bin\bash.exe" -lec "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1 +"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1 goto :EOF diff --git a/tools/ci/appveyor/appveyor_build.sh b/tools/ci/appveyor/appveyor_build.sh index 055ef3f5..bc8e0355 100644 --- a/tools/ci/appveyor/appveyor_build.sh +++ b/tools/ci/appveyor/appveyor_build.sh @@ -13,17 +13,19 @@ #* * #************************************************************************** +set -e + BUILD_PID=0 function run { NAME=$1 shift echo "-=-=- $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" - $@ + "$@" CODE=$? - if [ $CODE -ne 0 ]; then + if [[ $CODE -ne 0 ]] ; then echo "-=-=- $NAME failed! -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-" - if [ $BUILD_PID -ne 0 ] ; then + if [[ $BUILD_PID -ne 0 ]] ; then kill -KILL $BUILD_PID 2>/dev/null wait $BUILD_PID 2>/dev/null fi @@ -58,91 +60,91 @@ function set_configuration { FILE=$(pwd | cygpath -f - -m)/Makefile.config echo "Edit $FILE to turn C compiler warnings into errors" - sed -i -e "/^ *OC_CFLAGS *=/s/\r\?$/ $3\0/" $FILE + sed -i -e '/^ *OC_CFLAGS *=/s/\r\?$/ '"$3"'\0/' "$FILE" # run "Content of $FILE" cat Makefile.config } -APPVEYOR_BUILD_FOLDER=$(echo $APPVEYOR_BUILD_FOLDER| cygpath -f -) +APPVEYOR_BUILD_FOLDER=$(echo "$APPVEYOR_BUILD_FOLDER" | cygpath -f -) # These directory names are specified here, because getting UTF-8 correctly # through appveyor.yml -> Command Script -> Bash is quite painful... -OCAMLROOT=$(echo $PROGRAMFILES/Бактріан🐫| cygpath -f - -m) +OCAMLROOT=$(echo "$PROGRAMFILES/Бактріан🐫" | cygpath -f - -m) # This must be kept in sync with appveyor_build.cmd BUILD_PREFIX=🐫реализация -export PATH=$(echo $OCAMLROOT| cygpath -f -)/bin/flexdll:$PATH +PATH=$(echo "$OCAMLROOT" | cygpath -f -)/bin/flexdll:$PATH case "$1" in install) mkdir -p "$OCAMLROOT/bin/flexdll" - cd $APPVEYOR_BUILD_FOLDER/../flexdll + cd "$APPVEYOR_BUILD_FOLDER/../flexdll" # msvc64 objects need to be compiled with VS2015, so are copied later from # a source build. for f in flexdll.h flexlink.exe flexdll*_msvc.obj default*.manifest ; do - cp $f "$OCAMLROOT/bin/flexdll/" + cp "$f" "$OCAMLROOT/bin/flexdll/" done - if [ "$PORT" = "msvc64" ] ; then + if [[ $PORT = 'msvc64' ]] ; then echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \ >> ~/.bash_profile fi ;; msvc32-only) - cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32 + cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32" set_configuration msvc "$OCAMLROOT-msvc32" -WX - run "make world" make world - run "make runtimeopt" make runtimeopt - run "make -C otherlibs/systhreads libthreadsnat.lib" \ + run 'make world' make world + run 'make runtimeopt' make runtimeopt + run 'make -C otherlibs/systhreads libthreadsnat.lib' \ make -C otherlibs/systhreads libthreadsnat.lib exit 0 ;; test) - FULL_BUILD_PREFIX=$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX - run "ocamlc.opt -version" $FULL_BUILD_PREFIX-$PORT/ocamlc.opt -version - run "test $PORT" make -C $FULL_BUILD_PREFIX-$PORT tests - run "install $PORT" make -C $FULL_BUILD_PREFIX-$PORT install - if [ "$PORT" = "msvc64" ] ; then - run "check_all_arches" make -C $FULL_BUILD_PREFIX-$PORT check_all_arches + FULL_BUILD_PREFIX="$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX" + run 'ocamlc.opt -version' "$FULL_BUILD_PREFIX-$PORT/ocamlc.opt" -version + run "test $PORT" make -C "$FULL_BUILD_PREFIX-$PORT" tests + run "install $PORT" make -C "$FULL_BUILD_PREFIX-$PORT" install + if [[ $PORT = 'msvc64' ]] ; then + run 'check_all_arches' make -C "$FULL_BUILD_PREFIX-$PORT" check_all_arches fi ;; *) - cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT + cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT" - if [ "$PORT" = "msvc64" ] ; then - tar -xzf $APPVEYOR_BUILD_FOLDER/flexdll.tar.gz - cd flexdll-$FLEXDLL_VERSION + if [[ $PORT = 'msvc64' ]] ; then + tar -xzf "$APPVEYOR_BUILD_FOLDER/flexdll.tar.gz" + cd "flexdll-$FLEXDLL_VERSION" make MSVC_DETECT=0 CHAINS=msvc64 support cp flexdll*_msvc64.obj "$OCAMLROOT/bin/flexdll/" cd .. fi - if [ "$PORT" = "msvc64" ] ; then + if [[ $PORT = 'msvc64' ]] ; then set_configuration msvc64 "$OCAMLROOT" -WX else set_configuration mingw "$OCAMLROOT-mingw32" -Werror fi - cd $APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT + cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT" export TERM=ansi - if [ "$PORT" = "mingw32" ] ; then + if [[ $PORT = 'mingw32' ]] ; then set -o pipefail # For an explanation of the sed command, see # https://github.com/appveyor/ci/issues/1824 script --quiet --return --command \ "make -C ../$BUILD_PREFIX-mingw32 flexdll world.opt" \ - ../$BUILD_PREFIX-mingw32/build.log | + "../$BUILD_PREFIX-mingw32/build.log" | sed -e 's/\d027\[K//g' \ -e 's/\d027\[m/\d027[0m/g' \ -e 's/\d027\[01\([m;]\)/\d027[1\1/g' else - run "make world" make world - run "make bootstrap" make bootstrap - run "make opt" make opt - run "make opt.opt" make opt.opt + run 'make world' make world + run 'make bootstrap' make bootstrap + run 'make opt' make opt + run 'make opt.opt' make opt.opt fi ;; diff --git a/tools/ci/inria/extra-checks b/tools/ci/inria/extra-checks index 64b851bb..9e2afc4a 100755 --- a/tools/ci/inria/extra-checks +++ b/tools/ci/inria/extra-checks @@ -114,13 +114,36 @@ export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH" ######################################################################### -echo "======== clang 6.0, address sanitizer, UB sanitizer ==========" +# Ensure that the repo still passes the check-typo script +if [ ! -x tools/check-typo ] ; then + error "tools/check-typo does not appear to be executable?" +fi +tools/check-typo + +######################################################################### + +echo "======== old school build ==========" + +git clean -q -f -d -x + +instdir="$HOME/ocaml-tmp-install-$$" +./configure --prefix "$instdir" + +# Build the system without using world.opt +make $jobs world +make $jobs opt +make $jobs opt.opt +make install + +rm -rf "$instdir" -$make -s distclean || : +# It's a build system test only, so we don't bother testing the compiler -# `make distclean` does not clean the files from previous versions that -# are not produced by the current version, so use `git clean` in addition. -git clean -f -d -x +######################################################################### + +echo "======== clang 6.0, address sanitizer, UB sanitizer ==========" + +git clean -q -f -d -x # Use clang 6.0 # We cannot give the sanitizer options as part of -cc because @@ -160,17 +183,22 @@ LSAN_OPTIONS="suppressions=$(pwd)/tools/ci/inria/lsan-suppr.txt" \ make $jobs world.opt # Run the testsuite. -# The suppressed leak detections related to ocamlyacc mess up the output -# of the tests and are reported as failures by ocamltest. -# Hence, deactivate leak detection entirely. +# We deactivate leak detection for two reasons: +# - The suppressed leak detections related to ocamlyacc mess up the +# output of the tests and are reported as failures by ocamltest. +# - The Ocaml runtime does not free the memory when a fatal error +# occurs. -ASAN_OPTIONS="detect_leaks=0" $run_testsuite +# We already use sigaltstack for stack overflow detection. Our use +# interracts with ASAN's. Hence, we tell ASAN not to use it. + +ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite ######################################################################### echo "======== clang 6.0, thread sanitizer ==========" -$make -s distclean || : +git clean -q -f -d -x ./configure CC=clang-6.0 @@ -179,8 +207,7 @@ $make -s distclean || : set_config_var OC_CFLAGS "-O1 \ -fno-strict-aliasing -fwrapv -fno-omit-frame-pointer \ -Wall -Werror \ --fsanitize=thread \ --fsanitize-blacklist=$(pwd)/tools/ci/inria/tsan-suppr.txt" +-fsanitize=thread" # Build the system make $jobs world.opt @@ -199,7 +226,7 @@ TSAN_OPTIONS="die_after_fork=0" $run_testsuite # echo "======== clang 6.0, memory sanitizer ==========" -# $make -s distclean || : +# git clean -q -f -d -x # # Use clang 6.0 # # We cannot give the sanitizer options as part of -cc because @@ -223,11 +250,3 @@ TSAN_OPTIONS="die_after_fork=0" $run_testsuite # # Build the system (bytecode only) and test # make $jobs world # $run_testsuite - -######################################################################### - -# Ensure that the repo still passes the check-typo script -if [ ! -x tools/check-typo ] ; then - error "tools/check-typo does not appear to be executable?" -fi -tools/check-typo diff --git a/tools/ci/inria/main b/tools/ci/inria/main index e96da630..ca190321 100755 --- a/tools/ci/inria/main +++ b/tools/ci/inria/main @@ -222,11 +222,7 @@ done # Tell gcc to use only ASCII in its diagnostic outputs. export LC_ALL=C -$make -s distclean || : - -# `make distclean` does not clean the files from previous versions that -# are not produced by the current version, so use `git clean` in addition. -git clean -f -d -x +git clean -q -f -d -x if $flambda; then confoptions="$confoptions --enable-flambda --enable-flambda-invariants" @@ -235,10 +231,10 @@ fi eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions if $make_native; then - $make $jobs world.opt - if $check_make_alldepend; then $make alldepend; fi + $make $jobs --warn-undefined-variables + if $check_make_alldepend; then $make --warn-undefined-variables alldepend; fi else - $make $jobs world + $make $jobs --warn-undefined-variables fi if $dorebase; then # temporary solution to the cygwin fork problem @@ -246,11 +242,11 @@ if $dorebase; then rebase -b 0x7cd20000 otherlibs/unix/dllunix.so rebase -b 0x7cdc0000 otherlibs/systhreads/dllthreads.so fi -$make install +$make --warn-undefined-variables install rm -rf "$instdir" cd testsuite if test -n "$jobs" && test -x /usr/bin/parallel -then PARALLEL="$jobs $PARALLEL" $make parallel -else $make all +then PARALLEL="$jobs $PARALLEL" $make --warn-undefined-variables parallel +else $make --warn-undefined-variables all fi diff --git a/tools/ci/inria/tsan-suppr.txt b/tools/ci/inria/tsan-suppr.txt deleted file mode 100644 index 70521db6..00000000 --- a/tools/ci/inria/tsan-suppr.txt +++ /dev/null @@ -1,6 +0,0 @@ -# The treatment of pending signals involves unsynchronized accesses -fun:caml_record_signal -fun:caml_process_pending_signals -fun:caml_leave_blocking_section -# st_masterlock_waiters polls m->waiters without locking -fun:st_masterlock_waiters diff --git a/tools/ci/travis/travis-ci.sh b/tools/ci/travis/travis-ci.sh index d0d9098f..5aa1143a 100755 --- a/tools/ci/travis/travis-ci.sh +++ b/tools/ci/travis/travis-ci.sh @@ -14,6 +14,8 @@ #* * #************************************************************************** +set -e + # TRAVIS_COMMIT_RANGE has the form ... # TRAVIS_CUR_HEAD is # TRAVIS_PR_HEAD is @@ -28,22 +30,29 @@ # | / # TRAVIS_MERGE_BASE # -echo TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE -echo TRAVIS_COMMIT=$TRAVIS_COMMIT -if [[ $TRAVIS_EVENT_TYPE = "pull_request" ]] ; then +echo "TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE" +echo "TRAVIS_COMMIT=$TRAVIS_COMMIT" +if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]] ; then FETCH_HEAD=$(git rev-parse FETCH_HEAD) - echo FETCH_HEAD=$FETCH_HEAD + echo "FETCH_HEAD=$FETCH_HEAD" else FETCH_HEAD=$TRAVIS_COMMIT fi -if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then - echo "WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!" - if git cat-file -e $TRAVIS_COMMIT 2> /dev/null ; then - echo "TRAVIS_COMMIT exists, so going with it" - else - echo "TRAVIS_COMMIT does not exist; setting to FETCH_HEAD" - TRAVIS_COMMIT=$FETCH_HEAD +if [[ $TRAVIS_EVENT_TYPE = 'push' ]] ; then + if ! git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then + echo 'TRAVIS_COMMIT does not exist - CI failure' + exit 1 + fi +else + if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then + echo 'WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!' + if git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then + echo 'TRAVIS_COMMIT exists, so going with it' + else + echo 'TRAVIS_COMMIT does not exist; setting to FETCH_HEAD' + TRAVIS_COMMIT=$FETCH_HEAD + fi fi fi @@ -59,13 +68,13 @@ case $TRAVIS_EVENT_TYPE in # If this is not a pull request then TRAVIS_COMMIT_RANGE may be empty. pull_request) DEEPEN=50 - while ! git merge-base $TRAVIS_CUR_HEAD $TRAVIS_PR_HEAD > /dev/null 2>&1 + while ! git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD" >& /dev/null do - echo Deepening $TRAVIS_BRANCH by $DEEPEN commits - git fetch origin --deepen=$DEEPEN $TRAVIS_BRANCH + echo "Deepening $TRAVIS_BRANCH by $DEEPEN commits" + git fetch origin --deepen=$DEEPEN "$TRAVIS_BRANCH" ((DEEPEN*=2)) done - TRAVIS_MERGE_BASE=$(git merge-base $TRAVIS_CUR_HEAD $TRAVIS_PR_HEAD);; + TRAVIS_MERGE_BASE=$(git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD");; esac BuildAndTest () { @@ -81,17 +90,32 @@ request can be merged. ------------------------------------------------------------------------ EOF - configure_flags="\ - --prefix=$PREFIX \ - --enable-flambda-invariants \ - $CONFIG_ARG" + if [ "$MIN_BUILD" = "1" ] ; then + configure_flags="\ + --prefix=$PREFIX \ + --disable-shared \ + --disable-debug-runtime \ + --disable-instrumented-runtime \ + --disable-systhreads \ + --disable-str-lib \ + --disable-unix-lib \ + --disable-bigarray-lib \ + --disable-ocamldoc \ + --disable-native-compiler \ + $CONFIG_ARG" + else + configure_flags="\ + --prefix=$PREFIX \ + --enable-flambda-invariants \ + $CONFIG_ARG" + fi case $XARCH in x64) ./configure $configure_flags ;; i386) ./configure --build=x86_64-pc-linux-gnu --host=i386-pc-linux-gnu \ - AS="as" ASPP="gcc -c" \ + AS='as' ASPP='gcc -c' \ $configure_flags ;; *) @@ -101,17 +125,34 @@ EOF esac export PATH=$PREFIX/bin:$PATH - $MAKE world.opt - $MAKE ocamlnat + if [ "$MIN_BUILD" = "1" ] ; then + if $MAKE world.opt ; then + echo "world.opt is not supposed to work!" + exit 1 + else + $MAKE world + fi + else + $MAKE world.opt + $MAKE ocamlnat + fi cd testsuite echo Running the testsuite with the normal runtime $MAKE all - echo Running the testsuite with the debug runtime - $MAKE USE_RUNTIME="d" OCAMLTESTDIR=$(pwd)/_ocamltestd TESTLOG=_logd all + if [ "$MIN_BUILD" != "1" ] ; then + echo Running the testsuite with the debug runtime + $MAKE USE_RUNTIME='d' OCAMLTESTDIR="$(pwd)/_ocamltestd" TESTLOG=_logd all + fi cd .. + if command -v pdflatex &>/dev/null ; then + echo Ensuring that all library documentation compiles + make -C ocamldoc html_doc pdf_doc texi_doc + fi $MAKE install - echo Check the code examples in the manual - $MAKE manual-pregen + if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then + echo Check the code examples in the manual + $MAKE manual-pregen + fi # check_all_arches checks tries to compile all backends in place, # we would need to redo (small parts of) world.opt afterwards to # use the compiler again @@ -137,16 +178,16 @@ on the github pull request. ------------------------------------------------------------------------ EOF # check that Changes has been modified - git diff $TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD --name-only --exit-code Changes \ - > /dev/null && CheckNoChangesMessage || echo pass + git diff "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD" --name-only --exit-code \ + Changes > /dev/null && CheckNoChangesMessage || echo pass } CheckNoChangesMessage () { API_URL=https://api.github.com/repos/$TRAVIS_REPO_SLUG/issues/$TRAVIS_PULL_REQUEST/labels - if test -n "$(git log --grep="[Nn]o [Cc]hange.* needed" --max-count=1 \ - ${TRAVIS_MERGE_BASE}..${TRAVIS_PR_HEAD})" + if [[ -n $(git log --grep='[Nn]o [Cc]hange.* needed' --max-count=1 \ + "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD") ]] then echo pass - elif test -n "$(curl $API_URL | grep 'no-change-entry-needed')" + elif [[ -n $(curl "$API_URL" | grep 'no-change-entry-needed') ]] then echo pass else exit 1 fi @@ -155,13 +196,14 @@ CheckNoChangesMessage () { CheckManual () { cat< /dev/null && exit 1 || echo pass } # Test to see if any part of the directory name has been marked prune not_pruned () { DIR=$(dirname "$1") - if [ "$DIR" = "." ] ; then + if [[ $DIR = '.' ]] ; then return 0 else case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in @@ -200,7 +242,7 @@ not_pruned () { ;; *) - not_pruned $DIR + not_pruned "$DIR" return $? esac fi @@ -209,15 +251,15 @@ not_pruned () { CheckTypoTree () { export OCAML_CT_HEAD=$1 export OCAML_CT_LS_FILES="git diff-tree --no-commit-id --name-only -r $2 --" - export OCAML_CT_CAT="git cat-file --textconv" + export OCAML_CT_CAT='git cat-file --textconv' export OCAML_CT_PREFIX="$1:" - GIT_INDEX_FILE=tmp-index git read-tree --reset -i $1 - git diff-tree --diff-filter=d --no-commit-id --name-only -r $2 \ + GIT_INDEX_FILE=tmp-index git read-tree --reset -i "$1" + git diff-tree --diff-filter=d --no-commit-id --name-only -r "$2" \ | (while IFS= read -r path do - if not_pruned $path ; then + if not_pruned "$path" ; then echo "Checking $1: $path" - if ! tools/check-typo ./$path ; then + if ! tools/check-typo "./$path" ; then touch check-typo-failed fi else @@ -229,10 +271,10 @@ CheckTypoTree () { esac done) rm -f tmp-index - if [ -e CHECK_CONFIGURE ] ; then + if [[ -e CHECK_CONFIGURE ]] ; then rm -f CHECK_CONFIGURE echo "configure generation altered in $1" - echo "Verifying that configure.ac generates configure" + echo 'Verifying that configure.ac generates configure' git checkout "$1" mv configure configure.ref ./autogen @@ -247,32 +289,32 @@ please run ./autogen and commit" CHECK_ALL_COMMITS=0 CheckTypo () { - export OCAML_CT_GIT_INDEX="tmp-index" - export OCAML_CT_CA_FLAG="--cached" + export OCAML_CT_GIT_INDEX='tmp-index' + export OCAML_CT_CA_FLAG='--cached' # Work around an apparent bug in Ubuntu 12.4.5 # See https://bugs.launchpad.net/ubuntu/+source/gawk/+bug/1647879 rm -f check-typo-failed - if test -z "$TRAVIS_COMMIT_RANGE" - then CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT + if [[ -z $TRAVIS_COMMIT_RANGE ]] + then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT" else - if [ "$TRAVIS_EVENT_TYPE" = "pull_request" ] + if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]] then TRAVIS_COMMIT_RANGE=$TRAVIS_MERGE_BASE..$TRAVIS_PULL_REQUEST_SHA fi - if [ $CHECK_ALL_COMMITS -eq 1 ] + if [[ $CHECK_ALL_COMMITS -eq 1 ]] then - for commit in $(git rev-list $TRAVIS_COMMIT_RANGE --reverse) + for commit in $(git rev-list "$TRAVIS_COMMIT_RANGE" --reverse) do - CheckTypoTree $commit $commit + CheckTypoTree "$commit" "$commit" done else - if [ -z "$TRAVIS_PULL_REQUEST_SHA" ] - then CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT - else CheckTypoTree $TRAVIS_COMMIT $TRAVIS_COMMIT_RANGE + if [[ -z $TRAVIS_PULL_REQUEST_SHA ]] + then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT" + else CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT_RANGE" fi fi fi echo complete - if [ -e check-typo-failed ] + if [[ -e check-typo-failed ]] then exit 1 fi } diff --git a/tools/cmt2annot.ml b/tools/cmt2annot.ml index bfbac7c4..e0e4f849 100644 --- a/tools/cmt2annot.ml +++ b/tools/cmt2annot.ml @@ -17,10 +17,10 @@ open Asttypes open Typedtree -open Tast_mapper +open Tast_iterator -let bind_variables scope = - let super = Tast_mapper.default in +let variables_iterator scope = + let super = default_iterator in let pat sub p = begin match p.pat_desc with | Tpat_var (id, _) | Tpat_alias (_, id, _) -> @@ -34,8 +34,8 @@ let bind_variables scope = {super with pat} let bind_variables scope = - let o = bind_variables scope in - fun p -> ignore (o.pat o p) + let iter = variables_iterator scope in + fun p -> iter.pat iter p let bind_bindings scope bindings = let o = bind_variables scope in @@ -50,18 +50,18 @@ let bind_cases l = | None -> c_rhs.exp_loc | Some g -> {c_rhs.exp_loc with loc_start=g.exp_loc.loc_start} in - bind_variables loc c_lhs + bind_variables loc c_lhs ) l let record_module_binding scope mb = Stypes.record (Stypes.An_ident (mb.mb_name.loc, - mb.mb_name.txt, + Option.value mb.mb_name.txt ~default:"_", Annot.Idef scope)) let rec iterator ~scope rebuild_env = - let super = Tast_mapper.default in + let super = default_iterator in let class_expr sub node = Stypes.record (Stypes.Ti_class node); super.class_expr sub node @@ -106,7 +106,8 @@ let rec iterator ~scope rebuild_env = bind_cases f | Texp_letmodule (_, modname, _, _, body ) -> Stypes.record (Stypes.An_ident - (modname.loc,modname.txt,Annot.Idef body.exp_loc)) + (modname.loc,Option.value ~default:"_" modname.txt, + Annot.Idef body.exp_loc)) | _ -> () end; Stypes.record (Stypes.Ti_expr exp); @@ -146,27 +147,27 @@ let rec iterator ~scope rebuild_env = this will give a slightly different scope for the non-recursive binding case. *) structure_item_rem sub s [] - and structure sub l = + in + let structure sub l = let rec loop = function - | str :: rem -> structure_item_rem sub str rem :: loop rem - | [] -> [] + | str :: rem -> structure_item_rem sub str rem; loop rem + | [] -> () in - {l with str_items = loop l.str_items} + loop l.str_items in {super with class_expr; module_expr; expr; pat; structure_item; structure} let binary_part iter x = - let app f x = ignore (f iter x) in let open Cmt_format in match x with - | Partial_structure x -> app iter.structure x - | Partial_structure_item x -> app iter.structure_item x - | Partial_expression x -> app iter.expr x - | Partial_pattern x -> app iter.pat x - | Partial_class_expr x -> app iter.class_expr x - | Partial_signature x -> app iter.signature x - | Partial_signature_item x -> app iter.signature_item x - | Partial_module_type x -> app iter.module_type x + | Partial_structure x -> iter.structure iter x + | Partial_structure_item x -> iter.structure_item iter x + | Partial_expression x -> iter.expr iter x + | Partial_pattern x -> iter.pat iter x + | Partial_class_expr x -> iter.class_expr iter x + | Partial_signature x -> iter.signature iter x + | Partial_signature_item x -> iter.signature_item iter x + | Partial_module_type x -> iter.module_type iter x (* Save cmt information as faked annotations, attached to Location.none, on top of the .annot file. Only when -save-cmt-info is @@ -205,16 +206,16 @@ let gen_annot ?(save_cmt_info=false) target_filename filename cmt = | Some _ -> target_filename in if save_cmt_info then record_cmt_info cmt; - let iterator = iterator ~scope:Location.none cmt.cmt_use_summaries in + let iter = iterator ~scope:Location.none cmt.cmt_use_summaries in match cmt.cmt_annots with | Implementation typedtree -> - ignore (iterator.structure iterator typedtree); + iter.structure iter typedtree; Stypes.dump target_filename | Interface _ -> Printf.eprintf "Cannot generate annotations for interface file\n%!"; exit 2 | Partial_implementation parts -> - Array.iter (binary_part iterator) parts; + Array.iter (binary_part iter) parts; Stypes.dump target_filename | Packed _ -> Printf.fprintf stderr "Packed files not yet supported\n%!"; diff --git a/tools/gdb-macros b/tools/gdb-macros index 3c8c33a6..17c3110e 100644 --- a/tools/gdb-macros +++ b/tools/gdb-macros @@ -124,11 +124,11 @@ define camlheader end define camlheap - if $arg0 >= caml_young_start && $arg0 < caml_young_end + if $arg0 >= Caml_state->young_start && $arg0 < Caml_state->young_end printf "YOUNG" set $camlheap_result = 1 else - set $chunk = caml_heap_start + set $chunk = Caml_state->heap_start set $found = 0 while $chunk != 0 && ! $found set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize) @@ -253,7 +253,7 @@ end # displays the list of heap chunks define camlchunks - set $chunk = * (unsigned long *) &caml_heap_start + set $chunk = * (unsigned long *) &Caml_state->heap_start while $chunk != 0 set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize) set $chunk_alloc = * (unsigned long *) ($chunk - 3 * $camlwordsize) @@ -269,7 +269,7 @@ end # `camlvisitfun` can set `$camlvisitstop` to stop the iteration define camlvisit - set $cvchunk = * (unsigned long *) &caml_heap_start + set $cvchunk = * (unsigned long *) &Caml_state->heap_start set $camlvisitstop = 0 while $cvchunk != 0 && ! $camlvisitstop set $cvchunk_size = * (unsigned long *) ($cvchunk - 2 * $camlwordsize) @@ -290,7 +290,7 @@ define camlvisit end define caml_cv_check_fl0 - if $hp == * (unsigned long *) &caml_heap_start + if $hp == * (unsigned long *) &Caml_state->heap_start set $flcheck_prev = ((unsigned long) &sentinels + 16) end if $color == 2 && $size > 5 diff --git a/tools/git-dev-options.sh b/tools/git-dev-options.sh new file mode 100755 index 00000000..41925f43 --- /dev/null +++ b/tools/git-dev-options.sh @@ -0,0 +1,71 @@ +#! /bin/sh +#************************************************************************** +#* * +#* OCaml * +#* * +#* David Allsopp, OCaml Labs, Cambridge. * +#* * +#* Copyright 2019 MetaStack Solutions Ltd. * +#* * +#* All rights reserved. This file is distributed under the terms of * +#* the GNU Lesser General Public License version 2.1, with the * +#* special exception on linking described in the file LICENSE. * +#* * +#************************************************************************** + +# This script should have the same shebang as configure +if test -e '.git' ; then : + if test -z "$ac_read_git_config" ; then : + extra_args=$(git config ocaml.configure 2>/dev/null) + extended_cache=$(git config ocaml.configure-cache 2>/dev/null) + cache_file= + + # If ocaml.configure-cache is set, parse the command-line for the --host + # option, in order to determine the name of the cache file. + if test -n "$extended_cache" ; then : + echo "Detected Git configuration option ocaml.configure-cache set to \ +\"$extended_cache\"" + dashdash= + prev= + host=default + # The logic here is pretty borrowed from autoconf's + for option in $extra_args "$@" + do + if test -n "$prev" ; then : + host=$option + continue + fi + + case $dashdash$option in + --) + dashdash=yes ;; + -host | --host | --hos | --ho) + prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + case $option in + *=?*) host=$(expr "X$option" : '[^=]*=\(.*\)') ;; + *=) host= ;; + esac ;; + esac + done + cache_file="`dirname "$0"`/$extended_cache/ocaml-$host.cache" + fi + + # If either option has a value, re-invoke configure + if test -n "$extra_args$cache_file" ; then : + echo "Detected Git configuration option ocaml.configure set to \ +\"$extra_args\"" + # Too much effort to get the echo to show appropriate quoting - the + # invocation itself intentionally quotes $0 and passes $@ exactly as given + # but allows a single expansion of ocaml.configure + if test -n "$cache_file" ; then : + echo "Re-running $0 $extra_args --cache-file \"$cache_file\" $@" + ac_read_git_config=true exec "$0" $extra_args \ + --cache-file "$cache_file" "$@" + else + echo "Re-running $0 $extra_args $@" + ac_read_git_config=true exec "$0" $extra_args "$@" + fi + fi + fi +fi diff --git a/tools/lexer299.mll b/tools/lexer299.mll deleted file mode 100644 index 13453999..00000000 --- a/tools/lexer299.mll +++ /dev/null @@ -1,461 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* The lexer definition *) - -{ -open Lexing -open Misc - -type token = - AMPERAMPER - | AMPERSAND - | AND - | AS - | ASSERT - | BACKQUOTE - | BAR - | BARBAR - | BARRBRACKET - | BEGIN - | CHAR of (char) - | CLASS - | COLON - | COLONCOLON - | COLONEQUAL - | COLONGREATER - | COMMA - | CONSTRAINT - | DO - | DONE - | DOT - | DOTDOT - | DOWNTO - | ELSE - | END - | EOF - | EQUAL - | EXCEPTION - | EXTERNAL - | FALSE - | FLOAT of (string) - | FOR - | FUN - | FUNCTION - | FUNCTOR - | GREATER - | GREATERRBRACE - | GREATERRBRACKET - | HASH - | IF - | IN - | INCLUDE - | INFIXOP0 of (string) - | INFIXOP1 of (string) - | INFIXOP2 of (string) - | INFIXOP3 of (string) - | INFIXOP4 of (string) - | INHERIT - | INITIALIZER - | INT of (int) - | LABEL of (string) - | LABELID of (string) - | LAZY - | LBRACE - | LBRACELESS - | LBRACKET - | LBRACKETBAR - | LBRACKETLESS - | LESS - | LESSMINUS - | LET - | LIDENT of (string) - | LPAREN - | MATCH - | METHOD - | MINUSGREATER - | MODULE - | MUTABLE - | NEW - | OBJECT - | OF - | OPEN - | OR - | PARSER - | PREFIXOP of (string) - | PRIVATE - | QUESTION - | QUESTION2 - | QUOTE - | RBRACE - | RBRACKET - | REC - | RPAREN - | SEMI - | SEMISEMI - | SIG - | STAR - | STRING of (string) - | STRUCT - | SUBTRACTIVE of (string) - | THEN - | TO - | TRUE - | TRY - | TYPE - | UIDENT of (string) - | UNDERSCORE - | VAL - | VIRTUAL - | WHEN - | WHILE - | WITH - -type error = - | Illegal_character of char - | Unterminated_comment - | Unterminated_string - | Unterminated_string_in_comment -;; - -exception Error of error * int * int - -(* The table of keywords *) - -let keyword_table = - create_hashtable 149 [ - "and", AND; - "as", AS; - "assert", ASSERT; - "begin", BEGIN; - "class", CLASS; - "constraint", CONSTRAINT; - "do", DO; - "done", DONE; - "downto", DOWNTO; - "else", ELSE; - "end", END; - "exception", EXCEPTION; - "external", EXTERNAL; - "false", FALSE; - "for", FOR; - "fun", FUN; - "function", FUNCTION; - "functor", FUNCTOR; - "if", IF; - "in", IN; - "include", INCLUDE; - "inherit", INHERIT; - "initializer", INITIALIZER; - "lazy", LAZY; - "let", LET; - "match", MATCH; - "method", METHOD; - "module", MODULE; - "mutable", MUTABLE; - "new", NEW; - "object", OBJECT; - "of", OF; - "open", OPEN; - "or", OR; - "parser", PARSER; - "private", PRIVATE; - "rec", REC; - "sig", SIG; - "struct", STRUCT; - "then", THEN; - "to", TO; - "true", TRUE; - "try", TRY; - "type", TYPE; - "val", VAL; - "virtual", VIRTUAL; - "when", WHEN; - "while", WHILE; - "with", WITH; - - "mod", INFIXOP3("mod"); - "land", INFIXOP3("land"); - "lor", INFIXOP3("lor"); - "lxor", INFIXOP3("lxor"); - "lsl", INFIXOP4("lsl"); - "lsr", INFIXOP4("lsr"); - "asr", INFIXOP4("asr") -] - -(* To buffer string literals *) - -let initial_string_buffer = String.create 256 -let string_buff = ref initial_string_buffer -let string_index = ref 0 - -let reset_string_buffer () = - string_buff := initial_string_buffer; - string_index := 0 - -let store_string_char c = - if !string_index >= String.length (!string_buff) then begin - let new_buff = String.create (String.length (!string_buff) * 2) in - String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff)); - string_buff := new_buff - end; - String.unsafe_set (!string_buff) (!string_index) c; - incr string_index - -let get_stored_string () = - let s = String.sub (!string_buff) 0 (!string_index) in - string_buff := initial_string_buffer; - s - -(* To translate escape sequences *) - -let char_for_backslash = function - | 'n' -> '\010' - | 'r' -> '\013' - | 'b' -> '\008' - | 't' -> '\009' - | c -> c - -let char_for_decimal_code lexbuf i = - let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + - 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + - (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in - Char.chr(c land 0xFF) - -(* To store the position of the beginning of a string and comment *) -let string_start_pos = ref 0;; -let comment_start_pos = ref [];; - -(* Error report *) - -open Format - -let report_error ppf = function - | Illegal_character c -> - fprintf ppf "Illegal character (%s)" (Char.escaped c) - | Unterminated_comment -> - fprintf ppf "Comment not terminated" - | Unterminated_string -> - fprintf ppf "String literal not terminated" - | Unterminated_string_in_comment -> - fprintf ppf "This comment contains an unterminated string literal" -;; - -} - -let blank = [' ' '\010' '\013' '\009' '\012'] -let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] -let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] -let identchar = - ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] -let symbolchar = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] -let symbolchar2 = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' '<' '=' '>' '?' '@' '^' '|' '~'] -(* ['!' '$' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] *) -let decimal_literal = ['0'-'9']+ -let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+ -let oct_literal = '0' ['o' 'O'] ['0'-'7']+ -let bin_literal = '0' ['b' 'B'] ['0'-'1']+ -let float_literal = - ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)? - -rule token = parse - blank + - { token lexbuf } - | "_" - { UNDERSCORE } - | lowercase identchar * ':' [ ^ ':' '=' '>'] - { let s = Lexing.lexeme lexbuf in - lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - 1; - lexbuf.lex_curr_p <- - {lexbuf.lex_curr_p with pos_cnum = lexbuf.lex_curr_p.pos_cnum - 1}; - LABEL (String.sub s 0 (String.length s - 2)) } -(* - | lowercase identchar * ':' - { let s = Lexing.lexeme lexbuf in - LABEL (String.sub s 0 (String.length s - 1)) } - | '%' lowercase identchar * -*) - | ':' lowercase identchar * - { let s = Lexing.lexeme lexbuf in - let l = String.length s - 1 in - LABELID (String.sub s 1 l) } - | lowercase identchar * - { let s = Lexing.lexeme lexbuf in - try - Hashtbl.find keyword_table s - with Not_found -> - LIDENT s } - | uppercase identchar * - { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *) - | decimal_literal | hex_literal | oct_literal | bin_literal - { INT (int_of_string(Lexing.lexeme lexbuf)) } - | float_literal - { FLOAT (Lexing.lexeme lexbuf) } - | "\"" - { reset_string_buffer(); - let string_start = Lexing.lexeme_start lexbuf in - string_start_pos := string_start; - string lexbuf; - lexbuf.Lexing.lex_start_pos <- - string_start - lexbuf.Lexing.lex_abs_pos; - STRING (get_stored_string()) } - | "'" [^ '\\' '\''] "'" - { CHAR(Lexing.lexeme_char lexbuf 1) } - | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" - { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) } - | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - { CHAR(char_for_decimal_code lexbuf 2) } - | "(*" - { comment_start_pos := [Lexing.lexeme_start lexbuf]; - comment lexbuf; - token lexbuf } - | "(*)" - { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf; - Location.loc_end = Lexing.lexeme_end_p lexbuf; - Location.loc_ghost = false } - in - Location.prerr_warning loc (Warnings.Comment_start); - comment_start_pos := [Lexing.lexeme_start lexbuf]; - comment lexbuf; - token lexbuf - } - | "*)" - { let loc = { Location.loc_start = Lexing.lexeme_start_p lexbuf; - Location.loc_end = Lexing.lexeme_end_p lexbuf; - Location.loc_ghost = false } - in - Location.prerr_warning loc Warnings.Comment_not_end; - lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; - STAR - } - | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n") - (* # linenum ... *) - { token lexbuf } - | "#" { HASH } - | "&" { AMPERSAND } - | "&&" { AMPERAMPER } - | "`" { BACKQUOTE } - | "'" { QUOTE } - | "(" { LPAREN } - | ")" { RPAREN } - | "*" { STAR } - | "," { COMMA } - | "?" { QUESTION } - | "??" { QUESTION2 } - | "->" { MINUSGREATER } - | "." { DOT } - | ".." { DOTDOT } - | ":" { COLON } - | "::" { COLONCOLON } - | ":=" { COLONEQUAL } - | ":>" { COLONGREATER } - | ";" { SEMI } - | ";;" { SEMISEMI } - | "<" { LESS } - | "<-" { LESSMINUS } - | "=" { EQUAL } - | "[" { LBRACKET } - | "[|" { LBRACKETBAR } - | "[<" { LBRACKETLESS } - | "]" { RBRACKET } - | "{" { LBRACE } - | "{<" { LBRACELESS } - | "|" { BAR } - | "||" { BARBAR } - | "|]" { BARRBRACKET } - | ">" { GREATER } - | ">]" { GREATERRBRACKET } - | "}" { RBRACE } - | ">}" { GREATERRBRACE } - - | "!=" { INFIXOP0 "!=" } - | "-" { SUBTRACTIVE "-" } - | "-." { SUBTRACTIVE "-." } - - | ['!' '~'] symbolchar * - { PREFIXOP(Lexing.lexeme lexbuf) } - | '?' symbolchar2 * - { PREFIXOP(Lexing.lexeme lexbuf) } - | ['=' '<' '>' '|' '&' '$'] symbolchar * - { INFIXOP0(Lexing.lexeme lexbuf) } - | ['@' '^'] symbolchar * - { INFIXOP1(Lexing.lexeme lexbuf) } - | ['+' '-'] symbolchar * - { INFIXOP2(Lexing.lexeme lexbuf) } - | "**" symbolchar * - { INFIXOP4(Lexing.lexeme lexbuf) } - | ['*' '/' '%'] symbolchar * - { INFIXOP3(Lexing.lexeme lexbuf) } - | eof { EOF } - | _ - { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]), - Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) } - -and comment = parse - "(*" - { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos; - comment lexbuf; - } - | "*)" - { match !comment_start_pos with - | [] -> assert false - | [x] -> () - | _ :: l -> comment_start_pos := l; - comment lexbuf; - } - | "\"" - { reset_string_buffer(); - string_start_pos := Lexing.lexeme_start lexbuf; - begin try string lexbuf - with Error (Unterminated_string, _, _) -> - let st = List.hd !comment_start_pos in - raise (Error (Unterminated_string_in_comment, st, st + 2)) - end; - string_buff := initial_string_buffer; - comment lexbuf } - | "''" - { comment lexbuf } - | "'" [^ '\\' '\''] "'" - { comment lexbuf } - | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'" - { comment lexbuf } - | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - { comment lexbuf } - | eof - { let st = List.hd !comment_start_pos in - raise (Error (Unterminated_comment, st, st + 2)); - } - | _ - { comment lexbuf } - -and string = parse - '"' - { () } - | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] * - { string lexbuf } - | '\\' ['\\' '"' 'n' 't' 'b' 'r'] - { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); - string lexbuf } - | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] - { store_string_char(char_for_decimal_code lexbuf 1); - string lexbuf } - | eof - { raise (Error (Unterminated_string, - !string_start_pos, !string_start_pos+1)) } - | _ - { store_string_char(Lexing.lexeme_char lexbuf 0); - string lexbuf } diff --git a/tools/lexer301.mll b/tools/lexer301.mll deleted file mode 100644 index e574c365..00000000 --- a/tools/lexer301.mll +++ /dev/null @@ -1,462 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* The lexer definition *) - -{ -open Misc - -type token = - AMPERAMPER - | AMPERSAND - | AND - | AS - | ASSERT - | BACKQUOTE - | BAR - | BARBAR - | BARRBRACKET - | BEGIN - | CHAR of (char) - | CLASS - | COLON - | COLONCOLON - | COLONEQUAL - | COLONGREATER - | COMMA - | CONSTRAINT - | DO - | DONE - | DOT - | DOTDOT - | DOWNTO - | ELSE - | END - | EOF - | EQUAL - | EXCEPTION - | EXTERNAL - | FALSE - | FLOAT of (string) - | FOR - | FUN - | FUNCTION - | FUNCTOR - | GREATER - | GREATERRBRACE - | GREATERRBRACKET - | HASH - | IF - | IN - | INCLUDE - | INFIXOP0 of (string) - | INFIXOP1 of (string) - | INFIXOP2 of (string) - | INFIXOP3 of (string) - | INFIXOP4 of (string) - | INHERIT - | INITIALIZER - | INT of (int) - | LABEL of (string) - | LAZY - | LBRACE - | LBRACELESS - | LBRACKET - | LBRACKETBAR - | LBRACKETLESS - | LESS - | LESSMINUS - | LET - | LIDENT of (string) - | LPAREN - | MATCH - | METHOD - | MINUS - | MINUSDOT - | MINUSGREATER - | MODULE - | MUTABLE - | NEW - | OBJECT - | OF - | OPEN - | OPTLABEL of (string) - | OR - | PARSER - | PLUS - | PREFIXOP of (string) - | PRIVATE - | QUESTION - | QUESTION2 - | QUOTE - | RBRACE - | RBRACKET - | REC - | RPAREN - | SEMI - | SEMISEMI - | SIG - | STAR - | STRING of (string) - | STRUCT - | THEN - | TILDE - | TO - | TRUE - | TRY - | TYPE - | UIDENT of (string) - | UNDERSCORE - | VAL - | VIRTUAL - | WHEN - | WHILE - | WITH - -type error = - | Illegal_character of char - | Unterminated_comment - | Unterminated_string - | Unterminated_string_in_comment - | Keyword_as_label of string -;; - -exception Error of error * int * int - -(* The table of keywords *) - -let keyword_table = - create_hashtable 149 [ - "and", AND; - "as", AS; - "assert", ASSERT; - "begin", BEGIN; - "class", CLASS; - "constraint", CONSTRAINT; - "do", DO; - "done", DONE; - "downto", DOWNTO; - "else", ELSE; - "end", END; - "exception", EXCEPTION; - "external", EXTERNAL; - "false", FALSE; - "for", FOR; - "fun", FUN; - "function", FUNCTION; - "functor", FUNCTOR; - "if", IF; - "in", IN; - "include", INCLUDE; - "inherit", INHERIT; - "initializer", INITIALIZER; - "lazy", LAZY; - "let", LET; - "match", MATCH; - "method", METHOD; - "module", MODULE; - "mutable", MUTABLE; - "new", NEW; - "object", OBJECT; - "of", OF; - "open", OPEN; - "or", OR; - "parser", PARSER; - "private", PRIVATE; - "rec", REC; - "sig", SIG; - "struct", STRUCT; - "then", THEN; - "to", TO; - "true", TRUE; - "try", TRY; - "type", TYPE; - "val", VAL; - "virtual", VIRTUAL; - "when", WHEN; - "while", WHILE; - "with", WITH; - - "mod", INFIXOP3("mod"); - "land", INFIXOP3("land"); - "lor", INFIXOP3("lor"); - "lxor", INFIXOP3("lxor"); - "lsl", INFIXOP4("lsl"); - "lsr", INFIXOP4("lsr"); - "asr", INFIXOP4("asr") -] - -(* To buffer string literals *) - -let initial_string_buffer = String.create 256 -let string_buff = ref initial_string_buffer -let string_index = ref 0 - -let reset_string_buffer () = - string_buff := initial_string_buffer; - string_index := 0 - -let store_string_char c = - if !string_index >= String.length (!string_buff) then begin - let new_buff = String.create (String.length (!string_buff) * 2) in - String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff)); - string_buff := new_buff - end; - String.unsafe_set (!string_buff) (!string_index) c; - incr string_index - -let get_stored_string () = - let s = String.sub (!string_buff) 0 (!string_index) in - string_buff := initial_string_buffer; - s - -(* To translate escape sequences *) - -let char_for_backslash = function - | 'n' -> '\010' - | 'r' -> '\013' - | 'b' -> '\008' - | 't' -> '\009' - | c -> c - -let char_for_decimal_code lexbuf i = - let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + - 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + - (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in - Char.chr(c land 0xFF) - -(* To store the position of the beginning of a string and comment *) -let string_start_pos = ref 0;; -let comment_start_pos = ref [];; -let in_comment () = !comment_start_pos <> [];; - -(* Error report *) - -open Format - -let report_error ppf = function - | Illegal_character c -> - fprintf ppf "Illegal character (%s)" (Char.escaped c) - | Unterminated_comment -> - fprintf ppf "Comment not terminated" - | Unterminated_string -> - fprintf ppf "String literal not terminated" - | Unterminated_string_in_comment -> - fprintf ppf "This comment contains an unterminated string literal" - | Keyword_as_label kwd -> - fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd -;; - -} - -let blank = [' ' '\010' '\013' '\009' '\012'] -let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] -let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] -let identchar = - ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] -let symbolchar = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] -let decimal_literal = ['0'-'9']+ -let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+ -let oct_literal = '0' ['o' 'O'] ['0'-'7']+ -let bin_literal = '0' ['b' 'B'] ['0'-'1']+ -let float_literal = - ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)? - -rule token = parse - blank + - { token lexbuf } - | "_" - { UNDERSCORE } - | "~" { TILDE } - | "~" lowercase identchar * ':' - { let s = Lexing.lexeme lexbuf in - let name = String.sub s 1 (String.length s - 2) in - if Hashtbl.mem keyword_table name then - raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf, - Lexing.lexeme_end lexbuf)); - LABEL name } - | "?" { QUESTION } - | "?" lowercase identchar * ':' - { let s = Lexing.lexeme lexbuf in - let name = String.sub s 1 (String.length s - 2) in - if Hashtbl.mem keyword_table name then - raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf, - Lexing.lexeme_end lexbuf)); - OPTLABEL name } - | lowercase identchar * - { let s = Lexing.lexeme lexbuf in - try - Hashtbl.find keyword_table s - with Not_found -> - LIDENT s } - | uppercase identchar * - { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *) - | decimal_literal | hex_literal | oct_literal | bin_literal - { INT (int_of_string(Lexing.lexeme lexbuf)) } - | float_literal - { FLOAT (Lexing.lexeme lexbuf) } - | "\"" - { reset_string_buffer(); - let string_start = Lexing.lexeme_start lexbuf in - string_start_pos := string_start; - string lexbuf; - lexbuf.Lexing.lex_start_pos <- - string_start - lexbuf.Lexing.lex_abs_pos; - STRING (get_stored_string()) } - | "'" [^ '\\' '\''] "'" - { CHAR(Lexing.lexeme_char lexbuf 1) } - | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" - { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) } - | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - { CHAR(char_for_decimal_code lexbuf 2) } - | "(*" - { comment_start_pos := [Lexing.lexeme_start lexbuf]; - comment lexbuf; - token lexbuf } - | "(*)" - { let loc = Location.curr lexbuf - and warn = Warnings.Comment_start - in - Location.prerr_warning loc warn; - comment_start_pos := [Lexing.lexeme_start lexbuf]; - comment lexbuf; - token lexbuf - } - | "*)" - { let loc = Location.curr lexbuf - and warn = Warnings.Comment_not_end - in - Location.prerr_warning loc warn; - lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; - STAR - } - | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n") - (* # linenum ... *) - { token lexbuf } - | "#" { HASH } - | "&" { AMPERSAND } - | "&&" { AMPERAMPER } - | "`" { BACKQUOTE } - | "'" { QUOTE } - | "(" { LPAREN } - | ")" { RPAREN } - | "*" { STAR } - | "," { COMMA } - | "??" { QUESTION2 } - | "->" { MINUSGREATER } - | "." { DOT } - | ".." { DOTDOT } - | ":" { COLON } - | "::" { COLONCOLON } - | ":=" { COLONEQUAL } - | ":>" { COLONGREATER } - | ";" { SEMI } - | ";;" { SEMISEMI } - | "<" { LESS } - | "<-" { LESSMINUS } - | "=" { EQUAL } - | "[" { LBRACKET } - | "[|" { LBRACKETBAR } - | "[<" { LBRACKETLESS } - | "]" { RBRACKET } - | "{" { LBRACE } - | "{<" { LBRACELESS } - | "|" { BAR } - | "||" { BARBAR } - | "|]" { BARRBRACKET } - | ">" { GREATER } - | ">]" { GREATERRBRACKET } - | "}" { RBRACE } - | ">}" { GREATERRBRACE } - - | "!=" { INFIXOP0 "!=" } - | "+" { PLUS } - | "-" { MINUS } - | "-." { MINUSDOT } - - | "!" symbolchar * - { PREFIXOP(Lexing.lexeme lexbuf) } - | ['~' '?'] symbolchar + - { PREFIXOP(Lexing.lexeme lexbuf) } - | ['=' '<' '>' '|' '&' '$'] symbolchar * - { INFIXOP0(Lexing.lexeme lexbuf) } - | ['@' '^'] symbolchar * - { INFIXOP1(Lexing.lexeme lexbuf) } - | ['+' '-'] symbolchar * - { INFIXOP2(Lexing.lexeme lexbuf) } - | "**" symbolchar * - { INFIXOP4(Lexing.lexeme lexbuf) } - | ['*' '/' '%'] symbolchar * - { INFIXOP3(Lexing.lexeme lexbuf) } - | eof { EOF } - | _ - { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]), - Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) } - -and comment = parse - "(*" - { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos; - comment lexbuf; - } - | "*)" - { match !comment_start_pos with - | [] -> assert false - | [x] -> comment_start_pos := []; - | _ :: l -> comment_start_pos := l; - comment lexbuf; - } - | "\"" - { reset_string_buffer(); - string_start_pos := Lexing.lexeme_start lexbuf; - begin try string lexbuf - with Error (Unterminated_string, _, _) -> - let st = List.hd !comment_start_pos in - raise (Error (Unterminated_string_in_comment, st, st + 2)) - end; - string_buff := initial_string_buffer; - comment lexbuf } - | "''" - { comment lexbuf } - | "'" [^ '\\' '\''] "'" - { comment lexbuf } - | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'" - { comment lexbuf } - | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - { comment lexbuf } - | eof - { let st = List.hd !comment_start_pos in - raise (Error (Unterminated_comment, st, st + 2)); - } - | _ - { comment lexbuf } - -and string = parse - '"' - { () } - | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] * - { string lexbuf } - | '\\' ['\\' '"' 'n' 't' 'b' 'r'] - { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); - string lexbuf } - | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] - { store_string_char(char_for_decimal_code lexbuf 1); - string lexbuf } - | eof - { raise (Error (Unterminated_string, - !string_start_pos, !string_start_pos+1)) } - | _ - { store_string_char(Lexing.lexeme_char lexbuf 0); - string lexbuf } diff --git a/tools/make-version-header.sh b/tools/make-version-header.sh index 707d04fa..fe4549d2 100755 --- a/tools/make-version-header.sh +++ b/tools/make-version-header.sh @@ -33,7 +33,7 @@ case $# in 0) version="`ocamlc -v | tr -d '\r' | sed -n -e 's/.*version //p'`";; - 1) version="`sed -e 1q $1 | tr -d '\r'`";; + 1) version="`sed -e 1q "$1" | tr -d '\r'`";; *) echo "usage: make-version-header.sh [version-file]" >&2 exit 2;; esac @@ -44,12 +44,12 @@ patchlvl="`echo "$version" | sed -n -e '1s/^[0-9]*\.[0-9]*\.\([0-9]*\).*/\1/p'`" suffix="`echo "$version" | sed -n -e '1s/^[^+]*+\(.*\)/\1/p'`" echo "#define OCAML_VERSION_MAJOR $major" -printf "#define OCAML_VERSION_MINOR %d\n" $minor +printf '#define OCAML_VERSION_MINOR %d\n' "$minor" case $patchlvl in "") patchlvl=0;; esac echo "#define OCAML_VERSION_PATCHLEVEL $patchlvl" case "$suffix" in "") echo "#undef OCAML_VERSION_ADDITIONAL";; *) echo "#define OCAML_VERSION_ADDITIONAL \"$suffix\"";; esac -printf "#define OCAML_VERSION %d%02d%02d\n" $major $minor $patchlvl +printf '#define OCAML_VERSION %d%02d%02d\n' "$major" "$minor" "$patchlvl" echo "#define OCAML_VERSION_STRING \"$version\"" diff --git a/tools/objinfo_helper.c b/tools/objinfo_helper.c index 3d3ebc1c..fe3ebd42 100644 --- a/tools/objinfo_helper.c +++ b/tools/objinfo_helper.c @@ -18,6 +18,7 @@ #ifdef HAS_LIBBFD #include #include +#include // PACKAGE: protect against binutils change // https://sourceware.org/bugzilla/show_bug.cgi?id=14243 @@ -27,66 +28,113 @@ #define plugin_header_sym (symbol_prefix "caml_plugin_header") -int main(int argc, char ** argv) +/* We need to refer to a few functions of the BFD library that are */ +/* actually defined as macros. We thus define equivalent */ +/* functions below */ + +long get_static_symtab_upper_bound(bfd *fd) +{ + return bfd_get_symtab_upper_bound(fd); +} + +long get_dynamic_symtab_upper_bound(bfd *fd) +{ + return bfd_get_dynamic_symtab_upper_bound(fd); +} + +long canonicalize_static_symtab(bfd * fd, asymbol **symbolTable) +{ + return bfd_canonicalize_symtab(fd, symbolTable); +} + +long canonicalize_dynamic_symtab(bfd * fd, asymbol **symbolTable) +{ + return bfd_canonicalize_dynamic_symtab(fd, symbolTable); +} + +typedef struct { + long (*get_upper_bound)(bfd *); + long (*canonicalize)(bfd *, asymbol **); +} symTable_ops; + +symTable_ops staticSymTable_ops = { + &get_static_symtab_upper_bound, + &canonicalize_static_symtab +}; + +symTable_ops dynamicSymTable_ops = { + &get_dynamic_symtab_upper_bound, + &canonicalize_dynamic_symtab +}; + +/* Print an error message and exit */ +static void error(bfd *fd, char *msg, ...) +{ + va_list ap; + va_start(ap, msg); + vfprintf (stderr, msg, ap); + va_end(ap); + fprintf(stderr, "\n"); + if (fd!=NULL) bfd_close(fd); + exit(2); +} + +/* Look for plugin_header_sym in the specified symbol table */ +/* Return its address, -1 if not found */ +long lookup(bfd* fd, symTable_ops *ops) { - bfd *fd; - asection *sec; - file_ptr offset; long st_size; asymbol ** symbol_table; long sym_count, i; - if (argc != 2) { - fprintf(stderr, "Usage: objinfo_helper \n"); - return 2; + st_size = ops->get_upper_bound (fd); + if (st_size <= 0) return -1; + + symbol_table = malloc(st_size); + if (! symbol_table) + error(fd, "Error: out of memory"); + + sym_count = ops->canonicalize (fd, symbol_table); + + for (i = 0; i < sym_count; i++) { + if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0) + return symbol_table[i]->value; } + return -1; +} + +int main(int argc, char ** argv) +{ + bfd *fd; + asection *sec; + file_ptr offset; + long value; + + if (argc != 2) + error(NULL, "Usage: objinfo_helper "); fd = bfd_openr(argv[1], "default"); - if (!fd) { - fprintf(stderr, "Error opening file %s\n", argv[1]); - return 2; - } - if (! bfd_check_format (fd, bfd_object)) { - fprintf(stderr, "Error: wrong format\n"); - bfd_close(fd); - return 2; - } + if (!fd) + error(NULL, "Error opening file %s", argv[1]); + if (! bfd_check_format (fd, bfd_object)) + error(fd, "Error: wrong format"); sec = bfd_get_section_by_name(fd, ".data"); - if (! sec) { - fprintf(stderr, "Error: section .data not found\n"); - bfd_close(fd); - return 2; - } + if (! sec) + error(fd, "Error: section .data not found"); offset = sec->filepos; - st_size = bfd_get_dynamic_symtab_upper_bound (fd); - if (st_size <= 0) { - fprintf(stderr, "Error: size of section .data unknown\n"); - bfd_close(fd); - return 2; - } - symbol_table = malloc(st_size); - if (! symbol_table) { - fprintf(stderr, "Error: out of memory\n"); - bfd_close(fd); - return 2; - } + value = lookup(fd, &dynamicSymTable_ops); - sym_count = bfd_canonicalize_dynamic_symtab (fd, symbol_table); + if (value == -1) + value = lookup(fd, &staticSymTable_ops); + bfd_close(fd); - for (i = 0; i < sym_count; i++) { - if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0) { - printf("%ld\n", (long) (offset + symbol_table[i]->value)); - bfd_close(fd); - return 0; - } - } + if (value == -1) + error(NULL, "Error: missing symbol %s", plugin_header_sym); - fprintf(stderr, "Error: missing symbol %s\n", plugin_header_sym); - bfd_close(fd); - return 2; + printf("%ld\n", (long) offset + value); } #else diff --git a/tools/ocaml299to3.ml b/tools/ocaml299to3.ml deleted file mode 100644 index f0352c19..00000000 --- a/tools/ocaml299to3.ml +++ /dev/null @@ -1,141 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jacques Garrigue, Kyoto University RIMS *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -open Lexer299 - -let input_buffer = Buffer.create 16383 -let input_function ic buf len = - let len = input ic buf 0 len in - Buffer.add_substring input_buffer buf 0 len; - len - -let output_buffer = Buffer.create 16383 - -let modified = ref false - -let convert buffer = - let input_pos = ref 0 in - let copy_input stop = - Buffer.add_substring output_buffer (Buffer.contents input_buffer) - !input_pos (stop - !input_pos); - input_pos := stop - in - let last = ref (EOF, 0, 0) in - try while true do - let token = Lexer299.token buffer - and start = Lexing.lexeme_start buffer - and stop = Lexing.lexeme_end buffer - and last_token, last_start, last_stop = !last in - begin match token with - | LABEL l0 -> - let l = if l0 = "fun" then "f" else l0 in - begin match last_token with - | PREFIXOP "?(" -> - modified := true; - copy_input last_start; - Buffer.add_char output_buffer '?'; - Buffer.add_string output_buffer l; - Buffer.add_string output_buffer ":("; - input_pos := stop - | QUESTION | LPAREN | LBRACE | SEMI | MINUSGREATER - | EQUAL | COLON | COLONGREATER - | VAL | MUTABLE | EXTERNAL | METHOD | OF -> - if l0 = "fun" then begin - modified := true; - copy_input start; - Buffer.add_string output_buffer l; - Buffer.add_char output_buffer ':'; - input_pos := stop - end - | _ -> - modified := true; - copy_input start; - Buffer.add_char output_buffer '~'; - Buffer.add_string output_buffer l; - Buffer.add_char output_buffer ':'; - input_pos := stop - end - | LABELID l -> - modified := true; - begin match last_token with - | PREFIXOP "?(" -> - copy_input last_start; - Buffer.add_string output_buffer "?("; - Buffer.add_string output_buffer l; - input_pos := stop - | LPAREN -> - copy_input last_start; - Buffer.add_string output_buffer "~("; - Buffer.add_string output_buffer l; - input_pos := stop - | QUESTION -> - copy_input last_stop; - Buffer.add_string output_buffer l; - input_pos := stop - | _ -> - copy_input start; - Buffer.add_char output_buffer '~'; - Buffer.add_string output_buffer l; - input_pos := stop - end - | EOF -> raise End_of_file - | _ -> () - end; - if last_token = QUESTION && token = LPAREN then - last := (PREFIXOP "?(", last_start, stop) - else - last := (token, start, stop) - done with - End_of_file -> - copy_input (Buffer.length input_buffer) - -let convert_file name = - let ic = open_in name in - Buffer.clear input_buffer; - Buffer.clear output_buffer; - modified := false; - begin - try convert (Lexing.from_function (input_function ic)); close_in ic - with exn -> close_in ic; raise exn - end; - if !modified then begin - let backup = name ^ ".bak" in - if Sys.file_exists backup then Sys.remove name - else Sys.rename name backup; - let oc = open_out name in - Buffer.output_buffer oc output_buffer; - close_out oc - end - -let _ = - if Array.length Sys.argv < 2 || Sys.argv.(1) = "-h" || Sys.argv.(1) = "-help" - then begin - print_endline "Usage: ocaml299to3 ..."; - print_endline "Description:"; - print_endline - "Convert OCaml 2.99 O'Labl-style labels in implementation files to"; - print_endline - "a syntax compatible with version 3. Also `fun:' labels are replaced \ - by `f:'."; - print_endline "Other syntactic changes are not handled."; - print_endline "Old files are renamed to .bak."; - print_endline "Interface files do not need label syntax conversion."; - exit 0 - end; - for i = 1 to Array.length Sys.argv - 1 do - let name = Sys.argv.(i) in - prerr_endline ("Converting " ^ name); - Printexc.catch convert_file name - done diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index c72a2127..d799fff4 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -33,105 +33,14 @@ let incompatible o = exit 2 module Options = Main_args.Make_bytecomp_options (struct - let _a () = make_archive := true - let _absname = ignore - let _alert = ignore - let _annot = ignore - let _binannot = ignore - let _c = ignore - let _cc = ignore - let _cclib = ignore - let _ccopt = ignore - let _config = ignore - let _config_var = ignore - let _compat_32 = ignore - let _custom = ignore - let _dllib = ignore - let _dllpath = ignore - let _dtypes = ignore - let _for_pack = ignore - let _g = ignore - let _stop_after = ignore - let _i = ignore - let _I = ignore - let _impl _ = with_impl := true - let _intf _ = with_intf := true - let _intf_suffix = ignore - let _keep_docs = ignore - let _no_keep_docs = ignore - let _keep_locs = ignore - let _no_keep_locs = ignore - let _labels = ignore - let _linkall = ignore - let _make_runtime = ignore - let _alias_deps = ignore - let _no_alias_deps = ignore - let _app_funct = ignore - let _no_app_funct = ignore - let _no_check_prims = ignore - let _noassert = ignore - let _nolabels = ignore - let _noautolink = ignore - let _nostdlib = ignore - let _o = ignore - let _opaque = ignore - let _open = ignore - let _output_obj = ignore - let _output_complete_obj = ignore - let _pack = ignore - let _plugin = ignore - let _pp _ = incompatible "-pp" - let _ppx _ = incompatible "-ppx" - let _principal = ignore - let _no_principal = ignore - let _rectypes = ignore - let _no_rectypes = ignore - let _runtime_variant = ignore - let _with_runtime = ignore - let _without_runtime = ignore - let _safe_string = ignore - let _short_paths = ignore - let _strict_sequence = ignore - let _no_strict_sequence = ignore - let _strict_formats = ignore - let _no_strict_formats = ignore - let _thread = ignore - let _vmthread = ignore - let _unboxed_types = ignore - let _no_unboxed_types = ignore - let _unsafe = ignore - let _unsafe_string = ignore - let _use_prims = ignore - let _use_runtime = ignore - let _v = ignore - let _version = ignore - let _vnum = ignore - let _verbose = ignore - let _w = ignore - let _warn_error = ignore - let _warn_help = ignore - let _color = ignore - let _error_style = ignore - let _where = ignore - let _nopervasives = ignore - let _match_context_rows = ignore - let _dump_into_file = ignore - let _dno_unique_ids = ignore - let _dunique_ids = ignore - let _dsource = ignore - let _dparsetree = ignore - let _dtypedtree = ignore - let _drawlambda = ignore - let _dlambda = ignore - let _dflambda = ignore - let _dinstr = ignore - let _dcamlprimc = ignore - let _dtimings = ignore - let _dprofile = ignore - let _args = Arg.read_arg - let _args0 = Arg.read_arg0 - let anonymous = process_file -end);; + include Main_args.Default.Main + let _a () = make_archive := true + let _impl _ = with_impl := true + let _intf _ = with_intf := true + let _pp _ = incompatible "-pp" + let _ppx _ = incompatible "-ppx" + let anonymous = process_file + end);; let rev_compargs = ref ([] : string list) let rev_profargs = ref ([] : string list) diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 888dbf5b..9b92d3b0 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -33,149 +33,12 @@ let incompatible o = exit 2 module Options = Main_args.Make_optcomp_options (struct + include Main_args.Default.Optmain let _a () = make_archive := true - let _absname = ignore - let _afl_instrument = ignore - let _afl_inst_ratio = ignore - let _alert = ignore - let _annot = ignore - let _binannot = ignore - let _c = ignore - let _cc = ignore - let _cclib = ignore - let _ccopt = ignore - let _clambda_checks = ignore - let _compact = ignore - let _config = ignore - let _config_var = ignore - let _for_pack = ignore - let _g = ignore - let _stop_after = ignore - let _i = ignore - let _I = ignore let _impl _ = with_impl := true - let _inline = ignore - let _inline_toplevel = ignore - let _inlining_report = ignore - let _dump_pass = ignore - let _inline_max_depth = ignore - let _rounds = ignore - let _inline_max_unroll = ignore - let _inline_call_cost = ignore - let _inline_alloc_cost = ignore - let _inline_prim_cost = ignore - let _inline_branch_cost = ignore - let _inline_indirect_cost = ignore - let _inline_lifting_benefit = ignore - let _inline_branch_factor = ignore - let _classic_inlining = ignore - let _insn_sched = ignore let _intf _ = with_intf := true - let _intf_suffix = ignore - let _keep_docs = ignore - let _no_keep_docs = ignore - let _keep_locs = ignore - let _no_keep_locs = ignore - let _labels = ignore - let _linkall = ignore - let _alias_deps = ignore - let _no_alias_deps = ignore - let _app_funct = ignore - let _no_app_funct = ignore - let _no_float_const_prop = ignore - let _noassert = ignore - let _noautolink = ignore - let _nodynlink = ignore - let _no_insn_sched = ignore - let _nolabels = ignore - let _nostdlib = ignore - let _no_unbox_free_vars_of_closures = ignore - let _no_unbox_specialised_args = ignore - let _o = ignore - let _o2 = ignore - let _o3 = ignore - let _open = ignore - let _output_obj = ignore - let _output_complete_obj = ignore - let _p = ignore - let _pack = ignore - let _plugin = ignore let _pp _s = incompatible "-pp" let _ppx _s = incompatible "-ppx" - let _principal = ignore - let _no_principal = ignore - let _rectypes = ignore - let _no_rectypes = ignore - let _remove_unused_arguments = ignore - let _runtime_variant = ignore - let _with_runtime = ignore - let _without_runtime = ignore - let _S = ignore - let _safe_string = ignore - let _short_paths = ignore - let _strict_sequence = ignore - let _no_strict_sequence = ignore - let _strict_formats = ignore - let _no_strict_formats = ignore - let _shared = ignore - let _thread = ignore - let _unbox_closures = ignore - let _unbox_closures_factor = ignore - let _unboxed_types = ignore - let _no_unboxed_types = ignore - let _unsafe = ignore - let _unsafe_string = ignore - let _v = ignore - let _version = ignore - let _vnum = ignore - let _verbose = ignore - let _w = ignore - let _warn_error = ignore - let _warn_help = ignore - let _color = ignore - let _error_style = ignore - let _where = ignore - - let _linscan = ignore - let _nopervasives = ignore - let _match_context_rows = ignore - let _dump_into_file = ignore - let _dno_unique_ids = ignore - let _dunique_ids = ignore - let _dsource = ignore - let _dparsetree = ignore - let _dtypedtree = ignore - let _drawlambda = ignore - let _dlambda = ignore - let _drawclambda = ignore - let _dclambda = ignore - let _drawflambda = ignore - let _dflambda = ignore - let _dflambda_invariants = ignore - let _dflambda_no_invariants = ignore - let _dflambda_let = ignore - let _dflambda_verbose = ignore - let _dcmm = ignore - let _dsel = ignore - let _dcombine = ignore - let _dcse = ignore - let _dlive = ignore - let _davail = ignore - let _drunavail = ignore - let _dspill = ignore - let _dsplit = ignore - let _dinterf = ignore - let _dprefer = ignore - let _dalloc = ignore - let _dreload = ignore - let _dscheduling = ignore - let _dlinear = ignore - let _dstartup = ignore - let _dinterval = ignore - let _dtimings = ignore - let _dprofile = ignore - let _opaque = ignore - let _args = Arg.read_arg let _args0 = Arg.read_arg0 let anonymous = process_file diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml index 4ee1ef06..0eed5442 100644 --- a/tools/ocamlprof.ml +++ b/tools/ocamlprof.ml @@ -385,7 +385,7 @@ and rewrite_mod iflag smod = match smod.pmod_desc with Pmod_ident _ -> () | Pmod_structure sstr -> List.iter (rewrite_str_item iflag) sstr - | Pmod_functor(_param, _smty, sbody) -> rewrite_mod iflag sbody + | Pmod_functor(_param, sbody) -> rewrite_mod iflag sbody | Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2 | Pmod_constraint(smod, _smty) -> rewrite_mod iflag smod | Pmod_unpack(sexp) -> rewrite_exp iflag sexp diff --git a/tools/release-checklist b/tools/release-checklist index 2a9911bd..4da54b40 100644 --- a/tools/release-checklist +++ b/tools/release-checklist @@ -23,13 +23,13 @@ and the OCamlLabs folks (for OPAM testing). rm -f /tmp/env-$USER.sh cat >/tmp/env-$USER.sh < 4.07.0+dev9-2018-06-26 # for production releases: check and change the Changes header # (remove "next version" and add a date) -# Update ocaml-variants.opam file to depend on the new version of ocaml. -git add VERSION Changes ocaml-variants.opam -git commit -m "last commit before tagging $VERSION" +./autogen +git commit -a -m "last commit before tagging $VERSION" + # update VERSION with the new release; for example, # 4.07.0+dev9-2018-06-26 => 4.07.0+rc2 +# Update ocaml-variants.opam with new version. +# Update \year in manual/manual/macros.hva +rm -r autom4te.cache +./autogen make coreboot -j5 make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded." -git commit -m "change VERSION for $VERSION" -a +git commit -m "release $VERSION" -a git tag -m "release $VERSION" $VERSION # for production releases, change the VERSION file into (N+1)+dev0; for example, # 4.08.0 => 4.08.1+dev0 # for testing candidates, use N+dev(D+2) instead; for example, # 4.07.0+rc2 => 4.07.0+dev10-2018-06-26 -git commit -m "increment version number after tagging $VERSION" VERSION +# Revert ocaml-variants.opam to its "trunk" version. +rm -r autom4te.cache +./autogen +git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam git push git push --tags ``` +## 5.1: create the release on github (only for a production release) -## 6: create OPAM switches +open https://github.com/ocaml/ocaml/releases +# and click "Draft a new release" +# for a minor release, the description is: + Bug fixes. See [detailed list of changes](https://github.com/ocaml/ocaml/blob/$MAJOR.$MINOR/Changes). -Create OPAM switches for the new version, copying the particular -switch configuration choices from the previous version. - -We currently use a semi-automated process, copying and batch-editing -the compiler descriptions from the last release. The instructions -below assume an opam1 repository organization, an opam2 repository -will have a different layout. - -From a branch of the opam-repository, in `compilers/$MAJOR.$MINOR.$BUGFIX`: - -``` -cd .../opam-repository/packages/ocaml-variants -# copy foo+rc2+... switches into foo+rc3+... -OLD_DIRS=*+rc2* -VER="s/+rc2/+rc3/g" -NEW_DIRS="" -for f in $OLD_DIRS; do NEW_DIRS="$NEW_DIRS $(echo $f | sed $VER)"; done -echo $NEW_DIRS # for checking +## 6: create OPAM packages -for f in $OLD_DIRS; do - mkdir -p $(echo $f | sed $VER) - for file in $f/*; do - cp $file $(echo $file | sed $VER) - # we copy the file, but their content still corresponds to the old version - done - git add $(echo $f | sed $VER) -done - -git status - # inspect the new filenames - -for f in $NEW_DIRS; do sed -i $VER $f/*; done -git diff # inspect the result of this last change - -git add $NEW_DIRS - -# the strings below work on .descr files, -# they may need to be adapted -for f in $NEW_DIRS; do - sed -i "s/rc2/rc3/g" $f/* - sed -i "s/Second release candidate/Third release candidate/g" $f/* -done -git diff # inspect the result of this last change - -git add $NEW_DIRS - -git diff --cached # inspect the complete result +Create ocaml-variants packages for the new version, copying the particular +switch configuration choices from the previous version. -git commit -m "OPAM switches for $VERSION" -``` +Do not forget to add/update the checksum field for the tarballs in the +"url" section of the opam files. Use opam-lint before sending the pull +request. ## 7: build the release archives @@ -262,7 +228,7 @@ it was a release candidate. ``` cd $WORKTREE -make world.opt +make make install export PATH="$INSTDIR/bin:$PATH" cd manual @@ -294,12 +260,14 @@ source /tmp/env-$USER.sh cd $WEB_PATH/caml/pub/docs mkdir -p manual-ocaml-$BRANCH cd manual-ocaml-$BRANCH +rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz wget http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$BRANCH-refman-html.tar.gz tar -xzvf ocaml-$BRANCH-refman-html.tar.gz # this extracts into htmlman/ -cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH -rm -fR htmlman +/bin/cp -r htmlman/* . # move HTML content to docs/manual-caml-$BRANCH +rm -fR htmlman ocaml-$BRANCH-refman-html.tar.gz cd $WEB_PATH/caml/pub/docs +rm manual-ocaml ln -sf manual-ocaml-$BRANCH manual-ocaml ``` @@ -312,10 +280,6 @@ organize the webpage for the new release. See -## 12: update Mantis - -(this section intentionally left blank) - ## 13: announce the release on caml-list and caml-announce See the email announce templates at the end of this file. @@ -349,16 +313,33 @@ Happy hacking, ``` Dear OCaml users, -The release of OCaml version is imminent. We have -created a for your testing pleasure. Please -download the sources, compile, install, and test your favourite -software with it. Then let me know whether it works for you. +The release of OCaml version $MAJOR.$MINOR.$BUGFIX is imminent. We have +created a release candidate that you can test. + +The source code is available at these addresses: + + https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz + https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ocaml-$VERSION.tar.gz -We want to know about any show-stopping bugs, especially in the -compilation and installation phases. +The compiler can also be installed as an OPAM switch with one of the +following commands. + +opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git + +or -This is available as source code at this -address: < http://caml.inria.fr/pub/distrib/ocaml-$BRANCH/ > +opam switch create ocaml-variants.$VERSION+ --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git + + where you replace with one of these: + afl + default-unsafe-string + force-safe-string + flambda + fp + fp+flambda + +We want to know about all bugs. Please report them here: + https://github.com/ocaml/ocaml/issues Happy hacking, @@ -372,27 +353,28 @@ Happy hacking, ``` Dear OCaml users, -The release of OCaml 4.08.0 is approaching. We have created +The release of OCaml $MAJOR.$MINOR.$BUGFIX is approaching. We have created a beta version to help you adapt your software to the new features ahead of the release. The source code is available at these addresses: - https://github.com/ocaml/ocaml/archive/4.08.0+beta1.tar.gz - https://caml.inria.fr/pub/distrib/ocaml-4.08/ocaml-4.08.0+beta1.tar.gz + https://github.com/ocaml/ocaml/archive/$VERSION.tar.gz + https://caml.inria.fr/pub/distrib/ocaml-$BRANCH/$VERSION.tar.gz The compiler can also be installed as an OPAM switch with one of the following commands. -opam switch create ocaml-variants.4.08.0+beta1 --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git +opam switch create ocaml-variants.$VERSION --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git or -opam switch create ocaml-variants.4.08.0+beta1+ --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git +opam switch create ocaml-variants.$VERSION+ --repositories=default,beta=git+https://github.com/ocaml/ocaml-beta-repository.git where you replace with one of these: afl - default_unsafe_string + default-unsafe-string + force-safe-string flambda fp fp+flambda diff --git a/tools/scrapelabels.ml b/tools/scrapelabels.ml deleted file mode 100644 index 1c600414..00000000 --- a/tools/scrapelabels.ml +++ /dev/null @@ -1,290 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jacques Garrigue, Kyoto University RIMS *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -open StdLabels -open Lexer301 - -let input_buffer = Buffer.create 16383 -let input_function ic buf len = - let len = input ic buf 0 len in - Buffer.add_substring input_buffer buf 0 len; - len - -let output_buffer = Buffer.create 16383 - -let modified = ref false - -let modules = - ref [ "Arg"; "BigArray"; "Buffer"; "Condition"; "Dbm"; "Digest"; "Dynlink"; - "Event"; "Filename"; "Format"; "Gc"; "Genlex"; - "Lexing"; "Marshal"; "Mutex"; "Parsing"; "Pervasives"; "Queue"; - "Stack"; "Str"; "Stream"; "Sys"; - "Thread"; "ThreadUnix"; "Weak" ] - -let stdlabels = ["Array"; "List"; "String"] -let morelabels = ["Hashtbl"; "Map"; "Set"] -let alllabels = ref false -let noopen = ref false - -exception Closing of token - -let convert_impl buffer = - let input_pos = ref 0 in - let copy_input stop = - Buffer.add_substring output_buffer (Buffer.contents input_buffer) - !input_pos (stop - !input_pos); - input_pos := stop - in - let next_token () = - let token = Lexer301.token buffer - and start = Lexing.lexeme_start buffer - and stop = Lexing.lexeme_end buffer in - match token with - RPAREN | RBRACKET |BARRBRACKET | GREATERRBRACKET | END - | RBRACE | GREATERRBRACE -> - raise (Closing token) - | EOF -> - raise End_of_file - | _ -> - (token, start, stop) - in - let openunix = ref None and openstd = ref None and openmore = ref None in - let rec may_start (token, s, e) = - match token with - LIDENT _ -> search_start (dropext (next_token ())) - | UIDENT m when List.mem m !modules -> - may_discard (dropext (next_token ())) - | UIDENT m -> - List.iter ~f: - (fun (set,r) -> - if !r = None && List.mem m ~set then r := Some true) - [stdlabels, openstd; ["Unix"], openunix; morelabels, openmore]; - search_start (next_token ()) - | _ -> search_start (token, s, e) - - and dropext (token, s, e) = - match token with - DOT -> - let (token, s, e) = next_token () in - begin match token with - LPAREN | LBRACKET | LBRACE -> - process_paren (token, s, e); - dropext (next_token ()) - | UIDENT _ | LIDENT _ -> - dropext (next_token ()) - | _ -> - prerr_endline ("bad index at position " ^ Int.to_string s); - (token, s, e) - end - | _ -> - (token, s, e) - - and may_discard (token, s, e) = - match token with - TILDE | LABEL _ -> - modified := true; - copy_input s; input_pos := e; - may_discard (next_token ()) - | _ when !alllabels -> - may_discard (next_token ()) - | LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN - | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT-> - process_paren (token, s, e); - may_discard (next_token ()) - | PREFIXOP _ -> - may_discard (next_token ()) - | LIDENT _ | UIDENT _ -> - may_discard (dropext (next_token ())) - | BACKQUOTE -> - ignore (next_token ()); - may_discard (next_token ()) - | INT _ | CHAR _ | STRING _ | FLOAT _ | FALSE | TRUE -> - may_discard (next_token ()) - | _ -> - search_start (token, s, e) - - and search_start (token, s, e) = - match token with - LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN - | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT -> - process_paren (token, s, e); - search_start (next_token ()) - | EQUAL | SEMI | SEMISEMI | MINUSGREATER | LESSMINUS | COMMA - | IF | THEN | ELSE | WHILE | TO | DOWNTO | DO | IN | MATCH | TRY - | INFIXOP0 _ | INFIXOP1 _ | INFIXOP2 _ | INFIXOP3 _ | INFIXOP4 _ - | PLUS | MINUS | MINUSDOT | STAR | LESS | GREATER - | OR | BARBAR | AMPERSAND | AMPERAMPER | COLONEQUAL -> - may_start (next_token ()) - | OPEN -> - begin match next_token () with - | UIDENT m, _, _ -> - List.iter - ~f:(fun (set,r) -> if List.mem m ~set then r := Some false) - [stdlabels, openstd; ["Unix"], openunix; morelabels, openmore] - | _ -> () - end; - search_start (next_token ()) - | _ -> - search_start (next_token ()) - - and process_paren (token, s, e) = - try match token with - LPAREN | LBRACKET | LBRACKETBAR | LBRACKETLESS | BEGIN -> - may_start (next_token ()) - | LBRACE | LBRACELESS | STRUCT | SIG | OBJECT -> - search_start (next_token ()) - | _ -> - assert false - with Closing last -> - match token, last with - LPAREN, RPAREN - | (LBRACKET|LBRACKETBAR|LBRACKETLESS), - (RBRACKET|BARRBRACKET|GREATERRBRACKET) - | (BEGIN|STRUCT|SIG|OBJECT), END - | LBRACE, RBRACE - | LBRACELESS, GREATERRBRACE -> () - | _ -> raise (Closing last) - in - let first = next_token () in - try - if !alllabels then may_discard first else may_start first - with End_of_file -> - copy_input (Buffer.length input_buffer); - if not !alllabels - && List.exists (fun r -> !r = Some true) [openstd; openunix; openmore] - then begin - modified := true; - let text = Buffer.contents output_buffer in - Buffer.clear output_buffer; - let (token, s, _) = first in - Buffer.add_substring output_buffer text 0 s; - List.iter ~f: - (fun (r, s) -> - if !r = Some true then Buffer.add_string output_buffer s) - [ openstd, "open StdLabels\n"; openmore, "open MoreLabels\n"; - openunix, "module Unix = UnixLabels\n" ]; - let sep = - if List.mem token [CLASS; EXTERNAL; EXCEPTION; FUNCTOR; LET; - MODULE; FUNCTOR; TYPE; VAL] - then "\n" - else if token = OPEN then "" else ";;\n\n" - in - Buffer.add_string output_buffer sep; - Buffer.add_substring output_buffer text s (String.length text - s) - end - | Closing _ -> - prerr_endline ("bad closing token at position " ^ - Int.to_string (Lexing.lexeme_start buffer)); - modified := false - -type state = Out | Enter | In | Escape - -let convert_intf buffer = - let input_pos = ref 0 in - let copy_input stop = - Buffer.add_substring output_buffer (Buffer.contents input_buffer) - !input_pos (stop - !input_pos); - input_pos := stop - in - let last = ref (EOF, 0, 0) in - let state = ref Out in - try while true do - let token = Lexer301.token buffer - and start = Lexing.lexeme_start buffer - and stop = Lexing.lexeme_end buffer - and last_token, last_start, last_stop = !last in - begin match token with - | EXCEPTION | CONSTRAINT -> - state := In - | VAL | EXTERNAL | CLASS | METHOD | TYPE | AND -> - state := Enter - | EQUAL when !state = Enter -> - state := In - | COLON -> - begin match !state, last_token with - | In, LIDENT _ -> - modified := true; - copy_input last_start; - input_pos := stop - | Enter, _ -> - state := In - | Escape, _ -> - state := In - | _ -> - state := Out - end - | LBRACE | SEMI | QUESTION when !state = In -> - state := Escape - | SEMISEMI | SIG | STRUCT | END | OBJECT | OPEN | INCLUDE | MODULE -> - state := Out - | EOF -> raise End_of_file - | _ -> () - end; - last := (token, start, stop) - done with - End_of_file -> - copy_input (Buffer.length input_buffer) - -let convert_file ~intf name = - let ic = open_in name in - Buffer.clear input_buffer; - Buffer.clear output_buffer; - modified := false; - begin - let convert = if intf then convert_intf else convert_impl in - try convert (Lexing.from_function (input_function ic)); close_in ic - with exn -> close_in ic; raise exn - end; - if !modified then begin - let backup = name ^ ".bak" in - if Sys.file_exists backup then Sys.remove name - else Sys.rename name backup; - let oc = open_out name in - Buffer.output_buffer oc output_buffer; - close_out oc - end - else prerr_endline ("No changes in " ^ name) - -let _ = - let files = ref [] and intf = ref false - and keepstd = ref false and keepmore = ref false in - Arg.parse - [ "-intf", Arg.Set intf, - " remove all non-optional labels from an interface;\n" ^ - " other options are ignored"; - "-all", Arg.Set alllabels, - " remove all labels, possibly including optional ones!"; - "-keepstd", Arg.Set keepstd, - " keep labels for Array, List, String and Unix"; - "-keepmore", Arg.Set keepmore, - " keep also labels for Hashtbl, Map and Set; implies -keepstd"; - "-m", Arg.String (fun s -> modules := s :: !modules), - " remove also labels for "; - "-noopen", Arg.Set noopen, - " do not insert `open' statements for -keepstd/-keepmore" ] - (fun s -> files := s :: !files) - ("Usage: scrapelabels \n" ^ - " Remove labels from function arguments in standard library modules.\n" ^ - " With -intf option below, can also process interfaces.\n" ^ - " Old files are renamed to .bak if there is no backup yet.\n" ^ - "Options are:"); - if !keepmore then keepstd := true; - if not !keepstd then modules := "Unix" :: stdlabels @ !modules; - if not !keepmore then modules := morelabels @ !modules; - List.iter (List.rev !files) ~f: - begin fun name -> - prerr_endline ("Processing " ^ name); - Printexc.catch (convert_file ~intf:!intf) name - end diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index bda4fd9c..b8650375 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -197,16 +197,16 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct it comes from. Attempt to omit the prefix if the type comes from a module that has been opened. *) - let tree_of_qualified lookup_fun env ty_path name = + let tree_of_qualified find env ty_path name = match ty_path with | Pident _ -> Oide_ident name | Pdot(p, _s) -> - if try - match (lookup_fun (Lident (Out_name.print name)) env).desc with - | Tconstr(ty_path', _, _) -> Path.same ty_path ty_path' - | _ -> false - with Not_found -> false + if + match (find (Lident (Out_name.print name)) env).desc with + | Tconstr(ty_path', _, _) -> Path.same ty_path ty_path' + | _ -> false + | exception Not_found -> false then Oide_ident name else Oide_dot (Printtyp.tree_of_path p, Out_name.print name) | Papply _ -> @@ -214,10 +214,13 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct let tree_of_constr = tree_of_qualified - (fun lid env -> (Env.lookup_constructor lid env).cstr_res) + (fun lid env -> + (Env.find_constructor_by_name lid env).cstr_res) and tree_of_label = - tree_of_qualified (fun lid env -> (Env.lookup_label lid env).lbl_res) + tree_of_qualified + (fun lid env -> + (Env.find_label_by_name lid env).lbl_res) (* An abstract type *) @@ -548,7 +551,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct try (* Attempt to recover the constructor description for the exn from its name *) - let cstr = Env.lookup_constructor lid env in + let cstr = Env.find_constructor_by_name lid env in let path = match cstr.cstr_tag with Cstr_extension(p, _) -> p diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli index a74de583..7e150fc8 100644 --- a/toplevel/genprintval.mli +++ b/toplevel/genprintval.mli @@ -69,5 +69,5 @@ module type S = Env.t -> t -> type_expr -> Outcometree.out_value end -module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) : +module Make(O : OBJ)(_ : EVALPATH with type valu = O.t) : (S with type t = O.t) diff --git a/toplevel/opttopdirs.ml b/toplevel/opttopdirs.ml index 5dfe97d0..967c236c 100644 --- a/toplevel/opttopdirs.ml +++ b/toplevel/opttopdirs.ml @@ -125,11 +125,15 @@ type 'a printer_type_old = 'a -> unit let match_printer_type ppf desc typename = let printer_type = - try - Env.lookup_type (Ldot(Lident "Opttopdirs", typename)) !toplevel_env - with Not_found -> - fprintf ppf "Cannot find type Topdirs.%s.@." typename; - raise Exit in + match + Env.find_type_by_name + (Ldot(Lident "Opttopdirs", typename)) !toplevel_env + with + | (path, _) -> path + | exception Not_found -> + fprintf ppf "Cannot find type Topdirs.%s.@." typename; + raise Exit + in Ctype.begin_def(); let ty_arg = Ctype.newvar() in Ctype.unify !toplevel_env @@ -140,22 +144,22 @@ let match_printer_type ppf desc typename = ty_arg let find_printer_type ppf lid = - try - let (path, desc) = Env.lookup_value lid !toplevel_env in - let (ty_arg, is_old_style) = - try - (match_printer_type ppf desc "printer_type_new", false) - with Ctype.Unify _ -> - (match_printer_type ppf desc "printer_type_old", true) in - (ty_arg, path, is_old_style) - with - | Not_found -> + match Env.find_value_by_name lid !toplevel_env with + | (path, desc) -> begin + match match_printer_type ppf desc "printer_type_new" with + | ty_arg -> (ty_arg, path, false) + | exception Ctype.Unify _ -> begin + match match_printer_type ppf desc "printer_type_old" with + | ty_arg -> (ty_arg, path, true) + | exception Ctype.Unify _ -> + fprintf ppf "%a has a wrong type for a printing function.@." + Printtyp.longident lid; + raise Exit + end + end + | exception Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid; raise Exit - | Ctype.Unify _ -> - fprintf ppf "%a has a wrong type for a printing function.@." - Printtyp.longident lid; - raise Exit let dir_install_printer ppf lid = try diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 0174a9ab..c74f2147 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -187,7 +187,7 @@ let parse_mod_use_file name lb = [ Ptop_def [ Str.module_ (Mb.mk - (Location.mknoloc modname) + (Location.mknoloc (Some modname)) (Mod.structure items) ) ] @@ -248,19 +248,24 @@ let load_lambda ppf ~module_ident ~required_globals lam size = if !Clflags.keep_asm_file then !phrase_name ^ ext_dll else Filename.temp_file ("caml" ^ !phrase_name) ext_dll in - let fn = Filename.chop_extension dll in - if not Config.flambda then - Asmgen.compile_implementation_clambda - ~toplevel:need_symbol fn ~backend ~ppf_dump:ppf - { Lambda.code=slam ; main_module_block_size=size; - module_ident; required_globals } - else - Asmgen.compile_implementation_flambda - ~required_globals ~backend ~toplevel:need_symbol fn ~ppf_dump:ppf - (Flambda_middle_end.middle_end ~ppf_dump:ppf ~prefixname:fn ~backend ~size - ~module_ident ~module_initializer:slam ~filename:"toplevel"); - Asmlink.call_linker_shared [fn ^ ext_obj] dll; - Sys.remove (fn ^ ext_obj); + let filename = Filename.chop_extension dll in + let program = + { Lambda. + code = slam; + main_module_block_size = size; + module_ident; + required_globals; + } + in + let middle_end = + if Config.flambda then Flambda_middle_end.lambda_to_clambda + else Closure_middle_end.lambda_to_clambda + in + Asmgen.compile_implementation ~toplevel:need_symbol + ~backend ~filename ~prefixname:filename + ~middle_end ~ppf_dump:ppf program; + Asmlink.call_linker_shared [filename ^ ext_obj] dll; + Sys.remove (filename ^ ext_obj); let dll = if Filename.is_implicit dll @@ -539,17 +544,42 @@ let _ = Clflags.dlcode := true; () +let find_ocamlinit () = + let ocamlinit = ".ocamlinit" in + if Sys.file_exists ocamlinit then Some ocamlinit else + let getenv var = match Sys.getenv var with + | exception Not_found -> None | "" -> None | v -> Some v + in + let exists_in_dir dir file = match dir with + | None -> None + | Some dir -> + let file = Filename.concat dir file in + if Sys.file_exists file then Some file else None + in + let home_dir () = getenv "HOME" in + let config_dir () = + if Sys.win32 then None else + match getenv "XDG_CONFIG_HOME" with + | Some _ as v -> v + | None -> + match home_dir () with + | None -> None + | Some dir -> Some (Filename.concat dir ".config") + in + let init_ml = Filename.concat "ocaml" "init.ml" in + match exists_in_dir (config_dir ()) init_ml with + | Some _ as v -> v + | None -> exists_in_dir (home_dir ()) ocamlinit + let load_ocamlinit ppf = if !Clflags.noinit then () else match !Clflags.init_file with | Some f -> if Sys.file_exists f then ignore (use_silently ppf f) else fprintf ppf "Init file not found: \"%s\".@." f | None -> - if Sys.file_exists ".ocamlinit" then ignore (use_silently ppf ".ocamlinit") - else try - let home_init = Filename.concat (Sys.getenv "HOME") ".ocamlinit" in - if Sys.file_exists home_init then ignore (use_silently ppf home_init) - with Not_found -> () + match find_ocamlinit () with + | None -> () + | Some file -> ignore (use_silently ppf file) ;; let set_paths () = diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml index 0a96b579..b0573173 100644 --- a/toplevel/opttopmain.ml +++ b/toplevel/opttopmain.ml @@ -78,16 +78,6 @@ let file_argument name = else exit 2 end -let print_version () = - Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version; - exit 0; -;; - -let print_version_num () = - Printf.printf "%s\n" Sys.ocaml_version; - exit 0; -;; - let wrap_expand f s = let start = !current in let arr = f s in @@ -95,163 +85,11 @@ let wrap_expand f s = arr module Options = Main_args.Make_opttop_options (struct - let set r () = r := true - let clear r () = r := false - - let _absname = set absname - let _alert = Warnings.parse_alert_option - let _compact = clear optimize_for_speed - let _I dir = include_dirs := dir :: !include_dirs - let _init s = init_file := Some s - let _noinit = set noinit - let _clambda_checks () = clambda_checks := true - let _inline spec = - Float_arg_helper.parse spec - "Syntax: -inline | =[,...]" - inline_threshold - let _inline_indirect_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-indirect-cost | =[,...]" - inline_indirect_cost - let _inline_toplevel spec = - Int_arg_helper.parse spec - "Syntax: -inline-toplevel | =[,...]" - inline_toplevel_threshold - let _inlining_report () = inlining_report := true - let _dump_pass pass = set_dumped_pass pass true - let _rounds n = simplify_rounds := Some n - let _inline_max_unroll spec = - Int_arg_helper.parse spec - "Syntax: -inline-max-unroll | =[,...]" - inline_max_unroll - let _classic_inlining () = classic_inlining := true - let _inline_call_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-call-cost | =[,...]" - inline_call_cost - let _inline_alloc_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-alloc-cost | =[,...]" - inline_alloc_cost - let _inline_prim_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-prim-cost | =[,...]" - inline_prim_cost - let _inline_branch_cost spec = - Int_arg_helper.parse spec - "Syntax: -inline-branch-cost | =[,...]" - inline_branch_cost - let _inline_lifting_benefit spec = - Int_arg_helper.parse spec - "Syntax: -inline-lifting-benefit | =[,...]" - inline_lifting_benefit - let _inline_branch_factor spec = - Float_arg_helper.parse spec - "Syntax: -inline-branch-factor | =[,...]" - inline_branch_factor - let _inline_max_depth spec = - Int_arg_helper.parse spec - "Syntax: -inline-max-depth | =[,...]" - inline_max_depth - let _insn_sched = set insn_sched - let _no_insn_sched = clear insn_sched - let _no_unbox_free_vars_of_closures = clear unbox_free_vars_of_closures - let _no_unbox_specialised_args = clear unbox_specialised_args - let _o s = output_name := Some s - let _o2 () = - default_simplify_rounds := 2; - use_inlining_arguments_set o2_arguments; - use_inlining_arguments_set ~round:0 o1_arguments - let _o3 () = - default_simplify_rounds := 3; - use_inlining_arguments_set o3_arguments; - use_inlining_arguments_set ~round:1 o2_arguments; - use_inlining_arguments_set ~round:0 o1_arguments - let _remove_unused_arguments = set remove_unused_arguments - let _unbox_closures = set unbox_closures - let _unbox_closures_factor f = unbox_closures_factor := f - let _drawclambda = set dump_rawclambda - let _dclambda = set dump_clambda - let _drawflambda = set dump_rawflambda - 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 _dflambda_no_invariants = clear flambda_invariant_checks - let _labels = clear classic - let _alias_deps = clear transparent_modules - let _no_alias_deps = set transparent_modules - let _dlinscan = set use_linscan - let _app_funct = set applicative_functors - let _no_app_funct = clear applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noprompt = set noprompt - let _nopromptcont = set nopromptcont - let _nostdlib = set no_std_include - let _nopervasives = set nopervasives - let _ppx s = Compenv.first_ppx := s :: !Compenv.first_ppx - let _principal = set principal - let _no_principal = clear principal - let _real_paths = set real_paths - let _rectypes = set recursive_types - let _no_rectypes = clear recursive_types - let _strict_sequence = set strict_sequence - let _no_strict_sequence = clear strict_sequence - let _strict_formats = set strict_formats - let _no_strict_formats = clear strict_formats - let _S = set keep_asm_file - let _short_paths = clear real_paths - let _stdin () = file_argument "" - let _unboxed_types = set unboxed_types - let _no_unboxed_types = clear unboxed_types - let _unsafe = set unsafe - let _verbose = set verbose - let _version () = print_version () - let _vnum () = print_version_num () - let _no_version = set noversion - let _w s = Warnings.parse_options false s - let _warn_error s = Warnings.parse_options true s - let _warn_help = Warnings.help_warnings - - let _dno_unique_ids = clear unique_ids - let _dunique_ids = set unique_ids - let _dsource = set dump_source - let _dparsetree = set dump_parsetree - 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 - let _dcombine = set dump_combine - let _dcse = set dump_cse - let _dlive () = dump_live := true; Printmach.print_live := true - let _davail () = dump_avail := true - let _drunavail () = debug_runavail := true - let _dspill = set dump_spill - let _dsplit = set dump_split - let _dinterf = set dump_interf - let _dprefer = set dump_prefer - let _dalloc = set dump_regalloc - let _dreload = set dump_reload - let _dscheduling = set dump_scheduling - let _dlinear = set dump_linear - let _dinterval = set dump_interval - let _dstartup = set keep_startup_file - let _safe_string = clear unsafe_string - let _unsafe_string = set unsafe_string - let _open s = open_modules := s :: !open_modules - let _color = Misc.set_or_ignore color_reader.parse color - let _error_style = Misc.set_or_ignore error_style_reader.parse error_style - - let _args = wrap_expand Arg.read_arg - let _args0 = wrap_expand Arg.read_arg0 - - let anonymous = file_argument + include Main_args.Default.Opttopmain + let _stdin () = file_argument "" + let _args = wrap_expand Arg.read_arg + let _args0 = wrap_expand Arg.read_arg0 + let anonymous s = file_argument s end);; let () = diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 8469d84b..f4526692 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -280,11 +280,15 @@ type 'a printer_type_old = 'a -> unit let printer_type ppf typename = let printer_type = - try - Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env - with Not_found -> - fprintf ppf "Cannot find type Topdirs.%s.@." typename; - raise Exit in + match + Env.find_type_by_name + (Ldot(Lident "Topdirs", typename)) !toplevel_env + with + | path, _ -> path + | exception Not_found -> + fprintf ppf "Cannot find type Topdirs.%s.@." typename; + raise Exit + in printer_type let match_simple_printer_type desc printer_type = @@ -333,18 +337,18 @@ let match_printer_type ppf desc = false) let find_printer_type ppf lid = - try - let (path, desc) = Env.lookup_value lid !toplevel_env in - let (ty_arg, is_old_style) = match_printer_type ppf desc in - (ty_arg, path, is_old_style) - with - | Not_found -> - fprintf ppf "Unbound value %a.@." Printtyp.longident lid; - raise Exit - | Ctype.Unify _ -> + match Env.find_value_by_name lid !toplevel_env with + | (path, desc) -> begin + match match_printer_type ppf desc with + | (ty_arg, is_old_style) -> (ty_arg, path, is_old_style) + | exception Ctype.Unify _ -> fprintf ppf "%a has a wrong type for a printing function.@." Printtyp.longident lid; raise Exit + end + | exception Not_found -> + fprintf ppf "Unbound value %a.@." Printtyp.longident lid; + raise Exit let dir_install_printer ppf lid = try @@ -407,59 +411,60 @@ let tracing_function_ptr = (Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg)) let dir_trace ppf lid = - try - let (path, desc) = Env.lookup_value lid !toplevel_env in - (* Check if this is a primitive *) - match desc.val_kind with - | Val_prim _ -> - fprintf ppf "%a is an external function and cannot be traced.@." - Printtyp.longident lid - | _ -> - let clos = eval_value_path !toplevel_env path in - (* Nothing to do if it's not a closure *) - if Obj.is_block clos - && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag) - && (match Ctype.(repr (expand_head !toplevel_env desc.val_type)) - with {desc=Tarrow _} -> true | _ -> false) - then begin - match is_traced clos with - | Some opath -> - fprintf ppf "%a is already traced (under the name %a).@." - Printtyp.path path - Printtyp.path opath - | None -> - (* Instrument the old closure *) - traced_functions := - { path = path; - closure = clos; - actual_code = get_code_pointer clos; - instrumented_fun = - instrument_closure !toplevel_env lid ppf desc.val_type } - :: !traced_functions; - (* Redirect the code field of the closure to point - to the instrumentation function *) - set_code_pointer clos tracing_function_ptr; - fprintf ppf "%a is now traced.@." Printtyp.longident lid - end else fprintf ppf "%a is not a function.@." Printtyp.longident lid - with - | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid + match Env.find_value_by_name lid !toplevel_env with + | (path, desc) -> begin + (* Check if this is a primitive *) + match desc.val_kind with + | Val_prim _ -> + fprintf ppf "%a is an external function and cannot be traced.@." + Printtyp.longident lid + | _ -> + let clos = eval_value_path !toplevel_env path in + (* Nothing to do if it's not a closure *) + if Obj.is_block clos + && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag) + && (match Ctype.(repr (expand_head !toplevel_env desc.val_type)) + with {desc=Tarrow _} -> true | _ -> false) + then begin + match is_traced clos with + | Some opath -> + fprintf ppf "%a is already traced (under the name %a).@." + Printtyp.path path + Printtyp.path opath + | None -> + (* Instrument the old closure *) + traced_functions := + { path = path; + closure = clos; + actual_code = get_code_pointer clos; + instrumented_fun = + instrument_closure !toplevel_env lid ppf desc.val_type } + :: !traced_functions; + (* Redirect the code field of the closure to point + to the instrumentation function *) + set_code_pointer clos tracing_function_ptr; + fprintf ppf "%a is now traced.@." Printtyp.longident lid + end else fprintf ppf "%a is not a function.@." Printtyp.longident lid + end + | exception Not_found -> + fprintf ppf "Unbound value %a.@." Printtyp.longident lid let dir_untrace ppf lid = - try - let (path, _desc) = Env.lookup_value lid !toplevel_env in - let rec remove = function - | [] -> - fprintf ppf "%a was not traced.@." Printtyp.longident lid; - [] - | f :: rem -> - if Path.same f.path path then begin - set_code_pointer f.closure f.actual_code; - fprintf ppf "%a is no longer traced.@." Printtyp.longident lid; - rem - end else f :: remove rem in - traced_functions := remove !traced_functions - with - | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid + match Env.find_value_by_name lid !toplevel_env with + | (path, _desc) -> + let rec remove = function + | [] -> + fprintf ppf "%a was not traced.@." Printtyp.longident lid; + [] + | f :: rem -> + if Path.same f.path path then begin + set_code_pointer f.closure f.actual_code; + fprintf ppf "%a is no longer traced.@." Printtyp.longident lid; + rem + end else f :: remove rem in + traced_functions := remove !traced_functions + | exception Not_found -> + fprintf ppf "Unbound value %a.@." Printtyp.longident lid let dir_untrace_all ppf () = List.iter @@ -531,7 +536,7 @@ let reg_show_prim name to_sig doc = let () = reg_show_prim "show_val" (fun env loc id lid -> - let _path, desc = Typetexp.find_value env loc lid in + let _path, desc = Env.lookup_value ~loc lid env in [ Sig_value (id, desc, Exported) ] ) "Print the signature of the corresponding value." @@ -539,7 +544,7 @@ let () = let () = reg_show_prim "show_type" (fun env loc id lid -> - let _path, desc = Typetexp.find_type env loc lid in + let _path, desc = Env.lookup_type ~loc lid env in [ Sig_type (id, desc, Trec_not, Exported) ] ) "Print the signature of the corresponding type constructor." @@ -547,7 +552,7 @@ let () = let () = reg_show_prim "show_exception" (fun env loc id lid -> - let desc = Typetexp.find_constructor env loc lid in + let desc = Env.lookup_constructor ~loc Env.Positive lid env in if not (Ctype.equal env true [desc.cstr_res] [Predef.type_exn]) then raise Not_found; let ret_type = @@ -570,26 +575,27 @@ let () = let () = reg_show_prim "show_module" (fun env loc id lid -> - let rec accum_aliases path acc = - let md = Env.find_module path env in + let rec accum_aliases md acc = let acc = Sig_module (id, Mp_present, {md with md_type = trim_signature md.md_type}, Trec_not, Exported) :: acc in match md.md_type with - | Mty_alias path -> accum_aliases path acc + | Mty_alias path -> + let md = Env.find_module path env in + accum_aliases md acc | Mty_ident _ | Mty_signature _ | Mty_functor _ -> List.rev acc in - let path, _ = Typetexp.find_module env loc lid in - accum_aliases path [] + let _, md = Env.lookup_module ~loc lid env in + accum_aliases md [] ) "Print the signature of the corresponding module." let () = reg_show_prim "show_module_type" (fun env loc id lid -> - let _path, desc = Typetexp.find_modtype env loc lid in + let _path, desc = Env.lookup_modtype ~loc lid env in [ Sig_modtype (id, desc, Exported) ] ) "Print the signature of the corresponding module type." @@ -597,7 +603,7 @@ let () = let () = reg_show_prim "show_class" (fun env loc id lid -> - let _path, desc = Typetexp.find_class env loc lid in + let _path, desc = Env.lookup_class ~loc lid env in [ Sig_class (id, desc, Trec_not, Exported) ] ) "Print the signature of the corresponding class." @@ -605,7 +611,7 @@ let () = let () = reg_show_prim "show_class_type" (fun env loc id lid -> - let _path, desc = Typetexp.find_class_type env loc lid in + let _path, desc = Env.lookup_cltype ~loc lid env in [ Sig_class_type (id, desc, Trec_not, Exported) ] ) "Print the signature of the corresponding class type." diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index b1226b92..93d6a70f 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -36,6 +36,10 @@ type directive_info = { doc: string; } +(* Phase buffer that stores the last toplevel phrase (see + [Location.input_phrase_buffer]). *) +let phrase_buffer = Buffer.create 1024 + (* The table of toplevel value bindings and its accessors *) let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty @@ -147,7 +151,7 @@ let parse_mod_use_file name lb = [ Ptop_def [ Str.module_ (Mb.mk - (Location.mknoloc modname) + (Location.mknoloc (Some modname)) (Mod.structure items) ) ] @@ -447,6 +451,8 @@ let read_input_default prompt buffer len = if !i >= len then raise Exit; let c = input_char stdin in Bytes.set buffer !i c; + (* Also populate the phrase buffer as new characters are added. *) + Buffer.add_char phrase_buffer c; incr i; if c = '\n' then raise Exit; done; @@ -492,17 +498,42 @@ let _ = Env.import_crcs ~source:Sys.executable_name crc_intfs; () +let find_ocamlinit () = + let ocamlinit = ".ocamlinit" in + if Sys.file_exists ocamlinit then Some ocamlinit else + let getenv var = match Sys.getenv var with + | exception Not_found -> None | "" -> None | v -> Some v + in + let exists_in_dir dir file = match dir with + | None -> None + | Some dir -> + let file = Filename.concat dir file in + if Sys.file_exists file then Some file else None + in + let home_dir () = getenv "HOME" in + let config_dir () = + if Sys.win32 then None else + match getenv "XDG_CONFIG_HOME" with + | Some _ as v -> v + | None -> + match home_dir () with + | None -> None + | Some dir -> Some (Filename.concat dir ".config") + in + let init_ml = Filename.concat "ocaml" "init.ml" in + match exists_in_dir (config_dir ()) init_ml with + | Some _ as v -> v + | None -> exists_in_dir (home_dir ()) ocamlinit + let load_ocamlinit ppf = if !Clflags.noinit then () else match !Clflags.init_file with | Some f -> if Sys.file_exists f then ignore (use_silently ppf f) else fprintf ppf "Init file not found: \"%s\".@." f | None -> - if Sys.file_exists ".ocamlinit" then ignore (use_silently ppf ".ocamlinit") - else try - let home_init = Filename.concat (Sys.getenv "HOME") ".ocamlinit" in - if Sys.file_exists home_init then ignore (use_silently ppf home_init) - with Not_found -> () + match find_ocamlinit () with + | None -> () + | Some file -> ignore (use_silently ppf file) ;; let set_paths () = @@ -544,6 +575,7 @@ let loop ppf = Location.init lb "//toplevel//"; Location.input_name := "//toplevel//"; Location.input_lexbuf := Some lb; + Location.input_phrase_buffer := Some phrase_buffer; Sys.catch_break true; run_hooks After_setup; load_ocamlinit ppf; @@ -551,6 +583,8 @@ let loop ppf = let snap = Btype.snapshot () in try Lexing.flush_input lb; + (* Reset the phrase buffer when we flush the lexing buffer. *) + Buffer.reset phrase_buffer; Location.reset(); Warnings.reset_fatal (); first_line := true; diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index 735baebb..dec1659d 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -13,7 +13,6 @@ (* *) (**************************************************************************) -open Clflags open Compenv let usage = "Usage: ocaml [script-file [arguments]]\n\ @@ -81,15 +80,6 @@ let file_argument name = else exit 2 end -let print_version () = - Printf.printf "The OCaml toplevel, version %s\n" Sys.ocaml_version; - exit 0; -;; - -let print_version_num () = - Printf.printf "%s\n" Sys.ocaml_version; - exit 0; -;; let wrap_expand f s = let start = !current in @@ -98,66 +88,11 @@ let wrap_expand f s = arr module Options = Main_args.Make_bytetop_options (struct - let set r () = r := true - let clear r () = r := false - - let _absname = set Clflags.absname - let _alert = Warnings.parse_alert_option - let _I dir = include_dirs := dir :: !include_dirs - let _init s = init_file := Some s - let _noinit = set noinit - let _labels = clear classic - let _alias_deps = clear transparent_modules - let _no_alias_deps = set transparent_modules - let _app_funct = set applicative_functors - let _no_app_funct = clear applicative_functors - let _noassert = set noassert - let _nolabels = set classic - let _noprompt = set noprompt - let _nopromptcont = set nopromptcont - let _nostdlib = set no_std_include - let _nopervasives = set nopervasives - let _open s = open_modules := s :: !open_modules - let _ppx s = first_ppx := s :: !first_ppx - let _principal = set principal - let _no_principal = clear principal - let _rectypes = set recursive_types - let _no_rectypes = clear recursive_types - let _safe_string = clear unsafe_string - let _short_paths = clear real_paths - let _stdin () = file_argument "" - let _strict_sequence = set strict_sequence - let _no_strict_sequence = clear strict_sequence - let _strict_formats = set strict_formats - let _no_strict_formats = clear strict_formats - let _unboxed_types = set unboxed_types - let _no_unboxed_types = clear unboxed_types - let _unsafe = set unsafe - let _unsafe_string = set unsafe_string - let _version () = print_version () - let _vnum () = print_version_num () - let _no_version = set noversion - let _w s = Warnings.parse_options false s - let _warn_error s = Warnings.parse_options true s - let _warn_help = Warnings.help_warnings - let _dparsetree = set dump_parsetree - let _dtypedtree = set dump_typedtree - let _dno_unique_ids = clear unique_ids - let _dunique_ids = set unique_ids - let _dsource = set dump_source - let _drawlambda = set dump_rawlambda - let _dlambda = set dump_lambda - let _dflambda = set dump_flambda - let _dtimings () = profile_columns := [ `Time ] - let _dprofile () = profile_columns := Profile.all_columns - let _dinstr = set dump_instr - let _color = Misc.set_or_ignore color_reader.parse color - let _error_style = Misc.set_or_ignore error_style_reader.parse error_style - - let _args = wrap_expand Arg.read_arg - let _args0 = wrap_expand Arg.read_arg0 - - let anonymous s = file_argument s + include Main_args.Default.Topmain + let _stdin () = file_argument "" + let _args = wrap_expand Arg.read_arg + let _args0 = wrap_expand Arg.read_arg0 + let anonymous s = file_argument s end);; let () = diff --git a/typing/TODO.md b/typing/TODO.md index 4b559958..ebd0f999 100644 --- a/typing/TODO.md +++ b/typing/TODO.md @@ -24,6 +24,17 @@ everyone to get an idea of planned tasks, refine them through Pull Requests, suggest more cleanups, or even start working on specific tasks (ideally after discussing it first with maintainers). +# Code smells + +- global mutable state +- poor data representation +- avoid constructing a parsetree locally + (methods build a piece of AST with a self argument + with a *-using name to avoid conflicts; #row, etc.) +- avoid magic string literals + +# TODO List + Not all ideas have been thoroughly discussed, and there might not be a consensus for all of them. @@ -51,8 +62,15 @@ consensus for all of them. (be careful about memory leaks with the naive approach of representing links with a persistent heap). + Modest version of the proposal: have an explicit indirection layer + (type_expr Unode.t) + for nodes in the union-find structure. Efficiency cost? + - Make the logic for record/constructor disambiguation more readable. + (Jacques should write a specification, and then we could try + to make the implementation easier for others to understand.) + - Tidy up destructive substitution. - Get rid of syntactic encodings (generating Parsetree fragments @@ -62,6 +80,7 @@ consensus for all of them. magic "internal" names which should be avoided. - Get rid of -annot. + (see Nicolas' PR) - Consider storing warning settings (+other context) as part of `Env.t`? @@ -71,9 +90,15 @@ consensus for all of them. - Introduce a notion of syntactic "path-like location" to point to allow pointing to AST fragments, and use that to implement "unused" warnings in a less invasive and less imperative way. + (See Thomas' PR) - Deprecate -nolabels, or even get rid of it? + (We could even stop supporting unlabeled full applications. + First turn on the warning by default.) - Using e.g. bisect_ppx, monitor coverage of the typechecker implementation while running the testsuite, and expand the testsuite and/or kill dead code in the typechecker to increase coverage ratio. + (Partially done by Oxana's Outreachy internship. + See PR#8874. + Ask Florian Angeletti and Sebastien Hinderer about the current state.) diff --git a/typing/btype.ml b/typing/btype.ml index 0549d843..f3c3dd2a 100644 --- a/typing/btype.ml +++ b/typing/btype.ml @@ -15,7 +15,6 @@ (* Basic operations on core types *) -open Misc open Asttypes open Types @@ -62,9 +61,6 @@ let is_Tunivar = function {desc=Tunivar _} -> true | _ -> false let is_Tconstr = function {desc=Tconstr _} -> true | _ -> false let dummy_method = "*dummy method*" -let default_mty = function - Some mty -> mty - | None -> Mty_signature [] (**** Definitions for backtracking ****) @@ -168,13 +164,33 @@ let rec row_more row = | {desc=Tvariant row'} -> row_more row' | ty -> ty -let row_fixed row = +let merge_fixed_explanation fixed1 fixed2 = + match fixed1, fixed2 with + | Some Univar _ as x, _ | _, (Some Univar _ as x) -> x + | Some Fixed_private as x, _ | _, (Some Fixed_private as x) -> x + | Some Reified _ as x, _ | _, (Some Reified _ as x) -> x + | Some Rigid as x, _ | _, (Some Rigid as x) -> x + | None, None -> None + + +let fixed_explanation row = let row = row_repr row in - row.row_fixed || - match (repr row.row_more).desc with - Tvar _ | Tnil -> false - | Tunivar _ | Tconstr _ -> true - | _ -> assert false + match row.row_fixed with + | Some _ as x -> x + | None -> + let more = repr row.row_more in + match more.desc with + | Tvar _ | Tnil -> None + | Tunivar _ -> Some (Univar more) + | Tconstr (p,_,_) -> Some (Reified p) + | _ -> assert false + +let is_fixed row = match row.row_fixed with + | None -> false + | Some _ -> true + +let row_fixed row = fixed_explanation row <> None + let static_row row = let row = row_repr row in @@ -258,7 +274,7 @@ let rec fold_row f init row = Tvariant row -> fold_row f result row | Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil -> begin match - Misc.may_map (fun (_,l) -> List.fold_left f result l) row.row_name + Option.map (fun (_,l) -> List.fold_left f result l) row.row_name with | None -> result | Some result -> result @@ -314,6 +330,7 @@ type type_iterators = it_modtype_declaration: type_iterators -> modtype_declaration -> unit; it_class_declaration: type_iterators -> class_declaration -> unit; it_class_type_declaration: type_iterators -> class_type_declaration -> unit; + it_functor_param: type_iterators -> functor_parameter -> unit; it_module_type: type_iterators -> module_type -> unit; it_class_type: type_iterators -> class_type -> unit; it_type_kind: type_iterators -> type_kind -> unit; @@ -336,7 +353,7 @@ let iter_type_expr_kind f = function List.iter (fun cd -> iter_type_expr_cstr_args f cd.cd_args; - Misc.may f cd.cd_res + Option.iter f cd.cd_res ) cstrs | Type_record(lbls, _) -> @@ -360,32 +377,35 @@ let type_iterators = it.it_type_expr it vd.val_type and it_type_declaration it td = List.iter (it.it_type_expr it) td.type_params; - may (it.it_type_expr it) td.type_manifest; + Option.iter (it.it_type_expr it) td.type_manifest; it.it_type_kind it td.type_kind and it_extension_constructor it td = it.it_path td.ext_type_path; List.iter (it.it_type_expr it) td.ext_type_params; iter_type_expr_cstr_args (it.it_type_expr it) td.ext_args; - may (it.it_type_expr it) td.ext_ret_type + Option.iter (it.it_type_expr it) td.ext_ret_type and it_module_declaration it md = it.it_module_type it md.md_type and it_modtype_declaration it mtd = - may (it.it_module_type it) mtd.mtd_type + Option.iter (it.it_module_type it) mtd.mtd_type and it_class_declaration it cd = List.iter (it.it_type_expr it) cd.cty_params; it.it_class_type it cd.cty_type; - may (it.it_type_expr it) cd.cty_new; + Option.iter (it.it_type_expr it) cd.cty_new; it.it_path cd.cty_path and it_class_type_declaration it ctd = List.iter (it.it_type_expr it) ctd.clty_params; it.it_class_type it ctd.clty_type; it.it_path ctd.clty_path + and it_functor_param it = function + | Unit -> () + | Named (_, mt) -> it.it_module_type it mt and it_module_type it = function Mty_ident p | Mty_alias p -> it.it_path p | Mty_signature sg -> it.it_signature it sg - | Mty_functor (_, mto, mt) -> - may (it.it_module_type it) mto; + | Mty_functor (p, mt) -> + it.it_functor_param it p; it.it_module_type it mt and it_class_type it = function Cty_constr (p, tyl, cty) -> @@ -411,12 +431,12 @@ let type_iterators = | Tpackage (p, _, _) -> it.it_path p | Tvariant row -> - may (fun (p,_) -> it.it_path p) (row_repr row).row_name + Option.iter (fun (p,_) -> it.it_path p) (row_repr row).row_name | _ -> () and it_path _p = () in { it_path; it_type_expr = it_do_type_expr; it_do_type_expr; - it_type_kind; it_class_type; it_module_type; + it_type_kind; it_class_type; it_functor_param; it_module_type; it_signature; it_class_type_declaration; it_class_declaration; it_modtype_declaration; it_module_declaration; it_extension_constructor; it_type_declaration; it_value_description; it_signature_item; } @@ -428,16 +448,18 @@ let copy_row f fixed row keep more = | Rpresent(Some ty) -> Rpresent(Some(f ty)) | Reither(c, tl, m, e) -> let e = if keep then e else ref None in - let m = if row.row_fixed then fixed else m in + let m = if is_fixed row then fixed else m in let tl = List.map f tl in Reither(c, tl, m, e) | _ -> fi) row.row_fields in let name = - match row.row_name with None -> None + match row.row_name with + | None -> None | Some (path, tl) -> Some (path, List.map f tl) in + let row_fixed = if fixed then row.row_fixed else None in { row_fields = fields; row_more = more; - row_bound = (); row_fixed = row.row_fixed && fixed; + row_bound = (); row_fixed; row_closed = row.row_closed; row_name = name; } let rec copy_kind = function @@ -570,7 +592,7 @@ let unmark_type_decl decl = let unmark_extension_constructor ext = List.iter unmark_type ext.ext_type_params; iter_type_expr_cstr_args unmark_type ext.ext_args; - Misc.may unmark_type ext.ext_ret_type + Option.iter unmark_type ext.ext_ret_type let unmark_class_signature sign = unmark_type sign.csig_self; @@ -716,6 +738,11 @@ let link_type ty ty' = | _ -> () (* ; assert (check_memorized_abbrevs ()) *) (* ; check_expans [] ty' *) +let set_type_desc ty td = + if td != ty.desc then begin + log_type ty; + ty.desc <- td + end let set_level ty level = if level <> ty.level then begin if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level)); diff --git a/typing/btype.mli b/typing/btype.mli index 00d24745..6fe22127 100644 --- a/typing/btype.mli +++ b/typing/btype.mli @@ -48,7 +48,6 @@ val is_Tvar: type_expr -> bool val is_Tunivar: type_expr -> bool val is_Tconstr: type_expr -> bool val dummy_method: label -val default_mty: module_type option -> module_type val repr: type_expr -> type_expr (* Return the canonical representative of a type. *) @@ -69,8 +68,23 @@ val row_field: label -> row_desc -> row_field (* Return the canonical representative of a row field *) val row_more: row_desc -> type_expr (* Return the extension variable of the row *) + +val is_fixed: row_desc -> bool +(* Return whether the row is directly marked as fixed or not *) + val row_fixed: row_desc -> bool - (* Return whether the row should be treated as fixed or not *) +(* Return whether the row should be treated as fixed or not. + In particular, [is_fixed row] implies [row_fixed row]. +*) + +val fixed_explanation: row_desc -> fixed_explanation option +(* Return the potential explanation for the fixed row *) + +val merge_fixed_explanation: + fixed_explanation option -> fixed_explanation option + -> fixed_explanation option +(* Merge two explanations for a fixed row *) + val static_row: row_desc -> bool (* Return whether the row is static or not *) val hash_variant: label -> int @@ -107,6 +121,7 @@ type type_iterators = it_modtype_declaration: type_iterators -> modtype_declaration -> unit; it_class_declaration: type_iterators -> class_declaration -> unit; it_class_type_declaration: type_iterators -> class_type_declaration -> unit; + it_functor_param: type_iterators -> functor_parameter -> unit; it_module_type: type_iterators -> module_type -> unit; it_class_type: type_iterators -> class_type -> unit; it_type_kind: type_iterators -> type_kind -> unit; @@ -212,6 +227,8 @@ val undo_compress: snapshot -> unit val link_type: type_expr -> type_expr -> unit (* Set the desc field of [t1] to [Tlink t2], logging the old value if there is an active snapshot *) +val set_type_desc: type_expr -> type_desc -> unit + (* Set directly the desc field, without sharing *) val set_level: type_expr -> int -> unit val set_scope: type_expr -> int -> unit val set_name: @@ -223,8 +240,6 @@ val set_kind: field_kind option ref -> field_kind -> unit val set_commu: commutable ref -> commutable -> unit val set_typeset: TypeSet.t ref -> TypeSet.t -> unit (* Set references, logging the old value *) -val log_type: type_expr -> unit - (* Log the old value of a type, before modifying it by hand *) (**** Forward declarations ****) val print_raw: (Format.formatter -> type_expr -> unit) ref diff --git a/typing/ctype.ml b/typing/ctype.ml index a6189ad4..7f7e66bb 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -73,10 +73,16 @@ module Unification_trace = struct | Module_type of Path.t | Equation of 'a + type fixed_row_case = + | Cannot_be_closed + | Cannot_add_tags of string list + type variant = | No_intersection | No_tags of position * (Asttypes.label * row_field) list | Incompatible_types_for of string + | Fixed_row of position * fixed_row_case * fixed_explanation + type obj = | Missing_field of position * string @@ -124,6 +130,7 @@ module Unification_trace = struct Incompatible_fields { name; diff = swap_diff diff} | Obj (Missing_field(pos,s)) -> Obj(Missing_field(swap_position pos,s)) | Obj (Abstract_row pos) -> Obj(Abstract_row (swap_position pos)) + | Variant (Fixed_row(pos,k,f)) -> Variant (Fixed_row(swap_position pos,k,f)) | Variant (No_tags(pos,f)) -> Variant (No_tags(swap_position pos,f)) | x -> x let swap x = List.map swap_elt x @@ -830,8 +837,18 @@ let rec update_level env level expand ty = with Cannot_expand -> raise Trace.(Unify [escape(Constructor p)]) end - | Tconstr(_, _ :: _, _) when expand -> + | Tconstr(p, (_ :: _ as tl), _) -> + let variance = + try (Env.find_type p env).type_variance + with Not_found -> List.map (fun _ -> Variance.may_inv) tl in + let needs_expand = + expand || + List.exists2 + (fun var ty -> var = Variance.null && (repr ty).level > level) + variance tl + in begin try + if not needs_expand then raise Cannot_expand; link_type ty (!forward_try_expand_once env ty); update_level env level expand ty with Cannot_expand -> @@ -841,7 +858,7 @@ let rec update_level env level expand ty = | Tpackage (p, nl, tl) when level < Path.scope p -> let p' = normalize_package_path env p in if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]); - log_type ty; ty.desc <- Tpackage (p', nl, tl); + set_type_desc ty (Tpackage (p', nl, tl)); update_level env level expand ty | Tobject(_, ({contents=Some(p, _tl)} as nm)) when level < Path.scope p -> @@ -851,8 +868,7 @@ let rec update_level env level expand ty = let row = row_repr row in begin match row.row_name with | Some (p, _tl) when level < Path.scope p -> - log_type ty; - ty.desc <- Tvariant {row with row_name = None} + set_type_desc ty (Tvariant {row with row_name = None}) | _ -> () end; set_level ty level; @@ -1129,8 +1145,8 @@ let rec copy ?partial ?keep_names scope ty = in let row = match repr more' with (* PR#6163 *) - {desc=Tconstr _} when not row.row_fixed -> - {row with row_fixed = true} + {desc=Tconstr (x,_,_)} when not (is_fixed row) -> + {row with row_fixed = Some (Reified x)} | _ -> row in (* Open row if partial for pattern and contains Reither *) @@ -1147,13 +1163,13 @@ let rec copy ?partial ?keep_names scope ty = Reither _ -> false | _ -> true in - if row.row_closed && not row.row_fixed + if row.row_closed && not (is_fixed row) && TypeSet.is_empty (free_univars ty) && not (List.for_all not_reither row.row_fields) then (more', {row_fields = List.filter not_reither row.row_fields; row_more = more'; row_bound = (); - row_closed = false; row_fixed = false; row_name = None}) + row_closed = false; row_fixed = None; row_name = None}) else (more', row) | _ -> (more', row) in @@ -1223,7 +1239,7 @@ let new_declaration expansion_scope manifest = type_expansion_scope = expansion_scope; type_loc = Location.none; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } @@ -1282,7 +1298,7 @@ let map_kind f = function (fun c -> {c with cd_args = map_type_expr_cstr_args f c.cd_args; - cd_res = may_map f c.cd_res + cd_res = Option.map f c.cd_res }) cl) | Type_record (fl, rr) -> @@ -1296,7 +1312,7 @@ let map_kind f = function let instance_declaration decl = For_copy.with_scope (fun scope -> {decl with type_params = List.map (copy scope) decl.type_params; - type_manifest = may_map (copy scope) decl.type_manifest; + type_manifest = Option.map (copy scope) decl.type_manifest; type_kind = map_kind (copy scope) decl.type_kind; } ) @@ -2084,13 +2100,14 @@ let reify env t = | Tvariant r -> let r = row_repr r in if not (static_row r) then begin - if r.row_fixed then iterator (row_more r) else + if is_fixed r then iterator (row_more r) else let m = r.row_more in match m.desc with Tvar o -> let path, t = create_fresh_constr m.level o in let row = - {r with row_fields=[]; row_fixed=true; row_more = t} in + let row_fixed = Some (Reified path) in + {r with row_fields=[]; row_fixed; row_more = t} in link_type m (newty2 m.level (Tvariant row)); if m.level < fresh_constr_scope then raise Trace.(Unify [escape (Constructor path)]) @@ -2412,8 +2429,7 @@ let complete_type_list ?(allow_absent=false) env nl1 lv2 mty2 nl2 tl2 = environment. However no operation which cares about levels/scopes is going to happen while this module exists. The only operations that happen are: - - Env.lookup_type - - Env.find_type + - Env.find_type_by_name - nondep_instance None of which check the scope. @@ -2427,23 +2443,22 @@ let complete_type_list ?(allow_absent=false) env nl1 lv2 mty2 nl2 tl2 = | n :: nl, (n2, _ as nt2) :: ntl' when n >= n2 -> nt2 :: complete (if n = n2 then nl else nl1) ntl' | n :: nl, _ -> - try - let path = - Env.lookup_type (concat_longident (Longident.Lident "Pkg") n) env' - in - match Env.find_type path env' with - {type_arity = 0; type_kind = Type_abstract; - type_private = Public; type_manifest = Some t2} -> - (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2 - | {type_arity = 0; type_kind = Type_abstract; - type_private = Public; type_manifest = None} when allow_absent -> - complete nl ntl2 - | _ -> raise Exit - with - | Not_found when allow_absent -> complete nl ntl2 - | Exit -> raise Not_found + let lid = concat_longident (Longident.Lident "Pkg") n in + match Env.find_type_by_name lid env' with + | (_, {type_arity = 0; type_kind = Type_abstract; + type_private = Public; type_manifest = Some t2}) -> + (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2 + | (_, {type_arity = 0; type_kind = Type_abstract; + type_private = Public; type_manifest = None}) + when allow_absent -> + complete nl ntl2 + | _ -> raise Exit + | exception Not_found when allow_absent-> + complete nl ntl2 in - complete nl1 (List.combine nl2 tl2) + match complete nl1 (List.combine nl2 tl2) with + | res -> res + | exception Exit -> raise Not_found (* raise Not_found rather than Unify if the module types are incompatible *) let unify_package env unify_list lv1 p1 n1 tl1 lv2 p2 n2 tl2 = @@ -2745,7 +2760,7 @@ and unify_list env tl1 tl2 = and make_rowvar level use1 rest1 use2 rest2 = let set_name ty name = match ty.desc with - Tvar None -> log_type ty; ty.desc <- Tvar name + Tvar None -> set_type_desc ty (Tvar name) | _ -> () in let name = @@ -2785,8 +2800,8 @@ and unify_fields env ty1 ty2 = (* Optimization *) ) pairs with exn -> - log_type rest1; rest1.desc <- d1; - log_type rest2; rest2.desc <- d2; + set_type_desc rest1 d1; + set_type_desc rest2 d2; raise exn and unify_kind k1 k2 = @@ -2813,12 +2828,13 @@ and unify_row env row1 row2 = with Not_found -> ()) r2 end; - let fixed1 = row_fixed row1 and fixed2 = row_fixed row2 in - let more = - if fixed1 then rm1 else - if fixed2 then rm2 else - newty2 (min rm1.level rm2.level) (Tvar None) in - let fixed = fixed1 || fixed2 + let fixed1 = fixed_explanation row1 and fixed2 = fixed_explanation row2 in + let more = match fixed1, fixed2 with + | Some _, _ -> rm1 + | None, Some _ -> rm2 + | None, None -> newty2 (min rm1.level rm2.level) (Tvar None) + in + let fixed = merge_fixed_explanation fixed1 fixed2 and closed = row1.row_closed || row2.row_closed in let keep switch = List.for_all @@ -2852,10 +2868,18 @@ and unify_row env row1 row2 = if closed then filter_row_fields row.row_closed rest else rest in - if rest <> [] && (row.row_closed || row_fixed row) - || closed && row_fixed row && not row.row_closed then begin - let pos = if row == row1 then Trace.First else Trace.Second in - raise Trace.(Unify [Variant (No_tags(pos,rest))]) + begin match fixed_explanation row with + | None -> + if rest <> [] && row.row_closed then + let pos = if row == row1 then Trace.First else Trace.Second in + raise Trace.(Unify [Variant (No_tags(pos,rest))]) + | Some fixed -> + let pos = if row == row1 then Trace.First else Trace.Second in + if closed && not row.row_closed then + raise Trace.(Unify [Variant(Fixed_row(pos,Cannot_be_closed,fixed))]) + else if rest <> [] then + let case = Trace.Cannot_add_tags (List.map fst rest) in + raise Trace.(Unify [Variant(Fixed_row(pos,case,fixed))]) end; (* The following test is not principal... should rather use Tnil *) let rm = row_more row in @@ -2887,18 +2911,28 @@ and unify_row env row1 row2 = if is_Tvar rm then link_type rm (newty2 rm.level Tnil) end with exn -> - log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn + set_type_desc rm1 md1; set_type_desc rm2 md2; raise exn end and unify_row_field env fixed1 fixed2 more l f1 f2 = let f1 = row_field_repr f1 and f2 = row_field_repr f2 in + let if_not_fixed (pos,fixed) f = + match fixed with + | None -> f () + | Some fix -> + let tr = Trace.[ Variant (Fixed_row (pos,Cannot_add_tags [l],fix)) ] in + raise (Unify tr) in + let first = Trace.First, fixed1 and second = Trace.Second, fixed2 in + let either_fixed = match fixed1, fixed2 with + | None, None -> false + | _ -> true in if f1 == f2 then () else match f1, f2 with Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2 | Rpresent None, Rpresent None -> () | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) -> if e1 == e2 then () else - if (fixed1 || fixed2) && not (c1 || c2) + if either_fixed && not (c1 || c2) && List.length tl1 = List.length tl2 then begin (* PR#7496 *) let f = Reither (c1 || c2, [], m1 || m2, ref None) in @@ -2907,7 +2941,7 @@ and unify_row_field env fixed1 fixed2 more l f1 f2 = end else let redo = not !passive_variants && - (m1 || m2 || fixed1 || fixed2 || + (m1 || m2 || either_fixed || !rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) && begin match tl1 @ tl2 with [] -> false | t1 :: tl -> @@ -2946,27 +2980,33 @@ and unify_row_field env fixed1 fixed2 more l f1 f2 = let f1' = Reither(c1 || c2, tl1', m1 || m2, e) and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in set_row_field e1 f1'; set_row_field e2 f2'; - | Reither(_, _, false, e1), Rabsent when not fixed1 -> set_row_field e1 f2 - | Rabsent, Reither(_, _, false, e2) when not fixed2 -> set_row_field e2 f1 + | Reither(_, _, false, e1), Rabsent -> + if_not_fixed first (fun () -> set_row_field e1 f2) + | Rabsent, Reither(_, _, false, e2) -> + if_not_fixed second (fun () -> set_row_field e2 f1) | Rabsent, Rabsent -> () - | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 -> - set_row_field e1 f2; - let rm = repr more in - update_level !env rm.level t2; - update_scope rm.scope t2; - (try List.iter (fun t1 -> unify env t1 t2) tl - with exn -> e1 := None; raise exn) - | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 -> - set_row_field e2 f1; - let rm = repr more in - update_level !env rm.level t1; - update_scope rm.scope t1; - (try List.iter (unify env t1) tl - with exn -> e2 := None; raise exn) - | Reither(true, [], _, e1), Rpresent None when not fixed1 -> - set_row_field e1 f2 - | Rpresent None, Reither(true, [], _, e2) when not fixed2 -> - set_row_field e2 f1 + | Reither(false, tl, _, e1), Rpresent(Some t2) -> + if_not_fixed first (fun () -> + set_row_field e1 f2; + let rm = repr more in + update_level !env rm.level t2; + update_scope rm.scope t2; + (try List.iter (fun t1 -> unify env t1 t2) tl + with exn -> e1 := None; raise exn) + ) + | Rpresent(Some t1), Reither(false, tl, _, e2) -> + if_not_fixed second (fun () -> + set_row_field e2 f1; + let rm = repr more in + update_level !env rm.level t1; + update_scope rm.scope t1; + (try List.iter (unify env t1) tl + with exn -> e2 := None; raise exn) + ) + | Reither(true, [], _, e1), Rpresent None -> + if_not_fixed first (fun () -> set_row_field e1 f2) + | Rpresent None, Reither(true, [], _, e2) -> + if_not_fixed second (fun () -> set_row_field e2 f1) | _ -> raise (Unify []) @@ -3355,7 +3395,8 @@ let rec rigidify_rec vars ty = let more = repr row.row_more in if is_Tvar more && not (row_fixed row) then begin let more' = newty2 more.level more.desc in - let row' = {row with row_fixed=true; row_fields=[]; row_more=more'} + let row' = + {row with row_fixed=Some Rigid; row_fields=[]; row_more=more'} in link_type more (newty2 ty.level (Tvariant row')) end; iter_row (rigidify_rec vars) row; @@ -3908,18 +3949,8 @@ let rec filter_visited = function let memq_warn t visited = if List.memq t visited then (warn := true; true) else false -let rec lid_of_path ?(hash="") = function - Path.Pident id -> - Longident.Lident (hash ^ Ident.name id) - | Path.Pdot (p1, s) -> - Longident.Ldot (lid_of_path p1, hash ^ s) - | Path.Papply (p1, p2) -> - Longident.Lapply (lid_of_path ~hash p1, lid_of_path p2) - let find_cltype_for_path env p = - let cl_path = Env.lookup_type (lid_of_path ~hash:"#" p) env in - let cl_abbr = Env.find_type cl_path env in - + let cl_abbr = Env.find_hash_type p env in match cl_abbr.type_manifest with Some ty -> begin match (repr ty).desc with @@ -4057,7 +4088,7 @@ let rec build_subtype env visited loops posi level t = let c = collect fields in let row = { row_fields = List.map fst fields; row_more = newvar(); - row_bound = (); row_closed = posi; row_fixed = false; + row_bound = (); row_closed = posi; row_fixed = None; row_name = if c > Unchanged then None else row.row_name } in (newty (Tvariant row), Changed) @@ -4422,8 +4453,7 @@ let rec normalize_type_rec env visited ty = match tm.desc with (* PR#7348 *) Tconstr (Path.Pdot(m,i), tl, _abbrev) -> let i' = String.sub i 0 (String.length i - 4) in - log_type ty; - ty.desc <- Tconstr(Path.Pdot(m,i'), tl, ref Mnil) + set_type_desc ty (Tconstr(Path.Pdot(m,i'), tl, ref Mnil)) | _ -> assert false else match ty.desc with | Tvariant row -> @@ -4447,8 +4477,7 @@ let rec normalize_type_rec env visited ty = let fields = List.sort (fun (p,_) (q,_) -> compare p q) (List.filter (fun (_,fi) -> fi <> Rabsent) fields) in - log_type ty; - ty.desc <- Tvariant {row with row_fields = fields} + set_type_desc ty (Tvariant {row with row_fields = fields}) | Tobject (fi, nm) -> begin match !nm with | None -> () @@ -4461,7 +4490,7 @@ let rec normalize_type_rec env visited ty = | Tvar _ | Tunivar _ -> if v' != v then set_name nm (Some (n, v' :: l)) | Tnil -> - log_type ty; ty.desc <- Tconstr (n, l, ref Mnil) + set_type_desc ty (Tconstr (n, l, ref Mnil)) | _ -> set_name nm None end | _ -> @@ -4471,7 +4500,7 @@ let rec normalize_type_rec env visited ty = if fi.level < lowest_level then () else let fields, row = flatten_fields fi in let fi' = build_fields fi.level fields row in - log_type ty; fi.desc <- fi'.desc + set_type_desc fi fi'.desc | _ -> () end; iter_type_expr (normalize_type_rec env visited) ty @@ -4645,7 +4674,7 @@ let nondep_extension_constructor env ids ext = ext.ext_type_path, type_params in let args = map_type_expr_cstr_args (nondep_type_rec env ids) ext.ext_args in - let ret_type = may_map (nondep_type_rec env ids) ext.ext_ret_type in + let ret_type = Option.map (nondep_type_rec env ids) ext.ext_ret_type in clear_hash (); { ext_type_path = type_path; ext_type_params = type_params; @@ -4750,13 +4779,21 @@ let same_constr env t1 t2 = let () = Env.same_constr := same_constr -let maybe_pointer_type env typ = +let is_immediate = function + | Type_immediacy.Unknown -> false + | Type_immediacy.Always -> true + | Type_immediacy.Always_on_64bits -> + (* In bytecode, we don't know at compile time whether we are + targeting 32 or 64 bits. *) + !Clflags.native_code && Sys.word_size = 64 + +let immediacy env typ = match (repr typ).desc with | Tconstr(p, _args, _abbrev) -> begin try let type_decl = Env.find_type p env in - not type_decl.type_immediate - with Not_found -> true + type_decl.type_immediate + with Not_found -> Type_immediacy.Unknown (* This can happen due to e.g. missing -I options, causing some .cmi files to be unavailable. Maybe we should emit a warning. *) @@ -4764,10 +4801,17 @@ let maybe_pointer_type env typ = | Tvariant row -> let row = Btype.row_repr row in (* if all labels are devoid of arguments, not a pointer *) - not row.row_closed - || List.exists + if + not row.row_closed + || List.exists (function | _, (Rpresent (Some _) | Reither (false, _, _, _)) -> true | _ -> false) row.row_fields - | _ -> true + then + Type_immediacy.Unknown + else + Type_immediacy.Always + | _ -> Type_immediacy.Unknown + +let maybe_pointer_type env typ = not (is_immediate (immediacy env typ)) diff --git a/typing/ctype.mli b/typing/ctype.mli index 450a5ec2..2a4aa8c5 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -37,10 +37,17 @@ module Unification_trace: sig | Equation of 'a (** Errors for polymorphic variants *) + + type fixed_row_case = + | Cannot_be_closed + | Cannot_add_tags of string list + type variant = | No_intersection | No_tags of position * (Asttypes.label * row_field) list | Incompatible_types_for of string + | Fixed_row of position * fixed_row_case * fixed_explanation + (** Fixed row types, e.g. ['a. [> `X] as 'a] *) type obj = | Missing_field of position * string @@ -142,7 +149,6 @@ val set_object_name: val remove_object_name: type_expr -> unit val hide_private_methods: type_expr -> unit val find_cltype_for_path: Env.t -> Path.t -> type_declaration * type_expr -val lid_of_path: ?hash:string -> Path.t -> Longident.t val sort_row_fields: (label * row_field) list -> (label * row_field) list val merge_row_fields: @@ -353,6 +359,8 @@ val get_current_level: unit -> int val wrap_trace_gadt_instances: Env.t -> ('a -> 'b) -> 'a -> 'b val reset_reified_var_counter: unit -> unit +val immediacy : Env.t -> type_expr -> Type_immediacy.t + val maybe_pointer_type : Env.t -> type_expr -> bool (* True if type is possibly pointer, false if definitely not a pointer *) diff --git a/typing/datarepr.ml b/typing/datarepr.ml index 9c997a78..61d79bac 100644 --- a/typing/datarepr.ml +++ b/typing/datarepr.ml @@ -89,7 +89,7 @@ let constructor_args priv cd_args cd_res path rep = type_expansion_scope = Btype.lowest_level; type_loc = Location.none; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed; } in diff --git a/typing/env.ml b/typing/env.ml index c807269d..31e60414 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -45,10 +45,16 @@ type constructor_usages = mutable cu_pattern: bool; mutable cu_privatize: bool; } -let add_constructor_usage cu = function - | Positive -> cu.cu_positive <- true - | Pattern -> cu.cu_pattern <- true - | Privatize -> cu.cu_privatize <- true +let add_constructor_usage priv cu usage = + match priv with + | Asttypes.Private -> cu.cu_positive <- true + | Asttypes.Public -> begin + match usage with + | Positive -> cu.cu_positive <- true + | Pattern -> cu.cu_pattern <- true + | Privatize -> cu.cu_privatize <- true + end + let constructor_usages () = {cu_positive = false; cu_pattern = false; cu_privatize = false} @@ -56,17 +62,18 @@ let used_constructors : (string * Location.t * string, (constructor_usage -> unit)) Hashtbl.t = Hashtbl.create 16 -type error = - | Missing_module of Location.t * Path.t * Path.t - | Illegal_value_name of Location.t * string - -exception Error of error - -let error err = raise (Error err) - (** Map indexed by the name of module components. *) module NameMap = String.Map +type value_unbound_reason = + | Val_unbound_instance_variable + | Val_unbound_self + | Val_unbound_ancestor + | Val_unbound_ghost_recursive of Location.t + +type module_unbound_reason = + | Mod_unbound_illegal_recursion + type summary = Env_empty | Env_value of summary * Ident.t * value_description @@ -79,8 +86,10 @@ type summary = | Env_open of summary * Path.t | Env_functor_arg of summary * Ident.t | Env_constraints of summary * type_declaration Path.Map.t - | Env_copy_types of summary * string list + | Env_copy_types of summary | Env_persistent of summary * Ident.t + | Env_value_unbound of summary * string * value_unbound_reason + | Env_module_unbound of summary * string * module_unbound_reason type address = | Aident of Ident.t @@ -141,22 +150,23 @@ module TycompTbl = let nothing = fun () -> () - let mk_callback rest name desc = function + let mk_callback rest name desc using = + match using with | None -> nothing | Some f -> (fun () -> match rest with | [] -> f name None - | (hidden, _) :: _ -> f name (Some (desc, hidden)) - ) + | (hidden, _) :: _ -> f name (Some (desc, hidden))) - let rec find_all name tbl = + let rec find_all ~mark name tbl = List.map (fun (_id, desc) -> desc, nothing) (Ident.find_all name tbl.current) @ match tbl.opened with | None -> [] | Some {using; next; components} -> - let rest = find_all name next in + let rest = find_all ~mark name next in + let using = if mark then using else None in match NameMap.find name components with | exception Not_found -> rest | opened -> @@ -203,33 +213,41 @@ module IdTbl = bindings between each of them. *) - type 'a t = { + type ('a, 'b) t = { current: 'a Ident.tbl; (** Local bindings since the last open *) - opened: 'a opened option; + layer: ('a, 'b) layer; (** Symbolic representation of the last (innermost) open, if any. *) } - and 'a opened = { - root: Path.t; - (** The path of the opened module, to be prefixed in front of - its local names to produce a valid path in the current - environment. *) + and ('a, 'b) layer = + | Open of { + root: Path.t; + (** The path of the opened module, to be prefixed in front of + its local names to produce a valid path in the current + environment. *) - components: 'a NameMap.t; - (** Components from the opened module. *) + components: 'b NameMap.t; + (** Components from the opened module. *) - using: (string -> ('a * 'a) option -> unit) option; - (** A callback to be applied when a component is used from this - "open". This is used to detect unused "opens". The - arguments are used to detect shadowing. *) + using: (string -> ('a * 'a) option -> unit) option; + (** A callback to be applied when a component is used from this + "open". This is used to detect unused "opens". The + arguments are used to detect shadowing. *) - next: 'a t; - (** The table before opening the module. *) - } + next: ('a, 'b) t; + (** The table before opening the module. *) + } - let empty = { current = Ident.empty; opened = None } + | Map of { + f: ('a -> 'a); + next: ('a, 'b) t; + } + + | Nothing + + let empty = { current = Ident.empty; layer = Nothing } let add id x tbl = {tbl with current = Ident.add id x tbl.current} @@ -245,114 +263,112 @@ module IdTbl = in { current = Ident.empty; - opened = Some {using; root; components; next}; + layer = Open {using; root; components; next}; + } + + let map f next = + { + current = Ident.empty; + layer = Map {f; next} } let rec find_same id tbl = try Ident.find_same id tbl.current with Not_found as exn -> - begin match tbl.opened with - | Some {next; _} -> find_same id next - | None -> raise exn + begin match tbl.layer with + | Open {next; _} -> find_same id next + | Map {f; next} -> f (find_same id next) + | Nothing -> raise exn end - let rec find_name ~mark name tbl = + let rec find_name wrap ~mark name tbl = try let (id, desc) = Ident.find_name name tbl.current in Pident id, desc with Not_found as exn -> - begin match tbl.opened with - | Some {using; root; next; components} -> + begin match tbl.layer with + | Open {using; root; next; components} -> begin try - let descr = NameMap.find name components in + let descr = wrap (NameMap.find name components) in let res = Pdot (root, name), descr in if mark then begin match using with | None -> () | Some f -> begin - match find_name ~mark:false name next with + match find_name wrap ~mark:false name next with | exception Not_found -> f name None | _, descr' -> f name (Some (descr', descr)) end end; res with Not_found -> - find_name ~mark name next + find_name wrap ~mark name next end - | None -> + | Map {f; next} -> + let (p, desc) = find_name wrap ~mark name next in + p, f desc + | Nothing -> raise exn end - let rec update name f tbl = - try - let (id, desc) = Ident.find_name name tbl.current in - let new_desc = f desc in - {tbl with current = Ident.add id new_desc tbl.current} - with Not_found -> - begin match tbl.opened with - | Some {root; using; next; components} -> - begin try - let desc = NameMap.find name components in - let new_desc = f desc in - let components = NameMap.add name new_desc components in - {tbl with opened = Some {root; using; next; components}} - with Not_found -> - let next = update name f next in - {tbl with opened = Some {root; using; next; components}} - end - | None -> - tbl - end - - - - let rec find_all name tbl = + let rec find_all wrap name tbl = List.map (fun (id, desc) -> Pident id, desc) (Ident.find_all name tbl.current) @ - match tbl.opened with - | None -> [] - | Some {root; using = _; next; components} -> - try - let desc = NameMap.find name components in - (Pdot (root, name), desc) :: find_all name next + match tbl.layer with + | Nothing -> [] + | Open {root; using = _; next; components} -> + begin try + let desc = wrap (NameMap.find name components) in + (Pdot (root, name), desc) :: find_all wrap name next with Not_found -> - find_all name next + find_all wrap name next + end + | Map {f; next} -> + List.map (fun (p, desc) -> (p, f desc)) + (find_all wrap name next) - let rec fold_name f tbl acc = + let rec fold_name wrap f tbl acc = let acc = Ident.fold_name (fun id d -> f (Ident.name id) (Pident id, d)) tbl.current acc in - match tbl.opened with - | Some {root; using = _; next; components} -> + match tbl.layer with + | Open {root; using = _; next; components} -> acc |> NameMap.fold - (fun name desc -> f name (Pdot (root, name), desc)) + (fun name desc -> f name (Pdot (root, name), wrap desc)) components - |> fold_name f next - | None -> + |> fold_name wrap f next + | Nothing -> acc + | Map {f=g; next} -> + acc + |> fold_name wrap + (fun name (path, desc) -> f name (path, g desc)) + next let rec local_keys tbl acc = let acc = Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc in - match tbl.opened with - | Some o -> local_keys o.next acc - | None -> acc + match tbl.layer with + | Open {next; _ } | Map {next; _} -> local_keys next acc + | Nothing -> acc - let rec iter f tbl = + let rec iter wrap f tbl = Ident.iter (fun id desc -> f id (Pident id, desc)) tbl.current; - match tbl.opened with - | Some {root; using = _; next; components} -> + match tbl.layer with + | Open {root; using = _; next; components} -> NameMap.iter (fun s x -> let root_scope = Path.scope root in f (Ident.create_scoped ~scope:root_scope s) - (Pdot (root, s), x)) + (Pdot (root, s), wrap x)) components; - iter f next - | None -> () + iter wrap f next + | Map {f=g; next} -> + iter wrap (fun id (path, desc) -> f id (path, g desc)) next + | Nothing -> () let diff_keys tbl1 tbl2 = let keys2 = local_keys tbl2 [] in @@ -370,20 +386,15 @@ type type_descriptions = let in_signature_flag = 0x01 -type 'a value_or_persistent = - | Value of 'a - | Persistent - type t = { - values: (value_description * address_lazy) IdTbl.t; - constrs: (constructor_description * address_lazy option) TycompTbl.t; - labels: label_description TycompTbl.t; - types: (type_declaration * type_descriptions) IdTbl.t; - modules: (module_declaration_lazy * address_lazy) value_or_persistent IdTbl.t; - modtypes: modtype_declaration IdTbl.t; - components: (module_components * address_lazy) value_or_persistent IdTbl.t; - classes: (class_declaration * address_lazy) IdTbl.t; - cltypes: class_type_declaration IdTbl.t; + values: (value_entry, value_data) IdTbl.t; + constrs: constructor_data TycompTbl.t; + labels: label_data TycompTbl.t; + types: (type_data, type_data) IdTbl.t; + modules: (module_entry, module_data) IdTbl.t; + modtypes: (modtype_data, modtype_data) IdTbl.t; + classes: (class_data, class_data) IdTbl.t; + cltypes: (cltype_data, cltype_data) IdTbl.t; functor_args: unit Ident.tbl; summary: summary; local_constraints: type_declaration Path.Map.t; @@ -397,7 +408,10 @@ and module_components = { alerts: alerts; loc: Location.t; - comps: (components_maker, module_components_repr option) EnvLazy.t; + comps: + (components_maker, + (module_components_repr, module_components_failure) result) + EnvLazy.t; } and components_maker = { @@ -413,22 +427,24 @@ and module_components_repr = Structure_comps of structure_components | Functor_comps of functor_components +and module_components_failure = + | No_components_abstract + | No_components_alias of Path.t + and structure_components = { - mutable comp_values: (value_description * address_lazy) NameMap.t; - mutable comp_constrs: - ((constructor_description * address_lazy option) list) NameMap.t; - mutable comp_labels: label_description list NameMap.t; - mutable comp_types: (type_declaration * type_descriptions) NameMap.t; - mutable comp_modules: (module_declaration_lazy * address_lazy) NameMap.t; - mutable comp_modtypes: modtype_declaration NameMap.t; - mutable comp_components: (module_components * address_lazy) NameMap.t; - mutable comp_classes: (class_declaration * address_lazy) NameMap.t; - mutable comp_cltypes: class_type_declaration NameMap.t; + mutable comp_values: value_data NameMap.t; + mutable comp_constrs: constructor_data list NameMap.t; + mutable comp_labels: label_data list NameMap.t; + mutable comp_types: type_data NameMap.t; + mutable comp_modules: module_data NameMap.t; + mutable comp_modtypes: modtype_data NameMap.t; + mutable comp_classes: class_data NameMap.t; + mutable comp_cltypes: cltype_data NameMap.t; } and functor_components = { - fcomp_param: Ident.t; (* Formal parameter *) - fcomp_arg: module_type option; (* Argument signature *) + fcomp_arg: functor_parameter; + (* Formal parameter and argument signature *) fcomp_res: module_type; (* Result signature *) fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *) fcomp_subst_cache: (Path.t, module_type) Hashtbl.t @@ -440,6 +456,42 @@ and address_unforced = and address_lazy = (address_unforced, address) EnvLazy.t +and value_data = + { vda_description : value_description; + vda_address : address_lazy } + +and value_entry = + | Val_bound of value_data + | Val_unbound of value_unbound_reason + +and constructor_data = + { cda_description : constructor_description; + cda_address : address_lazy option; } + +and label_data = label_description + +and type_data = + { tda_declaration : type_declaration; + tda_descriptions : type_descriptions; } + +and module_data = + { mda_declaration : module_declaration_lazy; + mda_components : module_components; + mda_address : address_lazy; } + +and module_entry = + | Mod_local of module_data + | Mod_persistent + | Mod_unbound of module_unbound_reason + +and modtype_data = modtype_declaration + +and class_data = + { clda_declaration : class_declaration; + clda_address : address_lazy } + +and cltype_data = class_type_declaration + let empty_structure = Structure_comps { comp_values = NameMap.empty; @@ -447,9 +499,47 @@ let empty_structure = comp_labels = NameMap.empty; comp_types = NameMap.empty; comp_modules = NameMap.empty; comp_modtypes = NameMap.empty; - comp_components = NameMap.empty; comp_classes = NameMap.empty; + comp_classes = NameMap.empty; comp_cltypes = NameMap.empty } +type unbound_value_hint = + | No_hint + | Missing_rec of Location.t + +type lookup_error = + | Unbound_value of Longident.t * unbound_value_hint + | Unbound_type of Longident.t + | Unbound_constructor of Longident.t + | Unbound_label of Longident.t + | Unbound_module of Longident.t + | Unbound_class of Longident.t + | Unbound_modtype of Longident.t + | Unbound_cltype of Longident.t + | Unbound_instance_variable of string + | Not_an_instance_variable of string + | Masked_instance_variable of Longident.t + | Masked_self_variable of Longident.t + | Masked_ancestor_variable of Longident.t + | Structure_used_as_functor of Longident.t + | Abstract_used_as_functor of Longident.t + | Functor_used_as_structure of Longident.t + | Abstract_used_as_structure of Longident.t + | Generative_used_as_applicative of Longident.t + | Illegal_reference_to_recursive_module + | Cannot_scrape_alias of Longident.t * Path.t + +type error = + | Missing_module of Location.t * Path.t * Path.t + | Illegal_value_name of Location.t * string + | Lookup_error of Location.t * t * lookup_error + +exception Error of error + +let error err = raise (Error err) + +let lookup_error loc env err = + error (Lookup_error(loc, env, err)) + let copy_local ~from env = { env with local_constraints = from.local_constraints; @@ -467,8 +557,10 @@ let check_well_formed_module = ref (fun _ -> assert false) type declarations to silence the shadowing warnings. *) let check_shadowing env = function - | `Constructor (Some ((c1, _), (c2, _))) - when not (!same_constr env c1.cstr_res c2.cstr_res) -> + | `Constructor (Some (cda1, cda2)) + when not (!same_constr env + cda1.cda_description.cstr_res + cda2.cda_description.cstr_res) -> Some "constructor" | `Label (Some (l1, l2)) when not (!same_constr env l1.lbl_res l2.lbl_res) -> @@ -491,8 +583,7 @@ let empty = { values = IdTbl.empty; constrs = TycompTbl.empty; labels = TycompTbl.empty; types = IdTbl.empty; modules = IdTbl.empty; modtypes = IdTbl.empty; - components = IdTbl.empty; classes = IdTbl.empty; - cltypes = IdTbl.empty; + classes = IdTbl.empty; cltypes = IdTbl.empty; summary = Env_empty; local_constraints = Path.Map.empty; flags = 0; functor_args = Ident.empty; @@ -507,12 +598,21 @@ let in_signature b env = let is_in_signature env = env.flags land in_signature_flag <> 0 +let has_local_constraints env = + not (Path.Map.is_empty env.local_constraints) + let is_ident = function Pident _ -> true | Pdot _ | Papply _ -> false -let is_local_ext = function - | {cstr_tag = Cstr_extension(p, _)}, _ -> is_ident p +let is_ext cda = + match cda.cda_description with + | {cstr_tag = Cstr_extension _} -> true + | _ -> false + +let is_local_ext cda = + match cda.cda_description with + | {cstr_tag = Cstr_extension(p, _)} -> is_ident p | _ -> false let diff env1 env2 = @@ -521,23 +621,27 @@ let diff env1 env2 = IdTbl.diff_keys env1.modules env2.modules @ IdTbl.diff_keys env1.classes env2.classes +(* Functions for use in "wrap" parameters in IdTbl *) +let wrap_identity x = x +let wrap_value vda = Val_bound vda +let wrap_module mda = Mod_local mda + (* Forward declarations *) -let components_of_module' = - ref ((fun ~alerts:_ ~loc:_ _env _fsub _psub _path _addr _mty -> assert false): - alerts:alerts -> loc:Location.t -> t -> - Subst.t option -> Subst.t -> Path.t -> address_lazy -> module_type -> - module_components) let components_of_module_maker' = ref ((fun _ -> assert false) : - components_maker -> module_components_repr option) + components_maker -> + (module_components_repr, module_components_failure) result) + let components_of_functor_appl' = - ref ((fun _f _env _p1 _p2 -> assert false) : - functor_components -> t -> Path.t -> Path.t -> module_components) -let check_modtype_inclusion = - (* to be filled with Includemod.check_modtype_inclusion *) - ref ((fun ~loc:_ _env _mty1 _path1 _mty2 -> assert false) : - loc:Location.t -> t -> module_type -> Path.t -> module_type -> unit) + ref ((fun ~loc:_ _f _env _p1 _p2 -> assert false) : + loc:Location.t -> functor_components -> t -> + Path.t -> Path.t -> module_components) +let check_functor_application = + (* to be filled by Includemod *) + ref ((fun ~errors:_ ~loc:_ _env _mty1 _path1 _mty2 _path2 -> assert false) : + errors:bool -> loc:Location.t -> t -> module_type -> + Path.t -> module_type -> Path.t -> unit) let strengthen = (* to be filled with Mtype.strengthen *) ref ((fun ~aliasable:_ _env _mty _path -> assert false) : @@ -580,54 +684,75 @@ let find_same_module id tbl = | x -> x | exception Not_found when Ident.persistent id && not (Current_unit_name.is_name_of id) -> - Persistent + Mod_persistent -(* signature of persistent compilation units *) -type persistent_module = { - pm_signature: signature Lazy.t; - pm_components: module_components; -} +let find_name_module ~mark name tbl = + match IdTbl.find_name wrap_module ~mark name tbl with + | x -> x + | exception Not_found when not (Current_unit_name.is name) -> + let path = Pident(Ident.create_persistent name) in + path, Mod_persistent let add_persistent_structure id env = if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure"; if not (Current_unit_name.is_name_of id) then { env with - modules = IdTbl.add id Persistent env.modules; - components = IdTbl.add id Persistent env.components; + modules = IdTbl.add id Mod_persistent env.modules; summary = Env_persistent (env.summary, id); } else env +let components_of_module ~alerts ~loc env fs ps path addr mty = + { + alerts; + loc; + comps = EnvLazy.create { + cm_env = env; + cm_freshening_subst = fs; + cm_prefixing_subst = ps; + cm_path = path; + cm_addr = addr; + cm_mty = mty + } + } + let sign_of_cmi ~freshen { Persistent_env.Persistent_signature.cmi; _ } = let name = cmi.cmi_name in let sign = cmi.cmi_sign in let flags = cmi.cmi_flags in let id = Ident.create_persistent name in let path = Pident id in - let addr = EnvLazy.create_forced (Aident id) in let alerts = List.fold_left (fun acc -> function Alerts s -> s | _ -> acc) Misc.Stdlib.String.Map.empty flags in let loc = Location.none in - let pm_signature = lazy (Subst.signature Make_local Subst.identity sign) in - let pm_components = + let md = md (Mty_signature sign) in + let mda_address = EnvLazy.create_forced (Aident id) in + let mda_declaration = + EnvLazy.create (Subst.identity, Subst.Make_local, md) + in + let mda_components = let freshening_subst = - if freshen then (Some Subst.identity) else None in - !components_of_module' ~alerts ~loc - empty freshening_subst Subst.identity path addr (Mty_signature sign) in + if freshen then (Some Subst.identity) else None + in + components_of_module ~alerts ~loc + empty freshening_subst Subst.identity + path mda_address (Mty_signature sign) + in { - pm_signature; - pm_components; + mda_declaration; + mda_components; + mda_address; } let read_sign_of_cmi = sign_of_cmi ~freshen:true let save_sign_of_cmi = sign_of_cmi ~freshen:false -let persistent_env : persistent_module Persistent_env.t = +let persistent_env : module_data Persistent_env.t = Persistent_env.empty () let without_cmis f x = @@ -673,7 +798,7 @@ let reset_cache_toplevel () = (* get_components *) -let get_components_opt c = +let get_components_res c = match Persistent_env.can_load_cmis persistent_env with | Persistent_env.Can_load_cmis -> EnvLazy.force !components_of_module_maker' c.comps @@ -681,78 +806,154 @@ let get_components_opt c = EnvLazy.force_logged log !components_of_module_maker' c.comps let get_components c = - match get_components_opt c with - | None -> empty_structure - | Some c -> c + match get_components_res c with + | Error _ -> empty_structure + | Ok c -> c + +(* Module type of functor application *) + +let modtype_of_functor_appl fcomp p1 p2 = + match fcomp.fcomp_res with + | Mty_alias _ as mty -> mty + | mty -> + try + Hashtbl.find fcomp.fcomp_subst_cache p2 + with Not_found -> + let scope = Path.scope (Papply(p1, p2)) in + let mty = + let subst = + match fcomp.fcomp_arg with + | Unit + | Named (None, _) -> Subst.identity + | Named (Some param, _) -> Subst.add_module param p2 Subst.identity + in + Subst.modtype (Rescope scope) subst mty + in + Hashtbl.add fcomp.fcomp_subst_cache p2 mty; + mty (* Lookup by identifier *) -let rec find_module_descr path env = +let find_ident_module id env = + match find_same_module id env.modules with + | Mod_local data -> data + | Mod_unbound _ -> raise Not_found + | Mod_persistent -> find_pers_mod (Ident.name id) + +let rec find_module_components path env = match path with - Pident id -> - begin match find_same_module id env.components with - | Value x -> fst x - | Persistent -> (find_pers_mod (Ident.name id)).pm_components - end + | Pident id -> (find_ident_module id env).mda_components | Pdot(p, s) -> - begin match get_components (find_module_descr p env) with - Structure_comps c -> - fst (NameMap.find s c.comp_components) - | Functor_comps _ -> - raise Not_found - end + let sc = find_structure_components p env in + (NameMap.find s sc.comp_modules).mda_components | Papply(p1, p2) -> - begin match get_components (find_module_descr p1 env) with - Functor_comps f -> - !components_of_functor_appl' f env p1 p2 - | Structure_comps _ -> - raise Not_found - end + let fc = find_functor_components p1 env in + let loc = Location.(in_file !input_name) in + !components_of_functor_appl' ~loc fc env p1 p2 + +and find_structure_components path env = + match get_components (find_module_components path env) with + | Structure_comps c -> c + | Functor_comps _ -> raise Not_found + +and find_functor_components path env = + match get_components (find_module_components path env) with + | Functor_comps f -> f + | Structure_comps _ -> raise Not_found -let find proj1 proj2 path env = +let find_module ~alias path env = match path with - Pident id -> IdTbl.find_same id (proj1 env) + | Pident id -> + let data = find_ident_module id env in + EnvLazy.force subst_modtype_maker data.mda_declaration | Pdot(p, s) -> - begin match get_components (find_module_descr p env) with - Structure_comps c -> NameMap.find s (proj2 c) - | Functor_comps _ -> - raise Not_found - end - | Papply _ -> - raise Not_found + let sc = find_structure_components p env in + let data = NameMap.find s sc.comp_modules in + EnvLazy.force subst_modtype_maker data.mda_declaration + | Papply(p1, p2) -> + let fc = find_functor_components p1 env in + if alias then md (fc.fcomp_res) + else md (modtype_of_functor_appl fc p1 p2) -let find_value_full = - find (fun env -> env.values) (fun sc -> sc.comp_values) -and find_type_full = - find (fun env -> env.types) (fun sc -> sc.comp_types) -and find_modtype = - find (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) -and find_class_full = - find (fun env -> env.classes) (fun sc -> sc.comp_classes) -and find_cltype = - find (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) - -let find_value p env = - fst (find_value_full p env) -let find_class p env = - fst (find_class_full p env) +let find_value_full path env = + match path with + | Pident id -> begin + match IdTbl.find_same id env.values with + | Val_bound data -> data + | Val_unbound _ -> raise Not_found + end + | Pdot(p, s) -> + let sc = find_structure_components p env in + NameMap.find s sc.comp_values + | Papply _ -> raise Not_found + +let find_type_full path env = + match path with + | Pident id -> IdTbl.find_same id env.types + | Pdot(p, s) -> + let sc = find_structure_components p env in + NameMap.find s sc.comp_types + | Papply _ -> raise Not_found + +let find_modtype path env = + match path with + | Pident id -> IdTbl.find_same id env.modtypes + | Pdot(p, s) -> + let sc = find_structure_components p env in + NameMap.find s sc.comp_modtypes + | Papply _ -> raise Not_found + +let find_class_full path env = + match path with + | Pident id -> IdTbl.find_same id env.classes + | Pdot(p, s) -> + let sc = find_structure_components p env in + NameMap.find s sc.comp_classes + | Papply _ -> raise Not_found + +let find_cltype path env = + match path with + | Pident id -> IdTbl.find_same id env.cltypes + | Pdot(p, s) -> + let sc = find_structure_components p env in + NameMap.find s sc.comp_cltypes + | Papply _ -> raise Not_found + +let find_value path env = + (find_value_full path env).vda_description + +let find_class path env = + (find_class_full path env).clda_declaration + +let find_ident_constructor id env = + (TycompTbl.find_same id env.constrs).cda_description + +let find_ident_label id env = + TycompTbl.find_same id env.labels let type_of_cstr path = function - | {cstr_inlined = Some d; _} -> - (d, ([], List.map snd (Datarepr.labels_of_type path d))) + | {cstr_inlined = Some decl; _} -> + let labels = + List.map snd (Datarepr.labels_of_type path decl) + in + { tda_declaration = decl; tda_descriptions = ([], labels) } | _ -> assert false let find_type_full path env = match Path.constructor_typath path with - | Regular p -> - (try (Path.Map.find p env.local_constraints, ([], [])) - with Not_found -> find_type_full p env) + | Regular p -> begin + match Path.Map.find p env.local_constraints with + | decl -> + { tda_declaration = decl; tda_descriptions = [], [] } + | exception Not_found -> find_type_full p env + end | Cstr (ty_path, s) -> - let (_, (cstrs, _)) = + let tda = try find_type_full ty_path env with Not_found -> assert false in + let (cstrs, _) = tda.tda_descriptions in let cstr = try List.find (fun cstr -> cstr.cstr_name = s) cstrs with Not_found -> assert false @@ -760,93 +961,35 @@ let find_type_full path env = type_of_cstr path cstr | LocalExt id -> let cstr = - try fst (TycompTbl.find_same id env.constrs) + try (TycompTbl.find_same id env.constrs).cda_description with Not_found -> assert false in type_of_cstr path cstr | Ext (mod_path, s) -> let comps = - try find_module_descr mod_path env + try find_structure_components mod_path env with Not_found -> assert false in - let comps = - match get_components comps with - | Structure_comps c -> c - | Functor_comps _ -> assert false - in - let exts = - List.filter - (function ({cstr_tag=Cstr_extension _}, _) -> true | _ -> false) - (try NameMap.find s comps.comp_constrs - with Not_found -> assert false) + let cstrs = + try NameMap.find s comps.comp_constrs + with Not_found -> assert false in + let exts = List.filter is_ext cstrs in match exts with - | [(cstr, _)] -> type_of_cstr path cstr + | [cda] -> type_of_cstr path cda.cda_description | _ -> assert false let find_type p env = - fst (find_type_full p env) + (find_type_full p env).tda_declaration let find_type_descrs p env = - snd (find_type_full p env) - -let find_module ~alias path env = - match path with - Pident id -> - begin - match find_same_module id env.modules with - | Value (data, _) -> EnvLazy.force subst_modtype_maker data - | Persistent -> - let pm = find_pers_mod (Ident.name id) in - md (Mty_signature(Lazy.force pm.pm_signature)) - end - | Pdot(p, s) -> - begin match get_components (find_module_descr p env) with - Structure_comps c -> - let data, _ = NameMap.find s c.comp_modules in - EnvLazy.force subst_modtype_maker data - | Functor_comps _ -> - raise Not_found - end - | Papply(p1, p2) -> - let desc1 = find_module_descr p1 env in - begin match get_components desc1 with - Functor_comps f -> - let mty = - match f.fcomp_res with - | Mty_alias _ as mty -> mty - | mty -> - if alias then mty else - try - Hashtbl.find f.fcomp_subst_cache p2 - with Not_found -> - let mty = - Subst.modtype (Rescope (Path.scope path)) - (Subst.add_module f.fcomp_param p2 Subst.identity) - f.fcomp_res in - Hashtbl.add f.fcomp_subst_cache p2 mty; - mty - in - md mty - | Structure_comps _ -> - raise Not_found - end + (find_type_full p env).tda_descriptions let rec find_module_address path env = match path with - | Pident id -> - begin - match find_same_module id env.modules with - | Value (_, addr) -> get_address addr - | Persistent -> Aident id - end - | Pdot(p, s) -> begin - match get_components (find_module_descr p env) with - | Structure_comps c -> - let _, addr = NameMap.find s c.comp_modules in - get_address addr - | Functor_comps _ -> - raise Not_found - end + | Pident id -> get_address (find_ident_module id env).mda_address + | Pdot(p, s) -> + let c = find_structure_components p env in + get_address (NameMap.find s c.comp_modules).mda_address | Papply _ -> raise Not_found and force_address = function @@ -856,31 +999,46 @@ and force_address = function and get_address a = EnvLazy.force force_address a -let find_value_address p env = - get_address (snd (find_value_full p env)) +let find_value_address path env = + get_address (find_value_full path env).vda_address -let find_class_address p env = - get_address (snd (find_class_full p env)) +let find_class_address path env = + get_address (find_class_full path env).clda_address let rec get_constrs_address = function | [] -> raise Not_found - | (_, None) :: rest -> get_constrs_address rest - | (_, Some a) :: _ -> get_address a + | cda :: rest -> + match cda.cda_address with + | None -> get_constrs_address rest + | Some a -> get_address a let find_constructor_address path env = match path with | Pident id -> begin - match TycompTbl.find_same id env.constrs with - | _, None -> raise Not_found - | _, Some addr -> get_address addr - end - | Pdot(p, s) -> begin - match get_components (find_module_descr p env) with - | Structure_comps c -> - get_constrs_address (NameMap.find s c.comp_constrs) - | Functor_comps _ -> - raise Not_found + let cda = TycompTbl.find_same id env.constrs in + match cda.cda_address with + | None -> raise Not_found + | Some addr -> get_address addr end + | Pdot(p, s) -> + let c = find_structure_components p env in + get_constrs_address (NameMap.find s c.comp_constrs) + | Papply _ -> + raise Not_found + +let find_hash_type path env = + match path with + | Pident id -> + let name = "#" ^ Ident.name id in + let _, tda = + IdTbl.find_name wrap_identity ~mark:false name env.types + in + tda.tda_declaration + | Pdot(p, s) -> + let c = find_structure_components p env in + let name = "#" ^ s in + let tda = NameMap.find name c.comp_types in + tda.tda_declaration | Papply _ -> raise Not_found @@ -939,11 +1097,6 @@ let normalize_path_prefix oloc env path = | Papply _ -> assert false -let is_uident s = - match s.[0] with - | 'A'..'Z' -> true - | _ -> false - let normalize_type_path oloc env path = (* Inlined version of Path.is_constructor_typath: constructor type paths (i.e. path pointing to an inline @@ -954,7 +1107,7 @@ let normalize_type_path oloc env path = path | Pdot(p, s) -> let p2 = - if is_uident s && not (is_uident (Path.last p)) then + if Path.is_uident s && not (Path.is_uident (Path.last p)) then (* Cstr M.t.C *) normalize_path_prefix oloc env p else @@ -1011,380 +1164,32 @@ let rec is_functor_arg path env = | Pdot (p, _s) -> is_functor_arg p env | Papply _ -> true -(* Lookup by name *) - -exception Recmodule - -let report_alerts ?loc p alerts = - match loc with - | Some loc -> - Misc.Stdlib.String.Map.iter - (fun kind message -> - let message = if message = "" then "" else "\n" ^ message in - Location.alert ~kind loc - (Printf.sprintf "module %s%s" (Path.name p) message) - ) - alerts - | _ -> () - -let mark_module_used name loc = - try Hashtbl.find module_declarations (name, loc) () - with Not_found -> () - -let rec lookup_module_descr_aux ?loc ~mark lid env = - match lid with - Lident s -> - let find_components s = (find_pers_mod s).pm_components in - begin match IdTbl.find_name ~mark s env.components with - | exception Not_found when not (Current_unit_name.is s) -> - let p = Path.Pident (Ident.create_persistent s) in - (p, find_components s) - | (p, data) -> - (p, - match data with - | Value (comp, _) -> comp - | Persistent -> find_components s) - end - | Ldot(l, s) -> - let (p, descr) = lookup_module_descr ?loc ~mark l env in - begin match get_components descr with - Structure_comps c -> - let (descr, _addr) = NameMap.find s c.comp_components in - (Pdot(p, s), descr) - | Functor_comps _ -> - raise Not_found - end - | Lapply(l1, l2) -> - let (p1, desc1) = lookup_module_descr ?loc ~mark l1 env in - let p2 = lookup_module ~load:true ~mark ?loc l2 env in - let {md_type=mty2} = find_module p2 env in - begin match get_components desc1 with - Functor_comps f -> - let loc = match loc with Some l -> l | None -> Location.none in - (match f.fcomp_arg with - | None -> raise Not_found (* PR#7611 *) - | Some arg -> !check_modtype_inclusion ~loc env mty2 p2 arg); - (Papply(p1, p2), !components_of_functor_appl' f env p1 p2) - | Structure_comps _ -> - raise Not_found - end - -and lookup_module_descr ?loc ~mark lid env = - let (p, comps) as res = lookup_module_descr_aux ?loc ~mark lid env in - if mark then mark_module_used (Path.last p) comps.loc; -(* - Format.printf "USE module %s at %a@." (Path.last p) - Location.print comps.loc; -*) - report_alerts ?loc p comps.alerts; - res - -and lookup_module ~load ?loc ~mark lid env : Path.t = - match lid with - Lident s -> - begin match IdTbl.find_name ~mark s env.modules with - | exception Not_found - when not (Current_unit_name.is s) - && !Clflags.transparent_modules - && not load -> - check_pers_mod s - ~loc:(Option.value loc ~default:Location.none); - Path.Pident (Ident.create_persistent s) - | p, data -> - begin match data with - | Value (data, _) -> - let {md_loc; md_attributes; md_type} = - EnvLazy.force subst_modtype_maker data - in - if mark then mark_module_used s md_loc; - begin match md_type with - | Mty_ident (Path.Pident id) when Ident.name id = "#recmod#" -> - (* see #5965 *) - raise Recmodule - | _ -> () - end; - report_alerts ?loc p - (Builtin_attributes.alerts_of_attrs md_attributes) - | Persistent -> - if !Clflags.transparent_modules && not load then - check_pers_mod s - ~loc:(Option.value loc ~default:Location.none) - else begin - let pm = find_pers_mod s in - report_alerts ?loc p pm.pm_components.alerts - end - end; - p - end - | Ldot(l, s) -> - let (p, descr) = lookup_module_descr ?loc ~mark l env in - begin match get_components descr with - Structure_comps c -> - let (comps, _) = NameMap.find s c.comp_components in - if mark then mark_module_used s comps.loc; - let p = Pdot(p, s) in - report_alerts ?loc p comps.alerts; - p - | Functor_comps _ -> - raise Not_found - end - | Lapply(l1, l2) -> - let (p1, desc1) = lookup_module_descr ?loc ~mark l1 env in - let p2 = lookup_module ~load:true ?loc ~mark l2 env in - let {md_type=mty2} = find_module p2 env in - let p = Papply(p1, p2) in - begin match get_components desc1 with - Functor_comps f -> - let loc = match loc with Some l -> l | None -> Location.none in - (match f.fcomp_arg with - | None -> raise Not_found (* PR#7611 *) - | Some arg -> (!check_modtype_inclusion ~loc env mty2 p2) arg); - p - | Structure_comps _ -> - raise Not_found - end - -let lookup proj1 proj2 ?loc ~mark lid env = - match lid with - | Lident s -> IdTbl.find_name ~mark s (proj1 env) - | Ldot(l, s) -> - let path, desc = lookup_module_descr ?loc ~mark l env in - begin match get_components desc with - Structure_comps c -> - let data = NameMap.find s (proj2 c) in - (Pdot(path, s), data) - | Functor_comps _ -> - raise Not_found - end - | Lapply _ -> - raise Not_found - -let lookup_all_simple proj1 proj2 shadow ?loc ~mark lid env = - match lid with - Lident s -> - let xl = TycompTbl.find_all s (proj1 env) in - let rec do_shadow = - function - | [] -> [] - | ((x, f) :: xs) -> - (x, f) :: - (do_shadow (List.filter (fun (y, _) -> not (shadow x y)) xs)) - in - do_shadow xl - | Ldot(l, s) -> - let (_p, desc) = lookup_module_descr ?loc ~mark l env in - begin match get_components desc with - Structure_comps c -> - let comps = - try NameMap.find s (proj2 c) with Not_found -> [] - in - List.map - (fun data -> (data, (fun () -> ()))) - comps - | Functor_comps _ -> - raise Not_found - end - | Lapply _ -> - raise Not_found - -let has_local_constraints env = not (Path.Map.is_empty env.local_constraints) - -let cstr_shadow (cstr1, _) (cstr2, _) = - match cstr1.cstr_tag, cstr2.cstr_tag with - | Cstr_extension _, Cstr_extension _ -> true - | _ -> false - -let lbl_shadow _lbl1 _lbl2 = false - -let ignore_address (path, (desc, _addr)) = (path, desc) - -let lookup_value ?loc ~mark lid env = - ignore_address - (lookup (fun env -> env.values) (fun sc -> sc.comp_values) - ?loc ~mark lid env) -let lookup_all_constructors ?loc ~mark lid env = - lookup_all_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs) - cstr_shadow ?loc ~mark lid env -let lookup_all_labels ?loc ~mark lid env = - lookup_all_simple (fun env -> env.labels) (fun sc -> sc.comp_labels) - lbl_shadow ?loc ~mark lid env -let lookup_type ?loc ~mark lid env= - lookup (fun env -> env.types) (fun sc -> sc.comp_types) - ?loc ~mark lid env -let lookup_modtype ?loc ~mark lid env = - lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) - ?loc ~mark lid env -let lookup_class ?loc ~mark lid env = - ignore_address - (lookup (fun env -> env.classes) (fun sc -> sc.comp_classes) - ?loc ~mark lid env) -let lookup_cltype ?loc ~mark lid env = - lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) - ?loc ~mark lid env - -type copy_of_types = { - to_copy: string list; - initial_values: (value_description * address_lazy) IdTbl.t; - new_values: (value_description * address_lazy) IdTbl.t; -} - -let make_copy_of_types l env : copy_of_types = - let f (desc, addr) = - {desc with val_type = Subst.type_expr Subst.identity desc.val_type}, addr +(* Copying types associated with values *) + +let make_copy_of_types env0 = + let memo = Hashtbl.create 16 in + let copy t = + try + Hashtbl.find memo t.id + with Not_found -> + let t2 = Subst.type_expr Subst.identity t in + Hashtbl.add memo t.id t2; + t2 in - let values = - List.fold_left (fun env s -> IdTbl.update s f env) env.values l + let f = function + | Val_unbound _ as entry -> entry + | Val_bound vda -> + let desc = vda.vda_description in + let desc = { desc with val_type = copy desc.val_type } in + Val_bound { vda with vda_description = desc } in - {to_copy = l; initial_values = env.values; new_values = values} - -let do_copy_types { to_copy = l; initial_values; new_values = values } env = - if initial_values != env.values then fatal_error "Env.do_copy_types"; - {env with values; summary = Env_copy_types (env.summary, l)} - -let mark_value_used name vd = - try Hashtbl.find value_declarations (name, vd.val_loc) () - with Not_found -> () - -let mark_type_used name vd = - try Hashtbl.find type_declarations (name, vd.type_loc) () - with Not_found -> () - -let mark_constructor_used usage name vd constr = - try Hashtbl.find used_constructors (name, vd.type_loc, constr) usage - with Not_found -> () - -let mark_extension_used usage ext name = - let ty_name = Path.last ext.ext_type_path in - try Hashtbl.find used_constructors (ty_name, ext.ext_loc, name) usage - with Not_found -> () - -let set_value_used_callback name vd callback = - let key = (name, vd.val_loc) in - try - let old = Hashtbl.find value_declarations key in - Hashtbl.replace value_declarations key (fun () -> old (); callback ()) - (* this is to support cases like: - let x = let x = 1 in x in x - where the two declarations have the same location - (e.g. resulting from Camlp4 expansion of grammar entries) *) - with Not_found -> - Hashtbl.add value_declarations key callback - -let set_type_used_callback name td callback = - let loc = td.type_loc in - if loc.Location.loc_ghost then () - else let key = (name, loc) in - let old = - try Hashtbl.find type_declarations key - with Not_found -> ignore + let values = + IdTbl.map f env0.values in - Hashtbl.replace type_declarations key (fun () -> callback old) - -let lookup_value ?loc ?(mark = true) lid env = - let (_, desc) as r = lookup_value ?loc ~mark lid env in - if mark then mark_value_used (Longident.last lid) desc; - r - -let lookup_type ?loc ?(mark = true) lid env = - let (path, (decl, _)) = lookup_type ?loc ~mark lid env in - if mark then mark_type_used (Longident.last lid) decl; - path - -let mark_type_path env path = - try - let decl = find_type path env in - mark_type_used (Path.last path) decl - with Not_found -> () - -let ty_path t = - match repr t with - | {desc=Tconstr(path, _, _)} -> path - | _ -> assert false - -let lookup_constructor ?loc ?(mark = true) lid env = - match lookup_all_constructors ?loc ~mark lid env with - [] -> raise Not_found - | ((desc, _), use) :: _ -> - if mark then begin - mark_type_path env (ty_path desc.cstr_res); - use () - end; - desc - -let is_lident = function - Lident _ -> true - | _ -> false - -let lookup_all_constructors ?loc ?(mark = true) lid env = - try - let cstrs = lookup_all_constructors ?loc ~mark lid env in - let wrap_use desc use () = - if mark then begin - mark_type_path env (ty_path desc.cstr_res); - use () - end - in - List.map (fun ((cstr, _), use) -> (cstr, wrap_use cstr use)) cstrs - with - Not_found when is_lident lid -> [] - -let mark_constructor usage env name desc = - match desc.cstr_tag with - | Cstr_extension _ -> - begin - let ty_path = ty_path desc.cstr_res in - let ty_name = Path.last ty_path in - try Hashtbl.find used_constructors (ty_name, desc.cstr_loc, name) usage - with Not_found -> () - end - | _ -> - let ty_path = ty_path desc.cstr_res in - let ty_decl = try find_type ty_path env with Not_found -> assert false in - let ty_name = Path.last ty_path in - mark_constructor_used usage ty_name ty_decl name - -let lookup_label ?loc ?(mark = true) lid env = - match lookup_all_labels ?loc ~mark lid env with - [] -> raise Not_found - | (desc, use) :: _ -> - if mark then begin - mark_type_path env (ty_path desc.lbl_res); - use () - end; - desc - -let lookup_all_labels ?loc ?(mark = true) lid env = - try - let lbls = lookup_all_labels ?loc ~mark lid env in - let wrap_use desc use () = - if mark then begin - mark_type_path env (ty_path desc.lbl_res); - use () - end - in - List.map (fun (lbl, use) -> (lbl, wrap_use lbl use)) lbls - with - Not_found when is_lident lid -> [] - -let lookup_module ~load ?loc ?(mark = true) lid env = - lookup_module ~load ?loc ~mark lid env - -let lookup_modtype ?loc ?(mark = true) lid env = - lookup_modtype ?loc ~mark lid env - -let lookup_class ?loc ?(mark = true) lid env = - let (_, desc) as r = lookup_class ?loc ~mark lid env in - (* special support for Typeclass.unbound_class *) - if Path.name desc.cty_path = "" then ignore (lookup_type ?loc ~mark lid env) - else if mark then mark_type_path env desc.cty_path; - r - -let lookup_cltype ?loc ?(mark = true) lid env = - let (_, desc) as r = lookup_cltype ?loc ~mark lid env in - if Path.name desc.clty_path = "" then ignore (lookup_type ?loc lid env) - else mark_type_path env desc.clty_path; - mark_type_path env desc.clty_path; - r + (fun env -> + if env.values != env0.values then fatal_error "Env.make_copy_of_types"; + {env with values; summary = Env_copy_types env.summary} + ) (* Helper to handle optional substitutions. *) @@ -1399,7 +1204,7 @@ let may_subst subst_f sub x = type iter_cont = unit -> unit let iter_env_cont = ref [] -let rec scrape_alias_for_visit env sub mty = +let rec scrape_alias_for_visit env (sub : Subst.t option) mty = match mty with | Mty_alias path -> begin match may_subst Subst.module_path sub path with @@ -1413,8 +1218,8 @@ let rec scrape_alias_for_visit env sub mty = end | _ -> true -let iter_env proj1 proj2 f env () = - IdTbl.iter (fun id x -> f (Pident id) x) (proj1 env); +let iter_env wrap proj1 proj2 f env () = + IdTbl.iter wrap (fun id x -> f (Pident id) x) (proj1 env); let rec iter_components path path' mcomps = let cont () = let visit = @@ -1430,22 +1235,26 @@ let iter_env proj1 proj2 f env () = (fun s d -> f (Pdot (path, s)) (Pdot (path', s), d)) (proj2 comps); NameMap.iter - (fun s (c, _) -> - iter_components (Pdot (path, s)) (Pdot (path', s)) c) - comps.comp_components + (fun s mda -> + iter_components + (Pdot (path, s)) (Pdot (path', s)) mda.mda_components) + comps.comp_modules | Functor_comps _ -> () in iter_env_cont := (path, cont) :: !iter_env_cont in - IdTbl.iter - (fun id (path, comps) -> - match comps with - | Value (comps, _) -> iter_components (Pident id) path comps - | Persistent -> + IdTbl.iter wrap_module + (fun id (path, entry) -> + match entry with + | Mod_unbound _ -> () + | Mod_local data -> + iter_components (Pident id) path data.mda_components + | Mod_persistent -> let modname = Ident.name id in match Persistent_env.find_in_cache persistent_env modname with | None -> () - | Some pm -> iter_components (Pident id) path pm.pm_components) - env.components + | Some data -> + iter_components (Pident id) path data.mda_components) + env.modules let run_iter_cont l = iter_env_cont := []; @@ -1454,55 +1263,59 @@ let run_iter_cont l = iter_env_cont := []; cont -let iter_types f = iter_env (fun env -> env.types) (fun sc -> sc.comp_types) f +let iter_types f = + iter_env wrap_identity (fun env -> env.types) (fun sc -> sc.comp_types) + (fun p1 (p2, tda) -> f p1 (p2, tda.tda_declaration)) let same_types env1 env2 = - env1.types == env2.types && env1.components == env2.components + env1.types == env2.types && env1.modules == env2.modules let used_persistent () = Persistent_env.fold persistent_env (fun s _m r -> Concr.add s r) Concr.empty -let find_all_comps proj s (p,(mcomps, _)) = - match get_components mcomps with +let find_all_comps wrap proj s (p, mda) = + match get_components mda.mda_components with Functor_comps _ -> [] | Structure_comps comps -> try let c = NameMap.find s (proj comps) in - [Pdot(p,s), c] + [Pdot(p,s), wrap c] with Not_found -> [] let rec find_shadowed_comps path env = match path with - Pident id -> + | Pident id -> List.filter_map (fun (p, data) -> match data with - | Value x -> Some (p, x) - | Persistent -> None) - (IdTbl.find_all (Ident.name id) env.components) + | Mod_local x -> Some (p, x) + | Mod_unbound _ | Mod_persistent -> None) + (IdTbl.find_all wrap_module (Ident.name id) env.modules) | Pdot (p, s) -> let l = find_shadowed_comps p env in let l' = - List.map (find_all_comps (fun comps -> comps.comp_components) s) l + List.map + (find_all_comps wrap_identity + (fun comps -> comps.comp_modules) s) l in List.flatten l' | Papply _ -> [] -let find_shadowed proj1 proj2 path env = +let find_shadowed wrap proj1 proj2 path env = match path with Pident id -> - IdTbl.find_all (Ident.name id) (proj1 env) + IdTbl.find_all wrap (Ident.name id) (proj1 env) | Pdot (p, s) -> let l = find_shadowed_comps p env in - let l' = List.map (find_all_comps proj2 s) l in + let l' = List.map (find_all_comps wrap proj2 s) l in List.flatten l' | Papply _ -> [] let find_shadowed_types path env = List.map fst - (find_shadowed + (find_shadowed wrap_identity (fun env -> env.types) (fun comps -> comps.comp_types) path env) (* Expand manifest module type names at the top of the given module type *) @@ -1633,22 +1446,9 @@ let module_declaration_address env id presence md = | Mp_present -> EnvLazy.create_forced (Aident id) -let rec components_of_module ~alerts ~loc env fs ps path addr mty = - { - alerts; - loc; - comps = EnvLazy.create { - cm_env = env; - cm_freshening_subst = fs; - cm_prefixing_subst = ps; - cm_path = path; - cm_addr = addr; - cm_mty = mty - } - } - -and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; - cm_path; cm_addr; cm_mty} = +let rec components_of_module_maker + {cm_env; cm_freshening_subst; cm_prefixing_subst; + cm_path; cm_addr; cm_mty} : _ result = match scrape_alias cm_env cm_freshening_subst cm_mty with Mty_signature sg -> let c = @@ -1656,8 +1456,8 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; comp_constrs = NameMap.empty; comp_labels = NameMap.empty; comp_types = NameMap.empty; comp_modules = NameMap.empty; comp_modtypes = NameMap.empty; - comp_components = NameMap.empty; comp_classes = NameMap.empty; - comp_cltypes = NameMap.empty } in + comp_classes = NameMap.empty; comp_cltypes = NameMap.empty } + in let items_and_paths, freshening_sub, prefixing_sub = prefix_idents cm_path cm_freshening_subst cm_prefixing_subst sg in @@ -1680,8 +1480,8 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; | Val_prim _ -> EnvLazy.create_failed Not_found | _ -> next_address () in - c.comp_values <- - NameMap.add (Ident.name id) (decl', addr) c.comp_values; + let vda = { vda_description = decl'; vda_address = addr } in + c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values; | Sig_type(id, decl, _, _) -> let fresh_decl = may_subst Subst.type_declaration freshening_sub decl @@ -1693,14 +1493,16 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; List.map snd (Datarepr.constructors_of_type path final_decl) in let labels = List.map snd (Datarepr.labels_of_type path final_decl) in - c.comp_types <- - NameMap.add (Ident.name id) - (final_decl, (constructors, labels)) - c.comp_types; + let tda = + { tda_declaration = final_decl; + tda_descriptions = (constructors, labels); } + in + c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types; List.iter (fun descr -> - c.comp_constrs <- - add_to_tbl descr.cstr_name (descr, None) c.comp_constrs) + let cda = { cda_description = descr; cda_address = None } in + c.comp_constrs <- + add_to_tbl descr.cstr_name cda c.comp_constrs) constructors; List.iter (fun descr -> @@ -1712,8 +1514,8 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; let ext' = Subst.extension_constructor sub ext in let descr = Datarepr.extension_descr path ext' in let addr = next_address () in - c.comp_constrs <- - add_to_tbl (Ident.name id) (descr, Some addr) c.comp_constrs + let cda = { cda_description = descr; cda_address = Some addr } in + c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs | Sig_module(id, pres, md, _, _) -> let md' = (* The prefixed items get the same scope as [cm_path], which is @@ -1731,8 +1533,6 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; end | Mp_present -> next_address () in - c.comp_modules <- - NameMap.add (Ident.name id) (md', addr) c.comp_modules; let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in @@ -1740,10 +1540,15 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; components_of_module ~alerts ~loc:md.md_loc !env freshening_sub prefixing_sub path addr md.md_type in - c.comp_components <- - NameMap.add (Ident.name id) (comps, addr) c.comp_components; + let mda = + { mda_declaration = md'; + mda_components = comps; + mda_address = addr } + in + c.comp_modules <- + NameMap.add (Ident.name id) mda c.comp_modules; env := - store_module ~freshening_sub ~check:false id addr pres md !env + store_module ~freshening_sub ~check:None id addr pres md !env | Sig_modtype(id, decl, _) -> let fresh_decl = (* the fresh_decl is only going in the local temporary env, and @@ -1762,30 +1567,33 @@ and components_of_module_maker {cm_env; cm_freshening_subst; cm_prefixing_subst; env := store_modtype id fresh_decl !env | Sig_class(id, decl, _, _) -> let decl' = Subst.class_declaration sub decl in - c.comp_classes <- - NameMap.add (Ident.name id) (decl', next_address ()) - c.comp_classes + let addr = next_address () in + let clda = { clda_declaration = decl'; clda_address = addr } in + c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes | Sig_class_type(id, decl, _, _) -> let decl' = Subst.cltype_declaration sub decl in c.comp_cltypes <- NameMap.add (Ident.name id) decl' c.comp_cltypes) items_and_paths; - Some (Structure_comps c) - | Mty_functor(param, ty_arg, ty_res) -> + Ok (Structure_comps c) + | Mty_functor(arg, ty_res) -> let sub = may_subst Subst.compose cm_freshening_subst cm_prefixing_subst in let scoping = Subst.Rescope (Path.scope cm_path) in - Some (Functor_comps { - fcomp_param = param; + Ok (Functor_comps { (* fcomp_arg and fcomp_res must be prefixed eagerly, because they are interpreted in the outer environment *) - fcomp_arg = may_map (Subst.modtype scoping sub) ty_arg; + fcomp_arg = + (match arg with + | Unit -> Unit + | Named (param, ty_arg) -> + Named (param, Subst.modtype scoping sub ty_arg)); fcomp_res = Subst.modtype scoping sub ty_res; fcomp_cache = Hashtbl.create 17; fcomp_subst_cache = Hashtbl.create 17 }) - | Mty_ident _ - | Mty_alias _ -> None + | Mty_ident _ -> Error No_components_abstract + | Mty_alias p -> Error (No_components_alias p) (* Insertion of bindings by identifier + path *) @@ -1806,19 +1614,18 @@ and check_value_name name loc = (* Note: we could also check here general validity of the identifier, to protect against bad identifiers forged by -pp or -ppx preprocessors. *) - if String.length name > 0 && (name.[0] = '#') then for i = 1 to String.length name - 1 do if name.[i] = '#' then error (Illegal_value_name(loc, name)) done - and store_value ?check id addr decl env = check_value_name (Ident.name id) decl.val_loc; - may (fun f -> check_usage decl.val_loc id f value_declarations) check; + Option.iter (fun f -> check_usage decl.val_loc id f value_declarations) check; + let vda = { vda_description = decl; vda_address = addr } in { env with - values = IdTbl.add id (decl, addr) env.values; + values = IdTbl.add id (Val_bound vda) env.values; summary = Env_value(env.summary, id, decl) } and store_type ~check id info env = @@ -1830,39 +1637,42 @@ and store_type ~check id info env = let constructors = Datarepr.constructors_of_type path info in let labels = Datarepr.labels_of_type path info in let descrs = (List.map snd constructors, List.map snd labels) in - + let tda = { tda_declaration = info; tda_descriptions = descrs } in if check && not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_constructor ("", false, false)) then begin - let ty = Ident.name id in + let ty_name = Ident.name id in + let priv = info.type_private in List.iter - begin fun (_, {cstr_name = c; _}) -> - let k = (ty, loc, c) in + begin fun (_, cstr) -> + let name = cstr.cstr_name in + let loc = cstr.cstr_loc in + let k = (ty_name, loc, name) in if not (Hashtbl.mem used_constructors k) then let used = constructor_usages () in - Hashtbl.add used_constructors k (add_constructor_usage used); - if not (ty = "" || ty.[0] = '_') + Hashtbl.add used_constructors k (add_constructor_usage priv used); + if not (ty_name = "" || ty_name.[0] = '_') then !add_delayed_check_forward (fun () -> if not (is_in_signature env) && not used.cu_positive then Location.prerr_warning loc (Warnings.Unused_constructor - (c, used.cu_pattern, used.cu_privatize))) + (name, used.cu_pattern, used.cu_privatize))) end constructors end; { env with constrs = List.fold_right - (fun (id, descr) constrs -> TycompTbl.add id (descr, None) constrs) - constructors - env.constrs; + (fun (id, descr) constrs -> + let cda = { cda_description = descr; cda_address = None } in + TycompTbl.add id cda constrs) + constructors env.constrs; labels = List.fold_right (fun (id, descr) labels -> TycompTbl.add id descr labels) - labels - env.labels; - types = IdTbl.add id (info, descrs) env.types; + labels env.labels; + types = IdTbl.add id tda env.types; summary = Env_type(env.summary, id, info) } and store_type_infos id info env = @@ -1871,57 +1681,60 @@ and store_type_infos id info env = manifest-ness of the type. Used in components_of_module to keep track of type abbreviations (e.g. type t = float) in the computation of label representations. *) + let tda = { tda_declaration = info; tda_descriptions = [], [] } in { env with - types = IdTbl.add id (info,([],[])) env.types; + types = IdTbl.add id tda env.types; summary = Env_type(env.summary, id, info) } and store_extension ~check id addr ext env = let loc = ext.ext_loc in + let cstr = Datarepr.extension_descr (Pident id) ext in + let cda = { cda_description = cstr; cda_address = Some addr } in if check && not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_extension ("", false, false, false)) then begin + let priv = ext.ext_private in let is_exception = Path.same ext.ext_type_path Predef.path_exn in - let ty = Path.last ext.ext_type_path in - let n = Ident.name id in - let k = (ty, loc, n) in + let ty_name = Path.last ext.ext_type_path in + let name = cstr.cstr_name in + let k = (ty_name, loc, name) in if not (Hashtbl.mem used_constructors k) then begin let used = constructor_usages () in - Hashtbl.add used_constructors k (add_constructor_usage used); + Hashtbl.add used_constructors k (add_constructor_usage priv used); !add_delayed_check_forward (fun () -> if not (is_in_signature env) && not used.cu_positive then Location.prerr_warning loc (Warnings.Unused_extension - (n, is_exception, used.cu_pattern, used.cu_privatize) + (name, is_exception, used.cu_pattern, used.cu_privatize) ) ) end; end; - let desc = Datarepr.extension_descr (Pident id) ext in { env with - constrs = TycompTbl.add id (desc, Some addr) env.constrs; + constrs = TycompTbl.add id cda env.constrs; summary = Env_extension(env.summary, id, ext) } and store_module ~check ~freshening_sub id addr presence md env = let loc = md.md_loc in - if check then - check_usage loc id (fun s -> Warnings.Unused_module s) - module_declarations; + Option.iter (fun f -> check_usage loc id f module_declarations) check; let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in let module_decl_lazy = match freshening_sub with | None -> EnvLazy.create_forced md | Some s -> EnvLazy.create (s, Subst.Rescope (Ident.scope id), md) in + let comps = + components_of_module ~alerts ~loc:md.md_loc + env freshening_sub Subst.identity (Pident id) addr md.md_type + in + let mda = + { mda_declaration = module_decl_lazy; + mda_components = comps; + mda_address = addr } + in { env with - modules = IdTbl.add id (Value (module_decl_lazy, addr)) env.modules; - components = - IdTbl.add id - (Value - (components_of_module ~alerts ~loc:md.md_loc - env freshening_sub Subst.identity (Pident id) addr md.md_type, - addr)) - env.components; + modules = IdTbl.add id (Mod_local mda) env.modules; summary = Env_module(env.summary, id, presence, md) } and store_modtype id info env = @@ -1930,8 +1743,9 @@ and store_modtype id info env = summary = Env_modtype(env.summary, id, info) } and store_class id addr desc env = + let clda = { clda_declaration = desc; clda_address = addr } in { env with - classes = IdTbl.add id (desc, addr) env.classes; + classes = IdTbl.add id clda env.classes; summary = Env_class(env.summary, id, desc) } and store_cltype id desc env = @@ -1943,17 +1757,22 @@ let scrape_alias env mty = scrape_alias env None mty (* Compute the components of a functor application in a path. *) -let components_of_functor_appl f env p1 p2 = +let components_of_functor_appl ~loc f env p1 p2 = try Hashtbl.find f.fcomp_cache p2 with Not_found -> let p = Papply(p1, p2) in - let sub = Subst.add_module f.fcomp_param p2 Subst.identity in + let sub = + match f.fcomp_arg with + | Unit + | Named (None, _) -> Subst.identity + | Named (Some param, _) -> Subst.add_module param p2 Subst.identity + in (* we have to apply eagerly instead of passing sub to [components_of_module] because of the call to [check_well_formed_module]. *) let mty = Subst.modtype (Rescope (Path.scope p)) sub f.fcomp_res in let addr = EnvLazy.create_failed Not_found in - !check_well_formed_module env Location.(in_file !input_name) + !check_well_formed_module env loc ("the signature of " ^ Path.name p) mty; let comps = components_of_module ~alerts:Misc.Stdlib.String.Map.empty @@ -1967,7 +1786,6 @@ let components_of_functor_appl f env p1 p2 = (* Define forward functions *) let _ = - components_of_module' := components_of_module; components_of_functor_appl' := components_of_functor_appl; components_of_module_maker' := components_of_module_maker @@ -1990,6 +1808,14 @@ and add_extension ~check id ext env = store_extension ~check id addr ext env and add_module_declaration ?(arg=false) ~check id presence md env = + let check = + if not check then + None + else if arg && is_in_signature env then + Some (fun s -> Warnings.Unused_functor_parameter s) + else + Some (fun s -> Warnings.Unused_module s) + in let addr = module_declaration_address env id presence md in let env = store_module ~freshening_sub:None ~check id addr presence md env in if arg then add_functor_arg id env else env @@ -2031,8 +1857,9 @@ let enter_extension ~scope name ext env = let env = store_extension ~check:true id addr ext env in (id, env) -let enter_module_declaration ?arg id presence md env = - add_module_declaration ?arg ~check:true id presence md env +let enter_module_declaration ~scope ?arg s presence md env = + let id = Ident.create_scoped ~scope s in + (id, add_module_declaration ?arg ~check:true id presence md env) let enter_modtype ~scope name mtd env = let id = Ident.create_scoped ~scope name in @@ -2051,9 +1878,7 @@ let enter_cltype ~scope name desc env = (id, env) let enter_module ~scope ?arg s presence mty env = - let id = Ident.create_scoped ~scope s in - let env = enter_module_declaration ?arg id presence (md mty) env in - (id, env) + enter_module_declaration ~scope ?arg s presence (md mty) env (* Insertion of all components of a signature *) @@ -2077,22 +1902,33 @@ let enter_signature ~scope sg env = let sg = Subst.signature (Rescope scope) Subst.identity sg in sg, add_signature sg env +(* Add "unbound" bindings *) + +let enter_unbound_value name reason env = + let id = Ident.create_local name in + { env with + values = IdTbl.add id (Val_unbound reason) env.values; + summary = Env_value_unbound(env.summary, name, reason) } + +let enter_unbound_module name reason env = + let id = Ident.create_local name in + { env with + modules = IdTbl.add id (Mod_unbound reason) env.modules; + summary = Env_module_unbound(env.summary, name, reason) } + (* Open a signature path *) let add_components slot root env0 comps = let add_l w comps env0 = TycompTbl.add_open slot w comps env0 in - let add w comps env0 = IdTbl.add_open slot w root comps env0 in - let constrs = add_l (fun x -> `Constructor x) comps.comp_constrs env0.constrs in let labels = add_l (fun x -> `Label x) comps.comp_labels env0.labels in - let values = add (fun x -> `Value x) comps.comp_values env0.values in @@ -2108,20 +1944,9 @@ let add_components slot root env0 comps = let cltypes = add (fun x -> `Class_type x) comps.comp_cltypes env0.cltypes in - let components = - let components = - NameMap.map (fun x -> Value x) comps.comp_components - in - add (fun x -> `Component x) components env0.components - in - let modules = - let modules = - NameMap.map (fun x -> Value x) comps.comp_modules - in - add (fun x -> `Module x) modules env0.modules + add (fun x -> `Module x) comps.comp_modules env0.modules in - { env0 with summary = Env_open(env0.summary, root); constrs; @@ -2131,12 +1956,11 @@ let add_components slot root env0 comps = modtypes; classes; cltypes; - components; modules; } let open_signature slot root env0 = - match get_components (find_module_descr root env0) with + match get_components (find_module_components root env0) with | Functor_comps _ -> None | Structure_comps comps -> Some (add_components slot root env0 comps) @@ -2200,8 +2024,11 @@ let open_signature (* Read a signature from a file *) let read_signature modname filename = - let pm = read_pers_mod modname filename in - Lazy.force pm.pm_signature + let mda = read_pers_mod modname filename in + let md = EnvLazy.force subst_modtype_maker mda.mda_declaration in + match md.md_type with + | Mty_signature sg -> sg + | Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false let is_identchar_latin1 = function | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246' @@ -2250,70 +2077,784 @@ let save_signature_with_imports ~alerts sg modname filename imports = save_signature_with_transform with_imports ~alerts sg modname filename +(* Make the initial environment *) +let (initial_safe_string, initial_unsafe_string) = + Predef.build_initial_env + (add_type ~check:false) + (add_extension ~check:false) + empty + +(* Tracking usage *) + +let mark_module_used name loc = + match Hashtbl.find module_declarations (name, loc) with + | mark -> mark () + | exception Not_found -> () + +let mark_modtype_used _name _mtd = () + +let mark_value_used name vd = + match Hashtbl.find value_declarations (name, vd.val_loc) with + | mark -> mark () + | exception Not_found -> () + +let mark_type_used name td = + match Hashtbl.find type_declarations (name, td.type_loc) with + | mark -> mark () + | exception Not_found -> () + +let mark_type_path_used env path = + match find_type path env with + | decl -> mark_type_used (Path.last path) decl + | exception Not_found -> () + +let mark_constructor_used usage ty_name cd = + let name = Ident.name cd.cd_id in + let loc = cd.cd_loc in + let k = (ty_name, loc, name) in + match Hashtbl.find used_constructors k with + | mark -> mark usage + | exception Not_found -> () + +let mark_extension_used usage name ext = + let ty_name = Path.last ext.ext_type_path in + let loc = ext.ext_loc in + let k = (ty_name, loc, name) in + match Hashtbl.find used_constructors k with + | mark -> mark usage + | exception Not_found -> () + +let mark_constructor_description_used usage env cstr = + let ty_path = + match repr cstr.cstr_res with + | {desc=Tconstr(path, _, _)} -> path + | _ -> assert false + in + mark_type_path_used env ty_path; + let ty_name = Path.last ty_path in + let k = (ty_name, cstr.cstr_loc, cstr.cstr_name) in + match Hashtbl.find used_constructors k with + | mark -> mark usage + | exception Not_found -> () + +let mark_label_description_used () env lbl = + let ty_path = + match repr lbl.lbl_res with + | {desc=Tconstr(path, _, _)} -> path + | _ -> assert false + in + mark_type_path_used env ty_path + +let mark_class_used name cty = + match Hashtbl.find type_declarations (name, cty.cty_loc) with + | mark -> mark () + | exception Not_found -> () + +let mark_cltype_used name clty = + match Hashtbl.find type_declarations (name, clty.clty_loc) with + | mark -> mark () + | exception Not_found -> () + +let set_value_used_callback name vd callback = + let key = (name, vd.val_loc) in + try + let old = Hashtbl.find value_declarations key in + Hashtbl.replace value_declarations key (fun () -> old (); callback ()) + (* this is to support cases like: + let x = let x = 1 in x in x + where the two declarations have the same location + (e.g. resulting from Camlp4 expansion of grammar entries) *) + with Not_found -> + Hashtbl.add value_declarations key callback + +let set_type_used_callback name td callback = + let loc = td.type_loc in + if loc.Location.loc_ghost then () + else let key = (name, loc) in + let old = + try Hashtbl.find type_declarations key + with Not_found -> ignore + in + Hashtbl.replace type_declarations key (fun () -> callback old) + +(* Lookup by name *) + +let may_lookup_error report_errors loc env err = + if report_errors then lookup_error loc env err + else raise Not_found + +let report_module_unbound ~errors ~loc env reason = + match reason with + | Mod_unbound_illegal_recursion -> + (* see #5965 *) + may_lookup_error errors loc env Illegal_reference_to_recursive_module + +let report_value_unbound ~errors ~loc env reason lid = + match reason with + | Val_unbound_instance_variable -> + may_lookup_error errors loc env (Masked_instance_variable lid) + | Val_unbound_self -> + may_lookup_error errors loc env (Masked_self_variable lid) + | Val_unbound_ancestor -> + may_lookup_error errors loc env (Masked_ancestor_variable lid) + | Val_unbound_ghost_recursive rloc -> + let show_hint = + (* Only display the "missing rec" hint for non-ghost code *) + not loc.Location.loc_ghost + && not rloc.Location.loc_ghost + in + let hint = + if show_hint then Missing_rec rloc else No_hint + in + may_lookup_error errors loc env (Unbound_value(lid, hint)) + +let use_module ~use ~loc name path mda = + if use then begin + let comps = mda.mda_components in + mark_module_used name comps.loc; + Misc.Stdlib.String.Map.iter + (fun kind message -> + let message = if message = "" then "" else "\n" ^ message in + Location.alert ~kind loc + (Printf.sprintf "module %s%s" (Path.name path) message) + ) + comps.alerts + end + +let use_value ~use ~loc name path vda = + if use then begin + let desc = vda.vda_description in + mark_value_used name desc; + Builtin_attributes.check_alerts loc desc.val_attributes + (Path.name path) + end + +let use_type ~use ~loc name path tda = + if use then begin + let decl = tda.tda_declaration in + mark_type_used name decl; + Builtin_attributes.check_alerts loc decl.type_attributes + (Path.name path) + end + +let use_modtype ~use ~loc name path desc = + if use then begin + mark_modtype_used name desc; + Builtin_attributes.check_alerts loc desc.mtd_attributes + (Path.name path) + end + +let use_class ~use ~loc name path clda = + if use then begin + let desc = clda.clda_declaration in + mark_class_used name desc; + Builtin_attributes.check_alerts loc desc.cty_attributes + (Path.name path) + end + +let use_cltype ~use ~loc name path desc = + if use then begin + mark_cltype_used name desc; + Builtin_attributes.check_alerts loc desc.clty_attributes + (Path.name path) + end + +let use_label ~use ~loc env lbl = + if use then begin + mark_label_description_used () env lbl; + Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name + end + +let use_constructor_desc ~use ~loc usage env cstr = + if use then begin + mark_constructor_description_used usage env cstr; + Builtin_attributes.check_alerts loc cstr.cstr_attributes cstr.cstr_name + end + +let use_constructor ~use ~loc usage env cda = + use_constructor_desc ~use ~loc usage env cda.cda_description + +type _ load = + | Load : module_data load + | Don't_load : unit load + +let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env = + let path, data = + match find_name_module ~mark:use s env.modules with + | res -> res + | exception Not_found -> + may_lookup_error errors loc env (Unbound_module (Lident s)) + in + match data with + | Mod_local mda -> begin + use_module ~use ~loc s path mda; + match load with + | Load -> path, (mda : a) + | Don't_load -> path, (() : a) + end + | Mod_unbound reason -> + report_module_unbound ~errors ~loc env reason + | Mod_persistent -> begin + match load with + | Don't_load -> + check_pers_mod ~loc s; + path, (() : a) + | Load -> begin + match find_pers_mod s with + | mda -> + use_module ~use ~loc s path mda; + path, (mda : a) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_module (Lident s)) + end + end + +let lookup_ident_value ~errors ~use ~loc name env = + match IdTbl.find_name wrap_value ~mark:use name env.values with + | (path, Val_bound vda) -> + use_value ~use ~loc name path vda; + path, vda.vda_description + | (_, Val_unbound reason) -> + report_value_unbound ~errors ~loc env reason (Lident name) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_value (Lident name, No_hint)) + +let lookup_ident_type ~errors ~use ~loc s env = + match IdTbl.find_name wrap_identity ~mark:use s env.types with + | (path, data) as res -> + use_type ~use ~loc s path data; + res + | exception Not_found -> + may_lookup_error errors loc env (Unbound_type (Lident s)) + +let lookup_ident_modtype ~errors ~use ~loc s env = + match IdTbl.find_name wrap_identity ~mark:use s env.modtypes with + | (path, data) as res -> + use_modtype ~use ~loc s path data; + res + | exception Not_found -> + may_lookup_error errors loc env (Unbound_modtype (Lident s)) + +let lookup_ident_class ~errors ~use ~loc s env = + match IdTbl.find_name wrap_identity ~mark:use s env.classes with + | (path, clda) -> + use_class ~use ~loc s path clda; + path, clda.clda_declaration + | exception Not_found -> + may_lookup_error errors loc env (Unbound_class (Lident s)) + +let lookup_ident_cltype ~errors ~use ~loc s env = + match IdTbl.find_name wrap_identity ~mark:use s env.cltypes with + | (path, data) as res -> + use_cltype ~use ~loc s path data; + res + | exception Not_found -> + may_lookup_error errors loc env (Unbound_cltype (Lident s)) + +let lookup_all_ident_labels ~errors ~use ~loc s env = + match TycompTbl.find_all ~mark:use s env.labels with + | [] -> may_lookup_error errors loc env (Unbound_label (Lident s)) + | lbls -> begin + List.map + (fun (lbl, use_fn) -> + let use_fn () = + use_label ~use ~loc env lbl; + use_fn () + in + (lbl, use_fn)) + lbls + end + +(* Drop all extension constructors *) +let drop_exts cstrs = + List.filter (fun (cda, _) -> not (is_ext cda)) cstrs + +(* Only keep the latest extension constructor *) +let rec filter_shadowed_constructors cstrs = + match cstrs with + | (cda, _) as hd :: tl -> + if is_ext cda then hd :: drop_exts tl + else hd :: filter_shadowed_constructors tl + | [] -> [] + +let lookup_all_ident_constructors ~errors ~use ~loc usage s env = + match TycompTbl.find_all ~mark:use s env.constrs with + | [] -> may_lookup_error errors loc env (Unbound_constructor (Lident s)) + | cstrs -> + let cstrs = filter_shadowed_constructors cstrs in + List.map + (fun (cda, use_fn) -> + let use_fn () = + use_constructor ~use ~loc usage env cda; + use_fn () + in + (cda.cda_description, use_fn)) + cstrs + +let rec lookup_module_components ~errors ~use ~loc lid env = + match lid with + | Lident s -> + let path, data = lookup_ident_module Load ~errors ~use ~loc s env in + path, data.mda_components + | Ldot(l, s) -> + let path, data = lookup_dot_module ~errors ~use ~loc l s env in + path, data.mda_components + | Lapply(l1, l2) -> + let p1, f, arg = lookup_functor_components ~errors ~use ~loc l1 env in + let p2, md = lookup_module ~errors ~use ~loc l2 env in + !check_functor_application ~errors ~loc env md.md_type p2 arg p1; + let comps = !components_of_functor_appl' ~loc f env p1 p2 in + (Papply(p1, p2), comps) + +and lookup_structure_components ~errors ~use ~loc lid env = + let path, comps = lookup_module_components ~errors ~use ~loc lid env in + match get_components_res comps with + | Ok (Structure_comps comps) -> path, comps + | Ok (Functor_comps _) -> + may_lookup_error errors loc env (Functor_used_as_structure lid) + | Error No_components_abstract -> + may_lookup_error errors loc env (Abstract_used_as_structure lid) + | Error (No_components_alias p) -> + may_lookup_error errors loc env (Cannot_scrape_alias(lid, p)) + +and lookup_functor_components ~errors ~use ~loc lid env = + let path, comps = lookup_module_components ~errors ~use ~loc lid env in + match get_components_res comps with + | Ok (Functor_comps fcomps) -> begin + match fcomps.fcomp_arg with + | Unit -> (* PR#7611 *) + may_lookup_error errors loc env (Generative_used_as_applicative lid) + | Named (_, arg) -> path, fcomps, arg + end + | Ok (Structure_comps _) -> + may_lookup_error errors loc env (Structure_used_as_functor lid) + | Error No_components_abstract -> + may_lookup_error errors loc env (Abstract_used_as_functor lid) + | Error (No_components_alias p) -> + may_lookup_error errors loc env (Cannot_scrape_alias(lid, p)) + +and lookup_module ~errors ~use ~loc lid env = + match lid with + | Lident s -> + let path, data = lookup_ident_module Load ~errors ~use ~loc s env in + let md = EnvLazy.force subst_modtype_maker data.mda_declaration in + path, md + | Ldot(l, s) -> + let path, data = lookup_dot_module ~errors ~use ~loc l s env in + let md = EnvLazy.force subst_modtype_maker data.mda_declaration in + path, md + | Lapply(l1, l2) -> + let p1, fc, arg = lookup_functor_components ~errors ~use ~loc l1 env in + let p2, md2 = lookup_module ~errors ~use ~loc l2 env in + !check_functor_application ~errors ~loc env md2.md_type p2 arg p1; + let md = md (modtype_of_functor_appl fc p1 p2) in + Papply(p1, p2), md + +and lookup_dot_module ~errors ~use ~loc l s env = + let p, comps = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_modules with + | mda -> + let path = Pdot(p, s) in + use_module ~use ~loc s path mda; + (path, mda) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_module (Ldot(l, s))) + +let lookup_dot_value ~errors ~use ~loc l s env = + let (path, comps) = + lookup_structure_components ~errors ~use ~loc l env + in + match NameMap.find s comps.comp_values with + | vda -> + let path = Pdot(path, s) in + use_value ~use ~loc s path vda; + (path, vda.vda_description) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_value (Ldot(l, s), No_hint)) + +let lookup_dot_type ~errors ~use ~loc l s env = + let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_types with + | tda -> + let path = Pdot(p, s) in + use_type ~use ~loc s path tda; + (path, tda) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_type (Ldot(l, s))) + +let lookup_dot_modtype ~errors ~use ~loc l s env = + let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_modtypes with + | desc -> + let path = Pdot(p, s) in + use_modtype ~use ~loc s path desc; + (path, desc) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s))) + +let lookup_dot_class ~errors ~use ~loc l s env = + let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_classes with + | clda -> + let path = Pdot(p, s) in + use_class ~use ~loc s path clda; + (path, clda.clda_declaration) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_class (Ldot(l, s))) + +let lookup_dot_cltype ~errors ~use ~loc l s env = + let (p, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_cltypes with + | desc -> + let path = Pdot(p, s) in + use_cltype ~use ~loc s path desc; + (path, desc) + | exception Not_found -> + may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s))) + +let lookup_all_dot_labels ~errors ~use ~loc l s env = + let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_labels with + | [] | exception Not_found -> + may_lookup_error errors loc env (Unbound_label (Ldot(l, s))) + | lbls -> + List.map + (fun lbl -> + let use_fun () = use_label ~use ~loc env lbl in + (lbl, use_fun)) + lbls + +let lookup_all_dot_constructors ~errors ~use ~loc usage l s env = + match l with + | Longident.Lident "*predef*" -> + (* Hack to support compilation of default arguments *) + lookup_all_ident_constructors + ~errors ~use ~loc usage s initial_safe_string + | _ -> + let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in + match NameMap.find s comps.comp_constrs with + | [] | exception Not_found -> + may_lookup_error errors loc env (Unbound_constructor (Ldot(l, s))) + | cstrs -> + List.map + (fun cda -> + let use_fun () = use_constructor ~use ~loc usage env cda in + (cda.cda_description, use_fun)) + cstrs + +(* General forms of the lookup functions *) + +let lookup_module_path ~errors ~use ~loc ~load lid env : Path.t = + match lid with + | Lident s -> + if !Clflags.transparent_modules && not load then + fst (lookup_ident_module Don't_load ~errors ~use ~loc s env) + else + fst (lookup_ident_module Load ~errors ~use ~loc s env) + | Ldot(l, s) -> fst (lookup_dot_module ~errors ~use ~loc l s env) + | Lapply(l1, l2) -> + let (p1, _, arg) = lookup_functor_components ~errors ~use ~loc l1 env in + let p2, md2 = lookup_module ~errors ~use ~loc l2 env in + !check_functor_application ~errors ~loc env md2.md_type p2 arg p1; + Papply(p1, p2) + +let lookup_value ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_ident_value ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_dot_value ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_type_full ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_ident_type ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_dot_type ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_type ~errors ~use ~loc lid env = + let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in + path, tda.tda_declaration + +let lookup_modtype ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_ident_modtype ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_class ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_ident_class ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_dot_class ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_cltype ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_ident_cltype ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_dot_cltype ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_all_labels ~errors ~use ~loc lid env = + match lid with + | Lident s -> lookup_all_ident_labels ~errors ~use ~loc s env + | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc l s env + | Lapply _ -> assert false + +let lookup_label ~errors ~use ~loc lid env = + match lookup_all_labels ~errors ~use ~loc lid env with + | [] -> assert false + | (desc, use) :: _ -> use (); desc + +let lookup_all_labels_from_type ~use ~loc ty_path env = + match find_type_descrs ty_path env with + | exception Not_found -> [] + | (_, lbls) -> + List.map + (fun lbl -> + let use_fun () = use_label ~use ~loc env lbl in + (lbl, use_fun)) + lbls + +let lookup_all_constructors ~errors ~use ~loc usage lid env = + match lid with + | Lident s -> lookup_all_ident_constructors ~errors ~use ~loc usage s env + | Ldot(l, s) -> lookup_all_dot_constructors ~errors ~use ~loc usage l s env + | Lapply _ -> assert false + +let lookup_constructor ~errors ~use ~loc usage lid env = + match lookup_all_constructors ~errors ~use ~loc usage lid env with + | [] -> assert false + | (desc, use) :: _ -> use (); desc + +let lookup_all_constructors_from_type ~use ~loc usage ty_path env = + match find_type_descrs ty_path env with + | exception Not_found -> [] + | (cstrs, _) -> + List.map + (fun cstr -> + let use_fun () = + use_constructor_desc ~use ~loc usage env cstr + in + (cstr, use_fun)) + cstrs + +(* Lookup functions that do not mark the item as used or + warn if it has alerts, and raise [Not_found] rather + than report errors *) + +let find_module_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_module ~errors:false ~use:false ~loc lid env + +let find_value_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_value ~errors:false ~use:false ~loc lid env + +let find_type_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_type ~errors:false ~use:false ~loc lid env + +let find_modtype_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_modtype ~errors:false ~use:false ~loc lid env + +let find_class_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_class ~errors:false ~use:false ~loc lid env + +let find_cltype_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_cltype ~errors:false ~use:false ~loc lid env + +let find_constructor_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_constructor ~errors:false ~use:false ~loc Positive lid env + +let find_label_by_name lid env = + let loc = Location.(in_file !input_name) in + lookup_label ~errors:false ~use:false ~loc lid env + +(* Ordinary lookup functions *) + +let lookup_module_path ?(use=true) ~loc ~load lid env = + lookup_module_path ~errors:true ~use ~loc ~load lid env + +let lookup_module ?(use=true) ~loc lid env = + lookup_module ~errors:true ~use ~loc lid env + +let lookup_value ?(use=true) ~loc lid env = + check_value_name (Longident.last lid) loc; + lookup_value ~errors:true ~use ~loc lid env + +let lookup_type ?(use=true) ~loc lid env = + lookup_type ~errors:true ~use ~loc lid env + +let lookup_modtype ?(use=true) ~loc lid env = + lookup_modtype ~errors:true ~use ~loc lid env + +let lookup_class ?(use=true) ~loc lid env = + lookup_class ~errors:true ~use ~loc lid env + +let lookup_cltype ?(use=true) ~loc lid env = + lookup_cltype ~errors:true ~use ~loc lid env + +let lookup_all_constructors ?(use=true) ~loc usage lid env = + match lookup_all_constructors ~errors:true ~use ~loc usage lid env with + | exception Error(Lookup_error(loc', env', err)) -> + (Error(loc', env', err) : _ result) + | cstrs -> Ok cstrs + +let lookup_constructor ?(use=true) ~loc lid env = + lookup_constructor ~errors:true ~use ~loc lid env + +let lookup_all_constructors_from_type ?(use=true) ~loc usage ty_path env = + lookup_all_constructors_from_type ~use ~loc usage ty_path env + +let lookup_all_labels ?(use=true) ~loc lid env = + match lookup_all_labels ~errors:true ~use ~loc lid env with + | exception Error(Lookup_error(loc', env', err)) -> + (Error(loc', env', err) : _ result) + | lbls -> Ok lbls + +let lookup_label ?(use=true) ~loc lid env = + lookup_label ~errors:true ~use ~loc lid env + +let lookup_all_labels_from_type ?(use=true) ~loc ty_path env = + lookup_all_labels_from_type ~use ~loc ty_path env + +let lookup_instance_variable ?(use=true) ~loc name env = + match IdTbl.find_name wrap_value ~mark:use name env.values with + | (path, Val_bound vda) -> begin + let desc = vda.vda_description in + match desc.val_kind with + | Val_ivar(mut, cl_num) -> + use_value ~use ~loc name path vda; + path, mut, cl_num, desc.val_type + | _ -> + lookup_error loc env (Not_an_instance_variable name) + end + | (_, Val_unbound Val_unbound_instance_variable) -> + lookup_error loc env (Masked_instance_variable (Lident name)) + | (_, Val_unbound Val_unbound_self) -> + lookup_error loc env (Not_an_instance_variable name) + | (_, Val_unbound Val_unbound_ancestor) -> + lookup_error loc env (Not_an_instance_variable name) + | (_, Val_unbound Val_unbound_ghost_recursive _) -> + lookup_error loc env (Unbound_instance_variable name) + | exception Not_found -> + lookup_error loc env (Unbound_instance_variable name) + +(* Checking if a name is bound *) + +let bound_module name env = + match IdTbl.find_name wrap_module ~mark:false name env.modules with + | _ -> true + | exception Not_found -> + if Current_unit_name.is name then false + else begin + match find_pers_mod name with + | _ -> true + | exception Not_found -> false + end + +let bound wrap proj name env = + match IdTbl.find_name wrap ~mark:false name (proj env) with + | _ -> true + | exception Not_found -> false + +let bound_value name env = + bound wrap_value (fun env -> env.values) name env + +let bound_type name env = + bound wrap_identity (fun env -> env.types) name env + +let bound_modtype name env = + bound wrap_identity (fun env -> env.modtypes) name env + +let bound_class name env = + bound wrap_identity (fun env -> env.classes) name env + +let bound_cltype name env = + bound wrap_identity (fun env -> env.cltypes) name env + (* Folding on environments *) -let find_all proj1 proj2 f lid env acc = +let find_all wrap proj1 proj2 f lid env acc = match lid with - | None -> - IdTbl.fold_name + | None -> + IdTbl.fold_name wrap (fun name (p, data) acc -> f name p data acc) (proj1 env) acc - | Some l -> - let p, desc = lookup_module_descr ~mark:true l env in + | Some l -> + let p, desc = + lookup_module_components + ~errors:false ~use:false ~loc:Location.none l env + in begin match get_components desc with - Structure_comps c -> - NameMap.fold - (fun s data acc -> f s (Pdot (p, s)) data acc) - (proj2 c) acc - | Functor_comps _ -> - acc + | Structure_comps c -> + NameMap.fold + (fun s data acc -> f s (Pdot (p, s)) (wrap data) acc) + (proj2 c) acc + | Functor_comps _ -> + acc end let find_all_simple_list proj1 proj2 f lid env acc = match lid with - | None -> + | None -> TycompTbl.fold_name (fun data acc -> f data acc) (proj1 env) acc - | Some l -> - let (_p, desc) = lookup_module_descr ~mark:true l env in + | Some l -> + let (_p, desc) = + lookup_module_components + ~errors:false ~use:false ~loc:Location.none l env + in begin match get_components desc with - Structure_comps c -> - NameMap.fold - (fun _s comps acc -> - match comps with - | [] -> acc - | data :: _ -> f data acc) - (proj2 c) acc - | Functor_comps _ -> - acc + | Structure_comps c -> + NameMap.fold + (fun _s comps acc -> + match comps with + | [] -> acc + | data :: _ -> f data acc) + (proj2 c) acc + | Functor_comps _ -> + acc end let fold_modules f lid env acc = match lid with | None -> - IdTbl.fold_name - (fun name (p, data) acc -> - match data with - | Value (data, _) -> - let data = EnvLazy.force subst_modtype_maker data in - f name p data acc - | Persistent -> + IdTbl.fold_name wrap_module + (fun name (p, entry) acc -> + match entry with + | Mod_unbound _ -> acc + | Mod_local mda -> + let md = + EnvLazy.force subst_modtype_maker mda.mda_declaration + in + f name p md acc + | Mod_persistent -> match Persistent_env.find_in_cache persistent_env name with | None -> acc - | Some pm -> - let data = md (Mty_signature (Lazy.force pm.pm_signature)) in - f name p data acc) + | Some mda -> + let md = + EnvLazy.force subst_modtype_maker mda.mda_declaration + in + f name p md acc) env.modules acc | Some l -> - let p, desc = lookup_module_descr ~mark:true l env in + let p, desc = + lookup_module_components + ~errors:false ~use:false ~loc:Location.none l env + in begin match get_components desc with | Structure_comps c -> NameMap.fold - (fun s (data, _) acc -> - f s (Pdot (p, s)) - (EnvLazy.force subst_modtype_maker data) acc) + (fun s mda acc -> + let md = + EnvLazy.force subst_modtype_maker mda.mda_declaration + in + f s (Pdot (p, s)) md acc) c.comp_modules acc | Functor_comps _ -> @@ -2321,30 +2862,38 @@ let fold_modules f lid env acc = end let fold_values f = - find_all (fun env -> env.values) (fun sc -> sc.comp_values) - (fun k p (vd, _) acc -> f k p vd acc) + find_all wrap_value (fun env -> env.values) (fun sc -> sc.comp_values) + (fun k p ve acc -> + match ve with + | Val_unbound _ -> acc + | Val_bound vda -> f k p vda.vda_description acc) and fold_constructors f = find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs) - (fun (cd, _) acc -> f cd acc) + (fun cda acc -> f cda.cda_description acc) and fold_labels f = find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f and fold_types f = - find_all (fun env -> env.types) (fun sc -> sc.comp_types) f + find_all wrap_identity + (fun env -> env.types) (fun sc -> sc.comp_types) + (fun k p tda acc -> f k p tda.tda_declaration acc) and fold_modtypes f = - find_all (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f + find_all wrap_identity + (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f and fold_classes f = - find_all (fun env -> env.classes) (fun sc -> sc.comp_classes) - (fun k p (vd, _) acc -> f k p vd acc) + find_all wrap_identity (fun env -> env.classes) (fun sc -> sc.comp_classes) + (fun k p clda acc -> f k p clda.clda_declaration acc) and fold_cltypes f = - find_all (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f + find_all wrap_identity + (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f let filter_non_loaded_persistent f env = let to_remove = - IdTbl.fold_name - (fun name (_, data) acc -> - match data with - | Value _ -> acc - | Persistent -> + IdTbl.fold_name wrap_module + (fun name (_, entry) acc -> + match entry with + | Mod_local _ -> acc + | Mod_unbound _ -> acc + | Mod_persistent -> match Persistent_env.find_in_cache persistent_env name with | Some _ -> acc | None -> @@ -2387,27 +2936,23 @@ let filter_non_loaded_persistent f env = Env_functor_arg (filter_summary s ids, id) | Env_constraints (s, cstrs) -> Env_constraints (filter_summary s ids, cstrs) - | Env_copy_types (s, types) -> - Env_copy_types (filter_summary s ids, types) + | Env_copy_types s -> + Env_copy_types (filter_summary s ids) | Env_persistent (s, id) -> if String.Set.mem (Ident.name id) ids then filter_summary s (String.Set.remove (Ident.name id) ids) else Env_persistent (filter_summary s ids, id) + | Env_value_unbound (s, n, r) -> + Env_value_unbound (filter_summary s ids, n, r) + | Env_module_unbound (s, n, r) -> + Env_module_unbound (filter_summary s ids, n, r) in { env with modules = remove_ids env.modules to_remove; - components = remove_ids env.components to_remove; summary = filter_summary env.summary to_remove; } -(* Make the initial environment *) -let (initial_safe_string, initial_unsafe_string) = - Predef.build_initial_env - (add_type ~check:false) - (add_extension ~check:false) - empty - (* Return the environment summary *) let summary env = @@ -2445,6 +2990,130 @@ let env_of_only_summary env_from_summary env = open Format +(* Forward declarations *) + +let print_longident = + ref ((fun _ _ -> assert false) : formatter -> Longident.t -> unit) + +let print_path = + ref ((fun _ _ -> assert false) : formatter -> Path.t -> unit) + +let spellcheck ppf extract env lid = + let choices ~path name = Misc.spellcheck (extract path env) name in + match lid with + | Longident.Lapply _ -> () + | Longident.Lident s -> + Misc.did_you_mean ppf (fun () -> choices ~path:None s) + | Longident.Ldot (r, s) -> + Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s) + +let spellcheck_name ppf extract env name = + Misc.did_you_mean ppf + (fun () -> Misc.spellcheck (extract env) name) + +let extract_values path env = + fold_values (fun name _ _ acc -> name :: acc) path env [] +let extract_types path env = + fold_types (fun name _ _ acc -> name :: acc) path env [] +let extract_modules path env = + fold_modules (fun name _ _ acc -> name :: acc) path env [] +let extract_constructors path env = + fold_constructors (fun desc acc -> desc.cstr_name :: acc) path env [] +let extract_labels path env = + fold_labels (fun desc acc -> desc.lbl_name :: acc) path env [] +let extract_classes path env = + fold_classes (fun name _ _ acc -> name :: acc) path env [] +let extract_modtypes path env = + fold_modtypes (fun name _ _ acc -> name :: acc) path env [] +let extract_cltypes path env = + fold_cltypes (fun name _ _ acc -> name :: acc) path env [] +let extract_instance_variables env = + fold_values + (fun name _ descr acc -> + match descr.val_kind with + | Val_ivar _ -> name :: acc + | _ -> acc) None env [] + +let report_lookup_error _loc env ppf = function + | Unbound_value(lid, hint) -> begin + fprintf ppf "Unbound value %a" !print_longident lid; + spellcheck ppf extract_values env lid; + match hint with + | No_hint -> () + | Missing_rec def_loc -> + let (_, line, _) = + Location.get_pos_info def_loc.Location.loc_start + in + fprintf ppf + "@.@[%s@ %s %i@]" + "Hint: If this is a recursive definition," + "you should add the 'rec' keyword on line" + line + end + | Unbound_type lid -> + fprintf ppf "Unbound type constructor %a" !print_longident lid; + spellcheck ppf extract_types env lid; + | Unbound_module lid -> + fprintf ppf "Unbound module %a" !print_longident lid; + spellcheck ppf extract_modules env lid; + | Unbound_constructor lid -> + fprintf ppf "Unbound constructor %a" !print_longident lid; + spellcheck ppf extract_constructors env lid; + | Unbound_label lid -> + fprintf ppf "Unbound record field %a" !print_longident lid; + spellcheck ppf extract_labels env lid; + | Unbound_class lid -> + fprintf ppf "Unbound class %a" !print_longident lid; + spellcheck ppf extract_classes env lid; + | Unbound_modtype lid -> + fprintf ppf "Unbound module type %a" !print_longident lid; + spellcheck ppf extract_modtypes env lid; + | Unbound_cltype lid -> + fprintf ppf "Unbound class type %a" !print_longident lid; + spellcheck ppf extract_cltypes env lid; + | Unbound_instance_variable s -> + fprintf ppf "Unbound instance variable %s" s; + spellcheck_name ppf extract_instance_variables env s; + | Not_an_instance_variable s -> + fprintf ppf "The value %s is not an instance variable" s; + spellcheck_name ppf extract_instance_variables env s; + | Masked_instance_variable lid -> + fprintf ppf + "The instance variable %a@ \ + cannot be accessed from the definition of another instance variable" + !print_longident lid + | Masked_self_variable lid -> + fprintf ppf + "The self variable %a@ \ + cannot be accessed from the definition of an instance variable" + !print_longident lid + | Masked_ancestor_variable lid -> + fprintf ppf + "The ancestor variable %a@ \ + cannot be accessed from the definition of an instance variable" + !print_longident lid + | Illegal_reference_to_recursive_module -> + fprintf ppf "Illegal recursive module reference" + | Structure_used_as_functor lid -> + fprintf ppf "@[The module %a is a structure, it cannot be applied@]" + !print_longident lid + | Abstract_used_as_functor lid -> + fprintf ppf "@[The module %a is abstract, it cannot be applied@]" + !print_longident lid + | Functor_used_as_structure lid -> + fprintf ppf "@[The module %a is a functor, \ + it cannot have any components@]" !print_longident lid + | Abstract_used_as_structure lid -> + fprintf ppf "@[The module %a is abstract, \ + it cannot have any components@]" !print_longident lid + | Generative_used_as_applicative lid -> + fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \ + applied@ in@ type@ expressions@]" !print_longident lid + | Cannot_scrape_alias(lid, p) -> + fprintf ppf + "The module %a is an alias for module %a, which is missing" + !print_longident lid !print_path p + let report_error ppf = function | Missing_module(_, path1, path2) -> fprintf ppf "@[@["; @@ -2459,18 +3128,23 @@ let report_error ppf = function | Illegal_value_name(_loc, name) -> fprintf ppf "'%s' is not a valid value identifier." name + | Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err let () = Location.register_error_of_exn (function | Error err -> - let loc = match err with - (Missing_module (loc, _, _) | Illegal_value_name (loc, _)) -> loc + let loc = + match err with + | Missing_module (loc, _, _) + | Illegal_value_name (loc, _) + | Lookup_error(loc, _, _) -> loc in let error_of_printer = if loc = Location.none then Location.error_of_printer_file - else Location.error_of_printer ~loc ?sub:None in + else Location.error_of_printer ~loc ?sub:None + in Some (error_of_printer report_error err) | _ -> None diff --git a/typing/env.mli b/typing/env.mli index cf7490db..214ed233 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -18,6 +18,15 @@ open Types open Misc +type value_unbound_reason = + | Val_unbound_instance_variable + | Val_unbound_self + | Val_unbound_ancestor + | Val_unbound_ghost_recursive of Location.t + +type module_unbound_reason = + | Mod_unbound_illegal_recursion + type summary = Env_empty | Env_value of summary * Ident.t * value_description @@ -32,8 +41,10 @@ type summary = to skip, i.e. that won't be imported in the toplevel namespace. *) | Env_functor_arg of summary * Ident.t | Env_constraints of summary * type_declaration Path.Map.t - | Env_copy_types of summary * string list + | Env_copy_types of summary | Env_persistent of summary * Ident.t + | Env_value_unbound of summary * string * value_unbound_reason + | Env_module_unbound of summary * string * module_unbound_reason type address = | Aident of Ident.t @@ -53,7 +64,7 @@ type type_descriptions = (* For short-paths *) type iter_cont val iter_types: - (Path.t -> Path.t * (type_declaration * type_descriptions) -> unit) -> + (Path.t -> Path.t * type_declaration -> unit) -> t -> iter_cont val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list val same_types: t -> t -> bool @@ -73,6 +84,9 @@ val find_modtype: Path.t -> t -> modtype_declaration val find_class: Path.t -> t -> class_declaration val find_cltype: Path.t -> t -> class_type_declaration +val find_ident_constructor: Ident.t -> t -> constructor_description +val find_ident_label: Ident.t -> t -> label_description + val find_type_expansion: Path.t -> t -> type_expr list * type_expr * int val find_type_expansion_opt: @@ -81,6 +95,9 @@ val find_type_expansion_opt: of the compiler's type-based optimisations. *) val find_modtype_expansion: Path.t -> t -> module_type +val find_hash_type: Path.t -> t -> type_declaration +(* Find the "#t" type given the path for "t" *) + val find_value_address: Path.t -> t -> address val find_module_address: Path.t -> t -> address val find_class_address: Path.t -> t -> address @@ -109,51 +126,137 @@ val add_required_global: Ident.t -> unit val has_local_constraints: t -> bool +(* Mark definitions as used *) +val mark_value_used: string -> value_description -> unit +val mark_module_used: string -> Location.t -> unit +val mark_type_used: string -> type_declaration -> unit + +type constructor_usage = Positive | Pattern | Privatize +val mark_constructor_used: + constructor_usage -> string -> constructor_declaration -> unit +val mark_extension_used: + constructor_usage -> string -> extension_constructor -> unit + (* Lookup by long identifiers *) -(* ?loc is used to report 'deprecated module' warnings and other alerts *) +(* Lookup errors *) + +type unbound_value_hint = + | No_hint + | Missing_rec of Location.t + +type lookup_error = + | Unbound_value of Longident.t * unbound_value_hint + | Unbound_type of Longident.t + | Unbound_constructor of Longident.t + | Unbound_label of Longident.t + | Unbound_module of Longident.t + | Unbound_class of Longident.t + | Unbound_modtype of Longident.t + | Unbound_cltype of Longident.t + | Unbound_instance_variable of string + | Not_an_instance_variable of string + | Masked_instance_variable of Longident.t + | Masked_self_variable of Longident.t + | Masked_ancestor_variable of Longident.t + | Structure_used_as_functor of Longident.t + | Abstract_used_as_functor of Longident.t + | Functor_used_as_structure of Longident.t + | Abstract_used_as_structure of Longident.t + | Generative_used_as_applicative of Longident.t + | Illegal_reference_to_recursive_module + | Cannot_scrape_alias of Longident.t * Path.t + +val lookup_error: Location.t -> t -> lookup_error -> 'a + +(* The [lookup_foo] functions will emit proper error messages (by + raising [Error]) if the identifier cannot be found, whereas the + [find_foo_by_name] functions will raise [Not_found] instead. + + The [~use] parameters of the [lookup_foo] functions control + whether this lookup should be counted as a use for usage + warnings and alerts. + + [Longident.t]s in the program source should be looked up using + [lookup_foo ~use:true] exactly one time -- otherwise warnings may be + emitted the wrong number of times. *) val lookup_value: - ?loc:Location.t -> ?mark:bool -> - Longident.t -> t -> Path.t * value_description + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * value_description +val lookup_type: + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * type_declaration +val lookup_module: + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * module_declaration +val lookup_modtype: + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * modtype_declaration +val lookup_class: + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * class_declaration +val lookup_cltype: + ?use:bool -> loc:Location.t -> Longident.t -> t -> + Path.t * class_type_declaration + +val lookup_module_path: + ?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t + val lookup_constructor: - ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> constructor_description + ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t -> + constructor_description val lookup_all_constructors: - ?loc:Location.t -> ?mark:bool -> - Longident.t -> t -> (constructor_description * (unit -> unit)) list + ?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t -> + ((constructor_description * (unit -> unit)) list, + Location.t * t * lookup_error) result +val lookup_all_constructors_from_type: + ?use:bool -> loc:Location.t -> constructor_usage -> Path.t -> t -> + (constructor_description * (unit -> unit)) list + val lookup_label: - ?loc:Location.t -> ?mark:bool -> - Longident.t -> t -> label_description + ?use:bool -> loc:Location.t -> Longident.t -> t -> + label_description val lookup_all_labels: - ?loc:Location.t -> ?mark:bool -> - Longident.t -> t -> (label_description * (unit -> unit)) list -val lookup_type: - ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> Path.t - (* Since 4.04, this function no longer returns [type_description]. - To obtain it, you should either call [Env.find_type], or replace - it by [Typetexp.find_type] *) -val lookup_module: - load:bool -> ?loc:Location.t -> ?mark:bool -> Longident.t -> t -> Path.t -val lookup_modtype: - ?loc:Location.t -> ?mark:bool -> + ?use:bool -> loc:Location.t -> Longident.t -> t -> + ((label_description * (unit -> unit)) list, + Location.t * t * lookup_error) result +val lookup_all_labels_from_type: + ?use:bool -> loc:Location.t -> Path.t -> t -> + (label_description * (unit -> unit)) list + +val lookup_instance_variable: + ?use:bool -> loc:Location.t -> string -> t -> + Path.t * Asttypes.mutable_flag * string * type_expr + +val find_value_by_name: + Longident.t -> t -> Path.t * value_description +val find_type_by_name: + Longident.t -> t -> Path.t * type_declaration +val find_module_by_name: + Longident.t -> t -> Path.t * module_declaration +val find_modtype_by_name: Longident.t -> t -> Path.t * modtype_declaration -val lookup_class: - ?loc:Location.t -> ?mark:bool -> +val find_class_by_name: Longident.t -> t -> Path.t * class_declaration -val lookup_cltype: - ?loc:Location.t -> ?mark:bool -> +val find_cltype_by_name: Longident.t -> t -> Path.t * class_type_declaration -type copy_of_types -val make_copy_of_types: string list -> t -> copy_of_types -val do_copy_types: copy_of_types -> t -> t -(** [do_copy_types copy env] will raise a fatal error if the values in - [env] are different from the env passed to [make_copy_of_types]. *) +val find_constructor_by_name: + Longident.t -> t -> constructor_description +val find_label_by_name: + Longident.t -> t -> label_description + +(* Check if a name is bound *) + +val bound_value: string -> t -> bool +val bound_module: string -> t -> bool +val bound_type: string -> t -> bool +val bound_modtype: string -> t -> bool +val bound_class: string -> t -> bool +val bound_cltype: string -> t -> bool -exception Recmodule - (* Raise by lookup_module when the identifier refers - to one of the modules of a recursive definition - during the computation of its approximation (see #5965). *) +val make_copy_of_types: t -> (t -> t) (* Insertion by identifier *) @@ -217,7 +320,8 @@ val enter_module: scope:int -> ?arg:bool -> string -> module_presence -> module_type -> t -> Ident.t * t val enter_module_declaration: - ?arg:bool -> Ident.t -> module_presence -> module_declaration -> t -> t + scope:int -> ?arg:bool -> string -> module_presence -> + module_declaration -> t -> Ident.t * t val enter_modtype: scope:int -> string -> modtype_declaration -> t -> Ident.t * t val enter_class: scope:int -> string -> class_declaration -> t -> Ident.t * t @@ -228,6 +332,10 @@ val enter_cltype: in the process. *) val enter_signature: scope:int -> signature -> t -> signature * t +val enter_unbound_value : string -> value_unbound_reason -> t -> t + +val enter_unbound_module : string -> module_unbound_reason -> t -> t + (* Initialize the cache of in-core module interfaces. *) val reset_cache: unit -> unit @@ -280,6 +388,7 @@ val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t type error = | Missing_module of Location.t * Path.t * Path.t | Illegal_value_name of Location.t * string + | Lookup_error of Location.t * t * lookup_error exception Error of error @@ -287,18 +396,7 @@ open Format val report_error: formatter -> error -> unit - -val mark_value_used: string -> value_description -> unit -val mark_module_used: string -> Location.t -> unit -val mark_type_used: string -> type_declaration -> unit - -type constructor_usage = Positive | Pattern | Privatize -val mark_constructor_used: - constructor_usage -> string -> type_declaration -> string -> unit -val mark_constructor: - constructor_usage -> t -> string -> constructor_description -> unit -val mark_extension_used: - constructor_usage -> extension_constructor -> string -> unit +val report_lookup_error: Location.t -> t -> formatter -> lookup_error -> unit val in_signature: bool -> t -> t @@ -310,8 +408,9 @@ val set_type_used_callback: string -> type_declaration -> ((unit -> unit) -> unit) -> unit (* Forward declaration to break mutual recursion with Includemod. *) -val check_modtype_inclusion: - (loc:Location.t -> t -> module_type -> Path.t -> module_type -> unit) ref +val check_functor_application: + (errors:bool -> loc:Location.t -> t -> module_type -> + Path.t -> module_type -> Path.t -> unit) ref (* Forward declaration to break mutual recursion with Typemod. *) val check_well_formed_module: (t -> Location.t -> string -> module_type -> unit) ref @@ -322,36 +421,10 @@ val strengthen: (aliasable:bool -> t -> module_type -> Path.t -> module_type) ref (* Forward declaration to break mutual recursion with Ctype. *) val same_constr: (t -> type_expr -> type_expr -> bool) ref - -(** Folding over all identifiers (for analysis purpose) *) - -val fold_values: - (string -> Path.t -> value_description -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a -val fold_types: - (string -> Path.t -> type_declaration * type_descriptions -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a -val fold_constructors: - (constructor_description -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a -val fold_labels: - (label_description -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a - -(** Persistent structures are only traversed if they are already loaded. *) -val fold_modules: - (string -> Path.t -> module_declaration -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a - -val fold_modtypes: - (string -> Path.t -> modtype_declaration -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a -val fold_classes: - (string -> Path.t -> class_declaration -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a -val fold_cltypes: - (string -> Path.t -> class_type_declaration -> 'a -> 'a) -> - Longident.t option -> t -> 'a -> 'a +(* Forward declaration to break mutual recursion with Printtyp. *) +val print_longident: (Format.formatter -> Longident.t -> unit) ref +(* Forward declaration to break mutual recursion with Printtyp. *) +val print_path: (Format.formatter -> Path.t -> unit) ref (** Utilities *) val scrape_alias: t -> module_type -> module_type diff --git a/typing/envaux.ml b/typing/envaux.ml index 2780cc04..2d3a02bc 100644 --- a/typing/envaux.ml +++ b/typing/envaux.ml @@ -80,12 +80,18 @@ let rec env_from_summary sum subst = Env.add_local_type (Subst.type_path subst path) (Subst.type_declaration subst info)) map (env_from_summary s subst) - | Env_copy_types (s, sl) -> + | Env_copy_types s -> let env = env_from_summary s subst in - Env.do_copy_types (Env.make_copy_of_types sl env) env + Env.make_copy_of_types env env | Env_persistent (s, id) -> let env = env_from_summary s subst in Env.add_persistent_structure id env + | Env_value_unbound (s, str, reason) -> + let env = env_from_summary s subst in + Env.enter_unbound_value str reason env + | Env_module_unbound (s, str, reason) -> + let env = env_from_summary s subst in + Env.enter_unbound_module str reason env in Hashtbl.add env_cache (sum, subst) env; env diff --git a/typing/includeclass.ml b/typing/includeclass.ml index b641e138..483088d6 100644 --- a/typing/includeclass.ml +++ b/typing/includeclass.ml @@ -102,11 +102,11 @@ let include_err ppf = | CM_Hide_virtual (k, lab) -> fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab | CM_Public_method lab -> - fprintf ppf "@[The public method %s cannot become private" lab + fprintf ppf "@[The public method %s cannot become private@]" lab | CM_Virtual_method lab -> - fprintf ppf "@[The virtual method %s cannot become concrete" lab + fprintf ppf "@[The virtual method %s cannot become concrete@]" lab | CM_Private_method lab -> - fprintf ppf "The private method %s cannot become public" lab + fprintf ppf "@[The private method %s cannot become public@]" lab let report_error ppf = function | [] -> () diff --git a/typing/includecore.ml b/typing/includecore.ml index b5311b11..87f02b8c 100644 --- a/typing/includecore.ml +++ b/typing/includecore.ml @@ -122,79 +122,201 @@ let type_manifest env ty1 params1 ty2 params2 priv2 = (* Inclusion between type declarations *) +type position = Ctype.Unification_trace.position = First | Second + +let choose ord first second = + match ord with + | First -> first + | Second -> second + +let choose_other ord first second = + match ord with + | First -> choose Second first second + | Second -> choose First first second + +type label_mismatch = + | Type + | Mutability of position + +type record_mismatch = + | Label_mismatch of Types.label_declaration + * Types.label_declaration + * label_mismatch + | Label_names of int * Ident.t * Ident.t + | Label_missing of position * Ident.t + | Unboxed_float_representation of position + +type constructor_mismatch = + | Type + | Arity + | Inline_record of record_mismatch + | Kind of position + | Explicit_return_type of position + +type variant_mismatch = + | Constructor_mismatch of Types.constructor_declaration + * Types.constructor_declaration + * constructor_mismatch + | Constructor_names of int * Ident.t * Ident.t + | Constructor_missing of position * Ident.t + +type extension_constructor_mismatch = + | Constructor_privacy + | Constructor_mismatch of Ident.t + * Types.extension_constructor + * Types.extension_constructor + * constructor_mismatch + type type_mismatch = - Arity + | Arity | Privacy | Kind | Constraint | Manifest | Variance - | Field_type of Ident.t - | Field_mutable of Ident.t - | Field_arity of Ident.t - | Field_names of int * Ident.t * Ident.t - | Field_missing of bool * Ident.t - | Record_representation of bool (* true means second one is unboxed float *) - | Unboxed_representation of bool (* true means second one is unboxed *) - | Immediate + | Record_mismatch of record_mismatch + | Variant_mismatch of variant_mismatch + | Unboxed_representation of position + | Immediate of Type_immediacy.Violation.t -let report_type_mismatch0 first second decl ppf err = +let report_label_mismatch first second ppf err = + let pr fmt = Format.fprintf ppf fmt in + match (err : label_mismatch) with + | Type -> pr "The types are not equal." + | Mutability ord -> + pr "%s is mutable and %s is not." + (String.capitalize_ascii (choose ord first second)) + (choose_other ord first second) + +let report_record_mismatch first second decl ppf err = let pr fmt = Format.fprintf ppf fmt in match err with - Arity -> pr "They have different arities" - | Privacy -> pr "A private type would be revealed" - | Kind -> pr "Their kinds differ" - | Constraint -> pr "Their constraints differ" - | Manifest -> () - | Variance -> pr "Their variances do not agree" - | Field_type s -> - pr "The types for field %s are not equal" (Ident.name s) - | Field_mutable s -> - pr "The mutability of field %s is different" (Ident.name s) - | Field_arity s -> - pr "The arities for field %s differ" (Ident.name s) - | Field_names (n, name1, name2) -> - pr "Fields number %i have different names, %s and %s" + | Label_mismatch (l1, l2, err) -> + pr + "@[Fields do not match:@;<1 2>%a@ is not compatible with:\ + @;<1 2>%a@ %a" + Printtyp.label l1 + Printtyp.label l2 + (report_label_mismatch first second) err + | Label_names (n, name1, name2) -> + pr "@[Fields number %i have different names, %s and %s.@]" n (Ident.name name1) (Ident.name name2) - | Field_missing (b, s) -> - pr "The field %s is only present in %s %s" - (Ident.name s) (if b then second else first) decl - | Record_representation b -> - pr "Their internal representations differ:@ %s %s %s" - (if b then second else first) decl + | Label_missing (ord, s) -> + pr "@[The field %s is only present in %s %s.@]" + (Ident.name s) (choose ord first second) decl + | Unboxed_float_representation ord -> + pr "@[Their internal representations differ:@ %s %s %s.@]" + (choose ord first second) decl "uses unboxed float representation" - | Unboxed_representation b -> - pr "Their internal representations differ:@ %s %s %s" - (if b then second else first) decl + +let report_constructor_mismatch first second decl ppf err = + let pr fmt = Format.fprintf ppf fmt in + match (err : constructor_mismatch) with + | Type -> pr "The types are not equal." + | Arity -> pr "They have different arities." + | Inline_record err -> report_record_mismatch first second decl ppf err + | Kind ord -> + pr "%s uses inline records and %s doesn't." + (String.capitalize_ascii (choose ord first second)) + (choose_other ord first second) + | Explicit_return_type ord -> + pr "%s has explicit return type and %s doesn't." + (String.capitalize_ascii (choose ord first second)) + (choose_other ord first second) + +let report_variant_mismatch first second decl ppf err = + let pr fmt = Format.fprintf ppf fmt in + match (err : variant_mismatch) with + | Constructor_mismatch (c1, c2, err) -> + pr + "@[Constructors do not match:@;<1 2>%a@ is not compatible with:\ + @;<1 2>%a@ %a" + Printtyp.constructor c1 + Printtyp.constructor c2 + (report_constructor_mismatch first second decl) err + | Constructor_names (n, name1, name2) -> + pr "Constructors number %i have different names, %s and %s." + n (Ident.name name1) (Ident.name name2) + | Constructor_missing (ord, s) -> + pr "The constructor %s is only present in %s %s." + (Ident.name s) (choose ord first second) decl + +let report_extension_constructor_mismatch first second decl ppf err = + let pr fmt = Format.fprintf ppf fmt in + match (err : extension_constructor_mismatch) with + | Constructor_privacy -> pr "A private type would be revealed." + | Constructor_mismatch (id, ext1, ext2, err) -> + pr "@[Constructors do not match:@;<1 2>%a@ is not compatible with:\ + @;<1 2>%a@ %a@]" + (Printtyp.extension_only_constructor id) ext1 + (Printtyp.extension_only_constructor id) ext2 + (report_constructor_mismatch first second decl) err + +let report_type_mismatch0 first second decl ppf err = + let pr fmt = Format.fprintf ppf fmt in + match err with + | Arity -> pr "They have different arities." + | Privacy -> pr "A private type would be revealed." + | Kind -> pr "Their kinds differ." + | Constraint -> pr "Their constraints differ." + | Manifest -> () + | Variance -> pr "Their variances do not agree." + | Record_mismatch err -> report_record_mismatch first second decl ppf err + | Variant_mismatch err -> report_variant_mismatch first second decl ppf err + | Unboxed_representation ord -> + pr "Their internal representations differ:@ %s %s %s." + (choose ord first second) decl "uses unboxed representation" - | Immediate -> pr "%s is not an immediate type" first + | Immediate violation -> + let first = StringLabels.capitalize_ascii first in + match violation with + | Type_immediacy.Violation.Not_always_immediate -> + pr "%s is not an immediate type." first + | Type_immediacy.Violation.Not_always_immediate_on_64bits -> + pr "%s is not a type that is always immediate on 64 bit platforms." + first let report_type_mismatch first second decl ppf err = if err = Manifest then () else - Format.fprintf ppf "@ %a." (report_type_mismatch0 first second decl) err + Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err -let rec compare_constructor_arguments ~loc env cstr params1 params2 arg1 arg2 = +let rec compare_constructor_arguments ~loc env params1 params2 arg1 arg2 = match arg1, arg2 with | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 -> - if List.length arg1 <> List.length arg2 then Some (Field_arity cstr) + if List.length arg1 <> List.length arg2 then + Some (Arity : constructor_mismatch) else if (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *) Ctype.equal env true (params1 @ arg1) (params2 @ arg2) - then None else Some (Field_type cstr) + then None else Some Type | Types.Cstr_record l1, Types.Cstr_record l2 -> - compare_records env ~loc params1 params2 0 l1 l2 - | _ -> Some (Field_type cstr) + Option.map + (fun rec_err -> Inline_record rec_err) + (compare_records env ~loc params1 params2 0 l1 l2) + | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch) + | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch) + +and compare_constructors ~loc env params1 params2 res1 res2 args1 args2 = + match res1, res2 with + | Some r1, Some r2 -> + if Ctype.equal env true [r1] [r2] then + compare_constructor_arguments ~loc env [r1] [r2] args1 args2 + else Some Type + | Some _, None -> Some (Explicit_return_type First) + | None, Some _ -> Some (Explicit_return_type Second) + | None, None -> + compare_constructor_arguments ~loc env params1 params2 args1 args2 and compare_variants ~loc env params1 params2 n (cstrs1 : Types.constructor_declaration list) (cstrs2 : Types.constructor_declaration list) = match cstrs1, cstrs2 with - [], [] -> None - | [], c::_ -> Some (Field_missing (true, c.Types.cd_id)) - | c::_, [] -> Some (Field_missing (false, c.Types.cd_id)) + | [], [] -> None + | [], c::_ -> Some (Constructor_missing (Second, c.Types.cd_id)) + | c::_, [] -> Some (Constructor_missing (First, c.Types.cd_id)) | cd1::rem1, cd2::rem2 -> if Ident.name cd1.cd_id <> Ident.name cd2.cd_id then - Some (Field_names (n, cd1.cd_id, cd2.cd_id)) + Some (Constructor_names (n, cd1.cd_id, cd2.cd_id)) else begin Builtin_attributes.check_alerts_inclusion ~def:cd1.cd_loc @@ -202,36 +324,35 @@ and compare_variants ~loc env params1 params2 n loc cd1.cd_attributes cd2.cd_attributes (Ident.name cd1.cd_id); - let r = - match cd1.cd_res, cd2.cd_res with - | Some r1, Some r2 -> - if Ctype.equal env true [r1] [r2] then - compare_constructor_arguments ~loc env cd1.cd_id [r1] [r2] - cd1.cd_args cd2.cd_args - else Some (Field_type cd1.cd_id) - | Some _, None | None, Some _ -> - Some (Field_type cd1.cd_id) - | _ -> - compare_constructor_arguments ~loc env cd1.cd_id - params1 params2 cd1.cd_args cd2.cd_args - in - if r <> None then r - else compare_variants ~loc env params1 params2 (n+1) rem1 rem2 + match compare_constructors ~loc env params1 params2 + cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with + | Some r -> + Some ((Constructor_mismatch (cd1, cd2, r)) : variant_mismatch) + | None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2 end +and compare_labels env params1 params2 + (ld1 : Types.label_declaration) + (ld2 : Types.label_declaration) = + if ld1.ld_mutable <> ld2.ld_mutable + then + let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in + Some (Mutability ord) + else + if Ctype.equal env true (ld1.ld_type::params1) (ld2.ld_type::params2) + then None + else Some (Type : label_mismatch) and compare_records ~loc env params1 params2 n (labels1 : Types.label_declaration list) (labels2 : Types.label_declaration list) = match labels1, labels2 with - [], [] -> None - | [], l::_ -> Some (Field_missing (true, l.Types.ld_id)) - | l::_, [] -> Some (Field_missing (false, l.Types.ld_id)) + | [], [] -> None + | [], l::_ -> Some (Label_missing (Second, l.Types.ld_id)) + | l::_, [] -> Some (Label_missing (First, l.Types.ld_id)) | ld1::rem1, ld2::rem2 -> if Ident.name ld1.ld_id <> Ident.name ld2.ld_id - then Some (Field_names (n, ld1.ld_id, ld2.ld_id)) - else if ld1.ld_mutable <> ld2.ld_mutable then - Some (Field_mutable ld1.ld_id) + then Some (Label_names (n, ld1.ld_id, ld2.ld_id)) else begin Builtin_attributes.check_deprecated_mutable_inclusion ~def:ld1.ld_loc @@ -239,17 +360,26 @@ and compare_records ~loc env params1 params2 n loc ld1.ld_attributes ld2.ld_attributes (Ident.name ld1.ld_id); - if Ctype.equal env true (ld1.ld_type::params1)(ld2.ld_type::params2) - then (* add arguments to the parameters, cf. PR#7378 *) - compare_records ~loc env - (ld1.ld_type::params1) (ld2.ld_type::params2) - (n+1) - rem1 rem2 - else - Some (Field_type ld1.ld_id) + match compare_labels env params1 params2 ld1 ld2 with + | Some r -> Some (Label_mismatch (ld1, ld2, r)) + (* add arguments to the parameters, cf. PR#7378 *) + | None -> compare_records ~loc env + (ld1.ld_type::params1) (ld2.ld_type::params2) + (n+1) + rem1 rem2 end -let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 = +let compare_records_with_representation ~loc env params1 params2 n + labels1 labels2 rep1 rep2 + = + match compare_records ~loc env params1 params2 n labels1 labels2 with + | None when rep1 <> rep2 -> + let pos = if rep2 = Record_float then Second else First in + Some (Unboxed_float_representation pos) + | err -> err + +let type_declarations ?(equality = false) ~loc env ~mark name + decl1 path decl2 = Builtin_attributes.check_alerts_inclusion ~def:decl1.type_loc ~use:decl2.type_loc @@ -280,8 +410,8 @@ let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 = match (decl2.type_kind, decl1.type_unboxed.unboxed, decl2.type_unboxed.unboxed) with | Type_abstract, _, _ -> None - | _, true, false -> Some (Unboxed_representation false) - | _, false, true -> Some (Unboxed_representation true) + | _, true, false -> Some (Unboxed_representation First) + | _, false, true -> Some (Unboxed_representation Second) | _ -> None in if err <> None then err else @@ -289,29 +419,29 @@ let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 = (_, Type_abstract) -> None | (Type_variant cstrs1, Type_variant cstrs2) -> if mark then begin - let mark cstrs usage name decl = + let mark usage name cstrs = List.iter - (fun c -> - Env.mark_constructor_used usage name decl - (Ident.name c.Types.cd_id)) + (fun cstr -> + Env.mark_constructor_used usage name cstr) cstrs in let usage = - if decl1.type_private = Private || decl2.type_private = Public - then Env.Positive else Env.Privatize + if decl2.type_private = Public then Env.Positive + else Env.Privatize in - mark cstrs1 usage name decl1; - if equality then mark cstrs2 Env.Positive (Path.name path) decl2 + mark usage name cstrs1; + if equality then mark Env.Positive (Path.name path) cstrs2 end; - compare_variants ~loc env decl1.type_params - decl2.type_params 1 cstrs1 cstrs2 + Option.map + (fun var_err -> Variant_mismatch var_err) + (compare_variants ~loc env decl1.type_params decl2.type_params 1 + cstrs1 cstrs2) | (Type_record(labels1,rep1), Type_record(labels2,rep2)) -> - let err = - compare_records ~loc env decl1.type_params - decl2.type_params 1 labels1 labels2 - in - if err <> None || rep1 = rep2 then err else - Some (Record_representation (rep2 = Record_float)) + Option.map (fun rec_err -> Record_mismatch rec_err) + (compare_records_with_representation ~loc env + decl1.type_params decl2.type_params 1 + labels1 labels2 + rep1 rep2) | (Type_open, Type_open) -> None | (_, _) -> Some Kind in @@ -320,11 +450,14 @@ let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 = (* If attempt to assign a non-immediate type (e.g. string) to a type that * must be immediate, then we error *) let err = - if abstr && - not decl1.type_immediate && - decl2.type_immediate then - Some Immediate - else None + if not abstr then + None + else + match + Type_immediacy.coerce decl1.type_immediate ~as_:decl2.type_immediate + with + | Ok () -> None + | Error violation -> Some (Immediate violation) in if err <> None then err else let need_variance = @@ -351,10 +484,10 @@ let type_declarations ?(equality = false) ~loc env ~mark name decl1 path decl2 = let extension_constructors ~loc env ~mark id ext1 ext2 = if mark then begin let usage = - if ext1.ext_private = Private || ext2.ext_private = Public - then Env.Positive else Env.Privatize + if ext2.ext_private = Public then Env.Positive + else Env.Privatize in - Env.mark_extension_used usage ext1 (Ident.name id) + Env.mark_extension_used usage (Ident.name id) ext1 end; let ty1 = Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil)) @@ -364,22 +497,15 @@ let extension_constructors ~loc env ~mark id ext1 ext2 = in if not (Ctype.equal env true (ty1 :: ext1.ext_type_params) (ty2 :: ext2.ext_type_params)) - then Some (Field_type id) else - let r = - match ext1.ext_ret_type, ext2.ext_ret_type with - | Some r1, Some r2 -> - if Ctype.equal env true [r1] [r2] then - compare_constructor_arguments ~loc env id [r1] [r2] - ext1.ext_args ext2.ext_args - else Some (Field_type id) - | Some _, None | None, Some _ -> - Some (Field_type id) - | None, None -> - compare_constructor_arguments ~loc env id - ext1.ext_type_params ext2.ext_type_params - ext1.ext_args ext2.ext_args - in - if r <> None then r else - match ext1.ext_private, ext2.ext_private with - | Private, Public -> Some Privacy - | _, _ -> None + then Some (Constructor_mismatch (id, ext1, ext2, Type)) + else + let r = + compare_constructors ~loc env ext1.ext_type_params ext2.ext_type_params + ext1.ext_ret_type ext2.ext_ret_type + ext1.ext_args ext2.ext_args + in + match r with + | Some r -> Some (Constructor_mismatch (id, ext1, ext2, r)) + | None -> match ext1.ext_private, ext2.ext_private with + Private, Public -> Some Constructor_privacy + | _, _ -> None diff --git a/typing/includecore.mli b/typing/includecore.mli index 820cc61a..560d0ac1 100644 --- a/typing/includecore.mli +++ b/typing/includecore.mli @@ -20,21 +20,50 @@ open Types exception Dont_match +type position = Ctype.Unification_trace.position = First | Second + +type label_mismatch = + | Type + | Mutability of position + +type record_mismatch = + | Label_mismatch of label_declaration * label_declaration * label_mismatch + | Label_names of int * Ident.t * Ident.t + | Label_missing of position * Ident.t + | Unboxed_float_representation of position + +type constructor_mismatch = + | Type + | Arity + | Inline_record of record_mismatch + | Kind of position + | Explicit_return_type of position + +type variant_mismatch = + | Constructor_mismatch of constructor_declaration + * constructor_declaration + * constructor_mismatch + | Constructor_names of int * Ident.t * Ident.t + | Constructor_missing of position * Ident.t + +type extension_constructor_mismatch = + | Constructor_privacy + | Constructor_mismatch of Ident.t + * extension_constructor + * extension_constructor + * constructor_mismatch + type type_mismatch = - Arity + | Arity | Privacy | Kind | Constraint | Manifest | Variance - | Field_type of Ident.t - | Field_mutable of Ident.t - | Field_arity of Ident.t - | Field_names of int * Ident.t * Ident.t - | Field_missing of bool * Ident.t - | Record_representation of bool - | Unboxed_representation of bool - | Immediate + | Record_mismatch of record_mismatch + | Variant_mismatch of variant_mismatch + | Unboxed_representation of position + | Immediate of Type_immediacy.Violation.t val value_descriptions: loc:Location.t -> Env.t -> string -> @@ -48,7 +77,8 @@ val type_declarations: val extension_constructors: loc:Location.t -> Env.t -> mark:bool -> Ident.t -> - extension_constructor -> extension_constructor -> type_mismatch option + extension_constructor -> extension_constructor -> + extension_constructor_mismatch option (* val class_types: Env.t -> class_type -> class_type -> bool @@ -56,3 +86,5 @@ val class_types: val report_type_mismatch: string -> string -> string -> Format.formatter -> type_mismatch -> unit +val report_extension_constructor_mismatch: string -> string -> string -> + Format.formatter -> extension_constructor_mismatch -> unit diff --git a/typing/includemod.ml b/typing/includemod.ml index 01790075..d92b0fe0 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -25,7 +25,7 @@ type symptom = | Type_declarations of Ident.t * type_declaration * type_declaration * Includecore.type_mismatch | Extension_constructors of Ident.t * extension_constructor - * extension_constructor * Includecore.type_mismatch + * extension_constructor * Includecore.extension_constructor_mismatch | Module_types of module_type * module_type | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration | Modtype_permutation of Types.module_type * Typedtree.module_coercion @@ -41,10 +41,14 @@ type symptom = | Invalid_module_alias of Path.t type pos = - Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t + | Module of Ident.t + | Modtype of Ident.t + | Arg of functor_parameter + | Body of functor_parameter type error = pos list * Env.t * symptom exception Error of error list +exception Apply_error of Location.t * Path.t * Path.t * error list type mark = | Mark_both @@ -293,25 +297,32 @@ and try_modtypes ~loc env ~mark cxt subst mty1 mty2 = try_modtypes2 ~loc env ~mark cxt mty1 (Subst.modtype Keep subst mty2) | (Mty_signature sig1, Mty_signature sig2) -> signatures ~loc env ~mark cxt subst sig1 sig2 - | (Mty_functor(param1, None, res1), Mty_functor(_param2, None, res2)) -> + | (Mty_functor(Unit, res1), Mty_functor(Unit, res2)) -> begin - match modtypes ~loc env ~mark (Body param1::cxt) subst res1 res2 with + match modtypes ~loc env ~mark (Body Unit::cxt) subst res1 res2 with | Tcoerce_none -> Tcoerce_none | cc -> Tcoerce_functor (Tcoerce_none, cc) end - | (Mty_functor(param1, Some arg1, res1), - Mty_functor(param2, Some arg2, res2)) -> + | (Mty_functor(Named (param1, arg1) as arg, res1), + Mty_functor(Named (param2, arg2), res2)) -> let arg2' = Subst.modtype Keep subst arg2 in let cc_arg = modtypes ~loc env ~mark:(negate_mark mark) - (Arg param1::cxt) Subst.identity arg2' arg1 + (Arg arg::cxt) Subst.identity arg2' arg1 in - let cc_res = - modtypes ~loc (Env.add_module param1 Mp_present arg2' env) ~mark - (Body param1::cxt) - (Subst.add_module param2 (Path.Pident param1) subst) - res1 res2 + let env, subst = + match param1, param2 with + | Some p1, Some p2 -> + Env.add_module p1 Mp_present arg2' env, + Subst.add_module p2 (Path.Pident p1) subst + | None, Some p2 -> + Env.add_module p2 Mp_present arg2' env, subst + | Some p1, None -> + Env.add_module p1 Mp_present arg2' env, subst + | None, None -> + env, subst in + let cc_res = modtypes ~loc env ~mark (Body arg::cxt) subst res1 res2 in begin match (cc_arg, cc_res) with (Tcoerce_none, Tcoerce_none) -> Tcoerce_none | _ -> Tcoerce_functor(cc_arg, cc_res) @@ -543,9 +554,15 @@ let check_modtype_inclusion ~loc env mty1 path1 mty2 = (Mtype.strengthen ~aliasable env mty1 path1) mty2) let () = - Env.check_modtype_inclusion := (fun ~loc a b c d -> - try (check_modtype_inclusion ~loc a b c d : unit) - with Error _ -> raise Not_found) + Env.check_functor_application := + (fun ~errors ~loc env mty1 path1 mty2 path2 -> + try + check_modtype_inclusion ~loc env mty1 path1 mty2 + with Error errs -> + if errors then + raise (Apply_error(loc, path1, path2, errs)) + else + raise Not_found) (* Check that an implementation of a compilation unit meets its interface. *) @@ -654,8 +671,10 @@ module Illegal_permutation = struct | Sig_module (id, _, md,_,_) -> find env (Module id :: ctx) q md.md_type | _ -> raise Not_found end - | Mty_functor(x,Some mt,_), InArg :: q -> find env (Arg x :: ctx) q mt - | Mty_functor(x,_,mt), InBody :: q -> find env (Body x :: ctx) q mt + | Mty_functor(Named (_,mt) as arg,_), InArg :: q -> + find env (Arg arg :: ctx) q mt + | Mty_functor(arg, mt), InBody :: q -> + find env (Body arg :: ctx) q mt | _ -> raise Not_found let find env path mt = find env [] path mt @@ -709,7 +728,7 @@ let rec context ppf = function | Body x :: rem -> fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem | Arg x :: rem -> - fprintf ppf "functor (%a : %a) -> ..." Printtyp.ident x context_mty rem + fprintf ppf "functor (%s : %a) -> ..." (argname x) context_mty rem | [] -> fprintf ppf "" and context_mty ppf = function @@ -720,12 +739,13 @@ and args ppf = function Body x :: rem -> fprintf ppf "(%s)%a" (argname x) args rem | Arg x :: rem -> - fprintf ppf "(%a :@ %a) : ..." Printtyp.ident x context_mty rem + fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem | cxt -> fprintf ppf " :@ %a" context_mty cxt -and argname x = - let s = Ident.name x in - if s = "*" then "" else s +and argname = function + | Unit -> "" + | Named (None, _) -> "_" + | Named (Some id, _) -> Ident.name id let alt_context ppf cxt = if cxt = [] then () else @@ -760,20 +780,20 @@ let include_err env ppf = function "is not included in" !Oprint.out_sig_item (Printtyp.tree_of_type_declaration id d2 Trec_first) - show_locs (d1.type_loc, d2.type_loc) (Includecore.report_type_mismatch "the first" "the second" "declaration") err + show_locs (d1.type_loc, d2.type_loc) | Extension_constructors(id, x1, x2, err) -> - fprintf ppf "@[@[%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]" + fprintf ppf "@[@[%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]" "Extension declarations do not match" !Oprint.out_sig_item (Printtyp.tree_of_extension_constructor id x1 Text_first) "is not included in" !Oprint.out_sig_item (Printtyp.tree_of_extension_constructor id x2 Text_first) - show_locs (x1.ext_loc, x2.ext_loc) - (Includecore.report_type_mismatch + (Includecore.report_extension_constructor_mismatch "the first" "the second" "declaration") err + show_locs (x1.ext_loc, x2.ext_loc) | Module_types(mty1, mty2)-> fprintf ppf "@[Modules do not match:@ \ @@ -839,7 +859,11 @@ let report_error ppf errs = let print_errs ppf = List.iter (include_err' ppf) in Printtyp.Conflicts.reset(); fprintf ppf "@[%a%a%t@]" print_errs errs include_err err - Printtyp.Conflicts.print + Printtyp.Conflicts.print_explanations + +let report_apply_error p1 p2 ppf errs = + fprintf ppf "@[The type of %a does not match %a's parameter@ %a@]" + Printtyp.path p1 Printtyp.path p2 report_error errs (* We could do a better job to split the individual error items as sub-messages of the main interface mismatch on the whole unit. *) @@ -847,5 +871,7 @@ let () = Location.register_error_of_exn (function | Error err -> Some (Location.error_of_printer_file report_error err) + | Apply_error(loc, p1, p2, err) -> + Some (Location.error_of_printer ~loc (report_apply_error p1 p2) err) | _ -> None ) diff --git a/typing/includemod.mli b/typing/includemod.mli index f7ce4de7..4de7eee1 100644 --- a/typing/includemod.mli +++ b/typing/includemod.mli @@ -61,7 +61,7 @@ type symptom = | Type_declarations of Ident.t * type_declaration * type_declaration * Includecore.type_mismatch | Extension_constructors of Ident.t * extension_constructor - * extension_constructor * Includecore.type_mismatch + * extension_constructor * Includecore.extension_constructor_mismatch | Module_types of module_type * module_type | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration | Modtype_permutation of Types.module_type * Typedtree.module_coercion @@ -77,7 +77,10 @@ type symptom = | Invalid_module_alias of Path.t type pos = - Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t + | Module of Ident.t + | Modtype of Ident.t + | Arg of functor_parameter + | Body of functor_parameter type error = pos list * Env.t * symptom exception Error of error list diff --git a/typing/mtype.ml b/typing/mtype.ml index adbd7d70..38894e13 100644 --- a/typing/mtype.ml +++ b/typing/mtype.ml @@ -37,9 +37,14 @@ let rec strengthen ~aliasable env mty p = match scrape env mty with Mty_signature sg -> Mty_signature(strengthen_sig ~aliasable env sg p) - | Mty_functor(param, arg, res) - when !Clflags.applicative_functors && Ident.name param <> "*" -> - Mty_functor(param, arg, + | Mty_functor(Named (Some param, arg), res) + when !Clflags.applicative_functors -> + Mty_functor(Named (Some param, arg), + strengthen ~aliasable:false env res (Papply(p, Pident param))) + | Mty_functor(Named (None, arg), res) + when !Clflags.applicative_functors -> + let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in + Mty_functor(Named (Some param, arg), strengthen ~aliasable:false env res (Papply(p, Pident param))) | mty -> mty @@ -107,9 +112,9 @@ let rec make_aliases_absent pres mty = | Mty_alias _ -> Mp_absent, mty | Mty_signature sg -> pres, Mty_signature(make_aliases_absent_sig sg) - | Mty_functor(param, arg, res) -> + | Mty_functor(arg, res) -> let _, res = make_aliases_absent Mp_present res in - pres, Mty_functor(param, arg, res) + pres, Mty_functor(arg, res) | mty -> pres, mty @@ -171,14 +176,19 @@ let rec nondep_mty_with_presence env va ids pres mty = | Mty_signature sg -> let mty = Mty_signature(nondep_sig env va ids sg) in pres, mty - | Mty_functor(param, arg, res) -> + | Mty_functor(Unit, res) -> + pres, Mty_functor(Unit, nondep_mty env va ids res) + | Mty_functor(Named (param, arg), res) -> let var_inv = match va with Co -> Contra | Contra -> Co | Strict -> Strict in + let res_env = + match param with + | None -> env + | Some param -> Env.add_module ~arg:true param Mp_present arg env + in let mty = - Mty_functor(param, Misc.may_map (nondep_mty env var_inv ids) arg, - nondep_mty - (Env.add_module ~arg:true param Mp_present - (Btype.default_mty arg) env) va ids res) + Mty_functor(Named (param, nondep_mty env var_inv ids arg), + nondep_mty res_env va ids res) in pres, mty @@ -215,7 +225,7 @@ and nondep_sig env va ids sg = List.map (nondep_sig_item env va ids) sg and nondep_modtype_decl env ids mtd = - {mtd with mtd_type = Misc.may_map (nondep_mty env Strict ids) mtd.mtd_type} + {mtd with mtd_type = Option.map (nondep_mty env Strict ids) mtd.mtd_type} let nondep_supertype env ids = nondep_mty env Co ids let nondep_sig_item env ids = nondep_sig_item env Co ids @@ -335,7 +345,7 @@ let rec contains_type env = function end | Mty_signature sg -> contains_type_sig env sg - | Mty_functor (_, _, body) -> + | Mty_functor (_, body) -> contains_type env body | Mty_alias _ -> () diff --git a/typing/oprint.ml b/typing/oprint.ml index 0db53346..bf6f5f90 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -391,6 +391,8 @@ and print_out_label ppf (name, mut, arg) = fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name print_out_type arg +let out_label = ref print_out_label + let out_type = ref print_out_type (* Class types *) @@ -457,39 +459,86 @@ let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item") let out_signature = ref (fun _ -> failwith "Oprint.out_signature") let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension") -let rec print_out_functor funct ppf = - function - Omty_functor (_, None, mty_res) -> - if funct then fprintf ppf "() %a" (print_out_functor true) mty_res - else fprintf ppf "functor@ () %a" (print_out_functor true) mty_res - | Omty_functor (name, Some mty_arg, mty_res) -> begin - match name, funct with - | "_", true -> - fprintf ppf "->@ %a ->@ %a" - print_out_module_type mty_arg (print_out_functor false) mty_res - | "_", false -> - fprintf ppf "%a ->@ %a" - print_out_module_type mty_arg (print_out_functor false) mty_res - | name, true -> - fprintf ppf "(%s : %a) %a" name - print_out_module_type mty_arg (print_out_functor true) mty_res - | name, false -> - fprintf ppf "functor@ (%s : %a) %a" name - print_out_module_type mty_arg (print_out_functor true) mty_res - end - | m -> - if funct then fprintf ppf "->@ %a" print_out_module_type m - else print_out_module_type ppf m +(* For anonymous functor arguments, the logic to choose between + the long-form + functor (_ : S) -> ... + and the short-form + S -> ... + is as follows: if we are already printing long-form functor arguments, + we use the long form unless all remaining functor arguments can use + the short form. (Otherwise use the short form.) + + For example, + functor (X : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end + will get printed as + functor (X : S1) (_ : S2) (Y : S3) -> S4 -> S5 -> sig end + + but + functor (_ : S1) (_ : S2) (Y : S3) (_ : S4) (_ : S5) -> sig end + gets printed as + S1 -> S2 -> functor (Y : S3) -> S4 -> S5 -> sig end +*) + +(* take a module type that may be a functor type, + and return the longest prefix list of arguments + that should be printed in long form. *) +let collect_functor_arguments mty = + let rec collect_args acc = function + | Omty_functor (param, mty_res) -> + collect_args (param :: acc) mty_res + | non_functor -> (acc, non_functor) + in + let rec uncollect_anonymous_suffix acc rest = match acc with + | Some (None, mty_arg) :: acc -> + uncollect_anonymous_suffix acc + (Omty_functor (Some (None, mty_arg), rest)) + | _ :: _ | [] -> + (acc, rest) + in + let (acc, non_functor) = collect_args [] mty in + let (acc, rest) = uncollect_anonymous_suffix acc non_functor in + (List.rev acc, rest) -and print_out_module_type ppf = +let rec print_out_module_type ppf mty = + print_out_functor ppf mty +and print_out_functor ppf = function + | Omty_functor _ as t -> + let rec print_functor ppf = function + | Omty_functor (Some (None, mty_arg), mty_res) -> + fprintf ppf "%a ->@ %a" + print_simple_out_module_type mty_arg + print_functor mty_res + | Omty_functor _ as non_anonymous_functor -> + let (args, rest) = collect_functor_arguments non_anonymous_functor in + let print_arg ppf = function + | None -> + fprintf ppf "()" + | Some (param, mty) -> + fprintf ppf "(%s : %a)" + (Option.value param ~default:"_") + print_out_module_type mty + in + fprintf ppf "@[<2>functor@ %a@]@ ->@ %a" + (pp_print_list ~pp_sep:pp_print_space print_arg) args + print_functor rest + | non_functor -> + print_simple_out_module_type ppf non_functor + in + fprintf ppf "@[<2>%a@]" print_functor t + | t -> print_simple_out_module_type ppf t +and print_simple_out_module_type ppf = function Omty_abstract -> () - | Omty_functor _ as t -> - fprintf ppf "@[<2>%a@]" (print_out_functor false) t | Omty_ident id -> fprintf ppf "%a" print_ident id | Omty_signature sg -> - fprintf ppf "@[sig@ %a@;<1 -2>end@]" !out_signature sg + begin match sg with + | [] -> fprintf ppf "sig end" + | sg -> + fprintf ppf "@[sig@ %a@;<1 -2>end@]" print_out_signature sg + end | Omty_alias id -> fprintf ppf "(module %a)" print_ident id + | Omty_functor _ as non_simple -> + fprintf ppf "(%a)" print_out_module_type non_simple and print_out_signature ppf = function [] -> () @@ -606,7 +655,10 @@ and print_out_type_decl kwd ppf td = | Asttypes.Public -> () in let print_immediate ppf = - if td.otype_immediate then fprintf ppf " [%@%@immediate]" else () + match td.otype_immediate with + | Unknown -> () + | Always -> fprintf ppf " [%@%@immediate]" + | Always_on_64bits -> fprintf ppf " [%@%@immediate64]" in let print_unboxed ppf = if td.otype_unboxed then fprintf ppf " [%@%@unboxed]" else () @@ -704,6 +756,7 @@ and print_out_type_extension ppf te = (print_list print_out_constr (fun ppf -> fprintf ppf "@ | ")) te.otyext_constructors +let out_constr = ref print_out_constr let _ = out_module_type := print_out_module_type let _ = out_signature := print_out_signature let _ = out_sig_item := print_out_sig_item diff --git a/typing/oprint.mli b/typing/oprint.mli index 27ff8bc1..2eaaa264 100644 --- a/typing/oprint.mli +++ b/typing/oprint.mli @@ -18,7 +18,10 @@ open Outcometree val out_ident : (formatter -> out_ident -> unit) ref val out_value : (formatter -> out_value -> unit) ref +val out_label : (formatter -> string * bool * out_type -> unit) ref val out_type : (formatter -> out_type -> unit) ref +val out_constr : + (formatter -> string * out_type list * out_type option -> unit) ref val out_class_type : (formatter -> out_class_type -> unit) ref val out_module_type : (formatter -> out_module_type -> unit) ref val out_sig_item : (formatter -> out_sig_item -> unit) ref diff --git a/typing/outcometree.mli b/typing/outcometree.mli index ec92d15f..bb53d235 100644 --- a/typing/outcometree.mli +++ b/typing/outcometree.mli @@ -91,7 +91,7 @@ and out_class_sig_item = type out_module_type = | Omty_abstract - | Omty_functor of string * out_module_type option * out_module_type + | Omty_functor of (string option * out_module_type) option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident @@ -113,7 +113,7 @@ and out_type_decl = otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; - otype_immediate: bool; + otype_immediate: Type_immediacy.t; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor = diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 74873f7b..6ca3ebe7 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -42,7 +42,158 @@ let rec omegas i = let omega_list l = List.map (fun _ -> omega) l -let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty +module Pattern_head : sig + type desc = + | Any + | Construct of constructor_description + | Constant of constant + | Tuple of int + | Record of label_description list + | Variant of + { tag: label; has_arg: bool; + cstr_row: row_desc ref; + type_row : unit -> row_desc; } + (* the row of the type may evolve if [close_variant] is called, + hence the (unit -> ...) delay *) + | Array of int + | Lazy + + type t + + val desc : t -> desc + val env : t -> Env.t + val loc : t -> Location.t + val typ : t -> Types.type_expr + + (** [deconstruct p] returns the head of [p] and the list of sub patterns. + + @raises [Invalid_arg _] if [p] is an or- or an exception-pattern. *) + val deconstruct : pattern -> t * pattern list + + (** reconstructs a pattern, putting wildcards as sub-patterns. *) + val to_omega_pattern : t -> pattern + + val make + : loc:Location.t + -> typ:Types.type_expr + -> env:Env.t + -> desc + -> t + + val omega : t + +end = struct + type desc = + | Any + | Construct of constructor_description + | Constant of constant + | Tuple of int + | Record of label_description list + | Variant of + { tag: label; + has_arg: bool; + cstr_row: row_desc ref; + type_row: unit -> row_desc; } + | Array of int + | Lazy + + type t = { + desc: desc; + typ : Types.type_expr; + loc : Location.t; + env : Env.t; + attributes : attributes; + } + + let desc { desc } = desc + let env { env } = env + let loc { loc } = loc + let typ { typ } = typ + + let deconstruct q = + let rec deconstruct_desc = function + | Tpat_any + | Tpat_var _ -> Any, [] + | Tpat_constant c -> Constant c, [] + | Tpat_alias (p,_,_) -> deconstruct_desc p.pat_desc + | Tpat_tuple args -> + Tuple (List.length args), args + | Tpat_construct (_, c, args) -> + Construct c, args + | Tpat_variant (tag, arg, cstr_row) -> + let has_arg, pats = + match arg with + | None -> false, [] + | Some a -> true, [a] + in + let type_row () = + match Ctype.expand_head q.pat_env q.pat_type with + | {desc = Tvariant type_row} -> Btype.row_repr type_row + | _ -> assert false + in + Variant {tag; has_arg; cstr_row; type_row}, pats + | Tpat_array args -> + Array (List.length args), args + | Tpat_record (largs, _) -> + let lbls = List.map (fun (_,lbl,_) -> lbl) largs in + let pats = List.map (fun (_,_,pat) -> pat) largs in + Record lbls, pats + | Tpat_lazy p -> + Lazy, [p] + | Tpat_or _ -> invalid_arg "Parmatch.Pattern_head.deconstruct: (P | Q)" + | Tpat_exception _ -> + invalid_arg "Parmatch.Pattern_head.deconstruct: (exception P)" + in + let desc, pats = deconstruct_desc q.pat_desc in + { desc; typ = q.pat_type; loc = q.pat_loc; + env = q.pat_env; attributes = q.pat_attributes }, pats + + let to_omega_pattern t = + let pat_desc = + match t.desc with + | Any -> Tpat_any + | Lazy -> Tpat_lazy omega + | Constant c -> Tpat_constant c + | Tuple n -> Tpat_tuple (omegas n) + | Array n -> Tpat_array (omegas n) + | Construct c -> + let lid_loc = Location.mkloc (Longident.Lident c.cstr_name) t.loc in + Tpat_construct (lid_loc, c, omegas c.cstr_arity) + | Variant { tag; has_arg; cstr_row } -> + let arg_opt = if has_arg then Some omega else None in + Tpat_variant (tag, arg_opt, cstr_row) + | Record lbls -> + let lst = + List.map (fun lbl -> + let lid_loc = + Location.mkloc (Longident.Lident lbl.lbl_name) t.loc + in + (lid_loc, lbl, omega) + ) lbls + in + Tpat_record (lst, Closed) + in + { pat_desc; pat_type = t.typ; pat_loc = t.loc; pat_extra = []; + pat_env = t.env; pat_attributes = t.attributes } + + let make ~loc ~typ ~env desc = + { desc; loc; typ; env; attributes = [] } + + let omega = + { desc = Any + ; loc = Location.none + ; typ = Ctype.none + ; env = Env.empty + ; attributes = [] + } +end + +(* + Normalize a pattern -> + all arguments are omega (simple pattern) and no more variables +*) + +let normalize_pat p = Pattern_head.(to_omega_pattern @@ fst @@ deconstruct p) (*******************) (* Coherence check *) @@ -121,14 +272,11 @@ let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty *) let all_coherent column = let coherent_heads hp1 hp2 = - match hp1.pat_desc, hp2.pat_desc with - | (Tpat_var _ | Tpat_alias _ | Tpat_or _), _ - | _, (Tpat_var _ | Tpat_alias _ | Tpat_or _) -> - assert false - | Tpat_construct (_, c, _), Tpat_construct (_, c', _) -> + match Pattern_head.desc hp1, Pattern_head.desc hp2 with + | Construct c, Construct c' -> c.cstr_consts = c'.cstr_consts && c.cstr_nonconsts = c'.cstr_nonconsts - | Tpat_constant c1, Tpat_constant c2 -> begin + | Constant c1, Constant c2 -> begin match c1, c2 with | Const_char _, Const_char _ | Const_int _, Const_int _ @@ -145,22 +293,21 @@ let all_coherent column = | Const_float _ | Const_string _), _ -> false end - | Tpat_tuple l1, Tpat_tuple l2 -> List.length l1 = List.length l2 - | Tpat_record ((_, lbl1, _) :: _, _), Tpat_record ((_, lbl2, _) :: _, _) -> + | Tuple l1, Tuple l2 -> l1 = l2 + | Record (lbl1 :: _), Record (lbl2 :: _) -> Array.length lbl1.lbl_all = Array.length lbl2.lbl_all - | Tpat_any, _ - | _, Tpat_any - | Tpat_record ([], _), Tpat_record ([], _) - | Tpat_variant _, Tpat_variant _ - | Tpat_array _, Tpat_array _ - | Tpat_lazy _, Tpat_lazy _ -> true + | Any, _ + | _, Any + | Record [], Record [] + | Variant _, Variant _ + | Array _, Array _ + | Lazy, Lazy -> true | _, _ -> false in match List.find (fun head_pat -> - match head_pat.pat_desc with - | Tpat_var _ | Tpat_alias _ | Tpat_or _ -> assert false - | Tpat_any -> false + match Pattern_head.desc head_pat with + | Any -> false | _ -> true ) column with @@ -171,7 +318,7 @@ let all_coherent column = List.for_all (coherent_heads discr_pat) column let first_column simplified_matrix = - List.map fst simplified_matrix + List.map (fun ((head, _args), _rest) -> head) simplified_matrix (***********************) (* Compatibility check *) @@ -239,9 +386,10 @@ let first_column simplified_matrix = let is_absent tag row = Btype.row_field tag !row = Rabsent -let is_absent_pat p = match p.pat_desc with -| Tpat_variant (tag, _, row) -> is_absent tag row -| _ -> false +let is_absent_pat d = + match Pattern_head.desc d with + | Variant { tag; cstr_row; _ } -> is_absent tag cstr_row + | _ -> false let const_compare x y = match x,y with @@ -358,93 +506,58 @@ let get_constructor_type_path ty tenv = (****************************) (* Check top matching *) -let simple_match p1 p2 = - match p1.pat_desc, p2.pat_desc with - | Tpat_construct(_, c1, _), Tpat_construct(_, c2, _) -> +let simple_match d h = + match Pattern_head.desc d, Pattern_head.desc h with + | Construct c1, Construct c2 -> Types.equal_tag c1.cstr_tag c2.cstr_tag - | Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) -> - l1 = l2 - | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0 - | Tpat_lazy _, Tpat_lazy _ -> true - | Tpat_record _ , Tpat_record _ -> true - | Tpat_tuple p1s, Tpat_tuple p2s - | Tpat_array p1s, Tpat_array p2s -> List.length p1s = List.length p2s - | _, (Tpat_any | Tpat_var(_)) -> true + | Variant { tag = t1; _ }, Variant { tag = t2 } -> + t1 = t2 + | Constant c1, Constant c2 -> const_compare c1 c2 = 0 + | Lazy, Lazy -> true + | Record _, Record _ -> true + | Tuple len1, Tuple len2 + | Array len1, Array len2 -> len1 = len2 + | _, Any -> true | _, _ -> false - (* extract record fields as a whole *) -let record_arg p = match p.pat_desc with -| Tpat_any -> [] -| Tpat_record (args,_) -> args +let record_arg ph = match Pattern_head.desc ph with +| Any -> [] +| Record args -> args | _ -> fatal_error "Parmatch.as_record" -(* Raise Not_found when pos is not present in arg *) -let get_field pos arg = - let _,_, p = List.find (fun (_,lbl,_) -> pos = lbl.lbl_pos) arg in - p - -let extract_fields omegas arg = - List.map - (fun (_,lbl,_) -> - try - get_field lbl.lbl_pos arg - with Not_found -> omega) - omegas +let extract_fields lbls arg = + let get_field pos arg = + match List.find (fun (lbl,_) -> pos = lbl.lbl_pos) arg with + | _, p -> p + | exception Not_found -> omega + in + List.map (fun lbl -> get_field lbl.lbl_pos arg) lbls (* Build argument list when p2 >= p1, where p1 is a simple pattern *) -let rec simple_match_args p1 p2 = match p2.pat_desc with -| Tpat_alias (p2,_,_) -> simple_match_args p1 p2 -| Tpat_construct(_, _, args) -> args -| Tpat_variant(_, Some arg, _) -> [arg] -| Tpat_tuple(args) -> args -| Tpat_record(args,_) -> extract_fields (record_arg p1) args -| Tpat_array(args) -> args -| Tpat_lazy arg -> [arg] -| (Tpat_any | Tpat_var(_)) -> - begin match p1.pat_desc with - Tpat_construct(_, _,args) -> omega_list args - | Tpat_variant(_, Some _, _) -> [omega] - | Tpat_tuple(args) -> omega_list args - | Tpat_record(args,_) -> omega_list args - | Tpat_array(args) -> omega_list args - | Tpat_lazy _ -> [omega] - | _ -> [] +let simple_match_args discr head args = match Pattern_head.desc head with +| Constant _ -> [] +| Construct _ +| Variant _ +| Tuple _ +| Array _ +| Lazy -> args +| Record lbls -> extract_fields (record_arg discr) (List.combine lbls args) +| Any -> + begin match Pattern_head.desc discr with + | Construct cstr -> omegas cstr.cstr_arity + | Variant { has_arg = true } + | Lazy -> [omega] + | Record lbls -> omega_list lbls + | Array len + | Tuple len -> omegas len + | Variant { has_arg = false } + | Any + | Constant _ -> [] end -| _ -> [] - -(* - Normalize a pattern -> - all arguments are omega (simple pattern) and no more variables -*) - -let rec normalize_pat q = match q.pat_desc with - | Tpat_any | Tpat_constant _ -> q - | Tpat_var _ -> make_pat Tpat_any q.pat_type q.pat_env - | Tpat_alias (p,_,_) -> normalize_pat p - | Tpat_tuple (args) -> - make_pat (Tpat_tuple (omega_list args)) q.pat_type q.pat_env - | Tpat_construct (lid, c,args) -> - make_pat - (Tpat_construct (lid, c,omega_list args)) - q.pat_type q.pat_env - | Tpat_variant (l, arg, row) -> - make_pat (Tpat_variant (l, may_map (fun _ -> omega) arg, row)) - q.pat_type q.pat_env - | Tpat_array (args) -> - make_pat (Tpat_array (omega_list args)) q.pat_type q.pat_env - | Tpat_record (largs, closed) -> - make_pat - (Tpat_record (List.map (fun (lid,lbl,_) -> - lid, lbl,omega) largs, closed)) - q.pat_type q.pat_env - | Tpat_lazy _ -> - make_pat (Tpat_lazy omega) q.pat_type q.pat_env - | Tpat_or _ - | Tpat_exception _ -> fatal_error "Parmatch.normalize_pat" (* Consider a pattern matrix whose first column has been simplified to contain only _ or a head constructor @@ -456,14 +569,14 @@ let rec normalize_pat q = match q.pat_desc with We build a normalized /discriminating/ pattern from a pattern [q] by folding over the first column of the matrix, "refining" [q] as we go: - - when we encounter a row starting with [Tpat_tuple] or [Tpat_lazy] then we - can stop and return that pattern, as we cannot refine any further. Indeed, + - when we encounter a row starting with [Tuple] or [Lazy] then we + can stop and return that head, as we cannot refine any further. Indeed, these constructors are alone in their signature, so they will subsume - whatever other pattern we might find, as well as the pattern we're threading + whatever other head we might find, as well as the head we're threading along. - - when we find a [Tpat_record] then it is a bit more involved: it is also - alone in its signature, however it might only be matching a subset of the + - when we find a [Record] then it is a bit more involved: it is also alone + in its signature, however it might only be matching a subset of the record fields. We use these fields to refine our accumulator and keep going as another row might match on different fields. @@ -476,40 +589,38 @@ let rec normalize_pat q = match q.pat_desc with let discr_pat q pss = let rec refine_pat acc = function | [] -> acc - | (head, _) :: rows -> - match head.pat_desc with - | Tpat_or _ | Tpat_var _ | Tpat_alias _ -> assert false - | Tpat_any -> refine_pat acc rows - | Tpat_tuple _ | Tpat_lazy _ -> normalize_pat head - | Tpat_record (largs, closed) -> + | ((head, _), _) :: rows -> + match Pattern_head.desc head with + | Any -> refine_pat acc rows + | Tuple _ | Lazy -> head + | Record lbls -> (* N.B. we could make this case "simpler" by refining the record case using [all_record_args]. In which case we wouldn't need to fold over the first column for records. However it makes the witness we generate for the exhaustivity warning less pretty. *) - let new_omegas = - List.fold_right - (fun (lid, lbl,_) r -> - try - let _ = get_field lbl.lbl_pos r in - r - with Not_found -> - (lid, lbl,omega)::r) - largs (record_arg acc) + let fields = + List.fold_right (fun lbl r -> + if List.exists (fun l -> l.lbl_pos = lbl.lbl_pos) r then + r + else + lbl :: r + ) lbls (record_arg acc) in - let new_acc = - make_pat (Tpat_record (new_omegas, closed)) head.pat_type head.pat_env + let d = + let open Pattern_head in + make ~loc:(loc head) ~typ:(typ head) ~env:(env head) (Record fields) in - refine_pat new_acc rows + refine_pat d rows | _ -> acc in - let q = normalize_pat q in - (* short-circuiting: clearly if we have anything other than [Tpat_record] or - [Tpat_any] to start with, we're not going to be able refine at all. So + let q, _ = Pattern_head.deconstruct q in + match Pattern_head.desc q with + (* short-circuiting: clearly if we have anything other than [Record] or + [Any] to start with, we're not going to be able refine at all. So there's no point going over the matrix. *) - match q.pat_desc with - | Tpat_any | Tpat_record _ -> refine_pat q pss + | Any | Record _ -> refine_pat q pss | _ -> q (* @@ -525,7 +636,7 @@ let rec read_args xs r = match xs,r with | _,_ -> fatal_error "Parmatch.read_args" -let do_set_args erase_mutable q r = match q with +let do_set_args ~erase_mutable q r = match q with | {pat_desc = Tpat_tuple omegas} -> let args,rest = read_args omegas r in make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest @@ -576,8 +687,8 @@ let do_set_args erase_mutable q r = match q with q::r (* case any is used in matching.ml *) | _ -> fatal_error "Parmatch.set_args" -let set_args q r = do_set_args false q r -and set_args_erase_mutable q r = do_set_args true q r +let set_args q r = do_set_args ~erase_mutable:false q r +and set_args_erase_mutable q r = do_set_args ~erase_mutable:true q r (* Given a matrix of non-empty rows p1 :: r1... @@ -585,10 +696,8 @@ and set_args_erase_mutable q r = do_set_args true q r p3 :: r3... Simplify the first column [p1 p2 p3] by splitting all or-patterns. - The result is a list of couples - (simple pattern, rest of row) - where a "simple pattern" starts with either the catch-all pattern omega (_) - or a head constructor. + The result is a list of pairs + ((pattern head, arguments), rest of row) For example, x :: r1 @@ -596,19 +705,21 @@ and set_args_erase_mutable q r = do_set_args true q r (None as x) as y :: r3 (Some x | (None as x)) :: r4 becomes - (_, r1) - (Some _, r2) - (None, r3) - (Some x, r4) - (None, r4) + (( _ , [ ] ), r1) + (( Some, [_] ), r2) + (( None, [ ] ), r3) + (( Some, [x] ), r4) + (( None, [ ] ), r4) *) let simplify_head_pat ~add_column p ps k = let rec simplify_head_pat p ps k = match p.pat_desc with - | Tpat_alias (p,_,_) -> simplify_head_pat p ps k - | Tpat_var (_,_) -> add_column omega ps k + | Tpat_alias (p,_,_) -> + (* We have to handle aliases here, because there can be or-patterns + underneath, that [Pattern_head.deconstruct] won't handle. *) + simplify_head_pat p ps k | Tpat_or (p1,p2,_) -> simplify_head_pat p1 ps (simplify_head_pat p2 ps k) - | _ -> add_column p ps k + | _ -> add_column (Pattern_head.deconstruct p) ps k in simplify_head_pat p ps k let rec simplify_first_col = function @@ -619,23 +730,20 @@ let rec simplify_first_col = function simplify_head_pat ~add_column p ps (simplify_first_col rows) -(* Builds the specialized matrix of [pss] according to pattern [q]. +(* Builds the specialized matrix of [pss] according to the discriminating + pattern head [d]. See section 3.1 of http://moscova.inria.fr/~maranget/papers/warn/warn.pdf NOTES: - - expects [pss] to be a "simplified matrix", cf. [simplify_first_col] - - [q] was produced by [discr_pat] - we are polymorphic on the type of matrices we work on, in particular a row might not simply be a [pattern list]. That's why we have the [extend_row] parameter. *) -let build_specialized_submatrix ~extend_row q pss = +let build_specialized_submatrix ~extend_row discr pss = let rec filter_rec = function - | ({pat_desc = (Tpat_alias _ | Tpat_or _ | Tpat_var _) }, _) :: _ -> - assert false - | (p, ps) :: pss -> - if simple_match q p - then extend_row (simple_match_args q p) ps :: filter_rec pss + | ((head, args), ps) :: pss -> + if simple_match discr head + then extend_row (simple_match_args discr head args) ps :: filter_rec pss else filter_rec pss | _ -> [] in filter_rec pss @@ -645,7 +753,7 @@ let build_specialized_submatrix ~extend_row q pss = *) type 'matrix specialized_matrices = { default : 'matrix; - constrs : (pattern * 'matrix) list; + constrs : (Pattern_head.t * 'matrix) list; } (* Consider a pattern matrix whose first column has been simplified @@ -673,50 +781,52 @@ type 'matrix specialized_matrices = { See the documentation of [build_specialized_submatrix] for an explanation of the [extend_row] parameter. *) -let build_specialized_submatrices ~extend_row q rows = - let extend_group discr p r rs = - let r = extend_row (simple_match_args discr p) r in +let build_specialized_submatrices ~extend_row discr rows = + let extend_group discr p args r rs = + let r = extend_row (simple_match_args discr p args) r in (discr, r :: rs) in (* insert a row of head [p] and rest [r] into the right group *) - let rec insert_constr p r = function + let rec insert_constr head args r = function | [] -> (* if no group matched this row, it has a head constructor that was never seen before; add a new sub-matrix for this head *) - [extend_group (normalize_pat p) p r []] + [extend_group head head args r []] | (q0,rs) as bd::env -> - if simple_match q0 p - then extend_group q0 p r rs :: env - else bd :: insert_constr p r env + if simple_match q0 head + then extend_group q0 head args r rs :: env + else bd :: insert_constr head args r env in (* insert a row of head omega into all groups *) let insert_omega r env = - List.map (fun (q0,rs) -> extend_group q0 omega r rs) env + List.map (fun (q0,rs) -> extend_group q0 Pattern_head.omega [] r rs) env in let rec form_groups constr_groups omega_tails = function | [] -> (constr_groups, omega_tails) - | ({pat_desc=(Tpat_var _|Tpat_alias _|Tpat_or _)},_)::_ -> assert false - | ({pat_desc=Tpat_any}, tail) :: rest -> - (* note that calling insert_omega here would be wrong - as some groups may not have been formed yet, if the - first row with this head pattern comes after in the list *) - form_groups constr_groups (tail :: omega_tails) rest - | (p,r) :: rest -> - form_groups (insert_constr p r constr_groups) omega_tails rest + | ((head, args), tail) :: rest -> + match Pattern_head.desc head with + | Any -> + (* note that calling insert_omega here would be wrong + as some groups may not have been formed yet, if the + first row with this head pattern comes after in the list *) + form_groups constr_groups (tail :: omega_tails) rest + | _ -> + form_groups + (insert_constr head args tail constr_groups) omega_tails rest in let constr_groups, omega_tails = let initial_constr_group = - match q.pat_desc with - | Tpat_record(_) | Tpat_tuple(_) | Tpat_lazy(_) -> - (* [q] comes from [discr_pat], and in this case subsumes any of the + match Pattern_head.desc discr with + | Record _ | Tuple _ | Lazy -> + (* [discr] comes from [discr_pat], and in this case subsumes any of the patterns we could find on the first column of [rows]. So it is better to use it for our initial environment than any of the normalized pattern we might obtain from the first column. *) - [q,[]] + [discr,[]] | _ -> [] in form_groups initial_constr_group [] rows @@ -737,18 +847,16 @@ let set_last a = | x::l -> x :: loop l in function - | (_, []) -> (a, []) + | (_, []) -> (Pattern_head.deconstruct a, []) | (first, row) -> (first, loop row) -(* mark constructor lines for failure when they are incomplete - - Precondition: the input matrix has been simplified so that its - first column only contains _ or head constructors. *) +(* mark constructor lines for failure when they are incomplete *) let mark_partial = - List.map (function - | ({pat_desc=(Tpat_var _|Tpat_alias _|Tpat_or _)},_) -> assert false - | ({pat_desc = Tpat_any }, _) as ps -> ps - | ps -> set_last zero ps + let zero = make_pat (Tpat_constant (Const_int 0)) Ctype.none Env.empty in + List.map (fun ((hp, _), _ as ps) -> + match Pattern_head.desc hp with + | Any -> ps + | _ -> set_last zero ps ) let close_variant env row = @@ -771,56 +879,51 @@ let close_variant env row = row_closed = true; row_name = nm})) end -let row_of_pat pat = - match Ctype.expand_head pat.pat_env pat.pat_type with - {desc = Tvariant row} -> Btype.row_repr row - | _ -> assert false - (* Check whether the first column of env makes up a complete signature or - not. We work on the discriminating patterns of each sub-matrix: they - are simplified, and are not omega/Tpat_any. + not. We work on the discriminating pattern heads of each sub-matrix: they + are not omega/Any. *) let full_match closing env = match env with -| ({pat_desc = (Tpat_any | Tpat_var _ | Tpat_alias _ - | Tpat_or _ | Tpat_exception _)},_) :: _ -> - (* discriminating patterns are simplified *) - assert false | [] -> false -| ({pat_desc = Tpat_construct(_,c,_)},_) :: _ -> - if c.cstr_consts < 0 then false (* extensions *) - else List.length env = c.cstr_consts + c.cstr_nonconsts -| ({pat_desc = Tpat_variant _} as p,_) :: _ -> - let fields = - List.map - (function ({pat_desc = Tpat_variant (tag, _, _)}, _) -> tag - | _ -> assert false) - env - in - let row = row_of_pat p in - if closing && not (Btype.row_fixed row) then - (* closing=true, we are considering the variant as closed *) - List.for_all - (fun (tag,f) -> - match Btype.row_field_repr f with - Rabsent | Reither(_, _, false, _) -> true - | Reither (_, _, true, _) - (* m=true, do not discard matched tags, rather warn *) - | Rpresent _ -> List.mem tag fields) - row.row_fields - else - row.row_closed && - List.for_all - (fun (tag,f) -> - Btype.row_field_repr f = Rabsent || List.mem tag fields) - row.row_fields -| ({pat_desc = Tpat_constant(Const_char _)},_) :: _ -> - List.length env = 256 -| ({pat_desc = Tpat_constant(_)},_) :: _ -> false -| ({pat_desc = Tpat_tuple(_)},_) :: _ -> true -| ({pat_desc = Tpat_record(_)},_) :: _ -> true -| ({pat_desc = Tpat_array(_)},_) :: _ -> false -| ({pat_desc = Tpat_lazy(_)},_) :: _ -> true +| (discr, _) :: _ -> + match Pattern_head.desc discr with + | Any -> assert false + | Construct { cstr_tag = Cstr_extension _ ; _ } -> false + | Construct c -> List.length env = c.cstr_consts + c.cstr_nonconsts + | Variant { type_row; _ } -> + let fields = + List.map + (fun (d, _) -> + match Pattern_head.desc d with + | Variant { tag } -> tag + | _ -> assert false) + env + in + let row = type_row () in + if closing && not (Btype.row_fixed row) then + (* closing=true, we are considering the variant as closed *) + List.for_all + (fun (tag,f) -> + match Btype.row_field_repr f with + Rabsent | Reither(_, _, false, _) -> true + | Reither (_, _, true, _) + (* m=true, do not discard matched tags, rather warn *) + | Rpresent _ -> List.mem tag fields) + row.row_fields + else + row.row_closed && + List.for_all + (fun (tag,f) -> + Btype.row_field_repr f = Rabsent || List.mem tag fields) + row.row_fields + | Constant Const_char _ -> + List.length env = 256 + | Constant _ + | Array _ -> false + | Tuple _ + | Record _ + | Lazy -> true (* Written as a non-fragile matching, PR#7451 originated from a fragile matching below. *) @@ -829,18 +932,15 @@ let should_extend ext env = match ext with | Some ext -> begin match env with | [] -> assert false | (p,_)::_ -> - begin match p.pat_desc with - | Tpat_construct - (_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},_) -> - let path = get_constructor_type_path p.pat_type p.pat_env in - Path.same path ext - | Tpat_construct - (_, {cstr_tag=(Cstr_extension _)},_) -> false - | Tpat_constant _|Tpat_tuple _|Tpat_variant _ - | Tpat_record _|Tpat_array _ | Tpat_lazy _ - -> false - | Tpat_any|Tpat_var _|Tpat_alias _|Tpat_or _|Tpat_exception _ - -> assert false + begin match Pattern_head.desc p with + | Construct {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)} -> + let path = + get_constructor_type_path (Pattern_head.typ p) (Pattern_head.env p) + in + Path.same path ext + | Construct {cstr_tag=(Cstr_extension _)} -> false + | Constant _ | Tuple _ | Variant _ | Record _ | Array _ | Lazy -> false + | Any -> assert false end end @@ -888,6 +988,7 @@ let rec orify_many = function (* build an or-pattern from a constructor list *) let pat_of_constrs ex_pat cstrs = + let ex_pat = Pattern_head.to_omega_pattern ex_pat in if cstrs = [] then raise Empty else orify_many (List.map (pat_of_constr ex_pat) cstrs) @@ -932,10 +1033,9 @@ let rec get_variant_constructors env ty = (* Sends back a pattern that complements constructor tags all_tag *) let complete_constrs p all_tags = - let c = - match p.pat_desc with Tpat_construct (_, c, _) -> c | _ -> assert false in + let c = match Pattern_head.desc p with Construct c -> c | _ -> assert false in let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in - let constrs = get_variant_constructors p.pat_env c.cstr_res in + let constrs = get_variant_constructors (Pattern_head.env p) c.cstr_res in let others = List.filter (fun cnstr -> ConstructorTagHashtbl.mem not_tags cnstr.cstr_tag) @@ -945,23 +1045,30 @@ let complete_constrs p all_tags = const @ nonconst let build_other_constrs env p = - match p.pat_desc with - Tpat_construct (_, {cstr_tag=Cstr_constant _|Cstr_block _}, _) -> - let get_tag = function - | {pat_desc = Tpat_construct (_,c,_)} -> c.cstr_tag + match Pattern_head.desc p with + | Construct { cstr_tag = Cstr_constant _ | Cstr_block _ } -> + let get_tag q = + match Pattern_head.desc q with + | Construct c -> c.cstr_tag | _ -> fatal_error "Parmatch.get_tag" in let all_tags = List.map (fun (p,_) -> get_tag p) env in pat_of_constrs p (complete_constrs p all_tags) | _ -> extra_pat +let complete_constrs p all_tags = + (* This wrapper is here for [Matching], which (indirectly) calls this function + from [combine_constructor], and nowhere else. + So we know patterns have been fully simplified. *) + complete_constrs (fst @@ Pattern_head.deconstruct p) all_tags + (* Auxiliary for build_other *) let build_other_constant proj make first next p env = - let all = List.map (fun (p, _) -> proj p.pat_desc) env in + let all = List.map (fun (p, _) -> proj (Pattern_head.desc p)) env in let rec try_const i = if List.mem i all then try_const (next i) - else make_pat (make i) p.pat_type p.pat_env + else make_pat (make i) (Pattern_head.typ p) (Pattern_head.env p) in try_const first (* @@ -971,133 +1078,146 @@ let build_other_constant proj make first next p env = let some_private_tag = "" -let build_other ext env = match env with -| ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ -> - (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *) - make_pat (Tpat_var (Ident.create_local "*extension*", - {lid with txt="*extension*"})) Ctype.none Env.empty -| ({pat_desc = Tpat_construct _} as p,_) :: _ -> - begin match ext with - | Some ext -> - if Path.same ext (get_constructor_type_path p.pat_type p.pat_env) then - extra_pat - else - build_other_constrs env p - | _ -> - build_other_constrs env p - end -| ({pat_desc = Tpat_variant (_,_,r)} as p,_) :: _ -> - let tags = - List.map - (function ({pat_desc = Tpat_variant (tag, _, _)}, _) -> tag +let build_other ext env = + match env with + | [] -> omega + | (d, _) :: _ -> + match Pattern_head.desc d with + | Construct { cstr_tag = Cstr_extension _ } -> + (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *) + make_pat + (Tpat_var (Ident.create_local "*extension*", + {txt="*extension*"; loc = Pattern_head.loc d})) + Ctype.none Env.empty + | Construct _ -> + begin match ext with + | Some ext -> + if Path.same ext + (get_constructor_type_path + (Pattern_head.typ d) (Pattern_head.env d)) + then + extra_pat + else + build_other_constrs env d + | _ -> + build_other_constrs env d + end + | Variant { cstr_row; type_row } -> + let tags = + List.map + (fun (d, _) -> + match Pattern_head.desc d with + | Variant { tag } -> tag | _ -> assert false) - env - in - let row = row_of_pat p in - let make_other_pat tag const = - let arg = if const then None else Some omega in - make_pat (Tpat_variant(tag, arg, r)) p.pat_type p.pat_env in - begin match - List.fold_left - (fun others (tag,f) -> - if List.mem tag tags then others else - match Btype.row_field_repr f with - Rabsent (* | Reither _ *) -> others - (* This one is called after erasing pattern info *) - | Reither (c, _, _, _) -> make_other_pat tag c :: others - | Rpresent arg -> make_other_pat tag (arg = None) :: others) - [] row.row_fields - with - [] -> - let tag = - if Btype.row_fixed row then some_private_tag else - let rec mktag tag = - if List.mem tag tags then mktag (tag ^ "'") else tag in - mktag "AnyOtherTag" - in make_other_pat tag true - | pat::other_pats -> - List.fold_left - (fun p_res pat -> - make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env) - pat other_pats - end -| ({pat_desc = Tpat_constant(Const_char _)} as p,_) :: _ -> - let all_chars = - List.map - (fun (p,_) -> match p.pat_desc with - | Tpat_constant (Const_char c) -> c - | _ -> assert false) - env in - - let rec find_other i imax = - if i > imax then raise Not_found - else - let ci = Char.chr i in - if List.mem ci all_chars then - find_other (i+1) imax - else - make_pat (Tpat_constant (Const_char ci)) p.pat_type p.pat_env in - let rec try_chars = function - | [] -> omega - | (c1,c2) :: rest -> - try - find_other (Char.code c1) (Char.code c2) - with - | Not_found -> try_chars rest in - - try_chars - [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ; - ' ', '~' ; Char.chr 0 , Char.chr 255] - -| ({pat_desc=(Tpat_constant (Const_int _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_int i) -> i | _ -> assert false) - (function i -> Tpat_constant(Const_int i)) - 0 succ p env -| ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_int32 i) -> i | _ -> assert false) - (function i -> Tpat_constant(Const_int32 i)) - 0l Int32.succ p env -| ({pat_desc=(Tpat_constant (Const_int64 _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_int64 i) -> i | _ -> assert false) - (function i -> Tpat_constant(Const_int64 i)) - 0L Int64.succ p env -| ({pat_desc=(Tpat_constant (Const_nativeint _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_nativeint i) -> i | _ -> assert false) - (function i -> Tpat_constant(Const_nativeint i)) - 0n Nativeint.succ p env -| ({pat_desc=(Tpat_constant (Const_string _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_string (s, _)) -> String.length s + env + in + let make_other_pat tag const = + let arg = if const then None else Some omega in + make_pat (Tpat_variant(tag, arg, cstr_row)) + (Pattern_head.typ d) (Pattern_head.env d) + in + let row = type_row () in + begin match + List.fold_left + (fun others (tag,f) -> + if List.mem tag tags then others else + match Btype.row_field_repr f with + Rabsent (* | Reither _ *) -> others + (* This one is called after erasing pattern info *) + | Reither (c, _, _, _) -> make_other_pat tag c :: others + | Rpresent arg -> make_other_pat tag (arg = None) :: others) + [] row.row_fields + with + [] -> + let tag = + if Btype.row_fixed row then some_private_tag else + let rec mktag tag = + if List.mem tag tags then mktag (tag ^ "'") else tag in + mktag "AnyOtherTag" + in make_other_pat tag true + | pat::other_pats -> + List.fold_left + (fun p_res pat -> + make_pat (Tpat_or (pat, p_res, None)) + (Pattern_head.typ d) (Pattern_head.env d)) + pat other_pats + end + | Constant Const_char _ -> + let all_chars = + List.map + (fun (p,_) -> match Pattern_head.desc p with + | Constant (Const_char c) -> c | _ -> assert false) - (function i -> Tpat_constant(Const_string(String.make i '*', None))) - 0 succ p env -| ({pat_desc=(Tpat_constant (Const_float _))} as p,_) :: _ -> - build_other_constant - (function Tpat_constant(Const_float f) -> float_of_string f + env + in + let rec find_other i imax = + if i > imax then raise Not_found + else + let ci = Char.chr i in + if List.mem ci all_chars then + find_other (i+1) imax + else + make_pat (Tpat_constant (Const_char ci)) + (Pattern_head.typ d) (Pattern_head.env d) + in + let rec try_chars = function + | [] -> omega + | (c1,c2) :: rest -> + try + find_other (Char.code c1) (Char.code c2) + with + | Not_found -> try_chars rest + in + try_chars + [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ; + ' ', '~' ; Char.chr 0 , Char.chr 255] + | Constant Const_int _ -> + build_other_constant + (function Constant(Const_int i) -> i | _ -> assert false) + (function i -> Tpat_constant(Const_int i)) + 0 succ d env + | Constant Const_int32 _ -> + build_other_constant + (function Constant(Const_int32 i) -> i | _ -> assert false) + (function i -> Tpat_constant(Const_int32 i)) + 0l Int32.succ d env + | Constant Const_int64 _ -> + build_other_constant + (function Constant(Const_int64 i) -> i | _ -> assert false) + (function i -> Tpat_constant(Const_int64 i)) + 0L Int64.succ d env + | Constant Const_nativeint _ -> + build_other_constant + (function Constant(Const_nativeint i) -> i | _ -> assert false) + (function i -> Tpat_constant(Const_nativeint i)) + 0n Nativeint.succ d env + | Constant Const_string _ -> + build_other_constant + (function Constant(Const_string (s, _)) -> String.length s + | _ -> assert false) + (function i -> Tpat_constant(Const_string(String.make i '*', None))) + 0 succ d env + | Constant Const_float _ -> + build_other_constant + (function Constant(Const_float f) -> float_of_string f + | _ -> assert false) + (function f -> Tpat_constant(Const_float (string_of_float f))) + 0.0 (fun f -> f +. 1.0) d env + | Array _ -> + let all_lengths = + List.map + (fun (p,_) -> match Pattern_head.desc p with + | Array len -> len | _ -> assert false) - (function f -> Tpat_constant(Const_float (string_of_float f))) - 0.0 (fun f -> f +. 1.0) p env - -| ({pat_desc = Tpat_array _} as p,_)::_ -> - let all_lengths = - List.map - (fun (p,_) -> match p.pat_desc with - | Tpat_array args -> List.length args - | _ -> assert false) - env in - let rec try_arrays l = - if List.mem l all_lengths then try_arrays (l+1) - else - make_pat - (Tpat_array (omegas l)) - p.pat_type p.pat_env in - try_arrays 0 -| [] -> omega -| _ -> omega + env in + let rec try_arrays l = + if List.mem l all_lengths then try_arrays (l+1) + else + make_pat + (Tpat_array (omegas l)) + (Pattern_head.typ d) (Pattern_head.env d) in + try_arrays 0 + | _ -> omega let rec has_instance p = match p.pat_desc with | Tpat_variant (l,_,r) when is_absent l r -> false @@ -1162,18 +1282,20 @@ let rec satisfiable pss qs = match pss with List.exists (fun (p,pss) -> not (is_absent_pat p) && - satisfiable pss (simple_match_args p omega @ qs)) + satisfiable pss + (simple_match_args p Pattern_head.omega [] @ qs)) constrs end | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> false | q::qs -> let pss = simplify_first_col pss in - if not (all_coherent (q :: first_column pss)) then + let hq, qargs = Pattern_head.deconstruct q in + if not (all_coherent (hq :: first_column pss)) then false else begin let q0 = discr_pat q pss in satisfiable (build_specialized_submatrix ~extend_row:(@) q0 pss) - (simple_match_args q0 q @ qs) + (simple_match_args q0 hq qargs @ qs) end (* While [satisfiable] only checks whether the last row of [pss + qs] is @@ -1220,15 +1342,16 @@ let rec list_satisfying_vectors pss qs = else let witnesses = list_satisfying_vectors pss - (simple_match_args p omega @ qs) + (simple_match_args p Pattern_head.omega [] @ qs) in + let p = Pattern_head.to_omega_pattern p in List.map (set_args p) witnesses ) constrs ) in if full_match false constrs then for_constrs () else - begin match p.pat_desc with - | Tpat_construct _ -> + begin match Pattern_head.desc p with + | Construct _ -> (* activate this code for checking non-gadt constructors *) wild default (build_other_constrs constrs p) @ for_constrs () @@ -1238,15 +1361,16 @@ let rec list_satisfying_vectors pss qs = end | {pat_desc=Tpat_variant (l,_,r)}::_ when is_absent l r -> [] | q::qs -> + let hq, qargs = Pattern_head.deconstruct q in let pss = simplify_first_col pss in - if not (all_coherent (q :: first_column pss)) then + if not (all_coherent (hq :: first_column pss)) then [] else begin let q0 = discr_pat q pss in - List.map (set_args q0) + List.map (set_args (Pattern_head.to_omega_pattern q0)) (list_satisfying_vectors (build_specialized_submatrix ~extend_row:(@) q0 pss) - (simple_match_args q0 q @ qs)) + (simple_match_args q0 hq qargs @ qs)) end (******************************************) @@ -1275,13 +1399,16 @@ let rec do_match pss qs = match qs with in do_match (remove_first_column pss) qs | _ -> - let q0 = normalize_pat q in + (* [q] is generated by us, it doesn't come from the source. So we know + it's not of the form [P as name]. + Therefore there is no risk of [deconstruct] raising. *) + let q0, qargs = Pattern_head.deconstruct q in let pss = simplify_first_col pss in (* [pss] will (or won't) match [q0 :: qs] regardless of the coherence of its first column. *) do_match (build_specialized_submatrix ~extend_row:(@) q0 pss) - (simple_match_args q0 q @ qs) + (qargs @ qs) type 'a exhaust_result = @@ -1353,7 +1480,9 @@ let rec exhaust (ext:Path.t option) pss n = match pss with | { default; constrs = [] } -> (* first column of pss is made of variables only *) begin match exhaust ext default (n-1) with - | Witnesses r -> Witnesses (List.map (fun row -> q0::row) r) + | Witnesses r -> + let q0 = Pattern_head.to_omega_pattern q0 in + Witnesses (List.map (fun row -> q0::row) r) | r -> r end | { default; constrs } -> @@ -1363,10 +1492,13 @@ let rec exhaust (ext:Path.t option) pss n = match pss with else match exhaust - ext pss (List.length (simple_match_args p omega) + n - 1) + ext pss + (List.length (simple_match_args p Pattern_head.omega []) + + n - 1) with | Witnesses r -> - Witnesses (List.map (fun row -> (set_args p row)) r) + let p = Pattern_head.to_omega_pattern p in + Witnesses (List.map (set_args p) r) | r -> r in let before = try_many try_non_omega constrs in if @@ -1455,12 +1587,16 @@ let rec pressure_variants tdefs = function end in begin match constrs, tdefs with - ({pat_desc=Tpat_variant _} as p,_):: _, Some env -> - let row = row_of_pat p in + | [], _ + | _, None -> () + | (d, _) :: _, Some env -> + match Pattern_head.desc d with + | Variant { type_row; _ } -> + let row = type_row () in if Btype.row_fixed row || pressure_variants None default then () else close_variant env row - | _ -> () + | _ -> () end; ok end @@ -1656,16 +1792,17 @@ let rec every_satisfiables pss qs = match qs.active with | _ -> (* standard case, filter matrix *) let pss = simplify_first_usefulness_col pss in + let huq, args = Pattern_head.deconstruct uq in (* The handling of incoherent matrices is kept in line with [satisfiable] *) - if not (all_coherent (uq :: first_column pss)) then + if not (all_coherent (huq :: first_column pss)) then Unused else begin let q0 = discr_pat q pss in every_satisfiables (build_specialized_submatrix q0 pss ~extend_row:(fun ps r -> { r with active = ps @ r.active })) - {qs with active=simple_match_args q0 q @ rem} + {qs with active=simple_match_args q0 huq args @ rem} end end @@ -1902,7 +2039,7 @@ module Conv = struct in mkpat (Ppat_construct(lid, arg)) | Tpat_variant(label,p_opt,_row_desc) -> - let arg = Misc.may_map loop p_opt in + let arg = Option.map loop p_opt in mkpat (Ppat_variant(label, arg)) | Tpat_record (subpatterns, _closed_flag) -> let fields = @@ -1928,12 +2065,11 @@ end (* Whether the counter-example contains an extension pattern *) let contains_extension pat = - let r = ref false in - let rec loop = function - {pat_desc=Tpat_var (_, {txt="*extension*"})} -> - r := true - | p -> Typedtree.iter_pattern_desc loop p.pat_desc - in loop pat; !r + exists_pattern + (function + | {pat_desc=Tpat_var (_, {txt="*extension*"})} -> true + | _ -> false) + pat (* Build an untyped or-pattern from its expected type *) let ppat_of_type env ty = @@ -2296,12 +2432,13 @@ let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k = let rest_of_the_row = { row = ps; varsets = Ident.Set.add x head_bound_variables :: varsets; } in - add_column omega rest_of_the_row k + add_column (Pattern_head.deconstruct omega) rest_of_the_row k | Tpat_or (p1,p2,_) -> simpl head_bound_variables varsets p1 ps (simpl head_bound_variables varsets p2 ps k) | _ -> - add_column p { row = ps; varsets = head_bound_variables :: varsets; } k + add_column (Pattern_head.deconstruct p) + { row = ps; varsets = head_bound_variables :: varsets; } k in simpl head_bound_variables varsets p ps k (* @@ -2461,8 +2598,10 @@ let all_rhs_idents exp = Tmod_unpack ({exp_desc=Texp_ident (Path.Pident id_exp,_,_)},_)}, _) -> assert (Ident.Set.mem id_exp !ids) ; - if not (Ident.Set.mem id_mod !ids) then begin + begin match id_mod with + | Some id_mod when not (Ident.Set.mem id_mod !ids) -> ids := Ident.Set.remove id_exp !ids + | _ -> () end | _ -> assert false end diff --git a/typing/parmatch.mli b/typing/parmatch.mli index 000b02b4..e7778fdf 100644 --- a/typing/parmatch.mli +++ b/typing/parmatch.mli @@ -48,7 +48,7 @@ val le_pats : pattern list -> pattern list -> bool (** Exported compatibility functor, abstracted over constructor equality *) module Compat : functor - (Constr: sig + (_ : sig val equal : Types.constructor_description -> Types.constructor_description -> @@ -91,6 +91,14 @@ val ppat_of_type : (string, label_description) Hashtbl.t val pressure_variants: Env.t -> pattern list -> unit + +(** [check_partial pred loc caselist] and [check_unused refute pred caselist] + are called with a function [pred] which will be given counter-example + candidates: they may be partially ill-typed, and have to be type-checked + to extract a valid counter-example. + [pred] returns a valid counter-example or [None]. + [refute] indicates that [check_unused] was called on a refutation clause. + *) val check_partial: ((string, constructor_description) Hashtbl.t -> (string, label_description) Hashtbl.t -> diff --git a/typing/path.mli b/typing/path.mli index b008fabf..bddf9d67 100644 --- a/typing/path.mli +++ b/typing/path.mli @@ -37,6 +37,8 @@ val heads: t -> Ident.t list val last: t -> string +val is_uident: string -> bool + type typath = | Regular of t | Ext of t * string diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml index 29807e05..9b747668 100644 --- a/typing/persistent_env.ml +++ b/typing/persistent_env.ml @@ -343,7 +343,7 @@ let report_error ppf = let open Format in function | Illegal_renaming(modname, ps_name, filename) -> fprintf ppf - "Wrong file naming: %a@ contains the compiled interface for @ \ + "Wrong file naming: %a@ contains the compiled interface for@ \ %s when %s was expected" Location.print_filename filename ps_name modname | Inconsistent_import(name, source1, source2) -> fprintf ppf diff --git a/typing/persistent_env.mli b/typing/persistent_env.mli index 765a7b02..d04034ef 100644 --- a/typing/persistent_env.mli +++ b/typing/persistent_env.mli @@ -69,7 +69,7 @@ val check : 'a t -> (Persistent_signature.t -> 'a) [penv] (it may have failed) *) val looked_up : 'a t -> modname -> bool -(* [is_imported penv md] checks if [md] has been succesfully +(* [is_imported penv md] checks if [md] has been successfully imported in the environment [penv] *) val is_imported : 'a t -> modname -> bool diff --git a/typing/predef.ml b/typing/predef.ml index 5399656d..24f51dec 100644 --- a/typing/predef.ml +++ b/typing/predef.ml @@ -127,11 +127,11 @@ let decl_abstr = type_is_newtype = false; type_expansion_scope = lowest_level; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } -let decl_abstr_imm = {decl_abstr with type_immediate = true} +let decl_abstr_imm = {decl_abstr with type_immediate = Always} let cstr id args = { @@ -153,11 +153,11 @@ let common_initial_env add_type add_extension empty_env = let decl_bool = {decl_abstr with type_kind = Type_variant([cstr ident_false []; cstr ident_true []]); - type_immediate = true} + type_immediate = Always} and decl_unit = {decl_abstr with type_kind = Type_variant([cstr ident_void []]); - type_immediate = true} + type_immediate = Always} and decl_exn = {decl_abstr with type_kind = Type_open} diff --git a/typing/predef.mli b/typing/predef.mli index 878dc6eb..962a276a 100644 --- a/typing/predef.mli +++ b/typing/predef.mli @@ -57,6 +57,14 @@ val path_match_failure: Path.t val path_assert_failure : Path.t val path_undefined_recursive_module : Path.t +val ident_false : Ident.t +val ident_true : Ident.t +val ident_void : Ident.t +val ident_nil : Ident.t +val ident_cons : Ident.t +val ident_none : Ident.t +val ident_some : Ident.t + (* To build the initial environment. Since there is a nasty mutual recursion between predef and env, we break it by parameterizing over Env.t, Env.add_type and Env.add_extension. *) diff --git a/typing/primitive.ml b/typing/primitive.ml index c28bdfbf..0c3372b9 100644 --- a/typing/primitive.ml +++ b/typing/primitive.ml @@ -200,6 +200,10 @@ let native_name p = let byte_name p = p.prim_name +let native_name_is_external p = + let nat_name = native_name p in + nat_name <> "" && nat_name.[0] <> '%' + let report_error ppf err = match err with | Old_style_float_with_native_repr_attribute -> diff --git a/typing/primitive.mli b/typing/primitive.mli index 02ece7d9..ddd39779 100644 --- a/typing/primitive.mli +++ b/typing/primitive.mli @@ -63,6 +63,11 @@ val print val native_name: description -> string val byte_name: description -> string +(** [native_name_is_externa] returns [true] iff the [native_name] for the + given primitive identifies that the primitive is not implemented in the + compiler itself. *) +val native_name_is_external : description -> bool + type error = | Old_style_float_with_native_repr_attribute | Old_style_noalloc_with_noalloc_attribute diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 5df2e811..0c7821a7 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -34,6 +34,8 @@ let rec longident ppf = function | Ldot(p, s) -> fprintf ppf "%a.%s" longident p s | Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2 +let () = Env.print_longident := longident + (* Print an identifier avoiding name collisions *) module Out_name = struct @@ -75,18 +77,18 @@ module Namespace = struct | Class_type -> "class type" | Other -> "" + let pp ppf x = Format.pp_print_string ppf (show x) + let lookup = let to_lookup f lid = - fst @@ f ?loc:None ?mark:(Some false) (Lident lid) !printing_env in + fst @@ f (Lident lid) !printing_env + in function - | Type -> fun id -> - Env.lookup_type ?loc:None ~mark:false (Lident id) !printing_env - | Module -> fun id -> - Env.lookup_module ~load:true ~mark:false ?loc:None - (Lident id) !printing_env - | Module_type -> to_lookup Env.lookup_modtype - | Class -> to_lookup Env.lookup_class - | Class_type -> to_lookup Env.lookup_cltype + | Type -> to_lookup Env.find_type_by_name + | Module -> to_lookup Env.find_module_by_name + | Module_type -> to_lookup Env.find_modtype_by_name + | Class -> to_lookup Env.find_class_by_name + | Class_type -> to_lookup Env.find_cltype_by_name | Other -> fun _ -> raise Not_found let location namespace id = @@ -119,40 +121,79 @@ end *) module Conflicts = struct module M = String.Map - type explanation = { kind: namespace; name:string; location:Location.t} + type explanation = + { kind: namespace; name:string; root_name:string; location:Location.t} let explanations = ref M.empty - let explain namespace n id = + let collect_explanation namespace n id = let name = human_unique n id in + let root_name = Ident.name id in if not (M.mem name !explanations) then match Namespace.location namespace id with | None -> () | Some location -> - explanations := - M.add name { kind = namespace; location; name } !explanations + let explanation = { kind = namespace; location; name; root_name } in + explanations := M.add name explanation !explanations let pp_explanation ppf r= Format.fprintf ppf "@[%a:@,Definition of %s %s@]" Location.print_loc r.location (Namespace.show r.kind) r.name - let pp ppf l = + let print_located_explanations ppf l = Format.fprintf ppf "@[%a@]" (Format.pp_print_list pp_explanation) l let reset () = explanations := M.empty - let take () = + let list_explanations () = let c = !explanations in reset (); c |> M.bindings |> List.map snd |> List.sort Stdlib.compare - let print ppf = - let sep ppf = Format.fprintf ppf "@ " in - let l = - List.filter (* remove toplevel locations, since they are too imprecise *) - ( fun a -> - a.location.Location.loc_start.Lexing.pos_fname <> "//toplevel//" ) - (take ()) in - match l with + + let print_toplevel_hint ppf l = + let conj ppf () = Format.fprintf ppf " and@ " in + let pp_namespace_plural ppf n = Format.fprintf ppf "%as" Namespace.pp n in + let root_names = List.map (fun r -> r.kind, r.root_name) l in + let unique_root_names = List.sort_uniq Stdlib.compare root_names in + let submsgs = Array.make Namespace.size [] in + let () = List.iter (fun (n,_ as x) -> + submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n) + ) unique_root_names in + let pp_submsg ppf names = + match names with + | [] -> () + | [namespace, a] -> + Format.fprintf ppf + "@ \ + @[<2>Hint: The %a %s has been defined multiple times@ \ + in@ this@ toplevel@ session.@ \ + Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\ + @ Did you try to redefine them?@]" + Namespace.pp namespace a Namespace.pp namespace + | (namespace, _) :: _ :: _ -> + Format.fprintf ppf + "@ \ + @[<2>Hint: The %a %a have been defined multiple times@ \ + in@ this@ toplevel@ session.@ \ + Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\ + @ Did you try to redefine them?@]" + pp_namespace_plural namespace + Format.(pp_print_list ~pp_sep:conj pp_print_string) (List.map snd names) + pp_namespace_plural namespace in + Array.iter (pp_submsg ppf) submsgs + + let print_explanations ppf = + let ltop, l = + (* isolate toplevel locations, since they are too imprecise *) + let from_toplevel a = + a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in + List.partition from_toplevel (list_explanations ()) + in + begin match l with | [] -> () - | l -> Format.fprintf ppf "%t%a" sep pp l + | l -> Format.fprintf ppf "@ %a" print_located_explanations l + end; + (* if there are name collisions in a toplevel session, + display at least one generic hint by namespace *) + print_toplevel_hint ppf ltop let exists () = M.cardinal !explanations >0 end @@ -216,7 +257,7 @@ let pervasives_name namespace name = | Uniquely_associated_to (id',r) -> let hid, map = add_hid_id id' Ident.Map.empty in Out_name.set r (human_unique hid id'); - Conflicts.explain namespace hid id'; + Conflicts.collect_explanation namespace hid id'; set namespace @@ M.add name (Need_unique_name map) (get namespace); Out_name.create (pervasives name) | exception Not_found -> @@ -241,14 +282,14 @@ let ident_name_simple namespace id = r | Need_unique_name map -> let hid, m = find_hid id map in - Conflicts.explain namespace hid id; + Conflicts.collect_explanation namespace hid id; set namespace @@ M.add name (Need_unique_name m) (get namespace); Out_name.create (human_unique hid id) | Uniquely_associated_to (id',r) -> let hid', m = find_hid id' Ident.Map.empty in let hid, m = find_hid id m in Out_name.set r (human_unique hid' id'); - List.iter (fun (id,hid) -> Conflicts.explain namespace hid id) + List.iter (fun (id,hid) -> Conflicts.collect_explanation namespace hid id) [id, hid; id', hid' ]; set namespace @@ M.add name (Need_unique_name m) (get namespace); Out_name.create (human_unique hid id) @@ -289,8 +330,9 @@ let ident_stdlib = Ident.create_persistent "Stdlib" let non_shadowed_pervasive = function | Pdot(Pident id, s) as path -> Ident.same id ident_stdlib && - (try Path.same path (Env.lookup_type (Lident s) !printing_env) - with Not_found -> true) + (match Env.find_type_by_name (Lident s) !printing_env with + | (path', _) -> Path.same path path' + | exception Not_found -> true) | _ -> false let find_double_underscore s = @@ -333,12 +375,12 @@ let rec rewrite_double_underscore_paths env p = String.capitalize_ascii (String.sub name (i + 2) (String.length name - i - 2))) in - match Env.lookup_module ~load:true better_lid env with + match Env.find_module_by_name better_lid env with | exception Not_found -> p - | p' -> - if module_path_is_an_alias_of env p' ~alias_of:p then - p' - else + | p', _ -> + if module_path_is_an_alias_of env p' ~alias_of:p then + p' + else p let rewrite_double_underscore_paths env p = @@ -352,6 +394,10 @@ let rec tree_of_path namespace = function Oide_ident (ident_name namespace id) | Pdot(_, s) as path when non_shadowed_pervasive path -> Oide_ident (Naming_context.pervasives_name namespace s) + | Pdot(Pident t, s) + when namespace=Type && not (Path.is_uident (Ident.name t)) -> + (* [t.A]: inline record of the constructor [A] from type [t] *) + Oide_dot (Oide_ident (ident_name Type t), s) | Pdot(p, s) -> Oide_dot (tree_of_path Module p, s) | Papply(p1, p2) -> @@ -371,6 +417,8 @@ let strings_of_paths namespace p = let trees = List.map (tree_of_path namespace) p in List.map (Format.asprintf "%a" !Oprint.out_ident) trees +let () = Env.print_path := path + (* Print a recursive annotation *) let tree_of_rec = function @@ -472,14 +520,14 @@ and raw_type_desc ppf = function raw_type_list tl | Tvariant row -> fprintf ppf - "@[{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%B;@ @[<1>%s%t@]}@]" + "@[{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]" "row_fields=" (raw_list (fun ppf (l, f) -> fprintf ppf "@[%s,@ %a@]" l raw_field f)) row.row_fields "row_more=" raw_type row.row_more "row_closed=" row.row_closed - "row_fixed=" row.row_fixed + "row_fixed=" raw_row_fixed row.row_fixed "row_name=" (fun ppf -> match row.row_name with None -> fprintf ppf "None" @@ -488,6 +536,12 @@ and raw_type_desc ppf = function | Tpackage (p, _, tl) -> fprintf ppf "@[Tpackage(@,%a@,%a)@]" path p raw_type_list tl +and raw_row_fixed ppf = function +| None -> fprintf ppf "None" +| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private" +| Some Types.Rigid -> fprintf ppf "Some Rigid" +| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t +| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p and raw_field ppf = function Rpresent None -> fprintf ppf "Rpresent None" @@ -629,6 +683,14 @@ let wrap_printing_env ~error env f = if error then Env.without_cmis (wrap_printing_env env) f else wrap_printing_env env f +let rec lid_of_path = function + Path.Pident id -> + Longident.Lident (Ident.name id) + | Path.Pdot (p1, s) -> + Longident.Ldot (lid_of_path p1, s) + | Path.Papply (p1, p2) -> + Longident.Lapply (lid_of_path p1, lid_of_path p2) + let is_unambiguous path env = let l = Env.find_shadowed_types path env in List.exists (Path.same path) l || (* concrete paths are ok *) @@ -642,7 +704,7 @@ let is_unambiguous path env = (* also allow repeatedly defining and opening (for toplevel) *) let id = lid_of_path p in List.for_all (fun p -> lid_of_path p = id) rem && - Path.same p (Env.lookup_type id env) + Path.same p (fst (Env.find_type_by_name id env)) let rec get_best_path r = match !r with @@ -1039,7 +1101,13 @@ and tree_of_typfields sch rest = function let typexp sch ppf ty = !Oprint.out_type ppf (tree_of_typexp sch ty) -let type_expr ppf ty = typexp false ppf ty +let marked_type_expr ppf ty = typexp false ppf ty + +let type_expr ppf ty = + (* [type_expr] is used directly by error message printers, + we mark eventual loops ourself to avoid any misuse and stack overflow *) + reset_and_mark_loops ty; + marked_type_expr ppf ty and type_sch ppf ty = typexp true ppf ty @@ -1123,7 +1191,7 @@ let rec tree_of_type_decl id decl = List.iter (fun c -> mark_loops_constructor_arguments c.cd_args; - may mark_loops c.cd_res) + Option.iter mark_loops c.cd_res) cstrs | Type_record(l, _rep) -> List.iter (fun l -> mark_loops l.ld_type) l @@ -1183,15 +1251,12 @@ let rec tree_of_type_decl id decl = | Type_open -> tree_of_manifest Otyp_open, decl.type_private - in - let immediate = - Builtin_attributes.immediate decl.type_attributes in { otype_name = name; otype_params = args; otype_type = ty; otype_private = priv; - otype_immediate = immediate; + otype_immediate = Type_immediacy.of_attributes decl.type_attributes; otype_unboxed = decl.type_unboxed.unboxed; otype_cstrs = constraints } @@ -1215,6 +1280,14 @@ and tree_of_constructor cd = and tree_of_label l = (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type) +let constructor ppf c = + reset_except_context (); + !Oprint.out_constr ppf (tree_of_constructor c) + +let label ppf l = + reset_except_context (); + !Oprint.out_label ppf (tree_of_label l) + let tree_of_type_declaration id decl rs = Osig_type (tree_of_type_decl id decl, tree_of_rec rs) @@ -1227,6 +1300,17 @@ let constructor_arguments ppf a = (* Print an extension declaration *) +let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type = + match ext_ret_type with + | None -> (tree_of_constructor_arguments ext_args, None) + | Some res -> + let nm = !names in + names := []; + let ret = tree_of_typexp false res in + let args = tree_of_constructor_arguments ext_args in + names := nm; + (args, Some ret) + let tree_of_extension_constructor id ext es = reset_except_context (); let ty_name = Path.name ext.ext_type_path in @@ -1235,7 +1319,7 @@ let tree_of_extension_constructor id ext es = List.iter mark_loops ty_params; List.iter check_name_of_type (List.map proxy ty_params); mark_loops_constructor_arguments ext.ext_args; - may mark_loops ext.ext_ret_type; + Option.iter mark_loops ext.ext_ret_type; let type_param = function | Otyp_var (_, id) -> id @@ -1246,15 +1330,9 @@ let tree_of_extension_constructor id ext es = in let name = Ident.name id in let args, ret = - match ext.ext_ret_type with - | None -> (tree_of_constructor_arguments ext.ext_args, None) - | Some res -> - let nm = !names in - names := []; - let ret = tree_of_typexp false res in - let args = tree_of_constructor_arguments ext.ext_args in - names := nm; - (args, Some ret) + extension_constructor_args_and_ret_type_subtree + ext.ext_args + ext.ext_ret_type in let ext = { oext_name = name; @@ -1275,6 +1353,17 @@ let tree_of_extension_constructor id ext es = let extension_constructor id ppf ext = !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first) +let extension_only_constructor id ppf ext = + reset_except_context (); + let name = Ident.name id in + let args, ret = + extension_constructor_args_and_ret_type_subtree + ext.ext_args + ext.ext_ret_type + in + Format.fprintf ppf "@[%a@]" + !Oprint.out_constr (name, args, ret) + (* Print a value declaration *) let tree_of_value_description id decl = @@ -1488,7 +1577,7 @@ let dummy = type_is_newtype = false; type_expansion_scope = Btype.lowest_level; type_loc = Location.none; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } @@ -1543,15 +1632,22 @@ let rec tree_of_modtype ?(ellipsis=false) = function | Mty_signature sg -> Omty_signature (if ellipsis then [Osig_ellipsis] else tree_of_signature sg) - | Mty_functor(param, ty_arg, ty_res) -> - let res = - match ty_arg with None -> tree_of_modtype ~ellipsis ty_res - | Some mty -> - wrap_env (Env.add_module ~arg:true param Mp_present mty) - (tree_of_modtype ~ellipsis) ty_res + | Mty_functor(param, ty_res) -> + let param, res = + match param with + | Unit -> None, tree_of_modtype ~ellipsis ty_res + | Named (param, ty_arg) -> + let name, env = + match param with + | None -> None, fun env -> env + | Some id -> + Some (Ident.name id), + Env.add_module ~arg:true id Mp_present ty_arg + in + Some (name, tree_of_modtype ~ellipsis:false ty_arg), + wrap_env env (tree_of_modtype ~ellipsis) ty_res in - Omty_functor (Ident.name param, - may_map (tree_of_modtype ~ellipsis:false) ty_arg, res) + Omty_functor (param, res) | Mty_alias p -> Omty_alias (tree_of_path Module p) @@ -1658,7 +1754,7 @@ let printed_signature sourcefile ppf sg = if Warnings.(is_active @@ Erroneous_printed_signature "") && Conflicts.exists () then begin - let conflicts = Format.asprintf "%t" Conflicts.print in + let conflicts = Format.asprintf "%t" Conflicts.print_explanations in Location.prerr_warning (Location.in_file sourcefile) (Warnings.Erroneous_printed_signature conflicts); Warnings.check_fatal () @@ -1795,11 +1891,11 @@ let may_prepare_expansion compact (t, t') = mark_loops t; (t, t) | _ -> prepare_expansion (t, t') -let print_tags ppf fields = - match fields with [] -> () - | (t, _) :: fields -> - fprintf ppf "`%s" t; - List.iter (fun (t, _) -> fprintf ppf ",@ `%s" t) fields +let print_tag ppf = fprintf ppf "`%s" + +let print_tags = + let comma ppf () = Format.fprintf ppf ",@ " in + Format.pp_print_list ~pp_sep:comma print_tag let is_unit env ty = match (Ctype.expand_head env ty).desc with @@ -1835,6 +1931,24 @@ let print_pos ppf = function | Trace.First -> fprintf ppf "first" | Trace.Second -> fprintf ppf "second" +let explain_fixed_row_case ppf = function + | Trace.Cannot_be_closed -> Format.fprintf ppf "it cannot be closed" + | Trace.Cannot_add_tags tags -> + Format.fprintf ppf "it may not allow the tag(s) %a" + print_tags tags + +let explain_fixed_row pos expl = match expl with + | Types.Fixed_private -> + dprintf "The %a variant type is private" print_pos pos + | Types.Univar x -> + dprintf "The %a variant type is bound to the universal type variable %a" + print_pos pos type_expr x + | Types.Reified p -> + let p = tree_of_path Type p in + dprintf "The %a variant type is bound to %a" print_pos pos + !Oprint.out_ident p + | Types.Rigid -> ignore + let explain_variant = function | Trace.No_intersection -> Some(dprintf "@,These two variant types have no intersection") @@ -1842,10 +1956,19 @@ let explain_variant = function dprintf "@,@[The %a variant type does not allow tag(s)@ @[%a@]@]" print_pos pos - print_tags fields + print_tags (List.map fst fields) ) | Trace.Incompatible_types_for s -> Some(dprintf "@,Types for tag `%s are incompatible" s) + | Trace.Fixed_row (pos, k, (Univar _ | Reified _ | Fixed_private as e)) -> + Some ( + dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e) + explain_fixed_row_case k + ) + | Trace.Fixed_row (_,_, Rigid) -> + (* this case never happens *) + None + let explain_escape intro prev ctx e = let pre = match ctx with @@ -1899,9 +2022,9 @@ let explanation intro prev env = function | Trace.Variant v -> explain_variant v | Trace.Obj o -> explain_object o | Trace.Rec_occur(x,y) -> - mark_loops y; + reset_and_mark_loops y; Some(dprintf "@,@[The type variable %a occurs inside@ %a@]" - type_expr x type_expr y) + marked_type_expr x marked_type_expr y) let mismatch intro env trace = Trace.explain trace (fun ~prev h -> explanation intro prev env h) @@ -1968,7 +2091,7 @@ let unification_error env tr txt1 ppf txt2 ty_expect_explanation = (explain mis); if env <> Env.empty then warn_on_missing_defs env ppf head; - Conflicts.print ppf; + Conflicts.print_explanations ppf; print_labels := true with exn -> print_labels := true; @@ -2016,7 +2139,7 @@ let report_subtyping_error ppf env tr1 txt1 tr2 = fprintf ppf "%a%t%t@]" (trace false (mis = None) "is not compatible with type") tr2 (explain mis) - Conflicts.print + Conflicts.print_explanations ) diff --git a/typing/printtyp.mli b/typing/printtyp.mli index 77061d1a..1bd7fbdb 100644 --- a/typing/printtyp.mli +++ b/typing/printtyp.mli @@ -69,11 +69,22 @@ module Conflicts: sig type explanation = { kind: namespace; - name:string; location:Location.t} + name:string; + root_name:string; + location:Location.t + } + + val list_explanations: unit -> explanation list +(** [list_explanations()] return the list of conflict explanations + collected up to this point, and reset the list of collected + explanations *) + + val print_located_explanations: + Format.formatter -> explanation list -> unit + + val print_explanations: Format.formatter -> unit + (** Print all conflict explanations collected up to this point *) - val take: unit -> explanation list - val pp: Format.formatter -> explanation list -> unit - val print: Format.formatter -> unit val reset: unit -> unit end @@ -82,7 +93,18 @@ val reset: unit -> unit val mark_loops: type_expr -> unit val reset_and_mark_loops: type_expr -> unit val reset_and_mark_loops_list: type_expr list -> unit + val type_expr: formatter -> type_expr -> unit +val marked_type_expr: formatter -> type_expr -> unit +(** The function [type_expr] is the safe version of the pair + [(typed_expr, marked_type_expr)]: + it takes care of marking loops in the type expression and resetting + type variable names before printing. + Contrarily, the function [marked_type_expr] should only be called on + type expressions whose loops have been marked or it may stackoverflow + (see #8860 for examples). + *) + val constructor_arguments: formatter -> constructor_arguments -> unit val tree_of_type_scheme: type_expr -> out_type val type_sch : formatter -> type_expr -> unit @@ -94,6 +116,8 @@ val type_scheme_max: ?b_reset_names: bool -> (* End Maxence *) val tree_of_value_description: Ident.t -> value_description -> out_sig_item val value_description: Ident.t -> formatter -> value_description -> unit +val label : formatter -> label_declaration -> unit +val constructor : formatter -> constructor_declaration -> unit val tree_of_type_declaration: Ident.t -> type_declaration -> rec_status -> out_sig_item val type_declaration: Ident.t -> formatter -> type_declaration -> unit @@ -101,6 +125,16 @@ val tree_of_extension_constructor: Ident.t -> extension_constructor -> ext_status -> out_sig_item val extension_constructor: Ident.t -> formatter -> extension_constructor -> unit +(* Prints extension constructor with the type signature: + type ('a, 'b) bar += A of float +*) + +val extension_only_constructor: + Ident.t -> formatter -> extension_constructor -> unit +(* Prints only extension constructor without type signature: + A of float +*) + val tree_of_module: Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item val modtype: formatter -> module_type -> unit diff --git a/typing/printtyped.ml b/typing/printtyped.ml index 60eed58c..a637eaf8 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -43,6 +43,10 @@ let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.txt;; let fmt_ident = Ident.print +let fmt_modname f = function + | None -> fprintf f "_"; + | Some id -> Ident.print f id + let rec fmt_path_aux f x = match x with | Path.Pident (s) -> fprintf f "%a" fmt_ident s; @@ -389,7 +393,7 @@ and expression i ppf x = line i ppf "Texp_override\n"; list i string_x_expression ppf l; | Texp_letmodule (s, _, _, me, e) -> - line i ppf "Texp_letmodule \"%a\"\n" fmt_ident s; + line i ppf "Texp_letmodule \"%a\"\n" fmt_modname s; module_expr i ppf me; expression i ppf e; | Texp_letexception (cd, e) -> @@ -668,9 +672,12 @@ and module_type i ppf x = | Tmty_signature (s) -> line i ppf "Tmty_signature\n"; signature i ppf s; - | Tmty_functor (s, _, mt1, mt2) -> - line i ppf "Tmty_functor \"%a\"\n" fmt_ident s; - Misc.may (module_type i ppf) mt1; + | Tmty_functor (Unit, mt2) -> + line i ppf "Tmty_functor ()\n"; + module_type i ppf mt2; + | Tmty_functor (Named (s, _, mt1), mt2) -> + line i ppf "Tmty_functor \"%a\"\n" fmt_modname s; + module_type i ppf mt1; module_type i ppf mt2; | Tmty_with (mt, l) -> line i ppf "Tmty_with\n"; @@ -702,7 +709,7 @@ and signature_item i ppf x = line i ppf "Tsig_exception\n"; type_exception i ppf ext | Tsig_module md -> - line i ppf "Tsig_module \"%a\"\n" fmt_ident md.md_id; + line i ppf "Tsig_module \"%a\"\n" fmt_modname md.md_id; attributes i ppf md.md_attributes; module_type i ppf md.md_type | Tsig_modsubst ms -> @@ -735,12 +742,12 @@ and signature_item i ppf x = attribute i ppf "Tsig_attribute" a and module_declaration i ppf md = - line i ppf "%a" fmt_ident md.md_id; + line i ppf "%a" fmt_modname md.md_id; attributes i ppf md.md_attributes; module_type (i+1) ppf md.md_type; and module_binding i ppf x = - line i ppf "%a\n" fmt_ident x.mb_id; + line i ppf "%a\n" fmt_modname x.mb_id; attributes i ppf x.mb_attributes; module_expr (i+1) ppf x.mb_expr @@ -768,9 +775,12 @@ and module_expr i ppf x = | Tmod_structure (s) -> line i ppf "Tmod_structure\n"; structure i ppf s; - | Tmod_functor (s, _, mt, me) -> - line i ppf "Tmod_functor \"%a\"\n" fmt_ident s; - Misc.may (module_type i ppf) mt; + | Tmod_functor (Unit, me) -> + line i ppf "Tmod_functor ()\n"; + module_expr i ppf me; + | Tmod_functor (Named (s, _, mt), me) -> + line i ppf "Tmod_functor \"%a\"\n" fmt_modname s; + module_type i ppf mt; module_expr i ppf me; | Tmod_apply (me1, me2, _) -> line i ppf "Tmod_apply\n"; diff --git a/typing/rec_check.ml b/typing/rec_check.ml index e3ffec6c..5b224f94 100644 --- a/typing/rec_check.ml +++ b/typing/rec_check.ml @@ -854,7 +854,7 @@ and modexp : Typedtree.module_expr -> term_judg = path pth | Tmod_structure s -> structure s - | Tmod_functor (_, _, _, e) -> + | Tmod_functor (_, e) -> modexp e << Delay | Tmod_apply (f, p, _) -> join [ @@ -984,15 +984,21 @@ and structure_item : Typedtree.structure_item -> bind_judg = Env.join (modexp mexp m) (Env.remove_list included_ids env) (* G |- module M = E : m -| G *) -and module_binding : (Ident.t * Typedtree.module_expr) -> bind_judg = +and module_binding : (Ident.t option * Typedtree.module_expr) -> bind_judg = fun (id, mexp) m env -> (* GE |- E: m[mM + Guard] ------------------------------------- GE + G |- module M = E : m -| M:mM, G *) - let mM, env = Env.take id env in - let judg_E = modexp mexp << (Mode.join mM Guard) in + let judg_E, env = + match id with + | None -> modexp mexp << Guard, env + | Some id -> + let mM, env = Env.take id env in + let judg_E = modexp mexp << (Mode.join mM Guard) in + judg_E, env + in Env.join (judg_E m) env and open_declaration : Typedtree.open_declaration -> bind_judg = @@ -1002,12 +1008,18 @@ and open_declaration : Typedtree.open_declaration -> bind_judg = Env.join (judg_E m) (Env.remove_list bound_ids env) and recursive_module_bindings - : (Ident.t * Typedtree.module_expr) list -> bind_judg = + : (Ident.t option * Typedtree.module_expr) list -> bind_judg = fun m_bindings m env -> - let mids = List.map fst m_bindings in + let mids = List.filter_map fst m_bindings in let binding (mid, mexp) m = - let mM = Env.find mid env in - Env.remove_list mids (modexp mexp Mode.(compose m (join mM Guard))) + let judg_E = + match mid with + | None -> modexp mexp << Guard + | Some mid -> + let mM = Env.find mid env in + modexp mexp << (Mode.join mM Guard) + in + Env.remove_list mids (judg_E m) in Env.join (list binding m_bindings m) (Env.remove_list mids env) diff --git a/typing/subst.ml b/typing/subst.ml index 6a6ac7a9..5ae3d1b4 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -275,7 +275,7 @@ let constructor_declaration copy_scope s c = { cd_id = c.cd_id; cd_args = constructor_arguments copy_scope s c.cd_args; - cd_res = may_map (typexp copy_scope s) c.cd_res; + cd_res = Option.map (typexp copy_scope s) c.cd_res; cd_loc = loc s c.cd_loc; cd_attributes = attrs s c.cd_attributes; } @@ -380,7 +380,7 @@ let extension_constructor' copy_scope s ext = { ext_type_path = type_path s ext.ext_type_path; ext_type_params = List.map (typexp copy_scope s) ext.ext_type_params; ext_args = constructor_arguments copy_scope s ext.ext_args; - ext_ret_type = may_map (typexp copy_scope s) ext.ext_ret_type; + ext_ret_type = Option.map (typexp copy_scope s) ext.ext_ret_type; ext_private = ext.ext_private; ext_attributes = attrs s ext.ext_attributes; ext_loc = if s.for_saving then Location.none else ext.ext_loc; } @@ -458,10 +458,14 @@ let rec modtype scoping s = function end | Mty_signature sg -> Mty_signature(signature scoping s sg) - | Mty_functor(id, arg, res) -> + | Mty_functor(Unit, res) -> + Mty_functor(Unit, modtype scoping s res) + | Mty_functor(Named (None, arg), res) -> + Mty_functor(Named (None, (modtype scoping s) arg), modtype scoping s res) + | Mty_functor(Named (Some id, arg), res) -> let id' = Ident.rename id in - Mty_functor(id', may_map (modtype scoping s) arg, - modtype scoping (add_module id (Pident id') s) res) + Mty_functor(Named (Some id', (modtype scoping s) arg), + modtype scoping (add_module id (Pident id') s) res) | Mty_alias p -> Mty_alias (module_path s p) @@ -505,7 +509,7 @@ and module_declaration scoping s decl = and modtype_declaration scoping s decl = { - mtd_type = may_map (modtype scoping s) decl.mtd_type; + mtd_type = Option.map (modtype scoping s) decl.mtd_type; mtd_attributes = attrs s decl.mtd_attributes; mtd_loc = loc s decl.mtd_loc; } diff --git a/typing/tast_iterator.ml b/typing/tast_iterator.ml index 042e9cdc..a6a2e440 100644 --- a/typing/tast_iterator.ml +++ b/typing/tast_iterator.ml @@ -288,14 +288,18 @@ let signature_item sub {sig_desc; sig_env; _} = let class_description sub x = class_infos sub (sub.class_type sub) x +let functor_parameter sub = function + | Unit -> () + | Named (_, _, mtype) -> sub.module_type sub mtype + let module_type sub {mty_desc; mty_env; _} = sub.env sub mty_env; match mty_desc with | Tmty_ident _ -> () | Tmty_alias _ -> () | Tmty_signature sg -> sub.signature sub sg - | Tmty_functor (_, _, mtype1, mtype2) -> - Option.iter (sub.module_type sub) mtype1; + | Tmty_functor (arg, mtype2) -> + functor_parameter sub arg; sub.module_type sub mtype2 | Tmty_with (mtype, list) -> sub.module_type sub mtype; @@ -332,8 +336,8 @@ let module_expr sub {mod_desc; mod_env; _} = match mod_desc with | Tmod_ident _ -> () | Tmod_structure st -> sub.structure sub st - | Tmod_functor (_, _, mtype, mexpr) -> - Option.iter (sub.module_type sub) mtype; + | Tmod_functor (arg, mexpr) -> + functor_parameter sub arg; sub.module_expr sub mexpr | Tmod_apply (mexp1, mexp2, c) -> sub.module_expr sub mexp1; diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml index b4bd2ede..c288345e 100644 --- a/typing/tast_mapper.ml +++ b/typing/tast_mapper.ml @@ -73,8 +73,6 @@ type mapper = let id x = x let tuple2 f1 f2 (x, y) = (f1 x, f2 y) let tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) -let opt f = function None -> None | Some x -> Some (f x) - let structure sub {str_items; str_type; str_final_env} = { @@ -90,7 +88,7 @@ let class_infos sub f x = } let module_type_declaration sub x = - let mtd_type = opt (sub.module_type sub) x.mtd_type in + let mtd_type = Option.map (sub.module_type sub) x.mtd_type in {x with mtd_type} let module_declaration sub x = @@ -152,7 +150,7 @@ let constructor_args sub = function let constructor_decl sub cd = let cd_args = constructor_args sub cd.cd_args in - let cd_res = opt (sub.typ sub) cd.cd_res in + let cd_res = Option.map (sub.typ sub) cd.cd_res in {cd with cd_args; cd_res} let type_kind sub = function @@ -168,7 +166,7 @@ let type_declaration sub x = x.typ_cstrs in let typ_kind = sub.type_kind sub x.typ_kind in - let typ_manifest = opt (sub.typ sub) x.typ_manifest in + let typ_manifest = Option.map (sub.typ sub) x.typ_manifest in let typ_params = List.map (tuple2 (sub.typ sub) id) x.typ_params in {x with typ_cstrs; typ_kind; typ_manifest; typ_params} @@ -192,7 +190,7 @@ let extension_constructor sub x = let ext_kind = match x.ext_kind with Text_decl(ctl, cto) -> - Text_decl(constructor_args sub ctl, opt (sub.typ sub) cto) + Text_decl(constructor_args sub ctl, Option.map (sub.typ sub) cto) | Text_rebind _ as d -> d in {x with ext_kind} @@ -214,7 +212,8 @@ let pat sub x = | Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l) | Tpat_construct (loc, cd, l) -> Tpat_construct (loc, cd, List.map (sub.pat sub) l) - | Tpat_variant (l, po, rd) -> Tpat_variant (l, opt (sub.pat sub) po, rd) + | Tpat_variant (l, po, rd) -> + Tpat_variant (l, Option.map (sub.pat sub) po, rd) | Tpat_record (l, closed) -> Tpat_record (List.map (tuple3 id id (sub.pat sub)) l, closed) | Tpat_array l -> Tpat_array (List.map (sub.pat sub) l) @@ -231,9 +230,9 @@ let expr sub x = | Texp_constraint cty -> Texp_constraint (sub.typ sub cty) | Texp_coerce (cty1, cty2) -> - Texp_coerce (opt (sub.typ sub) cty1, sub.typ sub cty2) + Texp_coerce (Option.map (sub.typ sub) cty1, sub.typ sub cty2) | Texp_newtype _ as d -> d - | Texp_poly cto -> Texp_poly (opt (sub.typ sub) cto) + | Texp_poly cto -> Texp_poly (Option.map (sub.typ sub) cto) in let exp_extra = List.map (tuple3 extra id id) x.exp_extra in let exp_env = sub.env sub x.exp_env in @@ -250,7 +249,7 @@ let expr sub x = | Texp_apply (exp, list) -> Texp_apply ( sub.expr sub exp, - List.map (tuple2 id (opt (sub.expr sub))) list + List.map (tuple2 id (Option.map (sub.expr sub))) list ) | Texp_match (exp, cases, p) -> Texp_match ( @@ -268,7 +267,7 @@ let expr sub x = | Texp_construct (lid, cd, args) -> Texp_construct (lid, cd, List.map (sub.expr sub) args) | Texp_variant (l, expo) -> - Texp_variant (l, opt (sub.expr sub) expo) + Texp_variant (l, Option.map (sub.expr sub) expo) | Texp_record { fields; representation; extended_expression } -> let fields = Array.map (function | label, Kept t -> label, Kept t @@ -278,7 +277,7 @@ let expr sub x = in Texp_record { fields; representation; - extended_expression = opt (sub.expr sub) extended_expression; + extended_expression = Option.map (sub.expr sub) extended_expression; } | Texp_field (exp, lid, ld) -> Texp_field (sub.expr sub exp, lid, ld) @@ -295,7 +294,7 @@ let expr sub x = Texp_ifthenelse ( sub.expr sub exp1, sub.expr sub exp2, - opt (sub.expr sub) expo + Option.map (sub.expr sub) expo ) | Texp_sequence (exp1, exp2) -> Texp_sequence ( @@ -321,7 +320,7 @@ let expr sub x = ( sub.expr sub exp, meth, - opt (sub.expr sub) expo + Option.map (sub.expr sub) expo ) | Texp_new _ | Texp_instvar _ as d -> d @@ -427,6 +426,10 @@ let signature_item sub x = let class_description sub x = class_infos sub (sub.class_type sub) x +let functor_parameter sub = function + | Unit -> Unit + | Named (id, s, mtype) -> Named (id, s, sub.module_type sub mtype) + let module_type sub x = let mty_env = sub.env sub x.mty_env in let mty_desc = @@ -434,13 +437,8 @@ let module_type sub x = | Tmty_ident _ | Tmty_alias _ as d -> d | Tmty_signature sg -> Tmty_signature (sub.signature sub sg) - | Tmty_functor (id, s, mtype1, mtype2) -> - Tmty_functor ( - id, - s, - opt (sub.module_type sub) mtype1, - sub.module_type sub mtype2 - ) + | Tmty_functor (arg, mtype2) -> + Tmty_functor (functor_parameter sub arg, sub.module_type sub mtype2) | Tmty_with (mtype, list) -> Tmty_with ( sub.module_type sub mtype, @@ -485,13 +483,8 @@ let module_expr sub x = match x.mod_desc with | Tmod_ident _ as d -> d | Tmod_structure st -> Tmod_structure (sub.structure sub st) - | Tmod_functor (id, s, mtype, mexpr) -> - Tmod_functor ( - id, - s, - opt (sub.module_type sub) mtype, - sub.module_expr sub mexpr - ) + | Tmod_functor (arg, mexpr) -> + Tmod_functor (functor_parameter sub arg, sub.module_expr sub mexpr) | Tmod_apply (mexp1, mexp2, c) -> Tmod_apply ( sub.module_expr sub mexp1, @@ -528,7 +521,7 @@ let class_expr sub x = | Tcl_constraint (cl, clty, vals, meths, concrs) -> Tcl_constraint ( sub.class_expr sub cl, - opt (sub.class_type sub) clty, + Option.map (sub.class_type sub) clty, vals, meths, concrs @@ -546,7 +539,7 @@ let class_expr sub x = | Tcl_apply (cl, args) -> Tcl_apply ( sub.class_expr sub cl, - List.map (tuple2 id (opt (sub.expr sub))) args + List.map (tuple2 id (Option.map (sub.expr sub))) args ) | Tcl_let (rec_flag, value_bindings, ivars, cl) -> let (rec_flag, value_bindings) = @@ -691,7 +684,7 @@ let cases sub l = let case sub {c_lhs; c_guard; c_rhs} = { c_lhs = sub.pat sub c_lhs; - c_guard = opt (sub.expr sub) c_guard; + c_guard = Option.map (sub.expr sub) c_guard; c_rhs = sub.expr sub c_rhs; } diff --git a/typing/type_immediacy.ml b/typing/type_immediacy.ml new file mode 100644 index 00000000..557ed427 --- /dev/null +++ b/typing/type_immediacy.ml @@ -0,0 +1,43 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2019 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +type t = + | Unknown + | Always + | Always_on_64bits + +module Violation = struct + type t = + | Not_always_immediate + | Not_always_immediate_on_64bits +end + +let coerce t ~as_ = + match t, as_ with + | _, Unknown + | Always, Always + | (Always | Always_on_64bits), Always_on_64bits -> Ok () + | (Unknown | Always_on_64bits), Always -> + Error Violation.Not_always_immediate + | Unknown, Always_on_64bits -> + Error Violation.Not_always_immediate_on_64bits + +let of_attributes attrs = + match + Builtin_attributes.immediate attrs, + Builtin_attributes.immediate64 attrs + with + | true, _ -> Always + | false, true -> Always_on_64bits + | false, false -> Unknown diff --git a/typing/type_immediacy.mli b/typing/type_immediacy.mli new file mode 100644 index 00000000..3fc2e3b4 --- /dev/null +++ b/typing/type_immediacy.mli @@ -0,0 +1,40 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2019 Jane Street Group LLC *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Immediacy status of a type *) + +type t = + | Unknown + (** We don't know anything *) + | Always + (** We know for sure that values of this type are always immediate *) + | Always_on_64bits + (** We know for sure that values of this type are always immediate + on 64 bit platforms. For other platforms, we know nothing. *) + +module Violation : sig + type t = + | Not_always_immediate + | Not_always_immediate_on_64bits +end + +(** [coerce t ~as_] returns [Ok ()] iff [t] can be seen as type + immediacy [as_]. For instance, [Always] can be seen as + [Always_on_64bits] but the opposite is not true. Return [Error _] + if the coercion is not possible. *) +val coerce : t -> as_:t -> (unit, Violation.t) result + +(** Return the immediateness of a type as indicated by the user via + attributes *) +val of_attributes : Parsetree.attributes -> t diff --git a/typing/typeclass.ml b/typing/typeclass.ml index e384cf18..ce6b6812 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -47,6 +47,23 @@ type class_type_info = { clsty_info : Typedtree.class_type_declaration; } +type 'a full_class = { + id : Ident.t; + id_loc : tag loc; + clty: class_declaration; + ty_id: Ident.t; + cltydef: class_type_declaration; + obj_id: Ident.t; + obj_abbr: type_declaration; + cl_id: Ident.t; + cl_abbr: type_declaration; + arity: int; + pub_meths: string list; + coe: Warnings.loc list; + expr: 'a; + req: 'a Typedtree.class_infos; +} + type error = Unconsistent_constraint of Ctype.Unification_trace.t | Field_type_mismatch of string * string * Ctype.Unification_trace.t @@ -240,22 +257,15 @@ let rc node = (* Enter a value in the method environment only *) -let enter_met_env ?check loc lab kind ty val_env met_env par_env = - let (id, val_env) = - Env.enter_value lab - {val_type = ty; - val_kind = Val_unbound Val_unbound_instance_variable; - val_attributes = []; - Types.val_loc = loc} val_env +let enter_met_env ?check loc lab kind unbound_kind ty val_env met_env par_env = + let val_env = Env.enter_unbound_value lab unbound_kind val_env in + let par_env = Env.enter_unbound_value lab unbound_kind par_env in + let (id, met_env) = + Env.enter_value ?check lab + {val_type = ty; val_kind = kind; + val_attributes = []; Types.val_loc = loc} met_env in - (id, val_env, - Env.add_value ?check id {val_type = ty; val_kind = kind; - val_attributes = []; - Types.val_loc = loc} met_env, - Env.add_value id {val_type = ty; - val_kind = Val_unbound Val_unbound_instance_variable; - val_attributes = []; - Types.val_loc = loc} par_env) + (id, val_env, met_env, par_env) (* Enter an instance variable in the environment *) let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc = @@ -277,7 +287,7 @@ let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc = match id with Some id -> (id, val_env, met_env, par_env) | None -> enter_met_env Location.none lab (Val_ivar (mut, cl_num)) - ty val_env met_env par_env + Val_unbound_instance_variable ty val_env met_env par_env in vars := Vars.add lab (id, mut, virt, ty) !vars; result @@ -519,7 +529,7 @@ and class_type_aux env scty = in match scty.pcty_desc with Pcty_constr (lid, styl) -> - let (path, decl) = Typetexp.find_class_type env scty.pcty_loc lid.txt in + let (path, decl) = Env.lookup_cltype ~loc:scty.pcty_loc lid.txt env in if Path.same decl.clty_path unbound_class then raise(Error(scty.pcty_loc, env, Unbound_class_type_2 lid.txt)); let (params, clty) = @@ -624,8 +634,8 @@ and class_field_aux self_loc cl_num self_type meths vars | Some {txt=name} -> let (_id, val_env, met_env, par_env) = enter_met_env ~check:(fun s -> Warnings.Unused_ancestor s) - sparent.pcl_loc name (Val_anc (inh_meths, cl_num)) self_type - val_env met_env par_env + sparent.pcl_loc name (Val_anc (inh_meths, cl_num)) + Val_unbound_ancestor self_type val_env met_env par_env in (val_env, met_env, par_env,Some name) in @@ -824,8 +834,7 @@ and class_structure cl_num final val_env met_env loc (* Check that the binder has a correct type *) let ty = - if final then Ctype.newty (Tobject (Ctype.newvar(), ref None)) - else self_type in + if final then Ctype.newobj (Ctype.newvar()) else self_type in begin try Ctype.unify val_env public_self ty with Ctype.Unify _ -> raise(Error(spat.ppat_loc, val_env, Pattern_type_clash public_self)) @@ -855,7 +864,7 @@ and class_structure cl_num final val_env met_env loc str ) in - Ctype.unify val_env self_type (Ctype.newvar ()); + Ctype.unify val_env self_type (Ctype.newvar ()); (* useless ? *) let sign = {csig_self = public_self; csig_vars = Vars.map (fun (_id, mut, vr, ty) -> (mut, vr, ty)) !vars; @@ -865,6 +874,11 @@ and class_structure cl_num final val_env met_env loc let priv_meths = List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind <> Fpresent) methods in + (* ensure that inherited methods are listed too *) + List.iter (fun (met, _kind, _ty) -> + if Meths.mem met !meths then () else + ignore (Ctype.filter_self_method val_env met Private meths self_type)) + methods; if final then begin (* Unify private_self and a copy of self_type. self_type will not be modified after this point *) @@ -927,7 +941,7 @@ and class_expr cl_num val_env met_env scl = and class_expr_aux cl_num val_env met_env scl = match scl.pcl_desc with Pcl_constr (lid, styl) -> - let (path, decl) = Typetexp.find_class val_env scl.pcl_loc lid.txt in + let (path, decl) = Env.lookup_class ~loc:scl.pcl_loc lid.txt val_env in if Path.same decl.cty_path unbound_class then raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt)); let tyl = List.map @@ -1119,14 +1133,14 @@ and class_expr_aux cl_num val_env met_env scl = let ty' = extract_option_type val_env ty and ty0' = extract_option_type val_env ty0 in let arg = type_argument val_env sarg0 ty' ty0' in - Some (option_some arg) + Some (option_some val_env arg) with Not_found -> sargs, more_sargs, if Btype.is_optional l && (List.mem_assoc Nolabel sargs || List.mem_assoc Nolabel more_sargs) then - Some (option_none ty0 Location.none) + Some (option_none val_env ty0 Location.none) else None in let omitted = if arg = None then (l,ty0) :: omitted else omitted in @@ -1190,7 +1204,7 @@ and class_expr_aux cl_num val_env met_env scl = ((id', expr) :: vals, Env.add_value id' desc met_env)) - (let_bound_idents_with_loc defs) + (let_bound_idents_full defs) ([], met_env) in let cl = class_expr cl_num val_env met_env scl' in @@ -1294,7 +1308,7 @@ let temp_abbrev loc env id arity = type_expansion_scope = Btype.lowest_level; type_loc = loc; type_attributes = []; (* or keep attrs from the class decl? *) - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } env @@ -1544,7 +1558,7 @@ let class_infos define_class kind type_expansion_scope = Btype.lowest_level; type_loc = cl.pci_loc; type_attributes = []; (* or keep attrs from cl? *) - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } in @@ -1564,7 +1578,7 @@ let class_infos define_class kind type_expansion_scope = Btype.lowest_level; type_loc = cl.pci_loc; type_attributes = []; (* or keep attrs from cl? *) - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } in @@ -1598,11 +1612,11 @@ let final_decl env define_class List.iter Ctype.generalize clty.cty_params; generalize_class_type true clty.cty_type; - Misc.may Ctype.generalize clty.cty_new; + Option.iter Ctype.generalize clty.cty_new; List.iter Ctype.generalize obj_abbr.type_params; - Misc.may Ctype.generalize obj_abbr.type_manifest; + Option.iter Ctype.generalize obj_abbr.type_manifest; List.iter Ctype.generalize cl_abbr.type_params; - Misc.may Ctype.generalize cl_abbr.type_manifest; + Option.iter Ctype.generalize cl_abbr.type_manifest; if not (closed_class clty) then raise(Error(cl.pci_loc, env, Non_generalizable_class (id, clty))); @@ -1620,23 +1634,24 @@ let final_decl env define_class in raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason))) end; - - (id, cl.pci_name, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, - arity, pub_meths, coe, expr, - { ci_loc = cl.pci_loc; - ci_virt = cl.pci_virt; - ci_params = ci_params; -(* TODO : check that we have the correct use of identifiers *) - ci_id_name = cl.pci_name; - ci_id_class = id; - ci_id_class_type = ty_id; - ci_id_object = obj_id; - ci_id_typehash = cl_id; - ci_expr = expr; - ci_decl = clty; - ci_type_decl = cltydef; - ci_attributes = cl.pci_attributes; - }) + { id; clty; ty_id; cltydef; obj_id; obj_abbr; cl_id; cl_abbr; arity; + pub_meths; coe; expr; + id_loc = cl.pci_name; + req = { ci_loc = cl.pci_loc; + ci_virt = cl.pci_virt; + ci_params = ci_params; + (* TODO : check that we have the correct use of identifiers *) + ci_id_name = cl.pci_name; + ci_id_class = id; + ci_id_class_type = ty_id; + ci_id_object = obj_id; + ci_id_typehash = cl_id; + ci_expr = expr; + ci_decl = clty; + ci_type_decl = cltydef; + ci_attributes = cl.pci_attributes; + } + } (* (cl.pci_variance, cl.pci_loc)) *) let class_infos define_class kind @@ -1655,20 +1670,14 @@ let class_infos define_class kind (res, env) ) -let extract_type_decls - (_id, _id_loc, clty, _ty_id, cltydef, obj_id, obj_abbr, _cl_id, cl_abbr, - _arity, _pub_meths, _coe, _expr, required) decls = - (obj_id, obj_abbr, cl_abbr, clty, cltydef, required) :: decls +let extract_type_decls { clty; cltydef; obj_id; obj_abbr; cl_abbr; req} decls = + (obj_id, obj_abbr, cl_abbr, clty, cltydef, req) :: decls -let merge_type_decls - (id, id_loc, _clty, ty_id, _cltydef, obj_id, _obj_abbr, cl_id, _cl_abbr, - arity, pub_meths, coe, expr, req) (obj_abbr, cl_abbr, clty, cltydef) = - (id, id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, - arity, pub_meths, coe, expr, req) +let merge_type_decls decl (obj_abbr, cl_abbr, clty, cltydef) = + {decl with obj_abbr; cl_abbr; clty; cltydef} -let final_env define_class env - (id, _id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, - _arity, _pub_meths, _coe, _expr, _req) = +let final_env define_class env { id; clty; ty_id; cltydef; obj_id; obj_abbr; + cl_id; cl_abbr } = (* Add definitions after cleaning them *) Env.add_type ~check:true obj_id (Subst.type_declaration Subst.identity obj_abbr) ( @@ -1680,10 +1689,9 @@ let final_env define_class env else env))) (* Check that #c is coercible to c if there is a self-coercion *) -let check_coercions env - (id, id_loc, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, - arity, pub_meths, coercion_locs, _expr, req) = - begin match coercion_locs with [] -> () +let check_coercions env { id; id_loc; clty; ty_id; cltydef; obj_id; obj_abbr; + cl_id; cl_abbr; arity; pub_meths; coe; req } = + begin match coe with [] -> () | loc :: _ -> let cl_ty, obj_ty = match cl_abbr.type_manifest, obj_abbr.type_manifest with @@ -1880,7 +1888,6 @@ let report_error env ppf = function | Pattern_type_clash ty -> (* XXX Trace *) (* XXX Revoir message d'erreur | Improve error message *) - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[%s@ %a@]" "This pattern cannot match self: it only matches values of type" Printtyp.type_expr ty diff --git a/typing/typecore.ml b/typing/typecore.ml index 64d99ee1..9ff5ed42 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -76,7 +76,7 @@ type error = | Private_label of Longident.t * type_expr | Private_constructor of constructor_description * type_expr | Unbound_instance_variable of string * string list - | Instance_variable_not_mutable of bool * string + | Instance_variable_not_mutable of string | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t | Outside_class | Value_multiply_overridden of string @@ -85,7 +85,6 @@ type error = | Too_many_arguments of bool * type_expr * type_forcing_context option | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option | Scoping_let_module of string * type_expr - | Masked_instance_variable of Longident.t | Not_a_variant_type of Longident.t | Incoherent_label_order | Less_general of string * Ctype.Unification_trace.t @@ -176,119 +175,6 @@ let mk_expected ?explanation ty = { ty; explanation; } let case lhs rhs = {c_lhs = lhs; c_guard = None; c_rhs = rhs} -(* Upper approximation of free identifiers on the parse tree *) - -let iter_expression f e = - - let rec expr e = - f e; - match e.pexp_desc with - | Pexp_extension _ (* we don't iterate under extension point *) - | Pexp_ident _ - | Pexp_new _ - | Pexp_constant _ -> () - | Pexp_function pel -> List.iter case pel - | Pexp_fun (_, eo, _, e) -> may expr eo; expr e - | Pexp_apply (e, lel) -> expr e; List.iter (fun (_, e) -> expr e) lel - | Pexp_let (_, pel, e) -> expr e; List.iter binding pel - | Pexp_match (e, pel) - | Pexp_try (e, pel) -> expr e; List.iter case pel - | Pexp_array el - | Pexp_tuple el -> List.iter expr el - | Pexp_construct (_, eo) - | Pexp_variant (_, eo) -> may expr eo - | Pexp_record (iel, eo) -> - may expr eo; List.iter (fun (_, e) -> expr e) iel - | Pexp_open (_, e) - | Pexp_newtype (_, e) - | Pexp_poly (e, _) - | Pexp_lazy e - | Pexp_assert e - | Pexp_setinstvar (_, e) - | Pexp_send (e, _) - | Pexp_constraint (e, _) - | Pexp_coerce (e, _, _) - | Pexp_letexception (_, e) - | Pexp_field (e, _) -> expr e - | Pexp_while (e1, e2) - | Pexp_sequence (e1, e2) - | Pexp_setfield (e1, _, e2) -> expr e1; expr e2 - | Pexp_ifthenelse (e1, e2, eo) -> expr e1; expr e2; may expr eo - | Pexp_for (_, e1, e2, _, e3) -> expr e1; expr e2; expr e3 - | Pexp_override sel -> List.iter (fun (_, e) -> expr e) sel - | Pexp_letmodule (_, me, e) -> expr e; module_expr me - | Pexp_object { pcstr_fields = fs } -> List.iter class_field fs - | Pexp_letop { let_; ands; body; _ } -> - binding_op let_; List.iter binding_op ands; expr body - | Pexp_pack me -> module_expr me - | Pexp_unreachable -> () - - and case {pc_lhs = _; pc_guard; pc_rhs} = - may expr pc_guard; - expr pc_rhs - - and binding_op { pbop_exp; _ } = - expr pbop_exp - - and binding x = - expr x.pvb_expr - - and module_expr me = - match me.pmod_desc with - | Pmod_extension _ - | Pmod_ident _ -> () - | Pmod_structure str -> List.iter structure_item str - | Pmod_constraint (me, _) - | Pmod_functor (_, _, me) -> module_expr me - | Pmod_apply (me1, me2) -> module_expr me1; module_expr me2 - | Pmod_unpack e -> expr e - - - and structure_item str = - match str.pstr_desc with - | Pstr_eval (e, _) -> expr e - | Pstr_value (_, pel) -> List.iter binding pel - | Pstr_primitive _ - | Pstr_type _ - | Pstr_typext _ - | Pstr_exception _ - | Pstr_modtype _ - | Pstr_open _ - | Pstr_class_type _ - | Pstr_attribute _ - | Pstr_extension _ -> () - | Pstr_include {pincl_mod = me} - | Pstr_module {pmb_expr = me} -> module_expr me - | Pstr_recmodule l -> List.iter (fun x -> module_expr x.pmb_expr) l - | Pstr_class cdl -> List.iter (fun c -> class_expr c.pci_expr) cdl - - and class_expr ce = - match ce.pcl_desc with - | Pcl_constr _ -> () - | Pcl_structure { pcstr_fields = fs } -> List.iter class_field fs - | Pcl_fun (_, eo, _, ce) -> may expr eo; class_expr ce - | Pcl_apply (ce, lel) -> - class_expr ce; List.iter (fun (_, e) -> expr e) lel - | Pcl_let (_, pel, ce) -> - List.iter binding pel; class_expr ce - | Pcl_open (_, ce) - | Pcl_constraint (ce, _) -> class_expr ce - | Pcl_extension _ -> () - - and class_field cf = - match cf.pcf_desc with - | Pcf_inherit (_, ce, _) -> class_expr ce - | Pcf_val (_, _, Cfk_virtual _) - | Pcf_method (_, _, Cfk_virtual _ ) | Pcf_constraint _ -> () - | Pcf_val (_, _, Cfk_concrete (_, e)) - | Pcf_method (_, _, Cfk_concrete (_, e)) -> expr e - | Pcf_initializer e -> expr e - | Pcf_attribute _ | Pcf_extension _ -> () - - in - expr e - - (* Typing of constants *) let type_constant = function @@ -341,15 +227,14 @@ let type_option ty = let mkexp exp_desc exp_type exp_loc exp_env = { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] } -let option_none ty loc = - let lid = Longident.Lident "None" - and env = Env.initial_safe_string in - let cnone = Env.lookup_constructor lid env in +let option_none env ty loc = + let lid = Longident.Lident "None" in + let cnone = Env.find_ident_constructor Predef.ident_none env in mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env -let option_some texp = +let option_some env texp = let lid = Longident.Lident "Some" in - let csome = Env.lookup_constructor lid Env.initial_safe_string in + let csome = Env.find_ident_constructor Predef.ident_some env in mkexp ( Texp_construct(mknoloc lid , csome, [texp]) ) (type_option texp.exp_type) texp.exp_loc texp.exp_env @@ -378,16 +263,6 @@ let extract_label_names env ty = (* Typing of patterns *) -(* unification inside type_pat*) -let unify_pat_types loc env ty ty' = - try - unify env ty ty' - with - Unify trace -> - raise(Error(loc, env, Pattern_type_clash(trace, None))) - | Tags(l1,l2) -> - raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2))) - (* unification inside type_exp and type_expect *) let unify_exp_types loc env ty expected_ty = (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type @@ -407,21 +282,25 @@ let get_gadt_equations_level () = Some y -> y | None -> assert false -let unify_pat_types_gadt loc env ty ty' = - try unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty' +(* unification inside type_pat*) +let unify_pat_types ?(refine=false) loc env ty ty' = + try + if refine then + unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty' + else + unify !env ty ty' with | Unify trace -> raise(Error(loc, !env, Pattern_type_clash(trace, None))) | Tags(l1,l2) -> raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2))) -(* Creating new conjunctive types is not allowed when typing patterns *) - -let unify_pat env pat expected_ty = - try unify_pat_types pat.pat_loc env pat.pat_type expected_ty +let unify_pat ?refine env pat expected_ty = + try unify_pat_types ?refine pat.pat_loc env pat.pat_type expected_ty with Error (loc, env, Pattern_type_clash(trace, None)) -> raise(Error(loc, env, Pattern_type_clash(trace, Some pat.pat_desc))) +(* Creating new conjunctive types is not allowed when typing patterns *) (* make all Reither present in open variants *) let finalize_variant pat = match pat.pat_desc with @@ -438,7 +317,9 @@ let finalize_variant pat = | Reither (false, ty::tl, _, e) when not row.row_closed -> set_row_field e (Rpresent (Some ty)); begin match opat with None -> assert false - | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl) + | Some pat -> + let env = ref pat.pat_env in + List.iter (unify_pat env pat) (ty::tl) end | Reither (c, _l, true, e) when not (row_fixed row) -> set_row_field e (Reither (c, [], false, ref None)) @@ -450,18 +331,10 @@ let finalize_variant pat = row_bound=(); row_fixed=false; row_name=None})); *) | _ -> () -let rec iter_pattern f p = - f p; - iter_pattern_desc (iter_pattern f) p.pat_desc - let has_variants p = - try - iter_pattern (function {pat_desc=Tpat_variant _} -> raise Exit | _ -> ()) - p; - false - with Exit -> - true - + exists_pattern + (function {pat_desc=Tpat_variant _} -> true | _ -> false) + p (* pattern environment *) type pattern_variable = @@ -491,17 +364,13 @@ let reset_pattern scope allow = let maybe_add_pattern_variables_ghost loc_let env pv = List.fold_right - (fun {pv_id; pv_type; _} env -> - let lid = Longident.Lident (Ident.name pv_id) in - match Env.lookup_value ~mark:false lid env with - | _ -> env - | exception Not_found -> - Env.add_value pv_id - { val_type = pv_type; - val_kind = Val_unbound Val_unbound_ghost_recursive; - val_loc = loc_let; - val_attributes = []; - } env + (fun {pv_id; _} env -> + let name = Ident.name pv_id in + if Env.bound_value name env then env + else begin + Env.enter_unbound_value name + (Val_unbound_ghost_recursive loc_let) env + end ) pv env let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty @@ -521,10 +390,12 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty if not !allow_modules then raise (Error (loc, Env.empty, Modules_not_allowed)); module_variables := (name, loc) :: !module_variables - end else + end else begin (* moved to genannot *) - may (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s))) - !pattern_scope; + Option.iter + (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s))) + !pattern_scope + end; id let sort_pattern_variables vs = @@ -582,10 +453,10 @@ let rec build_as_type env p = (List.combine pl tyl) ty_args; ty_res | Tpat_variant(l, p', _) -> - let ty = may_map (build_as_type env) p' in + let ty = Option.map (build_as_type env) p' in newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar(); row_bound=(); row_name=None; - row_fixed=false; row_closed=false}) + row_fixed=None; row_closed=false}) | Tpat_record (lpl,_) -> let lbl = snd3 (List.hd lpl) in if lbl.lbl_private = Private then p.pat_type else @@ -602,7 +473,7 @@ let rec build_as_type env p = unify_pat env {arg with pat_type = build_as_type env arg} ty_arg end else begin let _, ty_arg', ty_res' = instance_label false lbl in - unify env ty_arg ty_arg'; + unify !env ty_arg ty_arg'; unify_pat env p ty_res' end in Array.iter do_label lbl.lbl_all; @@ -621,8 +492,7 @@ let rec build_as_type env p = | Tpat_array _ | Tpat_lazy _ | Tpat_exception _ -> p.pat_type let build_or_pat env loc lid = - let path, decl = Typetexp.find_type env lid.loc lid.txt - in + let path, decl = Env.lookup_type ~loc:lid.loc lid.txt env in let tyl = List.map (fun _ -> newvar()) decl.type_params in let row0 = let ty = expand_head env (newty(Tconstr(path, tyl, ref Mnil))) in @@ -646,7 +516,7 @@ let build_or_pat env loc lid = ([],[]) (row_repr row0).row_fields in let row = { row_fields = List.rev fields; row_more = newvar(); row_bound = (); - row_closed = false; row_fixed = false; row_name = Some (path, tyl) } + row_closed = false; row_fixed = None; row_name = Some (path, tyl) } in let ty = newty (Tvariant row) in let gloc = {loc with Location.loc_ghost=true} in @@ -710,11 +580,12 @@ let label_of_kind kind = module NameChoice(Name : sig type t + type usage val type_kind: string val get_name: t -> string val get_type: t -> type_expr - val get_descrs: Env.type_descriptions -> t list - val unbound_name_error: Env.t -> Longident.t loc -> 'a + val lookup_all_from_type: + Location.t -> usage -> Path.t -> Env.t -> (t * (unit -> unit)) list val in_env: t -> bool end) = struct open Name @@ -724,18 +595,21 @@ end) = struct | Tconstr(p, _, _) -> p | _ -> assert false - let lookup_from_type env tpath lid = - let descrs = get_descrs (Env.find_type_descrs tpath env) in - Env.mark_type_used (Path.last tpath) (Env.find_type tpath env); + let lookup_from_type env tpath usage lid = + let descrs = lookup_all_from_type lid.loc usage tpath env in match lid.txt with - Longident.Lident s -> begin - try - List.find (fun nd -> get_name nd = s) descrs - with Not_found -> - let names = List.map get_name descrs in - raise (Error (lid.loc, env, - Wrong_name ("", mk_expected (newvar ()), - type_kind, tpath, s, names))) + | Longident.Lident s -> begin + match + List.find (fun (nd, _) -> get_name nd = s) descrs + with + | descr, use -> + use (); + descr + | exception Not_found -> + let names = List.map (fun (nd, _) -> get_name nd) descrs in + raise (Error (lid.loc, env, + Wrong_name ("", mk_expected (newvar ()), + type_kind, tpath, s, names))) end | _ -> raise Not_found @@ -757,23 +631,30 @@ end) = struct reset(); strings_of_paths Type tpaths) let disambiguate_by_type env tpath lbls = - let check_type (lbl, _) = - let lbl_tpath = get_type_path lbl in - compare_type_path env tpath lbl_tpath - in - List.find check_type lbls + match lbls with + | (Error _ : _ result) -> raise Not_found + | Ok lbls -> + let check_type (lbl, _) = + let lbl_tpath = get_type_path lbl in + compare_type_path env tpath lbl_tpath + in + List.find check_type lbls - let disambiguate ?(warn=Location.prerr_warning) ?scope lid env opath lbls = + let disambiguate ?(warn=Location.prerr_warning) ?scope + usage lid env opath lbls = let scope = match scope with None -> lbls | Some l -> l in let lbl = match opath with None -> begin match lbls with - [] -> unbound_name_error env lid - | (lbl, use) :: rest -> + | (Error(loc', env', err) : _ result) -> + Env.lookup_error loc' env' err + | Ok [] -> assert false + | Ok((lbl, use) :: rest) -> use (); Printtyp.Conflicts.reset (); let paths = ambiguous_types env lbl rest in - let expansion = Format.asprintf "%t" Printtyp.Conflicts.print in + let expansion = + Format.asprintf "%t" Printtyp.Conflicts.print_explanations in if paths <> [] then warn lid.loc (Warnings.Ambiguous_name ([Longident.last lid.txt], @@ -793,15 +674,16 @@ end) = struct if not pr then begin (* Check if non-principal type is affecting result *) match lbls with - [] -> warn_pr () - | (lbl', _use') :: rest -> + | (Error _ : _ result) | Ok [] -> warn_pr () + | Ok ((lbl', _use') :: rest) -> let lbl_tpath = get_type_path lbl' in if not (compare_type_path env tpath lbl_tpath) then warn_pr () else Printtyp.Conflicts.reset (); let paths = ambiguous_types env lbl rest in let expansion = - Format.asprintf "%t" Printtyp.Conflicts.print in + Format.asprintf "%t" + Printtyp.Conflicts.print_explanations in if paths <> [] then warn lid.loc (Warnings.Ambiguous_name ([Longident.last lid.txt], @@ -809,7 +691,7 @@ end) = struct end; lbl with Not_found -> try - let lbl = lookup_from_type env tpath lid in + let lbl = lookup_from_type env tpath usage lid in if in_env lbl then begin let s = @@ -821,22 +703,25 @@ end) = struct if not pr then warn_pr (); lbl with Not_found -> - if lbls = [] then unbound_name_error env lid else - let tp = (tpath0, expand_path env tpath) in - let tpl = - List.map - (fun (lbl, _) -> - let tp0 = get_type_path lbl in - let tp = expand_path env tp0 in - (tp0, tp)) - lbls - in - raise (Error (lid.loc, env, - Name_type_mismatch (type_kind, lid.txt, tp, tpl))) + match lbls with + | (Error(loc', env', err) : _ result) -> + Env.lookup_error loc' env' err + | Ok lbls -> + let tp = (tpath0, expand_path env tpath) in + let tpl = + List.map + (fun (lbl, _) -> + let tp0 = get_type_path lbl in + let tp = expand_path env tp0 in + (tp0, tp)) + lbls + in + raise (Error (lid.loc, env, + Name_type_mismatch (type_kind, lid.txt, tp, tpl))) in if in_env lbl then begin match scope with - (lab1,_)::_ when lab1 == lbl -> () + | Ok ((lab1,_)::_) when lab1 == lbl -> () | _ -> Location.prerr_warning lid.loc (Warnings.Disambiguated_name(get_name lbl)) @@ -850,11 +735,12 @@ let wrap_disambiguate kind ty f x = module Label = NameChoice (struct type t = label_description + type usage = unit let type_kind = "record" let get_name lbl = lbl.lbl_name let get_type lbl = lbl.lbl_res - let get_descrs = snd - let unbound_name_error = Typetexp.unbound_label_error + let lookup_all_from_type loc () path env = + Env.lookup_all_labels_from_type ~loc path env let in_env lbl = match lbl.lbl_repres with | Record_regular | Record_float | Record_unboxed false -> true @@ -899,16 +785,21 @@ let disambiguate_lid_a_list loc closed env opath lid_a_list = there is still at least one candidate (for error message) * if the reduced list is valid, call Label.disambiguate *) - let scope = Typetexp.find_all_labels env lid.loc lid.txt in - if opath = None && scope = [] then - Typetexp.unbound_label_error env lid; - let (ok, labels) = - match opath with - Some (_, _, true) -> (true, scope) (* disambiguate only checks scope *) - | _ -> disambiguate_label_by_ids (opath=None) closed ids scope - in - if ok then Label.disambiguate lid env opath labels ~warn ~scope - else fst (List.hd labels) (* will fail later *) + let scope = Env.lookup_all_labels ~loc:lid.loc lid.txt env in + match opath, scope with + | None, Error(loc, env, err) -> + Env.lookup_error loc env err + | Some _, Error _ -> + Label.disambiguate () lid env opath scope ~warn ~scope + | _, Ok lbls -> + let (ok, lbls) = + match opath with + | Some (_, _, true) -> + (true, lbls) (* disambiguate only checks scope *) + | _ -> disambiguate_label_by_ids (opath=None) closed ids lbls + in + if ok then Label.disambiguate () lid env opath (Ok lbls) ~warn ~scope + else fst (List.hd lbls) (* will fail later *) in let lbl_a_list = List.map (fun (lid,a) -> lid, process_label lid, a) lid_a_list in @@ -1010,50 +901,29 @@ let check_recordpat_labels loc lbl_pat_list closed = module Constructor = NameChoice (struct type t = constructor_description + type usage = Env.constructor_usage let type_kind = "variant" let get_name cstr = cstr.cstr_name let get_type cstr = cstr.cstr_res - let get_descrs = fst - let unbound_name_error = Typetexp.unbound_constructor_error + let lookup_all_from_type loc usage path env = + Env.lookup_all_constructors_from_type ~loc usage path env let in_env _ = true end) (* unification of a type with a tconstr with freshly created arguments *) -let unify_head_only loc env ty constr = +let unify_head_only ~refine loc env ty constr = let (_, ty_res) = instance_constructor constr in - match (repr ty_res).desc with + let ty_res = repr ty_res in + match ty_res.desc with | Tconstr(p,args,m) -> ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m); - enforce_constraints env ty_res; - unify_pat_types loc env ty_res ty + enforce_constraints !env ty_res; + unify_pat_types ~refine loc env ty_res ty | _ -> assert false (* Typing of patterns *) -(* Remember current state for backtracking. - No variable information, as we only backtrack on - patterns without variables (cf. assert statements). *) -type state = - { snapshot: Btype.snapshot; - levels: Ctype.levels; - env: Env.t; } -let save_state env = - { snapshot = Btype.snapshot (); - levels = Ctype.save_levels (); - env = !env; } -let set_state s env = - Btype.backtrack s.snapshot; - Ctype.set_levels s.levels; - env := s.env - -(* type_pat does not generate local constraints inside or patterns *) -type type_pat_mode = - | Normal - | Splitting_or (* splitting an or-pattern *) - | Inside_or (* inside a non-split or-pattern *) - | Split_or (* always split or-patterns *) - (* "half typed" cases are produced in [type_cases] when we've just typechecked the pattern but haven't type-checked the body yet. At this point we might have added some type equalities to the environment, @@ -1067,26 +937,6 @@ type half_typed_case = unpacks: module_variable list; contains_gadt: bool; } -let all_idents_cases half_typed_cases = - let idents = Hashtbl.create 8 in - let f = function - | {pexp_desc=Pexp_ident { txt = Longident.Lident id; _ }; _} -> - Hashtbl.replace idents id () - | {pexp_desc=Pexp_letop{ let_; ands; _ }; _ } -> - Hashtbl.replace idents let_.pbop_op.txt (); - List.iter - (fun { pbop_op; _ } -> Hashtbl.replace idents pbop_op.txt ()) - ands - | _ -> () - in - List.iter - (fun { untyped_case = cp; _ } -> - may (iter_expression f) cp.pc_guard; - iter_expression f cp.pc_rhs - ) - half_typed_cases; - Hashtbl.fold (fun x () rest -> x :: rest) idents [] - let rec has_literal_pattern p = match p.ppat_desc with | Ppat_constant _ | Ppat_interval _ -> @@ -1115,41 +965,208 @@ let rec has_literal_pattern p = match p.ppat_desc with | Ppat_or (p, q) -> has_literal_pattern p || has_literal_pattern q -exception Need_backtrack - let check_scope_escape loc env level ty = try Ctype.check_scope_escape env level ty with Unify trace -> raise(Error(loc, env, Pattern_type_clash(trace, None))) -(* type_pat propagates the expected type as well as maps for - constructors and labels. - Unification may update the typing environment. *) -(* constrs <> None => called from parmatch: backtrack on or-patterns - explode > 0 => explode Ppat_any for gadts *) -let rec type_pat ?(exception_allowed=false) ~constrs ~labels ~no_existentials - ~mode ~explode ~env sp expected_ty k = +type pattern_checking_mode = + | Normal + (** We are checking user code. *) + | Counter_example of counter_example_checking_info + (** In [Counter_example] mode, we are checking a counter-example + candidate produced by Parmatch. This is a syntactic pattern that + represents a set of values by using or-patterns (p_1 | ... | p_n) + to enumerate all alternatives in the counter-example + search. These or-patterns occur at every choice point, possibly + deep inside the pattern. + + Parmatch does not use type information, so this pattern may + exhibit two issues: + - some parts of the pattern may be ill-typed due to GADTs, and + - some wildcard patterns may not match any values: their type is + empty. + + The aim of [type_pat] in the [Counter_example] mode is to refine + this syntactic pattern into a well-typed pattern, and ensure + that it matches at least one concrete value. + - It filters ill-typed branches of or-patterns. + (see {!splitting_mode} below) + - It tries to check that wildcard patterns are non-empty. + (see {!explosion_fuel}) + *) + +and counter_example_checking_info = { + explosion_fuel: int; + splitting_mode: splitting_mode; + constrs: (string, Types.constructor_description) Hashtbl.t; + labels: (string, Types.label_description) Hashtbl.t; + } +(** + [explosion_fuel] controls the checking of wildcard patterns. We + eliminate potentially-empty wildcard patterns by exploding them + into concrete sub-patterns, for example (K1 _ | K2 _) or + { l1: _; l2: _ }. [explosion_fuel] is the depth limit on wildcard + explosion. Such depth limit is required to avoid non-termination + and compilation-time blowups. + + [splitting_mode] controls the handling of or-patterns. In + [Counter_example] mode, we only need to select one branch that + leads to a well-typed pattern. Checking all branches is expensive, + we use different search strategies (see {!splitting_mode}) to + reduce the number of explored alternatives. + + [constrs] and [labels] contain metadata produced by [Parmatch] to + type-check the given syntactic pattern. [Parmatch] produces + counter-examples by turning typed patterns into + [Parsetree.pattern]. In this process, constructor and label paths + are lost, and are replaced by generated strings. [constrs] and + [labels] map those synthetic names back to the typed descriptions + of the original names. + *) + +(** Due to GADT constraints, an or-pattern produced within + a counter-example may have ill-typed branches. Consider for example + + type _ tag = Int : int tag | Bool : bool tag + + then [Parmatch] will propose the or-pattern [Int | Bool] whenever + a pattern of type [tag] is required to form a counter-example. For + example, a function expects a (int tag option) and only [None] is + handled by the user-written pattern. [Some (Int | Bool)] is not + well-typed in this context, only the sub-pattern [Some Int] is. + In this example, the expected type coming from the context + suffices to know which or-pattern branch must be chosen. + + In the general case, choosing a branch can have non-local effects + on the typability of the term. For example, consider a tuple type + ['a tag * ...'a...], where the first component is a GADT. All + constructor choices for this GADT lead to a well-typed branch in + isolation (['a] is unconstrained), but choosing one of them adds + a constraint on ['a] that may make the other tuple elements + ill-typed. + + In general, after choosing each possible branch of the or-pattern, + [type_pat] has to check the rest of the pattern to tell if this + choice leads to a well-typed term. This may lead to an explosion + of typing/search work -- the rest of the term may in turn contain + alternatives. + + We use careful strategies to try to limit counterexample-checking + time; [splitting_mode] represents those strategies. +*) +and splitting_mode = + | Backtrack_or + (** Always backtrack in or-patterns. + + [Backtrack_or] selects a single alternative from an or-pattern + by using backtracking, trying to choose each branch in turn, and + to complete it into a valid sub-pattern. We call this + "splitting" the or-pattern. + + We use this mode when looking for unused patterns or sub-patterns, + in particular to check a refutation clause (p -> .). + *) + | Refine_or of { inside_nonsplit_or: bool; } + (** Only backtrack when needed. + + [Refine_or] tries another approach for refining or-pattern. + + Instead of always splitting each or-pattern, It first attempts to + find branches that do not introduce new constraints (because they + do not contain GADT constructors). Those branches are such that, + if they fail, all other branches will fail. + + If we find one such branch, we attempt to complete the subpattern + (checking what's outside the or-pattern), ignoring other + branches -- we never consider another branch choice again. If all + branches are constrained, it falls back to splitting the + or-pattern. + + We use this mode when checking exhaustivity of pattern matching. + *) + +(** This exception is only used internally within [type_pat_aux], to jump + back to the parent or-pattern in the [Refine_or] strategy. + + Such a parent exists precisely when [inside_nonsplit_or = true]; + it's an invariant that we always setup an exception handler for + [Need_backtrack] when we set this flag. *) + exception Need_backtrack + +(** Remember current typing state for backtracking. + No variable information, as we only backtrack on + patterns without variables (cf. assert statements). *) +type state = + { snapshot: Btype.snapshot; + levels: Ctype.levels; + env: Env.t; } +let save_state env = + { snapshot = Btype.snapshot (); + levels = Ctype.save_levels (); + env = !env; } +let set_state s env = + Btype.backtrack s.snapshot; + Ctype.set_levels s.levels; + env := s.env + +(** Find the first alternative in the tree of or-patterns for which + [f] does not raise an error. If all fail, the last error is + propagated *) +let rec find_valid_alternative f pat = + match pat.ppat_desc with + | Ppat_or(p1,p2) -> + (try find_valid_alternative f p1 + with Error _ -> find_valid_alternative f p2) + | _ -> f pat + +let no_explosion = function + | Normal -> Normal + | Counter_example info -> + Counter_example { info with explosion_fuel = 0 } + +let get_splitting_mode = function + | Normal -> None + | Counter_example {splitting_mode} -> Some splitting_mode + +let enter_nonsplit_or mode = match mode with + | Normal -> Normal + | Counter_example info -> + let splitting_mode = match info.splitting_mode with + | Backtrack_or -> + (* in Backtrack_or mode, or-patterns are always split *) + assert false + | Refine_or _ -> + Refine_or {inside_nonsplit_or = true} + in Counter_example { info with splitting_mode } + +let rec type_pat ?(exception_allowed=false) ~no_existentials ~mode + ~env sp expected_ty k = Builtin_attributes.warning_scope sp.ppat_attributes (fun () -> - type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode - ~explode ~env sp expected_ty k + type_pat_aux ~exception_allowed ~no_existentials ~mode + ~env sp expected_ty k ) -and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode - ~explode ~env sp expected_ty k = - let mode' = if mode = Splitting_or then Normal else mode in - let type_pat ?(exception_allowed=false) ?(constrs=constrs) ?(labels=labels) - ?(mode=mode') ?(explode=explode) ?(env=env) = - type_pat ~exception_allowed ~constrs ~labels ~no_existentials ~mode ~explode - ~env +and type_pat_aux ~exception_allowed ~no_existentials ~mode + ~env sp expected_ty k = + let type_pat ?(exception_allowed=false) ?(mode=mode) ?(env=env) = + type_pat ~exception_allowed ~no_existentials ~mode ~env in let loc = sp.ppat_loc in + let refine = match mode with Normal -> false | Counter_example _ -> true in let rup k x = - if constrs = None then (ignore (rp x)); - unify_pat !env x (instance expected_ty); + if mode = Normal then (ignore (rp x)); + unify_pat ~refine env x (instance expected_ty); k x in - let rp k x : pattern = if constrs = None then k (rp x) else k x in + let rp k x : pattern = if mode = Normal then k (rp x) else k x in + let construction_not_used_in_counterexamples = (mode = Normal) in + let must_backtrack_on_gadt = match get_splitting_mode mode with + | None -> false + | Some Backtrack_or -> false + | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or + in match sp.ppat_desc with Ppat_any -> let k' d = rp k { @@ -1159,22 +1176,27 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode pat_attributes = sp.ppat_attributes; pat_env = !env } in - if explode > 0 then - let (sp, constrs, labels) = - try - Parmatch.ppat_of_type !env expected_ty - with Parmatch.Empty -> raise (Error (loc, !env, Empty_pattern)) - in - if sp.ppat_desc = Parsetree.Ppat_any then k' Tpat_any else - if mode = Inside_or then raise Need_backtrack else - let explode = - match sp.ppat_desc with - Parsetree.Ppat_or _ -> explode - 5 - | _ -> explode - 1 - in - type_pat ~constrs:(Some constrs) ~labels:(Some labels) - ~explode sp expected_ty k - else k' Tpat_any + begin match mode with + | Normal -> k' Tpat_any + | Counter_example {explosion_fuel; _} when explosion_fuel <= 0 -> + k' Tpat_any + | Counter_example ({explosion_fuel; _} as info) -> + begin match Parmatch.ppat_of_type !env expected_ty with + | exception Parmatch.Empty -> raise (Error (loc, !env, Empty_pattern)) + | (sp, constrs, labels) -> + if sp.ppat_desc = Parsetree.Ppat_any then k' Tpat_any else + if must_backtrack_on_gadt then raise Need_backtrack else + let explosion_fuel = + match sp.ppat_desc with + Parsetree.Ppat_or _ -> explosion_fuel - 5 + | _ -> explosion_fuel - 1 + in + let mode = + Counter_example { info with explosion_fuel; constrs; labels } + in + type_pat ~mode sp expected_ty k + end + end | Ppat_var name -> let ty = instance expected_ty in let id = (* PR#7330 *) @@ -1190,24 +1212,36 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode pat_attributes = sp.ppat_attributes; pat_env = !env } | Ppat_unpack name -> - assert (constrs = None); + assert construction_not_used_in_counterexamples; let t = instance expected_ty in - let id = enter_variable loc name t ~is_module:true sp.ppat_attributes in - rp k { - pat_desc = Tpat_var (id, name); - pat_loc = sp.ppat_loc; - pat_extra=[Tpat_unpack, loc, sp.ppat_attributes]; - pat_type = t; - pat_attributes = []; - pat_env = !env } + begin match name.txt with + | None -> + rp k { + pat_desc = Tpat_any; + pat_loc = sp.ppat_loc; + pat_extra=[Tpat_unpack, name.loc, sp.ppat_attributes]; + pat_type = t; + pat_attributes = []; + pat_env = !env } + | Some s -> + let v = { name with txt = s } in + let id = enter_variable loc v t ~is_module:true sp.ppat_attributes in + rp k { + pat_desc = Tpat_var (id, v); + pat_loc = sp.ppat_loc; + pat_extra=[Tpat_unpack, loc, sp.ppat_attributes]; + pat_type = t; + pat_attributes = []; + pat_env = !env } + end | Ppat_constraint( {ppat_desc=Ppat_var name; ppat_loc=lloc; ppat_attributes = attrs}, ({ptyp_desc=Ptyp_poly _} as sty)) -> (* explicitly polymorphic type *) - assert (constrs = None); + assert construction_not_used_in_counterexamples; let cty, force = Typetexp.transl_simple_type_delayed !env sty in let ty = cty.ctyp_type in - unify_pat_types lloc !env ty (instance expected_ty); + unify_pat_types ~refine lloc env ty (instance expected_ty); pattern_force := force :: !pattern_force; begin match ty.desc with | Tpoly (body, tyl) -> @@ -1227,10 +1261,10 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode | _ -> assert false end | Ppat_alias(sq, name) -> - assert (constrs = None); + assert construction_not_used_in_counterexamples; type_pat sq expected_ty (fun q -> begin_def (); - let ty_var = build_as_type !env q in + let ty_var = build_as_type env q in end_def (); generalize ty_var; let id = @@ -1262,7 +1296,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode in let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in let p = {p with ppat_loc=loc} in - type_pat ~explode:0 p expected_ty k + type_pat ~mode:(no_explosion mode) p expected_ty k (* TODO: record 'extra' to remember about interval *) | Ppat_interval _ -> raise (Error (loc, !env, Invalid_interval)) @@ -1274,7 +1308,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode let expected_ty = instance expected_ty in end_def (); generalize_structure expected_ty; - unify_pat_types loc !env ty expected_ty; + unify_pat_types ~refine loc env ty expected_ty; map_fold_cont (fun (p,t) -> type_pat p t) spl_ann (fun pl -> rp k { pat_desc = Tpat_tuple pl; @@ -1289,22 +1323,21 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode Some (p0, p, true) with Not_found -> None in - let candidates = - match lid.txt, constrs with - Longident.Lident s, Some constrs when Hashtbl.mem constrs s -> - [Hashtbl.find constrs s, (fun () -> ())] - | _ -> Typetexp.find_all_constructors !env lid.loc lid.txt - in let constr = + match lid.txt, mode with + | Longident.Lident s, Counter_example {constrs; _} -> + (* assert: cf. {!counter_example_checking_info} documentation *) + assert (Hashtbl.mem constrs s); + Hashtbl.find constrs s + | _ -> + let candidates = + Env.lookup_all_constructors Env.Pattern ~loc:lid.loc lid.txt !env in wrap_disambiguate "This variant pattern is expected to have" (mk_expected expected_ty) - (Constructor.disambiguate lid !env opath) candidates + (Constructor.disambiguate Env.Pattern lid !env opath) candidates in - if constr.cstr_generalized && constrs <> None && mode = Inside_or - then raise Need_backtrack; - Env.mark_constructor Env.Pattern !env (Longident.last lid.txt) constr; - Builtin_attributes.check_alerts loc constr.cstr_attributes - constr.cstr_name; + if constr.cstr_generalized && must_backtrack_on_gadt then + raise Need_backtrack; begin match no_existentials, constr.cstr_existentials with | None, _ | _, [] -> () | Some r, (_ :: _ as exs) -> @@ -1315,7 +1348,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode (* if constructor is gadt, we must verify that the expected type has the correct head *) if constr.cstr_generalized then - unify_head_only loc !env (instance expected_ty) constr; + unify_head_only ~refine loc env (instance expected_ty) constr; let sargs = match sarg with None -> [] @@ -1345,9 +1378,8 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode in let expected_ty = instance expected_ty in (* PR#7214: do not use gadt unification for toplevel lets *) - if not constr.cstr_generalized || no_existentials <> None - then unify_pat_types loc !env ty_res expected_ty - else unify_pat_types_gadt loc env ty_res expected_ty; + unify_pat_types loc env ty_res expected_ty + ~refine:(refine || constr.cstr_generalized && no_existentials = None); end_def (); generalize_structure expected_ty; generalize_structure ty_res; @@ -1382,7 +1414,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode row_bound = (); row_closed = false; row_more = newgenvar (); - row_fixed = false; + row_fixed = None; row_name = None } in begin_def (); let expected_ty = instance expected_ty in @@ -1390,8 +1422,9 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode generalize_structure expected_ty; (* PR#7404: allow some_private_tag blindly, as it would not unify with the abstract row variable *) - if l = Parmatch.some_private_tag then assert (constrs <> None) - else unify_pat_types loc !env (newgenty (Tvariant row)) expected_ty; + if l = Parmatch.some_private_tag + then assert (match mode with Normal -> false | Counter_example _ -> true) + else unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty; let k arg = rp k { pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()}); @@ -1421,7 +1454,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode begin_def (); let (_, ty_arg, ty_res) = instance_label false label in begin try - unify_pat_types loc !env ty_res (instance record_ty) + unify_pat_types ~refine loc env ty_res (instance record_ty) with Error(_loc, _env, Pattern_type_clash(trace, _)) -> raise(Error(label_lid.loc, !env, Label_mismatch(label_lid.txt, trace))) @@ -1441,23 +1474,25 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode pat_attributes = sp.ppat_attributes; pat_env = !env } in - if constrs = None then - k (wrap_disambiguate "This record pattern is expected to have" - (mk_expected expected_ty) - (type_label_a_list ?labels loc false !env type_label_pat opath - lid_sp_list) - (k' (fun x -> x))) - else - type_label_a_list ?labels loc false !env type_label_pat opath - lid_sp_list (k' k) + begin match mode with + | Normal -> + k (wrap_disambiguate "This record pattern is expected to have" + (mk_expected expected_ty) + (type_label_a_list loc false !env type_label_pat opath + lid_sp_list) + (k' (fun x -> x))) + | Counter_example {labels; _} -> + type_label_a_list ~labels loc false !env type_label_pat opath + lid_sp_list (k' k) + end | Ppat_array spl -> let ty_elt = newgenvar() in begin_def (); let expected_ty = instance expected_ty in end_def (); generalize_structure expected_ty; - unify_pat_types - loc !env (Predef.type_array ty_elt) expected_ty; + unify_pat_types ~refine + loc env (Predef.type_array ty_elt) expected_ty; map_fold_cont (fun p -> type_pat p ty_elt) spl (fun pl -> rp k { pat_desc = Tpat_array pl; @@ -1466,9 +1501,17 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode pat_attributes = sp.ppat_attributes; pat_env = !env }) | Ppat_or(sp1, sp2) -> + let may_split, must_split = + match get_splitting_mode mode with + | None -> false, false + | Some Backtrack_or -> true, true + | Some (Refine_or _) -> true, false in let state = save_state env in - begin match - if mode = Split_or || mode = Splitting_or then raise Need_backtrack; + let split_or sp = + assert may_split; + let typ pat = type_pat ~exception_allowed pat expected_ty k in + find_valid_alternative (fun pat -> set_state state env; typ pat) sp in + if must_split then split_or sp else begin let initial_pattern_variables = !pattern_variables in let initial_module_variables = !module_variables in let equation_level = !gadt_equations_level in @@ -1478,9 +1521,10 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode let lev = get_current_level () in gadt_equations_level := Some lev; let env1 = ref !env in + let inside_or = enter_nonsplit_or mode in let p1 = - try Some (type_pat ~exception_allowed ~mode:Inside_or sp1 expected_ty - ~env:env1 (fun x -> x)) + try Some (type_pat ~exception_allowed ~mode:inside_or + sp1 expected_ty ~env:env1 (fun x -> x)) with Need_backtrack -> None in let p1_variables = !pattern_variables in let p1_module_variables = !module_variables in @@ -1488,8 +1532,8 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode module_variables := initial_module_variables; let env2 = ref !env in let p2 = - try Some (type_pat ~exception_allowed ~mode:Inside_or sp2 expected_ty - ~env:env2 (fun x -> x)) + try Some (type_pat ~exception_allowed ~mode:inside_or + sp2 expected_ty ~env:env2 (fun x -> x)) with Need_backtrack -> None in end_def (); gadt_equations_level := equation_level; @@ -1502,36 +1546,34 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode List.iter (fun { pv_type; pv_loc; _ } -> check_scope_escape pv_loc !env2 outter_lev pv_type ) p2_variables; - match p1, p2 with - None, None -> raise Need_backtrack - | Some p, None | None, Some p -> p (* no variables in this case *) + begin match p1, p2 with + | None, None -> + let inside_nonsplit_or = + match get_splitting_mode mode with + | None | Some Backtrack_or -> false + | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or in + if inside_nonsplit_or + then raise Need_backtrack + else split_or sp + | Some p, None | None, Some p -> rp k p (* no variables in this case *) | Some p1, Some p2 -> let alpha_env = enter_orpat_variables loc !env p1_variables p2_variables in pattern_variables := p1_variables; module_variables := p1_module_variables; - { pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None); - pat_loc = loc; pat_extra=[]; - pat_type = instance expected_ty; - pat_attributes = sp.ppat_attributes; - pat_env = !env } - with - p -> rp k p - | exception Need_backtrack when mode <> Inside_or -> - assert (constrs <> None); - set_state state env; - let mode = - if mode = Split_or then mode else Splitting_or in - try type_pat ~exception_allowed ~mode sp1 expected_ty k - with Error _ -> - set_state state env; - type_pat ~exception_allowed ~mode sp2 expected_ty k + rp k { pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None); + pat_loc = loc; + pat_extra=[]; + pat_type = instance expected_ty; + pat_attributes = sp.ppat_attributes; + pat_env = !env } + end end | Ppat_lazy sp1 -> let nv = newgenvar () in - unify_pat_types loc !env (Predef.type_lazy_t nv) expected_ty; + unify_pat_types ~refine loc env (Predef.type_lazy_t nv) expected_ty; (* do not explode under lazy: PR#7421 *) - type_pat ~explode:0 sp1 nv (fun p1 -> + type_pat ~mode:(no_explosion mode) sp1 nv (fun p1 -> rp k { pat_desc = Tpat_lazy p1; pat_loc = loc; pat_extra=[]; @@ -1546,7 +1588,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode end_def(); generalize_structure ty; let ty, expected_ty' = instance ty, ty in - unify_pat_types loc !env ty (instance expected_ty); + unify_pat_types ~refine loc env ty (instance expected_ty); type_pat ~exception_allowed sp expected_ty' (fun p -> (*Format.printf "%a@.%a@." Printtyp.raw_type_expr ty @@ -1566,7 +1608,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode in k p) | Ppat_type lid -> let (path, p,ty) = build_or_pat !env loc lid in - unify_pat_types loc !env ty (instance expected_ty); + unify_pat_types ~refine loc env ty (instance expected_ty); k { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra } | Ppat_open (lid,p) -> @@ -1582,7 +1624,7 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode if not exception_allowed then raise (Error (loc, !env, Exception_pattern_disallowed)) else begin - let p_exn = type_pat p Predef.type_exn k in + type_pat p Predef.type_exn (fun p_exn -> rp k { pat_desc = Tpat_exception p_exn; pat_loc = sp.ppat_loc; @@ -1590,17 +1632,17 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode pat_type = expected_ty; pat_env = !env; pat_attributes = sp.ppat_attributes; - } + }) end | Ppat_extension ext -> raise (Error_forward (Builtin_attributes.error_of_extension ext)) -let type_pat ?exception_allowed ?no_existentials ?constrs ?labels ?(mode=Normal) - ?(explode=0) ?(lev=get_current_level()) env sp expected_ty = +let type_pat ?exception_allowed ?no_existentials ?(mode=Normal) + ?(lev=get_current_level()) env sp expected_ty = Misc.protect_refs [Misc.R (gadt_equations_level, Some lev)] (fun () -> let r = - type_pat ?exception_allowed ~no_existentials ~constrs ~labels ~mode - ~explode ~env sp expected_ty (fun x -> x) + type_pat ?exception_allowed ~no_existentials ~mode + ~env sp expected_ty (fun x -> x) in iter_pattern (fun p -> p.pat_env <- !env) r; r @@ -1608,15 +1650,20 @@ let type_pat ?exception_allowed ?no_existentials ?constrs ?labels ?(mode=Normal) (* this function is passed to Partial.parmatch to type check gadt nonexhaustiveness *) -let partial_pred ~lev ?mode ?explode env expected_ty constrs labels p = +let partial_pred ~lev ~splitting_mode ?(explode=0) + env expected_ty constrs labels p = let env = ref env in let state = save_state env in + let mode = + Counter_example { + splitting_mode; + explosion_fuel = explode; + constrs; labels; + } in try reset_pattern None true; let typed_p = - Ctype.with_passive_variants - (type_pat ~lev ~constrs ~labels ?mode ?explode env p) - expected_ty + Ctype.with_passive_variants (type_pat ~lev ~mode env p) expected_ty in set_state state env; (* types are invalidated but we don't need them here *) @@ -1627,14 +1674,15 @@ let partial_pred ~lev ?mode ?explode env expected_ty constrs labels p = let check_partial ?(lev=get_current_level ()) env expected_ty loc cases = let explode = match cases with [_] -> 5 | _ -> 0 in + let splitting_mode = Refine_or {inside_nonsplit_or = false} in Parmatch.check_partial - (partial_pred ~lev ~explode env expected_ty) loc cases + (partial_pred ~lev ~splitting_mode ~explode env expected_ty) loc cases let check_unused ?(lev=get_current_level ()) env expected_ty cases = Parmatch.check_unused (fun refute constrs labels spat -> match - partial_pred ~lev ~mode:Split_or ~explode:5 + partial_pred ~lev ~splitting_mode:Backtrack_or ~explode:5 env expected_ty constrs labels spat with Some pat when refute -> @@ -1688,7 +1736,7 @@ let type_class_arg_pattern cl_num val_env met_env l spat = iter_pattern finalize_variant pat end; List.iter (fun f -> f()) (get_ref pattern_force); - if is_optional l then unify_pat val_env pat (type_option (newvar ())); + if is_optional l then unify_pat (ref val_env) pat (type_option (newvar ())); let (pv, met_env) = List.fold_right (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} (pv, env) -> @@ -1726,12 +1774,8 @@ let type_self_pattern cl_num privty val_env met_env par_env spat = List.fold_right (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} (val_env, met_env, par_env) -> - (Env.add_value pv_id {val_type = pv_type; - val_kind = - Val_unbound Val_unbound_instance_variable; - val_attributes = pv_attributes; - Types.val_loc = pv_loc; - } val_env, + let name = Ident.name pv_id in + (Env.enter_unbound_value name Val_unbound_self val_env, Env.add_value pv_id {val_type = pv_type; val_kind = Val_self (meths, vars, cl_num, privty); @@ -1741,12 +1785,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat = ~check:(fun s -> if pv_as_var then Warnings.Unused_var s else Warnings.Unused_var_strict s) met_env, - Env.add_value pv_id {val_type = pv_type; - val_kind = - Val_unbound Val_unbound_instance_variable; - val_attributes = pv_attributes; - Types.val_loc = pv_loc; - } par_env)) + Env.enter_unbound_value name Val_unbound_self par_env)) pv (val_env, met_env, par_env) in (pat, meths, vars, val_env, met_env, par_env) @@ -1767,15 +1806,18 @@ let force_delayed_checks () = reset_delayed_checks (); Btype.backtrack snap -let rec final_subexpression sexp = - match sexp.pexp_desc with - Pexp_let (_, _, e) - | Pexp_sequence (_, e) - | Pexp_try (e, _) - | Pexp_ifthenelse (_, e, _) - | Pexp_match (_, {pc_rhs=e} :: _) +let rec final_subexpression exp = + match exp.exp_desc with + Texp_let (_, _, e) + | Texp_sequence (_, e) + | Texp_try (e, _) + | Texp_ifthenelse (_, e, _) + | Texp_match (_, {c_rhs=e} :: _, _) + | Texp_letmodule (_, _, _, _, e) + | Texp_letexception (_, e) + | Texp_open (_, e) -> final_subexpression e - | _ -> sexp + | _ -> exp (* Generalization criterion for expressions *) @@ -1946,13 +1988,11 @@ let rec approx_type env sty = | Ptyp_tuple args -> newty (Ttuple (List.map (approx_type env) args)) | Ptyp_constr (lid, ctl) -> - begin try - let path = Env.lookup_type lid.txt env in - let decl = Env.find_type path env in - if List.length ctl <> decl.type_arity then raise Not_found; + let path, decl = Env.lookup_type ~use:false ~loc:lid.loc lid.txt env in + if List.length ctl <> decl.type_arity then newvar () + else begin let tyl = List.map (approx_type env) ctl in newconstr path tyl - with Not_found -> newvar () end | Ptyp_poly (_, sty) -> approx_type env sty @@ -2020,7 +2060,7 @@ let check_univars env expans kind exp ty_expected vars = generalize t; match t.desc with Tvar name when t.level = generic_level -> - log_type t; t.desc <- Tunivar name; true + set_type_desc t (Tunivar name); true | _ -> false) vars in if List.length vars = List.length vars' then () else @@ -2125,9 +2165,9 @@ let create_package_type loc env (p, l) = let open Ast_helper in List.fold_left (fun sexp (name, loc) -> - Exp.letmodule ~loc:sexp.pexp_loc + Exp.letmodule ~loc:{ sexp.pexp_loc with loc_ghost = true } ~attrs:[Attr.mk (mknoloc "#modulepat") (PStr [])] - name + { name with txt = Some name.txt } (Mod.unpack ~loc (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt) name.loc))) @@ -2145,7 +2185,7 @@ let contains_variant_either ty = match ty.desc with Tvariant row -> let row = row_repr row in - if not row.row_fixed then + if not (is_fixed row) then List.iter (fun (_,f) -> match row_field_repr f with Reither _ -> raise Exit | _ -> ()) @@ -2158,36 +2198,42 @@ let contains_variant_either ty = try loop ty; unmark_type ty; false with Exit -> unmark_type ty; true -let iter_ppat f p = +let shallow_iter_ppat f p = match p.ppat_desc with | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _ | Ppat_extension _ | Ppat_type _ | Ppat_unpack _ -> () | Ppat_array pats -> List.iter f pats | Ppat_or (p1,p2) -> f p1; f p2 - | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg + | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> Option.iter f arg | Ppat_tuple lst -> List.iter f lst | Ppat_exception p | Ppat_alias (p,_) | Ppat_open (_,p) | Ppat_constraint (p,_) | Ppat_lazy p -> f p | Ppat_record (args, _flag) -> List.iter (fun (_,p) -> f p) args -let contains_polymorphic_variant p = +let exists_ppat f p = + let exception Found in let rec loop p = - match p.ppat_desc with - Ppat_variant _ | Ppat_type _ -> raise Exit - | _ -> iter_ppat loop p - in - try loop p; false with Exit -> true + if f p then raise Found else (); + shallow_iter_ppat loop p in + match loop p with + | exception Found -> true + | () -> false -let contains_gadt p = - let check p = - match p.pat_desc with - | Tpat_construct (_, cd, _) when cd.cstr_generalized -> - raise Exit - | _ -> () - in - try iter_pattern check p; false with Exit -> true +let contains_polymorphic_variant p = + exists_ppat + (function + | {ppat_desc = (Ppat_variant _ | Ppat_type _)} -> true + | _ -> false) + p + +let contains_gadt cp = + exists_pattern + (function + | {pat_desc = Tpat_construct (_, cd, _)} when cd.cstr_generalized -> true + | _ -> false) + cp (* There are various things that we need to do in presence of GADT constructors that aren't required if there are none. @@ -2195,12 +2241,11 @@ let contains_gadt p = patterns contain some GADT constructors. So we conservatively assume that any constructor might be a GADT constructor. *) let may_contain_gadts p = - let rec loop p = - match p.ppat_desc with - | Ppat_construct (_, _) -> raise Exit - | _ -> iter_ppat loop p - in - try loop p; false with Exit -> true + exists_ppat + (function + | {ppat_desc = Ppat_construct (_, _)} -> true + | _ -> false) + p let check_absent_variant env = iter_pattern @@ -2208,29 +2253,18 @@ let check_absent_variant env = let row = row_repr !row in if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent) row.row_fields - || not row.row_fixed && not (static_row row) (* same as Ctype.poly *) + || not (is_fixed row) && not (static_row row) (* same as Ctype.poly *) then () else let ty_arg = match arg with None -> [] | Some p -> [correct_levels p.pat_type] in let row' = {row_fields = [s, Reither(arg=None,ty_arg,true,ref None)]; row_more = newvar (); row_bound = (); - row_closed = false; row_fixed = false; row_name = None} in + row_closed = false; row_fixed = None; row_name = None} in (* Should fail *) - unify_pat env {pat with pat_type = newty (Tvariant row')} - (correct_levels pat.pat_type) + unify_pat (ref env) {pat with pat_type = newty (Tvariant row')} + (correct_levels pat.pat_type) | _ -> ()) -(* Duplicate types of values in the environment *) -(* XXX Should we do something about global type variables too? *) - -let duplicate_ident_types half_typed_cases env = - let caselist = - List.filter (fun { typed_pat; _ } -> - contains_gadt typed_pat - ) half_typed_cases - in - Env.make_copy_of_types (all_idents_cases caselist) env - (* Getting proper location of already typed expressions. Used to avoid confusing locations on type error messages in presence of @@ -2325,7 +2359,8 @@ and type_expect_ match desc.val_kind with | Val_ivar (_, cl_num) -> let (self_path, _) = - Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env + Env.find_value_by_name + (Longident.Lident ("self-" ^ cl_num)) env in Texp_instvar(self_path, path, match lid.txt with @@ -2333,22 +2368,9 @@ and type_expect_ | _ -> assert false) | Val_self (_, _, cl_num, _) -> let (path, _) = - Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env + Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env in Texp_ident(path, lid, desc) - | Val_unbound Val_unbound_instance_variable -> - raise(Error(loc, env, Masked_instance_variable lid.txt)) - | Val_unbound Val_unbound_ghost_recursive -> - let desc_loc = desc.Types.val_loc in - (* Only display the "missing rec" hint for non-ghost code *) - if not loc.Location.loc_ghost - && not desc_loc.Location.loc_ghost - then - raise Typetexp.(Error ( - loc, env, Unbound_value_missing_rec (lid.txt, desc_loc) - )) - else - raise Typetexp.(Error (loc, env, Unbound_value lid.txt)) | _ -> Texp_ident(path, lid, desc) in @@ -2565,8 +2587,8 @@ and type_expect_ end | _ -> raise Not_found with Not_found -> - let arg = may_map (type_exp env) sarg in - let arg_type = may_map (fun arg -> arg.exp_type) arg in + let arg = Option.map (type_exp env) sarg in + let arg_type = Option.map (fun arg -> arg.exp_type) arg in rue { exp_desc = Texp_variant(l, arg); exp_loc = loc; exp_extra = []; @@ -2574,7 +2596,7 @@ and type_expect_ row_more = newvar (); row_bound = (); row_closed = false; - row_fixed = false; + row_fixed = None; row_name = None}); exp_attributes = sexp.pexp_attributes; exp_env = env } @@ -2738,8 +2760,6 @@ and type_expect_ unify_exp env record ty_record; if label.lbl_mut = Immutable then raise(Error(loc, env, Label_not_mutable lid.txt)); - Builtin_attributes.check_deprecated_mutable lid.loc label.lbl_attributes - (Longident.last lid.txt); rue { exp_desc = Texp_setfield(record, label_loc, label, newval); exp_loc = loc; exp_extra = []; @@ -2951,10 +2971,12 @@ and type_expect_ end in begin match - Env.lookup_value (Longident.Lident ("selfpat-" ^ cl_num)) env, - Env.lookup_value (Longident.Lident ("self-" ^cl_num)) env + Env.find_value_by_name + (Longident.Lident ("selfpat-" ^ cl_num)) env, + Env.find_value_by_name + (Longident.Lident ("self-" ^cl_num)) env with - (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)), + | (_, ({val_kind = Val_self (meths, _, _, privty)} as desc)), (path, _) -> obj_meths := Some meths; let (_, typ) = @@ -3045,7 +3067,7 @@ and type_expect_ Undefined_method (obj.exp_type, met, valid_methods))) end | Pexp_new cl -> - let (cl_path, cl_decl) = Typetexp.find_class env cl.loc cl.txt in + let (cl_path, cl_decl) = Env.lookup_class ~loc:cl.loc cl.txt env in begin match cl_decl.cty_new with None -> raise(Error(loc, env, Virtual_class cl.txt)) @@ -3057,37 +3079,27 @@ and type_expect_ exp_attributes = sexp.pexp_attributes; exp_env = env } end - | Pexp_setinstvar (lab, snewval) -> - begin try - let (path, desc) = Env.lookup_value (Longident.Lident lab.txt) env in - match desc.val_kind with - Val_ivar (Mutable, cl_num) -> - let newval = - type_expect env snewval (mk_expected (instance desc.val_type)) - in - let (path_self, _) = - Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env - in - rue { - exp_desc = Texp_setinstvar(path_self, path, lab, newval); - exp_loc = loc; exp_extra = []; - exp_type = instance Predef.type_unit; - exp_attributes = sexp.pexp_attributes; - exp_env = env } - | Val_ivar _ -> - raise(Error(loc, env, Instance_variable_not_mutable(true,lab.txt))) - | _ -> - raise(Error(loc, env, Instance_variable_not_mutable(false,lab.txt))) - with - Not_found -> - let collect_vars name _path val_desc li = - match val_desc.val_kind with - | Val_ivar (Mutable, _) -> name::li - | _ -> li in - let valid_vars = Env.fold_values collect_vars None env [] in - raise(Error(loc, env, - Unbound_instance_variable (lab.txt, valid_vars))) - end + | Pexp_setinstvar (lab, snewval) -> begin + let (path, mut, cl_num, ty) = + Env.lookup_instance_variable ~loc lab.txt env + in + match mut with + | Mutable -> + let newval = + type_expect env snewval (mk_expected (instance ty)) + in + let (path_self, _) = + Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env + in + rue { + exp_desc = Texp_setinstvar(path_self, path, lab, newval); + exp_loc = loc; exp_extra = []; + exp_type = instance Predef.type_unit; + exp_attributes = sexp.pexp_attributes; + exp_env = env } + | _ -> + raise(Error(loc, env, Instance_variable_not_mutable lab.txt)) + end | Pexp_override lst -> let _ = List.fold_right @@ -3100,8 +3112,8 @@ and type_expect_ [] in begin match try - Env.lookup_value (Longident.Lident "selfpat-*") env, - Env.lookup_value (Longident.Lident "self-*") env + Env.find_value_by_name (Longident.Lident "selfpat-*") env, + Env.find_value_by_name (Longident.Lident "self-*") env with Not_found -> raise(Error(loc, env, Outside_class)) with @@ -3142,8 +3154,15 @@ and type_expect_ | _ -> Mp_present in let scope = create_scope () in + let md = + { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc } + in let (id, new_env) = - Env.enter_module ~scope name.txt pres modl.mod_type env + match name.txt with + | None -> None, env + | Some name -> + let id, env = Env.enter_module_declaration ~scope name pres md env in + Some id, env in Typetexp.widen context; (* ideally, we should catch Expr_type_clash errors @@ -3273,7 +3292,7 @@ and type_expect_ type_expansion_scope = Btype.lowest_level; type_loc = loc; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } in @@ -3411,7 +3430,10 @@ and type_expect_ Pstr_eval ({ pexp_desc = Pexp_construct (lid, None); _ }, _) } ] -> let path = - match (Typetexp.find_constructor env lid.loc lid.txt).cstr_tag with + let cd = + Env.lookup_constructor Env.Positive ~loc:lid.loc lid.txt env + in + match cd.cstr_tag with | Cstr_extension (path, _) -> path | _ -> raise (Error (lid.loc, env, Not_an_extension_constructor)) in @@ -3435,7 +3457,7 @@ and type_expect_ exp_env = env } and type_ident env ?(recarg=Rejected) lid = - let (path, desc) = Typetexp.find_value env lid.loc lid.txt in + let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in if !Clflags.annotations then begin let dloc = desc.Types.val_loc in let annot = @@ -3467,24 +3489,13 @@ and type_binding_op_ident env s = let path, desc = type_ident env lid in let path = match desc.val_kind with - | Val_ivar _ | Val_unbound Val_unbound_instance_variable -> + | Val_ivar _ -> fatal_error "Illegal name for instance variable" | Val_self (_, _, cl_num, _) -> let path, _ = - Env.lookup_value (Longident.Lident ("self-" ^ cl_num)) env + Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env in path - | Val_unbound Val_unbound_ghost_recursive -> - let desc_loc = desc.Types.val_loc in - (* Only display the "missing rec" hint for non-ghost code *) - if not loc.Location.loc_ghost - && not desc_loc.Location.loc_ghost - then - raise Typetexp.(Error ( - loc, env, Unbound_value_missing_rec (lid.txt, desc_loc) - )) - else - raise Typetexp.(Error (loc, env, Unbound_value lid.txt)) | _ -> path in path, desc @@ -3557,10 +3568,10 @@ and type_label_access env srecord lid = Some(p0, p, (repr ty_exp).level = generic_level || not !Clflags.principal) with Not_found -> None in - let labels = Typetexp.find_all_labels env lid.loc lid.txt in + let labels = Env.lookup_all_labels ~loc:lid.loc lid.txt env in let label = wrap_disambiguate "This expression has" (mk_expected ty_exp) - (Label.disambiguate lid env opath) labels in + (Label.disambiguate () lid env opath) labels in (record, label, opath) (* Typing format strings for printing or reading. @@ -3649,7 +3660,8 @@ and type_format loc str env = | Float_G -> mk_constr "Float_G" [] | Float_h -> mk_constr "Float_h" [] | Float_H -> mk_constr "Float_H" [] - | Float_F -> mk_constr "Float_F" [] in + | Float_F -> mk_constr "Float_F" [] + | Float_CF -> mk_constr "Float_CF" [] in mk_exp_loc (Pexp_tuple [flag; kind]) and mk_counter cnt = match cnt with | Line_counter -> mk_constr "Line_counter" [] @@ -3847,7 +3859,7 @@ and type_label_exp create env loc ty_expected arg with exn when maybe_expansive arg -> try (* Try to retype without propagating ty_arg, cf PR#4862 *) - may Btype.backtrack snap; + Option.iter Btype.backtrack snap; begin_def (); let arg = type_exp env sarg in end_def (); @@ -3888,7 +3900,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected = let rec make_args args ty_fun = match (expand_head env ty_fun).desc with | Tarrow (l,ty_arg,ty_fun,_) when is_optional l -> - let ty = option_none (instance ty_arg) sarg.pexp_loc in + let ty = option_none env (instance ty_arg) sarg.pexp_loc in make_args ((l, Some ty) :: args) ty_fun | Tarrow (l,_,ty_res',_) when l = Nolabel || !Clflags.classic -> List.rev args, ty_fun, no_labels ty_res' @@ -4095,7 +4107,7 @@ and type_application env funct sargs = else begin may_warn sarg0.pexp_loc (Warnings.Not_principal "using an optional argument here"); - Some (fun () -> option_some (type_argument env sarg0 + Some (fun () -> option_some env (type_argument env sarg0 (extract_option_type env ty) (extract_option_type env ty0))) end @@ -4108,7 +4120,7 @@ and type_application env funct sargs = may_warn funct.exp_loc (Warnings.Without_principality "eliminated optional argument"); ignored := (l,ty,lv) :: !ignored; - Some (fun () -> option_none (instance ty) Location.none) + Some (fun () -> option_none env (instance ty) Location.none) end else begin may_warn funct.exp_loc (Warnings.Without_principality "commuted an argument"); @@ -4164,14 +4176,14 @@ and type_construct env loc lid sarg ty_expected_explained attrs = Some(p0, p, principal) with Not_found -> None in - let constrs = Typetexp.find_all_constructors env lid.loc lid.txt in + let constrs = + Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env + in let constr = wrap_disambiguate "This variant expression is expected to have" ty_expected_explained - (Constructor.disambiguate lid env opath) constrs in - Env.mark_constructor Env.Positive env (Longident.last lid.txt) constr; - Builtin_attributes.check_alerts loc constr.cstr_attributes - constr.cstr_name; + (Constructor.disambiguate Env.Positive lid env opath) constrs + in let sargs = match sarg with None -> [] @@ -4239,13 +4251,14 @@ and type_construct env loc lid sarg ty_expected_explained attrs = (* Typing of statements (expressions whose values are discarded) *) and type_statement ?explanation env sexp = - let loc = (final_subexpression sexp).pexp_loc in begin_def(); let exp = type_exp env sexp in end_def(); let ty = expand_head env exp.exp_type and tv = newvar() in if is_Tvar ty && ty.level > tv.level then - Location.prerr_warning loc Warnings.Nonreturning_statement; + Location.prerr_warning + (final_subexpression exp).exp_loc + Warnings.Nonreturning_statement; if !Clflags.strict_sequence then let expected_ty = instance Predef.type_unit in with_explanation explanation (fun () -> @@ -4334,16 +4347,16 @@ and type_cases ?exception_allowed ?in_function env ty_arg ty_res partial_flag let does_contain_gadt = List.exists (fun { contains_gadt; _ } -> contains_gadt) half_typed_cases in - let ty_res, duplicated_ident_types = + let ty_res, do_copy_types = if does_contain_gadt && not !Clflags.principal then - correct_levels ty_res, duplicate_ident_types half_typed_cases env - else ty_res, duplicate_ident_types [] env + correct_levels ty_res, Env.make_copy_of_types env + else ty_res, (fun env -> env) in (* Unify all cases (delayed to keep it order-free) *) let ty_arg' = newvar () in let unify_pats ty = List.iter (fun { typed_pat = pat; pat_type_for_unif = pat_ty; _ } -> - unify_pat_types pat.pat_loc env pat_ty ty + unify_pat_types pat.pat_loc (ref env) pat_ty ty ) half_typed_cases in unify_pats ty_arg'; @@ -4373,7 +4386,7 @@ and type_cases ?exception_allowed ?in_function env ty_arg ty_res partial_flag contains_gadt; _ } -> let ext_env = if contains_gadt then - Env.do_copy_types duplicated_ident_types ext_env + do_copy_types ext_env else ext_env in @@ -4512,7 +4525,7 @@ and type_let {pat with pat_type = snd (instance_poly ~keep_names:true false tl ty)} | _ -> pat - in unify_pat env pat (type_approx env binding.pvb_expr)) + in unify_pat (ref env) pat (type_approx env binding.pvb_expr)) pat_list spat_sexp_list; (* Polymorphic variant processing *) List.iter @@ -4787,8 +4800,9 @@ let type_expression env sexp = generalize exp.exp_type; match sexp.pexp_desc with Pexp_ident lid -> + let loc = sexp.pexp_loc in (* Special case for keeping type variables when looking-up a variable *) - let (_path, desc) = Env.lookup_value lid.txt env in + let (_path, desc) = Env.lookup_value ~use:false ~loc lid.txt env in {exp with exp_type = desc.val_type} | _ -> exp @@ -4945,7 +4959,6 @@ let report_error ~loc env = function fprintf ppf "but an expression was expected of type"); ) () | Apply_non_function typ -> - reset_and_mark_loops typ; begin match (repr typ).desc with Tarrow _ -> Location.errorf ~loc @@ -4962,7 +4975,6 @@ let report_error ~loc env = function | Nolabel -> fprintf ppf "without label" | l -> fprintf ppf "with label %s" (prefixed_label_name l) in - reset_and_mark_loops ty; Location.errorf ~loc "@[@[<2>The function applied to this argument has type@ %a@]@.\ This argument cannot be applied %a@]" @@ -4980,7 +4992,6 @@ let report_error ~loc env = function | Wrong_name (eorp, ty_expected, kind, p, name, valid_names) -> Location.error_of_printer ~loc (fun ppf () -> let { ty; explanation } = ty_expected in - reset_and_mark_loops ty; if Path.is_constructor_typath p then begin fprintf ppf "@[The field %s is not part of the record \ @@ -5015,7 +5026,6 @@ let report_error ~loc env = function | Invalid_format msg -> Location.errorf ~loc "%s" msg | Undefined_method (ty, me, valid_methods) -> - reset_and_mark_loops ty; Location.error_of_printer ~loc (fun ppf () -> fprintf ppf "@[@[This expression has type@;<1 2>%a@]@,\ @@ -5038,11 +5048,8 @@ let report_error ~loc env = function fprintf ppf "Unbound instance variable %s" var; spellcheck ppf var valid_vars; ) () - | Instance_variable_not_mutable (b, v) -> - if b then - Location.errorf ~loc "The instance variable %s is not mutable" v - else - Location.errorf ~loc "The value %s is not an instance variable" v + | Instance_variable_not_mutable v -> + Location.errorf ~loc "The instance variable %s is not mutable" v | Not_subtype(tr1, tr2) -> Location.error_of_printer ~loc (fun ppf () -> report_subtyping_error ppf env tr1 "is not a subtype of" tr2 @@ -5071,7 +5078,6 @@ let report_error ~loc env = function "of the form: `(foo : ty1 :> ty2)'." ) () | Too_many_arguments (in_function, ty, explanation) -> - reset_and_mark_loops ty; if in_function then begin Location.errorf ~loc "This function expects too many arguments,@ \ @@ -5090,23 +5096,16 @@ let report_error ~loc env = function | Nolabel -> "but its first argument is not labelled" | l -> sprintf "but its first argument is labelled %s" (prefixed_label_name l) in - reset_and_mark_loops ty; Location.errorf ~loc "@[@[<2>This function should have type@ %a%t@]@,%s@]" type_expr ty (report_type_expected_explanation_opt explanation) (label_mark l) | Scoping_let_module(id, ty) -> - reset_and_mark_loops ty; Location.errorf ~loc "This `let module' expression has type@ %a@ \ In this type, the locally bound module name %s escapes its scope" type_expr ty id - | Masked_instance_variable lid -> - Location.errorf ~loc - "The instance variable %a@ \ - cannot be accessed from the definition of another instance variable" - longident lid | Private_type ty -> Location.errorf ~loc "Cannot create values of the private type %a" type_expr ty diff --git a/typing/typecore.mli b/typing/typecore.mli index e28f75e0..f8fc66e9 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -101,10 +101,9 @@ val type_argument: Env.t -> Parsetree.expression -> type_expr -> type_expr -> Typedtree.expression -val option_some: Typedtree.expression -> Typedtree.expression -val option_none: type_expr -> Location.t -> Typedtree.expression +val option_some: Env.t -> Typedtree.expression -> Typedtree.expression +val option_none: Env.t -> type_expr -> Location.t -> Typedtree.expression val extract_option_type: Env.t -> type_expr -> type_expr -val iter_pattern: (Typedtree.pattern -> unit) -> Typedtree.pattern -> unit val generalizable: int -> type_expr -> bool val reset_delayed_checks: unit -> unit val force_delayed_checks: unit -> unit @@ -143,7 +142,7 @@ type error = | Private_label of Longident.t * type_expr | Private_constructor of constructor_description * type_expr | Unbound_instance_variable of string * string list - | Instance_variable_not_mutable of bool * string + | Instance_variable_not_mutable of string | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t | Outside_class | Value_multiply_overridden of string @@ -152,7 +151,6 @@ type error = | Too_many_arguments of bool * type_expr * type_forcing_context option | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option | Scoping_let_module of string * type_expr - | Masked_instance_variable of Longident.t | Not_a_variant_type of Longident.t | Incoherent_label_order | Less_general of string * Ctype.Unification_trace.t diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 982a83e0..3e0a8291 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -113,7 +113,7 @@ let enter_type rec_flag env sdecl id = type_expansion_scope = Btype.lowest_level; type_loc = sdecl.ptype_loc; type_attributes = sdecl.ptype_attributes; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } in @@ -129,8 +129,10 @@ let update_type temp_env env id loc = with Ctype.Unify trace -> raise (Error(loc, Type_clash (env, trace))) -let get_unboxed_type_representation = - Typedecl_unboxed.get_unboxed_type_representation +let get_unboxed_type_representation env ty = + match Typedecl_unboxed.get_unboxed_type_representation env ty with + | Typedecl_unboxed.This x -> Some x + | _ -> None (* Determine if a type's values are represented by floats at run-time. *) let is_float env ty = @@ -167,7 +169,7 @@ let set_fixed_row env loc p decl = match tm.desc with Tvariant row -> let row = Btype.row_repr row in - tm.desc <- Tvariant {row with row_fixed = true}; + tm.desc <- Tvariant {row with row_fixed = Some Fixed_private}; if Btype.static_row row then Btype.newgenty Tnil else row.row_more | Tobject (ty, _) -> @@ -493,7 +495,7 @@ let transl_declaration env sdecl id = type_expansion_scope = Btype.lowest_level; type_loc = sdecl.ptype_loc; type_attributes = sdecl.ptype_attributes; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_status; } in @@ -508,9 +510,11 @@ let transl_declaration env sdecl id = Ctype.end_def (); (* Add abstract row *) if is_fixed_type sdecl then begin - let p = - try Env.lookup_type (Longident.Lident(Ident.name id ^ "#row")) env - with Not_found -> assert false in + let p, _ = + try Env.find_type_by_name + (Longident.Lident(Ident.name id ^ "#row")) env + with Not_found -> assert false + in set_fixed_row env sdecl.ptype_loc p decl end; (* Check for cyclic abbreviations *) @@ -718,16 +722,16 @@ let check_well_founded env loc path to_check ty = in match ty.desc with | Tconstr(p, _, _) when arg_exn <> None || to_check p -> - if to_check p then may raise arg_exn + if to_check p then Option.iter raise arg_exn else Btype.iter_type_expr (check ty0 TypeSet.empty) ty; begin try let ty' = Ctype.try_expand_once_opt env ty in let ty0 = if TypeSet.is_empty parents then ty else ty0 in check ty0 (TypeSet.add ty parents) ty' with - Ctype.Cannot_expand -> may raise arg_exn + Ctype.Cannot_expand -> Option.iter raise arg_exn end - | _ -> may raise arg_exn + | _ -> Option.iter raise arg_exn in let snap = Btype.snapshot () in try Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty @@ -797,7 +801,7 @@ let check_recursion env loc path decl to_check = Btype.iter_type_expr (check_regular cpath args prev_exp) ty end in - Misc.may + Option.iter (fun body -> let (args, body) = Ctype.instance_parameterized_type @@ -888,10 +892,15 @@ let transl_type_decl env rec_flag sdecl_list = let sdecl_list = List.map (fun sdecl -> - let ptype_name = - mkloc (sdecl.ptype_name.txt ^"#row") sdecl.ptype_name.loc in + let ptype_name = + let loc = { sdecl.ptype_name.loc with Location.loc_ghost = true } in + mkloc (sdecl.ptype_name.txt ^"#row") loc + in + let ptype_kind = Ptype_abstract in + let ptype_manifest = None in + let ptype_loc = { sdecl.ptype_loc with Location.loc_ghost = true } in {sdecl with - ptype_name; ptype_kind = Ptype_abstract; ptype_manifest = None}) + ptype_name; ptype_kind; ptype_manifest; ptype_loc }) fixed_types @ sdecl_list in @@ -1023,12 +1032,8 @@ let transl_extension_constructor env type_path type_params in args, ret_type, Text_decl(targs, tret_type) | Pext_rebind lid -> - let cdescr = Typetexp.find_constructor env lid.loc lid.txt in - let usage = - if cdescr.cstr_private = Private || priv = Public - then Env.Positive else Env.Privatize - in - Env.mark_constructor usage env (Longident.last lid.txt) cdescr; + let usage = if priv = Public then Env.Positive else Env.Privatize in + let cdescr = Env.lookup_constructor ~loc:lid.loc usage lid.txt env in let (args, cstr_res) = Ctype.instance_constructor cdescr in let res, ret_type = if cdescr.cstr_generalized then @@ -1136,9 +1141,9 @@ let transl_extension_constructor env type_path type_params let transl_type_extension extend env loc styext = reset_type_variables(); Ctype.begin_def(); - let (type_path, type_decl) = + let type_path, type_decl = let lid = styext.ptyext_path in - Typetexp.find_type env lid.loc lid.txt + Env.lookup_type ~loc:lid.loc lid.txt env in begin match type_decl.type_kind with @@ -1196,7 +1201,7 @@ let transl_type_extension extend env loc styext = List.iter (fun ext -> Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args; - may Ctype.generalize ext.ext_type.ext_ret_type) + Option.iter Ctype.generalize ext.ext_type.ext_ret_type) constructors; (* Check that all type variables are closed *) List.iter @@ -1250,7 +1255,7 @@ let transl_exception env sext = Ctype.end_def(); (* Generalize types *) Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args; - may Ctype.generalize ext.ext_type.ext_ret_type; + Option.iter Ctype.generalize ext.ext_type.ext_ret_type; (* Check that all type variables are closed *) begin match Ctype.closed_extension_constructor ext.ext_type with Some ty -> @@ -1489,7 +1494,7 @@ let transl_with_constraint env id row_path orig_decl sdecl = type_expansion_scope = Btype.lowest_level; type_loc = sdecl.ptype_loc; type_attributes = sdecl.ptype_attributes; - type_immediate = false; + type_immediate = Unknown; type_unboxed; } in @@ -1541,7 +1546,7 @@ let abstract_type_decl arity = type_expansion_scope = Btype.lowest_level; type_loc = Location.none; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } in Ctype.end_def(); @@ -1582,12 +1587,14 @@ let explain_unbound_gen ppf tv tl typ kwd pr = Printtyp.reset_and_mark_loops_list [typ ti; ty0]; fprintf ppf ".@.@[In %s@ %a@;<1 -2>the variable %a is unbound@]" - kwd pr ti Printtyp.type_expr tv + kwd pr ti Printtyp.marked_type_expr tv with Not_found -> () let explain_unbound ppf tv tl typ kwd lab = explain_unbound_gen ppf tv tl typ kwd - (fun ppf ti -> fprintf ppf "%s%a" (lab ti) Printtyp.type_expr (typ ti)) + (fun ppf ti -> + fprintf ppf "%s%a" (lab ti) Printtyp.marked_type_expr (typ ti) + ) let explain_unbound_single ppf tv ty = let trivial ty = @@ -1629,16 +1636,13 @@ let report_error ppf = function | Recursive_abbrev s -> fprintf ppf "The type abbreviation %s is cyclic" s | Cycle_in_def (s, ty) -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[The definition of %s contains a cycle:@ %a@]" s Printtyp.type_expr ty | Definition_mismatch (ty, None) -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[@[%s@ %s@;<1 2>%a@]@]" "This variant or record definition" "does not match that of type" Printtyp.type_expr ty | Definition_mismatch (ty, Some err) -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[@[%s@ %s@;<1 2>%a@]%a@]" "This variant or record definition" "does not match that of type" Printtyp.type_expr ty @@ -1721,8 +1725,8 @@ let report_error ppf = function | Rebind_wrong_type (lid, env, trace) -> Printtyp.report_unification_error ppf env trace (function ppf -> - fprintf ppf "The constructor %a@ has type" - Printtyp.longident lid) + fprintf ppf "The constructor %a@ has type" + Printtyp.longident lid) (function ppf -> fprintf ppf "but was expected to be of type") | Rebind_mismatch (lid, p, p') -> @@ -1754,27 +1758,29 @@ let report_error ppf = function | 3 when not teen -> "rd" | _ -> "th" in - (* FIXME: this test below is horrible, use a proper variant *) - if n = -1 then - fprintf ppf "@[%s@ %s@ It" - "In this definition, a type variable has a variance that" - "is not reflected by its occurrence in type parameters." - else if n = -2 then - fprintf ppf "@[%s@ %s@]" - "In this definition, a type variable cannot be deduced" - "from the type parameters." - else if n = -3 then - fprintf ppf "@[%s@ %s@ It" - "In this definition, a type variable has a variance that" - "cannot be deduced from the type parameters." - else - fprintf ppf "@[%s@ %s@ The %d%s type parameter" - "In this definition, expected parameter" - "variances are not satisfied." - n (suffix n); - if n <> -2 then - fprintf ppf " was expected to be %s,@ but it is %s.@]" - (variance v2) (variance v1) + (match n with + | Variance_not_reflected -> + fprintf ppf "@[%s@ %s@ It" + "In this definition, a type variable has a variance that" + "is not reflected by its occurrence in type parameters." + | No_variable -> + fprintf ppf "@[%s@ %s@]" + "In this definition, a type variable cannot be deduced" + "from the type parameters." + | Variance_not_deducible -> + fprintf ppf "@[%s@ %s@ It" + "In this definition, a type variable has a variance that" + "cannot be deduced from the type parameters." + | Variance_not_satisfied n -> + fprintf ppf "@[%s@ %s@ The %d%s type parameter" + "In this definition, expected parameter" + "variances are not satisfied." + n (suffix n)); + (match n with + | No_variable -> () + | _ -> + fprintf ppf " was expected to be %s,@ but it is %s.@]" + (variance v2) (variance v1)) | Unavailable_type_constructor p -> fprintf ppf "The definition of type %a@ is unavailable" Printtyp.path p | Bad_fixed_type r -> @@ -1789,20 +1795,25 @@ let report_error ppf = function fprintf ppf "Too many [@@unboxed]/[@@untagged] attributes" | Cannot_unbox_or_untag_type Unboxed -> fprintf ppf "@[Don't know how to unbox this type.@ \ - Only float, int32, int64 and nativeint can be unboxed.@]" + Only float, int32, int64 and nativeint can be unboxed.@]" | 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.@]" + a direct argument or result of the primitive,@ \ + it should not occur deeply into its type.@]" (match kind with Unboxed -> "@unboxed" | Untagged -> "@untagged") - | Immediacy Typedecl_immediacy.Bad_immediate_attribute -> - fprintf ppf "@[%s@ %s@]" - "Types marked with the immediate attribute must be" - "non-pointer types like int or bool" + | Immediacy (Typedecl_immediacy.Bad_immediacy_attribute violation) -> + fprintf ppf "@[%a@]" Format.pp_print_text + (match violation with + | Type_immediacy.Violation.Not_always_immediate -> + "Types marked with the immediate attribute must be \ + non-pointer types like int or bool." + | Type_immediacy.Violation.Not_always_immediate_on_64bits -> + "Types marked with the immediate64 attribute must be \ + produced using the Stdlib.Sys.Immediate64.Make functor.") | Bad_unboxed_attribute msg -> fprintf ppf "@[This type cannot be unboxed because@ %s.@]" msg | Wrong_unboxed_type_float -> diff --git a/typing/typedecl_immediacy.ml b/typing/typedecl_immediacy.ml index 3bb6907a..ccd09e81 100644 --- a/typing/typedecl_immediacy.ml +++ b/typing/typedecl_immediacy.ml @@ -16,12 +16,9 @@ open Types -type error = Bad_immediate_attribute +type error = Bad_immediacy_attribute of Type_immediacy.Violation.t exception Error of Location.t * error -let marked_as_immediate decl = - Builtin_attributes.immediate decl.type_attributes - let compute_decl env tdecl = match (tdecl.type_kind, tdecl.type_manifest) with | (Type_variant [{cd_args = Cstr_tuple [arg]; _}], _) @@ -29,26 +26,38 @@ let compute_decl env tdecl = | (Type_record ([{ld_type = arg; _}], _), _) when tdecl.type_unboxed.unboxed -> begin match Typedecl_unboxed.get_unboxed_type_representation env arg with - | Some argrepr -> not (Ctype.maybe_pointer_type env argrepr) - | None -> false + | Typedecl_unboxed.Unavailable -> Type_immediacy.Unknown + | Typedecl_unboxed.This argrepr -> Ctype.immediacy env argrepr + | Typedecl_unboxed.Only_on_64_bits argrepr -> + match Ctype.immediacy env argrepr with + | Type_immediacy.Always -> Type_immediacy.Always_on_64bits + | Type_immediacy.Always_on_64bits | Type_immediacy.Unknown as x -> x end | (Type_variant (_ :: _ as cstrs), _) -> - not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs) - | (Type_abstract, Some(typ)) -> - not (Ctype.maybe_pointer_type env typ) - | (Type_abstract, None) -> marked_as_immediate tdecl - | _ -> false + if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs) + then + Type_immediacy.Always + else + Type_immediacy.Unknown + | (Type_abstract, Some(typ)) -> Ctype.immediacy env typ + | (Type_abstract, None) -> Type_immediacy.of_attributes tdecl.type_attributes + | _ -> Type_immediacy.Unknown -let property : (bool, unit) Typedecl_properties.property = +let property : (Type_immediacy.t, unit) Typedecl_properties.property = let open Typedecl_properties in let eq = (=) in let merge ~prop:_ ~new_prop = new_prop in - let default _decl = false in + let default _decl = Type_immediacy.Unknown in let compute env decl () = compute_decl env decl in let update_decl decl immediacy = { decl with type_immediate = immediacy } in let check _env _id decl () = - if (marked_as_immediate decl) && (not decl.type_immediate) then - raise (Error (decl.type_loc, Bad_immediate_attribute)) in + let written_by_user = Type_immediacy.of_attributes decl.type_attributes in + match Type_immediacy.coerce decl.type_immediate ~as_:written_by_user with + | Ok () -> () + | Error violation -> + raise (Error (decl.type_loc, + Bad_immediacy_attribute violation)) + in { eq; merge; diff --git a/typing/typedecl_immediacy.mli b/typing/typedecl_immediacy.mli index 6a9c3d91..17fb985c 100644 --- a/typing/typedecl_immediacy.mli +++ b/typing/typedecl_immediacy.mli @@ -14,12 +14,12 @@ (* *) (**************************************************************************) -type error = Bad_immediate_attribute +type error = Bad_immediacy_attribute of Type_immediacy.Violation.t exception Error of Location.t * error -val compute_decl : Env.t -> Types.type_declaration -> bool +val compute_decl : Env.t -> Types.type_declaration -> Type_immediacy.t -val property : (bool, unit) Typedecl_properties.property +val property : (Type_immediacy.t, unit) Typedecl_properties.property val update_decls : Env.t -> diff --git a/typing/typedecl_unboxed.ml b/typing/typedecl_unboxed.ml index 8a1f0e28..e2d29a86 100644 --- a/typing/typedecl_unboxed.ml +++ b/typing/typedecl_unboxed.ml @@ -16,17 +16,25 @@ open Types +type t = + | Unavailable + | This of type_expr + | Only_on_64_bits of type_expr + (* We use the Ctype.expand_head_opt version of expand_head to get access to the manifest type of private abbreviations. *) let rec get_unboxed_type_representation env ty fuel = - if fuel < 0 then None else + if fuel < 0 then Unavailable else let ty = Ctype.repr (Ctype.expand_head_opt env ty) in match ty.desc with | Tconstr (p, args, _) -> begin match Env.find_type p env with - | exception Not_found -> Some ty - | {type_immediate = true; _} -> Some Predef.type_int - | {type_unboxed = {unboxed = false}} -> Some ty + | exception Not_found -> This ty + | {type_immediate = Always; _} -> + This Predef.type_int + | {type_immediate = Always_on_64bits; _} -> + Only_on_64_bits Predef.type_int + | {type_unboxed = {unboxed = false}} -> This ty | {type_params; type_kind = Type_record ([{ld_type = ty2; _}], _) | Type_variant [{cd_args = Cstr_tuple [ty2]; _}] @@ -36,12 +44,12 @@ let rec get_unboxed_type_representation env ty fuel = let ty2 = match ty2.desc with Tpoly (t, _) -> t | _ -> ty2 in get_unboxed_type_representation env (Ctype.apply env type_params ty2 args) (fuel - 1) - | {type_kind=Type_abstract} -> None + | {type_kind=Type_abstract} -> Unavailable (* This case can occur when checking a recursive unboxed type declaration. *) | _ -> assert false (* only the above can be unboxed *) end - | _ -> Some ty + | _ -> This ty let get_unboxed_type_representation env ty = (* Do not give too much fuel: PR#7424 *) diff --git a/typing/typedecl_unboxed.mli b/typing/typedecl_unboxed.mli index 88a056de..9afd38e8 100644 --- a/typing/typedecl_unboxed.mli +++ b/typing/typedecl_unboxed.mli @@ -1,4 +1,25 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Gabriel Scherer, projet Parsifal, INRIA Saclay *) +(* Rodolphe Lepigre, projet Deducteam, INRIA Saclay *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + open Types +type t = + | Unavailable + | This of type_expr + | Only_on_64_bits of type_expr + (* for typeopt.ml *) -val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option +val get_unboxed_type_representation: Env.t -> type_expr -> t diff --git a/typing/typedecl_variance.ml b/typing/typedecl_variance.ml index 1e9a48c6..6b3bd288 100644 --- a/typing/typedecl_variance.ml +++ b/typing/typedecl_variance.ml @@ -22,10 +22,17 @@ module TypeMap = Btype.TypeMap type surface_variance = bool * bool * bool +type variance_error = +| Variance_not_satisfied of int +| No_variable +| Variance_not_reflected +| Variance_not_deducible + type error = -| Bad_variance of int * surface_variance * surface_variance +| Bad_variance of variance_error * surface_variance * surface_variance | Varying_anonymous + exception Error of Location.t * error (* Compute variance *) @@ -148,7 +155,10 @@ let compute_variance_type env ~check (required, loc) decl tyl = let var = get_variance ty tvl in let (co,cn) = get_upper var and ij = mem Inj var in if Btype.is_Tvar ty && (co && not c || cn && not n || not ij && i) - then raise (Error(loc, Bad_variance (!pos, (co,cn,ij), (c,n,i))))) + then raise (Error(loc, Bad_variance + (Variance_not_satisfied !pos, + (co,cn,ij), + (c,n,i))))) params required; (* Check propagation from constrained parameters *) let args = Btype.newgenty (Ttuple params) in @@ -181,7 +191,9 @@ let compute_variance_type env ~check (required, loc) decl tyl = let (c1,n1) = get_upper v1 and (c2,n2,_,i2) = get_lower v2 in if c1 && not c2 || n1 && not n2 then if List.memq ty fvl then - let code = if not i2 then -2 else if c2 || n2 then -1 else -3 in + let code = if not i2 then No_variable + else if c2 || n2 then Variance_not_reflected + else Variance_not_deducible in raise (Error (loc, Bad_variance (code, (c1,n1,false), (c2,n2,false)))) else Btype.iter_type_expr check ty diff --git a/typing/typedecl_variance.mli b/typing/typedecl_variance.mli index bcebcd7b..99ce18d6 100644 --- a/typing/typedecl_variance.mli +++ b/typing/typedecl_variance.mli @@ -28,8 +28,14 @@ type prop = Variance.t list type req = surface_variance list val property : (Variance.t list, req) property +type variance_error = +| Variance_not_satisfied of int +| No_variable +| Variance_not_reflected +| Variance_not_deducible + type error = -| Bad_variance of int * surface_variance * surface_variance +| Bad_variance of variance_error * surface_variance * surface_variance | Varying_anonymous exception Error of Location.t * error diff --git a/typing/typedtree.ml b/typing/typedtree.ml index 43de0ff0..96f5256d 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -15,7 +15,6 @@ (* Abstract syntax tree after typing *) -open Misc open Asttypes open Types @@ -107,7 +106,8 @@ and expression_desc = | Texp_setinstvar of Path.t * Path.t * string loc * expression | Texp_override of Path.t * (Path.t * string loc * expression) list | Texp_letmodule of - Ident.t * string loc * Types.module_presence * module_expr * expression + Ident.t option * string option loc * Types.module_presence * module_expr * + expression | Texp_letexception of extension_constructor * expression | Texp_assert of expression | Texp_lazy of expression @@ -218,10 +218,14 @@ and module_type_constraint = Tmodtype_implicit | Tmodtype_explicit of module_type +and functor_parameter = + | Unit + | Named of Ident.t option * string option loc * module_type + and module_expr_desc = Tmod_ident of Path.t * Longident.t loc | Tmod_structure of structure - | Tmod_functor of Ident.t * string loc * module_type option * module_expr + | Tmod_functor of functor_parameter * module_expr | Tmod_apply of module_expr * module_expr * module_coercion | Tmod_constraint of module_expr * Types.module_type * module_type_constraint * module_coercion @@ -257,8 +261,8 @@ and structure_item_desc = and module_binding = { - mb_id: Ident.t; - mb_name: string loc; + mb_id: Ident.t option; + mb_name: string option loc; mb_presence: module_presence; mb_expr: module_expr; mb_attributes: attribute list; @@ -292,7 +296,7 @@ and module_type = and module_type_desc = Tmty_ident of Path.t * Longident.t loc | Tmty_signature of signature - | Tmty_functor of Ident.t * string loc * module_type option * module_type + | Tmty_functor of functor_parameter * module_type | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list | Tmty_typeof of module_expr | Tmty_alias of Path.t * Longident.t loc @@ -335,8 +339,8 @@ and signature_item_desc = and module_declaration = { - md_id: Ident.t; - md_name: string loc; + md_id: Ident.t option; + md_name: string option loc; md_presence: module_presence; md_type: module_type; md_attributes: attribute list; @@ -588,11 +592,11 @@ and 'a class_infos = (* Auxiliary functions over the a.s.t. *) -let iter_pattern_desc f = function +let shallow_iter_pattern_desc f = function | Tpat_alias(p, _, _) -> f p | Tpat_tuple patl -> List.iter f patl | Tpat_construct(_, _, patl) -> List.iter f patl - | Tpat_variant(_, pat, _) -> may f pat + | Tpat_variant(_, pat, _) -> Option.iter f pat | Tpat_record (lbl_pat_list, _) -> List.iter (fun (_, _, pat) -> f pat) lbl_pat_list | Tpat_array patl -> List.iter f patl @@ -603,7 +607,7 @@ let iter_pattern_desc f = function | Tpat_var _ | Tpat_constant _ -> () -let map_pattern_desc f d = +let shallow_map_pattern_desc f d = match d with | Tpat_alias (p1, id, s) -> Tpat_alias (f p1, id, s) @@ -626,43 +630,56 @@ let map_pattern_desc f d = | Tpat_any | Tpat_variant (_,None,_) -> d -(* List the identifiers bound by a pattern or a let *) +let rec iter_pattern f p = + f p; + shallow_iter_pattern_desc (iter_pattern f) p.pat_desc -let idents = ref([]: (Ident.t * string loc * Types.type_expr) list) +let exists_pattern f p = + let exception Found in + let raiser f x = if (f x) then raise Found else () in + match iter_pattern (raiser f) p with + | exception Found -> true + | () -> false + +(* List the identifiers bound by a pattern or a let *) -let rec bound_idents pat = +let rec iter_bound_idents f pat = match pat.pat_desc with - | Tpat_var (id,s) -> idents := (id,s,pat.pat_type) :: !idents + | Tpat_var (id,s) -> + f (id,s,pat.pat_type) | Tpat_alias(p, id, s) -> - bound_idents p; idents := (id,s,pat.pat_type) :: !idents + iter_bound_idents f p; + f (id,s,pat.pat_type) | Tpat_or(p1, _, _) -> - (* Invariant : both arguments binds the same variables *) - bound_idents p1 - | d -> iter_pattern_desc bound_idents d + (* Invariant : both arguments bind the same variables *) + iter_bound_idents f p1 + | d -> + shallow_iter_pattern_desc (iter_bound_idents f) d -let pat_bound_idents_full pat = - idents := []; - bound_idents pat; - let res = !idents in - idents := []; - res - -let pat_bound_idents pat = - List.map (fun (id,_,_) -> id) (pat_bound_idents_full pat) +let rev_pat_bound_idents_full pat = + let idents_full = ref [] in + let add id_full = idents_full := id_full :: !idents_full in + iter_bound_idents add pat; + !idents_full -let rev_let_bound_idents_with_loc bindings = - idents := []; - List.iter (fun vb -> bound_idents vb.vb_pat) bindings; - let res = !idents in idents := []; res +let rev_only_idents idents_full = + List.rev_map (fun (id,_,_) -> id) idents_full -let let_bound_idents_with_loc pat_expr_list = - List.rev(rev_let_bound_idents_with_loc pat_expr_list) +let pat_bound_idents_full pat = + List.rev (rev_pat_bound_idents_full pat) +let pat_bound_idents pat = + rev_only_idents (rev_pat_bound_idents_full pat) -let rev_let_bound_idents pat = - List.map (fun (id,_,_) -> id) (rev_let_bound_idents_with_loc pat) +let rev_let_bound_idents_full bindings = + let idents_full = ref [] in + let add id_full = idents_full := id_full :: !idents_full in + List.iter (fun vb -> iter_bound_idents add vb.vb_pat) bindings; + !idents_full +let let_bound_idents_full bindings = + List.rev (rev_let_bound_idents_full bindings) let let_bound_idents pat = - List.map (fun (id,_,_) -> id) (let_bound_idents_with_loc pat) + rev_only_idents (rev_let_bound_idents_full pat) let alpha_var env id = List.assoc id env @@ -679,7 +696,7 @@ let rec alpha_pat env p = match p.pat_desc with | Not_found -> new_p end | d -> - {p with pat_desc = map_pattern_desc (alpha_pat env) d} + {p with pat_desc = shallow_map_pattern_desc (alpha_pat env) d} let mkloc = Location.mkloc let mknoloc = Location.mknoloc diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 129f34f0..a646ca2b 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -221,7 +221,8 @@ and expression_desc = | Texp_setinstvar of Path.t * Path.t * string loc * expression | Texp_override of Path.t * (Path.t * string loc * expression) list | Texp_letmodule of - Ident.t * string loc * Types.module_presence * module_expr * expression + Ident.t option * string option loc * Types.module_presence * module_expr * + expression | Texp_letexception of extension_constructor * expression | Texp_assert of expression | Texp_lazy of expression @@ -338,10 +339,14 @@ and module_type_constraint = | Tmodtype_explicit of module_type (** The module type was in the source file. *) +and functor_parameter = + | Unit + | Named of Ident.t option * string option loc * module_type + and module_expr_desc = Tmod_ident of Path.t * Longident.t loc | Tmod_structure of structure - | Tmod_functor of Ident.t * string loc * module_type option * module_expr + | Tmod_functor of functor_parameter * module_expr | Tmod_apply of module_expr * module_expr * module_coercion | Tmod_constraint of module_expr * Types.module_type * module_type_constraint * module_coercion @@ -380,8 +385,8 @@ and structure_item_desc = and module_binding = { - mb_id: Ident.t; - mb_name: string loc; + mb_id: Ident.t option; + mb_name: string option loc; mb_presence: module_presence; mb_expr: module_expr; mb_attributes: attributes; @@ -415,7 +420,7 @@ and module_type = and module_type_desc = Tmty_ident of Path.t * Longident.t loc | Tmty_signature of signature - | Tmty_functor of Ident.t * string loc * module_type option * module_type + | Tmty_functor of functor_parameter * module_type | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list | Tmty_typeof of module_expr | Tmty_alias of Path.t * Longident.t loc @@ -457,8 +462,8 @@ and signature_item_desc = and module_declaration = { - md_id: Ident.t; - md_name: string loc; + md_id: Ident.t option; + md_name: string option loc; md_presence: module_presence; md_type: module_type; md_attributes: attributes; @@ -713,13 +718,16 @@ and 'a class_infos = (* Auxiliary functions over the a.s.t. *) -val iter_pattern_desc: (pattern -> unit) -> pattern_desc -> unit -val map_pattern_desc: (pattern -> pattern) -> pattern_desc -> pattern_desc +val shallow_iter_pattern_desc: + (pattern -> unit) -> pattern_desc -> unit +val shallow_map_pattern_desc: + (pattern -> pattern) -> pattern_desc -> pattern_desc -val let_bound_idents: value_binding list -> Ident.t list -val rev_let_bound_idents: value_binding list -> Ident.t list +val iter_pattern: (pattern -> unit) -> pattern -> unit +val exists_pattern: (pattern -> bool) -> pattern -> bool -val let_bound_idents_with_loc: +val let_bound_idents: value_binding list -> Ident.t list +val let_bound_idents_full: value_binding list -> (Ident.t * string loc * type_expr) list (** Alpha conversion of patterns *) diff --git a/typing/typemod.ml b/typing/typemod.ml index 93ed01ef..4a0c13e3 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -105,11 +105,6 @@ type error = exception Error of Location.t * Env.t * error exception Error_forward of Location.error -let update_location loc = function - Error (_, env, err) -> Error (loc, env, err) - | err -> err -let () = Typetexp.typemod_update_location := update_location - open Typedtree let rec path_concat head p = @@ -137,7 +132,7 @@ let extract_sig_open env loc mty = (* Compute the environment after opening a module *) let type_open_ ?used_slot ?toplevel ovf env loc lid = - let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in + let path = Env.lookup_module_path ~load:true ~loc:lid.loc lid.txt env in match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with | Some env -> path, env | None -> @@ -312,11 +307,18 @@ let iterator_with_env env = env := env_before ); Btype.it_module_type = (fun self -> function - | Mty_functor (param, mty_arg, mty_body) -> - may (self.Btype.it_module_type self) mty_arg; + | Mty_functor (param, mty_body) -> let env_before = !env in - env := lazy (Env.add_module ~arg:true param Mp_present - (Btype.default_mty mty_arg) (Lazy.force env_before)); + begin match param with + | Unit -> () + | Named (param, mty_arg) -> + self.Btype.it_module_type self mty_arg; + match param with + | None -> () + | Some id -> + env := lazy (Env.add_module ~arg:true id Mp_present + mty_arg (Lazy.force env_before)) + end; self.Btype.it_module_type self mty_body; env := env_before; | mty -> @@ -329,7 +331,7 @@ let retype_applicative_functor_type ~loc env funct arg = let mty_arg = (Env.find_module arg env).md_type in let mty_param = match Env.scrape_alias env mty_functor with - | Mty_functor (_, Some mty_param, _) -> mty_param + | Mty_functor (Named (_, mty_param), _) -> mty_param | _ -> assert false (* could trigger due to MPR#7611 *) in Includemod.check_modtype_inclusion ~loc env mty_arg arg mty_param @@ -489,7 +491,7 @@ let merge_constraint initial_env remove_aliases loc sg constr = type_is_newtype = false; type_expansion_scope = Btype.lowest_level; type_attributes = []; - type_immediate = false; + type_immediate = Unknown; type_unboxed = unboxed_false_default_false; } and id_row = Ident.create_local (s^"#row") in @@ -529,7 +531,7 @@ let merge_constraint initial_env remove_aliases loc sg constr = update_rec_next rs rem | (Sig_module(id, pres, md, rs, priv) :: rem, [s], Pwith_module (_, lid')) when Ident.name id = s -> - let path, md' = Typetexp.find_module initial_env loc lid'.txt in + let path, md' = Env.lookup_module ~loc lid'.txt initial_env in let mty = md'.md_type in let mty = Mtype.scrape_for_type_of ~remove_aliases env mty in let md'' = { md' with md_type = mty } in @@ -539,7 +541,7 @@ let merge_constraint initial_env remove_aliases loc sg constr = Sig_module(id, pres, newmd, rs, priv) :: rem | (Sig_module(id, _, md, rs, _) :: rem, [s], Pwith_modsubst (_, lid')) when Ident.name id = s -> - let path, md' = Typetexp.find_module initial_env loc lid'.txt in + let path, md' = Env.lookup_module ~loc lid'.txt initial_env in let aliasable = not (Env.is_functor_arg path env) in let newmd = Mtype.strengthen_decl ~aliasable env md' path in ignore(Includemod.modtypes ~loc env newmd.md_type md.md_type); @@ -598,17 +600,13 @@ let merge_constraint initial_env remove_aliases loc sg constr = in match type_decl_is_alias sdecl with | Some lid -> - let replacement = - try Env.lookup_type lid.txt initial_env + let replacement, _ = + try Env.find_type_by_name lid.txt initial_env with Not_found -> assert false in fun s path -> Subst.add_type_path path replacement s | None -> - let body = - match tdecl.typ_type.type_manifest with - | None -> assert false - | Some x -> x - in + let body = Option.get tdecl.typ_type.type_manifest in let params = tdecl.typ_type.type_params in if params_are_constrained params then raise(Error(loc, initial_env, @@ -616,7 +614,7 @@ let merge_constraint initial_env remove_aliases loc sg constr = fun s path -> Subst.add_type_function path ~params ~body s in let sub = List.fold_left how_to_extend_subst Subst.identity !real_ids in - (* This signature will not be used direcly, it will always be freshened + (* This signature will not be used directly, it will always be freshened by the caller. So what we do with the scope doesn't really matter. But making it local makes it unlikely that we will ever use the result of this function unfreshened without issue. *) @@ -682,23 +680,36 @@ let map_ext fn exts rem = let rec approx_modtype env smty = match smty.pmty_desc with Pmty_ident lid -> - let (path, _info) = Typetexp.find_modtype env smty.pmty_loc lid.txt in + let (path, _info) = + Env.lookup_modtype ~use:false ~loc:smty.pmty_loc lid.txt env + in Mty_ident path | Pmty_alias lid -> - let path = Typetexp.lookup_module env smty.pmty_loc lid.txt in - Mty_alias path + let path = + Env.lookup_module_path ~use:false ~load:false + ~loc:smty.pmty_loc lid.txt env + in + Mty_alias(path) | Pmty_signature ssg -> Mty_signature(approx_sig env ssg) - | Pmty_functor(param, sarg, sres) -> - let arg = may_map (approx_modtype env) sarg in - let rarg = Mtype.scrape_for_functor_arg env (Btype.default_mty arg) in - let scope = Ctype.create_scope () in - let (id, newenv) = - Env.enter_module ~scope ~arg:true param.txt - Mp_present rarg env + | Pmty_functor(param, sres) -> + let (param, newenv) = + match param with + | Unit -> Types.Unit, env + | Named (param, sarg) -> + let arg = approx_modtype env sarg in + match param.txt with + | None -> Types.Named (None, arg), env + | Some name -> + let rarg = Mtype.scrape_for_functor_arg env arg in + let scope = Ctype.create_scope () in + let (id, newenv) = + Env.enter_module ~scope ~arg:true name Mp_present rarg env + in + Types.Named (Some id, arg), newenv in let res = approx_modtype newenv sres in - Mty_functor(id, arg, res) + Mty_functor(param, res) | Pmty_with(sbody, constraints) -> let body = approx_modtype env sbody in List.iter @@ -709,9 +720,9 @@ let rec approx_modtype env smty = | Pwith_module (_, lid') -> (* Lookup the module to make sure that it is not recursive. (GPR#1626) *) - ignore (Typetexp.find_module env lid'.loc lid'.txt) + ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env) | Pwith_modsubst (_, lid') -> - ignore (Typetexp.find_module env lid'.loc lid'.txt)) + ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env)) constraints; body | Pmty_typeof smod -> @@ -738,37 +749,45 @@ and approx_sig env ssg = map_rec_type ~rec_flag (fun rs (id, info) -> Sig_type(id, info, rs, Exported)) decls rem | Psig_typesubst _ -> approx_sig env srem + | Psig_module { pmd_name = { txt = None; _ }; _ } -> + approx_sig env srem | Psig_module pmd -> let scope = Ctype.create_scope () in - let id = Ident.create_scoped ~scope pmd.pmd_name.txt in let md = approx_module_declaration env pmd in let pres = match md.Types.md_type with | Mty_alias _ -> Mp_absent | _ -> Mp_present in - let newenv = Env.enter_module_declaration id pres md env in + let id, newenv = + Env.enter_module_declaration ~scope (Option.get pmd.pmd_name.txt) + pres md env + in Sig_module(id, pres, md, Trec_not, Exported) :: approx_sig newenv srem | Psig_modsubst pms -> let scope = Ctype.create_scope () in - let id = Ident.create_scoped ~scope pms.pms_name.txt in let _, md = - Typetexp.find_module env pms.pms_manifest.loc pms.pms_manifest.txt + Env.lookup_module ~use:false ~loc:pms.pms_manifest.loc + pms.pms_manifest.txt env in let pres = match md.Types.md_type with | Mty_alias _ -> Mp_absent | _ -> Mp_present in - let newenv = Env.enter_module_declaration id pres md env in + let _, newenv = + Env.enter_module_declaration ~scope pms.pms_name.txt pres md env + in approx_sig newenv srem | Psig_recmodule sdecls -> let scope = Ctype.create_scope () in let decls = - List.map + List.filter_map (fun pmd -> - (Ident.create_scoped ~scope pmd.pmd_name.txt, - approx_module_declaration env pmd) + Option.map (fun name -> + Ident.create_scoped ~scope name, + approx_module_declaration env pmd + ) pmd.pmd_name.txt ) sdecls in @@ -816,7 +835,7 @@ and approx_sig env ssg = and approx_modtype_info env sinfo = { - mtd_type = may_map (approx_modtype env) sinfo.pmtd_type; + mtd_type = Option.map (approx_modtype env) sinfo.pmtd_type; mtd_attributes = sinfo.pmtd_attributes; mtd_loc = sinfo.pmtd_loc; } @@ -1069,11 +1088,11 @@ let has_remove_aliases_attribute attr = (* Check and translate a module type expression *) let transl_modtype_longident loc env lid = - let (path, _info) = Typetexp.find_modtype env loc lid in + let (path, _info) = Env.lookup_modtype ~loc lid env in path let transl_module_alias loc env lid = - Typetexp.lookup_module env loc lid + Env.lookup_module_path ~load:false ~loc lid env let mkmty desc typ env loc attrs = let mty = { @@ -1116,17 +1135,34 @@ and transl_modtype_aux env smty = let sg = transl_signature env ssg in mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc smty.pmty_attributes - | Pmty_functor(param, sarg, sres) -> - let arg = Misc.may_map (transl_modtype_functor_arg env) sarg in - let ty_arg = Misc.may_map (fun m -> m.mty_type) arg in - let scope = Ctype.create_scope () in - let (id, newenv) = - Env.enter_module ~scope ~arg:true - param.txt Mp_present (Btype.default_mty ty_arg) env + | Pmty_functor(sarg_opt, sres) -> + let t_arg, ty_arg, newenv = + match sarg_opt with + | Unit -> Unit, Types.Unit, env + | Named (param, sarg) -> + let arg = transl_modtype_functor_arg env sarg in + let (id, newenv) = + match param.txt with + | None -> None, env + | Some name -> + let scope = Ctype.create_scope () in + let id, newenv = + let arg_md = + { md_type = arg.mty_type; + md_attributes = []; + md_loc = param.loc; + } + in + Env.enter_module_declaration ~scope ~arg:true name Mp_present + arg_md env + in + Some id, newenv + in + Named (id, param, arg), Types.Named (id, arg.mty_type), newenv in let res = transl_modtype newenv sres in - mkmty (Tmty_functor (id, param, arg, res)) - (Mty_functor(id, ty_arg, res.mty_type)) env loc + mkmty (Tmty_functor (t_arg, res)) + (Mty_functor(ty_arg, res.mty_type)) env loc smty.pmty_attributes | Pmty_with(sbody, constraints) -> let body = transl_modtype env sbody in @@ -1239,7 +1275,6 @@ and transl_signature env sg = final_env | Psig_module pmd -> let scope = Ctype.create_scope () in - let id = Ident.create_scoped ~scope pmd.pmd_name.txt in let tmty = Builtin_attributes.warning_scope pmd.pmd_attributes (fun () -> transl_modtype env pmd.pmd_type) @@ -1255,21 +1290,31 @@ and transl_signature env sg = md_loc=pmd.pmd_loc; } in - Signature_names.check_module names pmd.pmd_name.loc id; - let newenv = Env.enter_module_declaration id pres md env in + let id, newenv = + match pmd.pmd_name.txt with + | None -> None, env + | Some name -> + let id, newenv = + Env.enter_module_declaration ~scope name pres md env + in + Signature_names.check_module names pmd.pmd_name.loc id; + Some id, newenv + in let (trem, rem, final_env) = transl_sig newenv srem in mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name; md_presence=pres; md_type=tmty; md_loc=pmd.pmd_loc; md_attributes=pmd.pmd_attributes}) env loc :: trem, - Sig_module(id, pres, md, Trec_not, Exported) :: rem, + (match id with + | None -> rem + | Some id -> Sig_module(id, pres, md, Trec_not, Exported) :: rem), final_env | Psig_modsubst pms -> let scope = Ctype.create_scope () in - let id = Ident.create_scoped ~scope pms.pms_name.txt in let path, md = - Typetexp.find_module env pms.pms_manifest.loc pms.pms_manifest.txt + Env.lookup_module ~loc:pms.pms_manifest.loc + pms.pms_manifest.txt env in let aliasable = not (Env.is_functor_arg path env) in let md = @@ -1285,11 +1330,13 @@ and transl_signature env sg = | Mty_alias _ -> Mp_absent | _ -> Mp_present in + let id, newenv = + Env.enter_module_declaration ~scope pms.pms_name.txt pres md env + in let info = `Substituted_away (Subst.add_module id path Subst.identity) in Signature_names.check_module ~info names pms.pms_name.loc id; - let newenv = Env.enter_module_declaration id pres md env in let (trem, rem, final_env) = transl_sig newenv srem in mksig (Tsig_modsubst {ms_id=id; ms_name=pms.pms_name; ms_manifest=path; ms_txt=pms.pms_manifest; @@ -1299,19 +1346,26 @@ and transl_signature env sg = rem, final_env | Psig_recmodule sdecls -> - let (decls, newenv) = + let (tdecls, newenv) = transl_recmodule_modtypes env sdecls in + let decls = + List.filter_map (fun md -> + match md.md_id with + | None -> None + | Some id -> Some (id, md) + ) tdecls + in List.iter - (fun md -> Signature_names.check_module names md.md_loc md.md_id) + (fun (id, md) -> Signature_names.check_module names md.md_loc id) decls; let (trem, rem, final_env) = transl_sig newenv srem in - mksig (Tsig_recmodule decls) env loc :: trem, - map_rec (fun rs md -> + mksig (Tsig_recmodule tdecls) env loc :: trem, + map_rec (fun rs (id, md) -> let d = {Types.md_type = md.md_type.mty_type; md_attributes = md.md_attributes; md_loc = md.md_loc; } in - Sig_module(md.md_id, Mp_present, d, rs, Exported)) + Sig_module(id, Mp_present, d, rs, Exported)) decls rem, final_env | Psig_modtype pmtd -> @@ -1431,10 +1485,12 @@ and transl_modtype_decl names env pmtd = and transl_modtype_decl_aux names env {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = - let tmty = Misc.may_map (transl_modtype env) pmtd_type in + let tmty = + Option.map (transl_modtype (Env.in_signature true env)) pmtd_type + in let decl = { - Types.mtd_type=may_map (fun t -> t.mty_type) tmty; + Types.mtd_type=Option.map (fun t -> t.mty_type) tmty; mtd_attributes=pmtd_attributes; mtd_loc=pmtd_loc; } @@ -1457,12 +1513,16 @@ and transl_recmodule_modtypes env sdecls = let make_env curr = List.fold_left (fun env (id, _, mty) -> - Env.add_module ~arg:true id Mp_present mty env) + Option.fold ~none:env + ~some:(fun id -> Env.add_module ~arg:true id Mp_present mty env) id) env curr in let make_env2 curr = List.fold_left (fun env (id, _, mty) -> - Env.add_module ~arg:true id Mp_present mty.mty_type env) + Option.fold ~none:env + ~some:(fun id -> + Env.add_module ~arg:true id Mp_present mty.mty_type env + ) id) env curr in let transition env_c curr = List.map2 @@ -1473,29 +1533,27 @@ and transl_recmodule_modtypes env sdecls = in (id, id_loc, tmty)) sdecls curr in - let map_mtys = List.map + let map_mtys = + List.filter_map (fun (id, _, mty) -> - (id, Types.{md_type = mty.mty_type; - md_loc = mty.mty_loc; - md_attributes = mty.mty_attributes})) in + Option.map (fun id -> + (id, Types.{md_type = mty.mty_type; + md_loc = mty.mty_loc; + md_attributes = mty.mty_attributes}) + ) id) + in let scope = Ctype.create_scope () in let ids = - List.map (fun x -> Ident.create_scoped ~scope x.pmd_name.txt) sdecls + List.map (fun x -> Option.map (Ident.create_scoped ~scope) x.pmd_name.txt) + sdecls in let approx_env = - (* - cf #5965 - We use a dummy module type in order to detect a reference to one - of the module being defined during the call to approx_modtype. - It will be detected in Env.lookup_module. - *) List.fold_left - (fun env id -> - let dummy = - Mty_ident (Path.Pident (Ident.create_scoped ~scope "#recmod#")) - in - Env.add_module ~arg:true id Mp_present dummy env - ) + (fun env -> + Option.fold ~none:env ~some:(fun id -> (* cf #5965 *) + Env.enter_unbound_module (Ident.name id) + Mod_unbound_illegal_recursion env + )) env ids in let init = @@ -1555,9 +1613,13 @@ let rec closed_modtype env = function | Mty_signature sg -> let env = Env.add_signature sg env in List.for_all (closed_signature_item env) sg - | Mty_functor(id, param, body) -> + | Mty_functor(arg_opt, body) -> let env = - Env.add_module ~arg:true id Mp_present (Btype.default_mty param) env + match arg_opt with + | Unit + | Named (None, _) -> env + | Named (Some id, param) -> + Env.add_module ~arg:true id Mp_present param env in closed_modtype env body @@ -1582,9 +1644,14 @@ let check_nongen_schemes env sg = (* Helpers for typing recursive modules *) let anchor_submodule name anchor = - match anchor with None -> None | Some p -> Some(Pdot(p, name)) -let anchor_recmodule id = - Some (Pident id) + match anchor, name with + | None, _ + | _, None -> + None + | Some p, Some name -> + Some(Pdot(p, name)) + +let anchor_recmodule = Option.map (fun id -> Pident id) let enrich_type_decls anchor decls oldenv newenv = match anchor with @@ -1601,9 +1668,12 @@ let enrich_type_decls anchor decls oldenv newenv = oldenv decls let enrich_module_type anchor name mty env = - match anchor with - None -> mty - | Some p -> Mtype.enrich_modtype env (Pdot(p, name)) mty + match anchor, name with + | None, _ + | _, None -> + mty + | Some p, Some name -> + Mtype.enrich_modtype env (Pdot(p, name)) mty let check_recmodule_inclusion env bindings = (* PR#4450, PR#4470: consider @@ -1627,8 +1697,13 @@ let check_recmodule_inclusion env bindings = the number of mutually recursive declarations. *) let subst_and_strengthen env scope s id mty = - Mtype.strengthen ~aliasable:false env (Subst.modtype (Rescope scope) s mty) - (Subst.module_path s (Pident id)) in + let mty = Subst.modtype (Rescope scope) s mty in + match id with + | None -> mty + | Some id -> + Mtype.strengthen ~aliasable:false env mty + (Subst.module_path s (Pident id)) + in let rec check_incl first_time n env s = let scope = Ctype.create_scope () in @@ -1636,32 +1711,42 @@ let check_recmodule_inclusion env bindings = (* Generate fresh names Y_i for the rec. bound module idents X_i *) let bindings1 = List.map - (fun (id, name, _mty_decl, _modl, mty_actual, _attrs, _loc) -> - (id, Ident.create_scoped ~scope name.txt, mty_actual)) + (fun (id, _name, _mty_decl, _modl, mty_actual, _attrs, _loc) -> + let ids = + Option.map + (fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id + in + (ids, mty_actual)) bindings in (* Enter the Y_i in the environment with their actual types substituted by the input substitution s *) let env' = List.fold_left - (fun env (id, id', mty_actual) -> - let mty_actual' = - if first_time - then mty_actual - else subst_and_strengthen env scope s id mty_actual in - Env.add_module ~arg:false id' Mp_present mty_actual' env) + (fun env (ids, mty_actual) -> + match ids with + | None -> env + | Some (id, id') -> + let mty_actual' = + if first_time + then mty_actual + else subst_and_strengthen env scope s (Some id) mty_actual + in + Env.add_module ~arg:false id' Mp_present mty_actual' env) env bindings1 in (* Build the output substitution Y_i <- X_i *) let s' = List.fold_left - (fun s (id, id', _mty_actual) -> - Subst.add_module id (Pident id') s) + (fun s (ids, _mty_actual) -> + match ids with + | None -> s + | Some (id, id') -> Subst.add_module id (Pident id') s) Subst.identity bindings1 in (* Recurse with env' and s' *) check_incl false (n-1) env' s' end else begin (* Base case: check inclusion of s(mty_actual) in s(mty_decl) and insert coercion if needed *) - let check_inclusion (id, id_loc, mty_decl, modl, mty_actual, attrs, loc) = + let check_inclusion (id, name, mty_decl, modl, mty_actual, attrs, loc) = let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type and mty_actual' = subst_and_strengthen env scope s id mty_actual in let coercion = @@ -1679,7 +1764,7 @@ let check_recmodule_inclusion env bindings = } in { mb_id = id; - mb_name = id_loc; + mb_name = name; mb_presence = Mp_present; mb_expr = modl'; mb_attributes = attrs; @@ -1722,16 +1807,14 @@ let rec package_constraints env loc mty constrs = Mty_signature sg' let modtype_of_package env loc p nl tl = - try match (Env.find_modtype p env).mtd_type with + match (Env.find_modtype p env).mtd_type with | Some mty when nl <> [] -> package_constraints env loc mty (List.combine (List.map Longident.flatten nl) tl) | _ -> if nl = [] then Mty_ident p else raise(Error(loc, env, Signature_expected)) - with Not_found -> - let error = Typetexp.Unbound_modtype (Ctype.lid_of_path p) in - raise(Typetexp.Error(loc, env, error)) + | exception Not_found -> assert false let package_subtype env p1 nl1 tl1 p2 nl2 tl2 = let mkmty p nl tl = @@ -1771,7 +1854,8 @@ and type_module_aux ~alias sttn funct_body anchor env smod = match smod.pmod_desc with Pmod_ident lid -> let path = - Typetexp.lookup_module ~load:(not alias) env smod.pmod_loc lid.txt in + Env.lookup_module_path ~load:(not alias) ~loc:smod.pmod_loc lid.txt env + in let md = { mod_desc = Tmod_ident (path, lid); mod_type = Mty_alias path; mod_env = env; @@ -1813,20 +1897,34 @@ and type_module_aux ~alias sttn funct_body anchor env smod = if List.length sg' = List.length sg then md else wrap_constraint env false md (Mty_signature sg') Tmodtype_implicit - | Pmod_functor(name, smty, sbody) -> - let mty = may_map (transl_modtype_functor_arg env) smty in - let ty_arg = Misc.may_map (fun m -> m.mty_type) mty in - let scope = Ctype.create_scope () in - let (id, newenv), funct_body = - match ty_arg with - | None -> (Ident.create_scoped ~scope "*", env), false - | Some mty -> - Env.enter_module ~scope ~arg:true name.txt Mp_present mty env, - true + | Pmod_functor(arg_opt, sbody) -> + let t_arg, ty_arg, newenv, funct_body = + match arg_opt with + | Unit -> Unit, Types.Unit, env, false + | Named (param, smty) -> + let mty = transl_modtype_functor_arg env smty in + let scope = Ctype.create_scope () in + let (id, newenv) = + match param.txt with + | None -> None, env + | Some name -> + let arg_md = + { md_type = mty.mty_type; + md_attributes = []; + md_loc = param.loc; + } + in + let id, newenv = + Env.enter_module_declaration ~scope ~arg:true name Mp_present + arg_md env + in + Some id, newenv + in + Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true in let body = type_module sttn funct_body None newenv sbody in - rm { mod_desc = Tmod_functor(id, name, mty, body); - mod_type = Mty_functor(id, ty_arg, body.mod_type); + rm { mod_desc = Tmod_functor(t_arg, body); + mod_type = Mty_functor(ty_arg, body.mod_type); mod_env = env; mod_attributes = smod.pmod_attributes; mod_loc = smod.pmod_loc } @@ -1836,15 +1934,17 @@ and type_module_aux ~alias sttn funct_body anchor env smod = let funct = type_module (sttn && path <> None) funct_body None env sfunct in begin match Env.scrape_alias env funct.mod_type with - Mty_functor(param, mty_param, mty_res) as mty_functor -> - let generative, mty_param = - (mty_param = None, Btype.default_mty mty_param) in - if generative then begin - if sarg.pmod_desc <> Pmod_structure [] then - raise (Error (sfunct.pmod_loc, env, Apply_generative)); - if funct_body && Mtype.contains_type env funct.mod_type then - raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body)); - end; + | Mty_functor (Unit, mty_res) -> + if sarg.pmod_desc <> Pmod_structure [] then + raise (Error (sfunct.pmod_loc, env, Apply_generative)); + if funct_body && Mtype.contains_type env funct.mod_type then + raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body)); + rm { mod_desc = Tmod_apply(funct, arg, Tcoerce_none); + mod_type = mty_res; + mod_env = env; + mod_attributes = smod.pmod_attributes; + mod_loc = smod.pmod_loc } + | Mty_functor (Named (param, mty_param), mty_res) as mty_functor -> let coercion = try Includemod.modtypes ~loc:sarg.pmod_loc env arg.mod_type mty_param @@ -1852,23 +1952,29 @@ and type_module_aux ~alias sttn funct_body anchor env smod = raise(Error(sarg.pmod_loc, env, Not_included msg)) in let mty_appl = match path with - Some path -> + | Some path -> let scope = Ctype.create_scope () in - Subst.modtype (Rescope scope) - (Subst.add_module param path Subst.identity) - mty_res - | None -> - if generative then mty_res else - let env = - Env.add_module ~arg:true param Mp_present arg.mod_type env + let subst = + match param with + | None -> Subst.identity + | Some p -> Subst.add_module p path Subst.identity in - check_well_formed_module env smod.pmod_loc - "the signature of this functor application" mty_res; - let nondep_mty = - try Mtype.nondep_supertype env [param] mty_res - with Ctype.Nondep_cannot_erase _ -> - raise(Error(smod.pmod_loc, env, - Cannot_eliminate_dependency mty_functor)) + Subst.modtype (Rescope scope) subst mty_res + | None -> + let env, nondep_mty = + match param with + | None -> env, mty_res + | Some param -> + let env = + Env.add_module ~arg:true param Mp_present arg.mod_type + env + in + check_well_formed_module env smod.pmod_loc + "the signature of this functor application" mty_res; + try env, Mtype.nondep_supertype env [param] mty_res + with Ctype.Nondep_cannot_erase _ -> + raise(Error(smod.pmod_loc, env, + Cannot_eliminate_dependency mty_functor)) in begin match Includemod.modtypes ~loc:smod.pmod_loc env mty_res nondep_mty @@ -2035,7 +2141,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = List.map (fun (id, { Asttypes.loc; _ }, _typ)-> Signature_names.check_value names loc id; Sig_value(id, Env.find_value (Pident id) newenv, Exported) - ) (let_bound_idents_with_loc defs), + ) (let_bound_idents_full defs), newenv | Pstr_primitive sdesc -> let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in @@ -2080,11 +2186,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs; pmb_loc; } -> + let outer_scope = Ctype.get_current_level () in let scope = Ctype.create_scope () in - let id = - Ident.create_scoped ~scope name.txt (* create early for PR#6752 *) - in - Signature_names.check_module names pmb_loc id; let modl = Builtin_attributes.warning_scope attrs (fun () -> @@ -2104,15 +2207,23 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = } in (*prerr_endline (Ident.unique_toplevel_name id);*) - Mtype.lower_nongen (scope - 1) md.md_type; - let newenv = Env.enter_module_declaration id pres md env in + Mtype.lower_nongen outer_scope md.md_type; + let id, newenv, sg = + match name.txt with + | None -> None, env, [] + | Some name -> + let id, e = Env.enter_module_declaration ~scope name pres md env in + Signature_names.check_module names pmb_loc id; + Some id, e, + [Sig_module(id, pres, + {md_type = modl.mod_type; + md_attributes = attrs; + md_loc = pmb_loc; + }, Trec_not, Exported)] + in Tstr_module {mb_id=id; mb_name=name; mb_expr=modl; mb_presence=pres; mb_attributes=attrs; mb_loc=pmb_loc; }, - [Sig_module(id, pres, - {md_type = modl.mod_type; - md_attributes = attrs; - md_loc = pmb_loc; - }, Trec_not, Exported)], + sg, newenv | Pstr_recmodule sbind -> let sbind = @@ -2137,7 +2248,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = pmd_attributes=attrs; pmd_loc=loc}) sbind ) in List.iter - Signature_names.(fun md -> check_module names md.md_loc md.md_id) + (fun md -> + Option.iter Signature_names.(check_module names md.md_loc) md.md_id) decls; let bindings1 = List.map2 @@ -2150,35 +2262,42 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = ) in let mty' = - enrich_module_type anchor (Ident.name id) modl.mod_type newenv + enrich_module_type anchor name.txt modl.mod_type newenv in (id, name, mty, modl, mty', attrs, loc)) decls sbind in let newenv = (* allow aliasing recursive modules from outside *) List.fold_left (fun env md -> - let mdecl = - { - md_type = md.md_type.mty_type; - md_attributes = md.md_attributes; - md_loc = md.md_loc; - } - in - Env.add_module_declaration ~check:true - md.md_id Mp_present mdecl env + match md.md_id with + | None -> env + | Some id -> + let mdecl = + { + md_type = md.md_type.mty_type; + md_attributes = md.md_attributes; + md_loc = md.md_loc; + } + in + Env.add_module_declaration ~check:true + id Mp_present mdecl env ) env decls in let bindings2 = check_recmodule_inclusion newenv bindings1 in + let mbs = + List.filter_map (fun mb -> Option.map (fun id -> id, mb) mb.mb_id) + bindings2 + in Tstr_recmodule bindings2, - map_rec (fun rs mb -> - Sig_module(mb.mb_id, Mp_present, { + map_rec (fun rs (id, mb) -> + Sig_module(id, Mp_present, { md_type=mb.mb_expr.mod_type; md_attributes=mb.mb_attributes; md_loc=mb.mb_loc; }, rs, Exported)) - bindings2 [], + mbs [], newenv | Pstr_modtype pmtd -> (* check that it is non-abstract *) @@ -2319,7 +2438,7 @@ let rec normalize_modtype env = function Mty_ident _ | Mty_alias _ -> () | Mty_signature sg -> normalize_signature env sg - | Mty_functor(_id, _param, body) -> normalize_modtype env body + | Mty_functor(_param, body) -> normalize_modtype env body and normalize_signature env = List.iter (normalize_signature_item env) @@ -2335,7 +2454,7 @@ let type_module_type_of env smod = let tmty = match smod.pmod_desc with | Pmod_ident lid -> (* turn off strengthening in this case *) - let path, md = Typetexp.find_module env smod.pmod_loc lid.txt in + let path, md = Env.lookup_module ~loc:smod.pmod_loc lid.txt env in rm { mod_desc = Tmod_ident (path, lid); mod_type = md.md_type; mod_env = env; @@ -2351,6 +2470,42 @@ let type_module_type_of env smod = (* For Typecore *) +(* Graft a longident onto a path *) +let rec extend_path path = + fun lid -> + match lid with + | Lident name -> Pdot(path, name) + | Ldot(m, name) -> Pdot(extend_path path m, name) + | Lapply _ -> assert false + +(* Lookup a type's longident within a signature *) +let lookup_type_in_sig sg = + let types, modules = + List.fold_left + (fun acc item -> + match item with + | Sig_type(id, _, _, _) -> + let types, modules = acc in + let types = String.Map.add (Ident.name id) id types in + types, modules + | Sig_module(id, _, _, _, _) -> + let types, modules = acc in + let modules = String.Map.add (Ident.name id) id modules in + types, modules + | _ -> acc) + (String.Map.empty, String.Map.empty) sg + in + let rec module_path = function + | Lident name -> Pident (String.Map.find name modules) + | Ldot(m, name) -> Pdot(module_path m, name) + | Lapply _ -> assert false + in + fun lid -> + match lid with + | Lident name -> Pident (String.Map.find name types) + | Ldot(m, name) -> Pdot(module_path m, name) + | Lapply _ -> assert false + let type_package env m p nl = (* Same as Pexp_letmodule *) (* remember original level *) @@ -2359,40 +2514,62 @@ let type_package env m p nl = let modl = type_module env m in let scope = Ctype.create_scope () in Typetexp.widen context; - let (mp, env) = - match modl.mod_desc with - | Tmod_ident (mp,_) -> (mp, env) - | Tmod_constraint ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _) - -> (mp, env) (* PR#6982 *) - | _ -> - let (id, new_env) = - Env.enter_module ~scope ~arg:true "%M" Mp_present modl.mod_type env + let nl', tl', env = + match nl with + | [] -> [], [], env + | nl -> + let type_path, env = + match modl.mod_desc with + | Tmod_ident (mp,_) + | Tmod_constraint + ({mod_desc=Tmod_ident (mp,_)}, _, Tmodtype_implicit, _) -> + (* We special case these because interactions between + strengthening of module types and packages can cause + spurious escape errors. See examples from PR#6982 in the + testsuite. This can be removed when such issues are + fixed. *) + extend_path mp, env + | _ -> + let sg = extract_sig_open env modl.mod_loc modl.mod_type in + let sg, env = Env.enter_signature ~scope sg env in + lookup_type_in_sig sg, env in - (Pident id, new_env) - in - let rec mkpath mp = function - | Lident name -> Pdot(mp, name) - | Ldot (m, name) -> Pdot(mkpath mp m, name) - | _ -> assert false + let nl', tl' = + List.fold_right + (fun lid (nl, tl) -> + match type_path lid with + | exception Not_found -> (nl, tl) + | path -> begin + match Env.find_type path env with + | exception Not_found -> (nl, tl) + | decl -> + if decl.type_arity > 0 then begin + (nl, tl) + end else begin + let t = Btype.newgenty (Tconstr (path,[],ref Mnil)) in + (lid :: nl, t :: tl) + end + end) + nl ([], []) + in + nl', tl', env in - let tl' = - List.map - (fun name -> Btype.newgenty (Tconstr (mkpath mp name,[],ref Mnil))) - (* beware of interactions with Printtyp and short-path: - mp.name may have an arity > 0, cf. PR#7534 *) - nl in (* go back to original level *) Ctype.end_def (); - if nl = [] then - (wrap_constraint env true modl (Mty_ident p) Tmodtype_implicit, []) - else let mty = modtype_of_package env modl.mod_loc p nl tl' in + let mty = + if nl = [] then (Mty_ident p) + else modtype_of_package env modl.mod_loc p nl' tl' + in List.iter2 (fun n ty -> try Ctype.unify env ty (Ctype.newvar ()) with Ctype.Unify _ -> - raise (Error(m.pmod_loc, env, Scoping_pack (n,ty)))) - nl tl'; - (wrap_constraint env true modl mty Tmodtype_implicit, tl') + raise (Error(modl.mod_loc, env, Scoping_pack (n,ty)))) + nl' tl'; + let modl = wrap_constraint env true modl mty Tmodtype_implicit in + (* Dropped exports should have produced an error above *) + assert (List.length nl = List.length tl'); + modl, tl' (* Fill in the forward declarations *) diff --git a/typing/types.ml b/typing/types.ml index 8bda6b6c..3bd25556 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -45,9 +45,10 @@ and row_desc = row_more: type_expr; row_bound: unit; row_closed: bool; - row_fixed: bool; + row_fixed: fixed_explanation option; row_name: (Path.t * type_expr list) option } - +and fixed_explanation = + | Univar of type_expr | Fixed_private | Reified of Path.t | Rigid and row_field = Rpresent of type_expr option | Reither of bool * type_expr list * bool * row_field option ref @@ -103,11 +104,6 @@ and value_kind = (* Self *) | Val_anc of (string * Ident.t) list * string (* Ancestor *) - | Val_unbound of value_unbound_reason (* Unbound variable *) - -and value_unbound_reason = - | Val_unbound_instance_variable - | Val_unbound_ghost_recursive (* Variance *) @@ -153,7 +149,7 @@ type type_declaration = type_expansion_scope: int; type_loc: Location.t; type_attributes: Parsetree.attributes; - type_immediate: bool; + type_immediate: Type_immediacy.t; type_unboxed: unboxed_status; } @@ -261,9 +257,13 @@ type visibility = type module_type = Mty_ident of Path.t | Mty_signature of signature - | Mty_functor of Ident.t * module_type option * module_type + | Mty_functor of functor_parameter * module_type | Mty_alias of Path.t +and functor_parameter = + | Unit + | Named of Ident.t option * module_type + and module_presence = | Mp_present | Mp_absent diff --git a/typing/types.mli b/typing/types.mli index 32c468f4..1dea43aa 100644 --- a/typing/types.mli +++ b/typing/types.mli @@ -160,9 +160,13 @@ and row_desc = row_more: type_expr; row_bound: unit; (* kept for compatibility *) row_closed: bool; - row_fixed: bool; + row_fixed: fixed_explanation option; row_name: (Path.t * type_expr list) option } - +and fixed_explanation = + | Univar of type_expr (** The row type was bound to an univar *) + | Fixed_private (** The row type is private *) + | Reified of Path.t (** The row was reified *) + | Rigid (** The row type was made rigid during constraint verification *) and row_field = Rpresent of type_expr option | Reither of bool * type_expr list * bool * row_field option ref @@ -260,11 +264,6 @@ and value_kind = (* Self *) | Val_anc of (string * Ident.t) list * string (* Ancestor *) - | Val_unbound of value_unbound_reason (* Unbound variable *) - -and value_unbound_reason = - | Val_unbound_instance_variable - | Val_unbound_ghost_recursive (* Variance *) @@ -300,7 +299,7 @@ type type_declaration = type_expansion_scope: int; type_loc: Location.t; type_attributes: Parsetree.attributes; - type_immediate: bool; (* true iff type should not be a pointer *) + type_immediate: Type_immediacy.t; type_unboxed: unboxed_status; } @@ -413,9 +412,13 @@ type visibility = type module_type = Mty_ident of Path.t | Mty_signature of signature - | Mty_functor of Ident.t * module_type option * module_type + | Mty_functor of functor_parameter * module_type | Mty_alias of Path.t +and functor_parameter = + | Unit + | Named of Ident.t option * module_type + and module_presence = | Mp_present | Mp_absent diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 36501f08..a55e53d0 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -28,8 +28,7 @@ exception Already_bound type error = Unbound_type_variable of string - | Unbound_type_constructor of Longident.t - | Unbound_type_constructor_2 of Path.t + | Undefined_type_constructor of Path.t | Type_arity_mismatch of Longident.t * int * int | Bound_type_variable of string | Recursive_type @@ -45,26 +44,8 @@ type error = | Cannot_quantify of string * type_expr | Multiple_constraints_on_type of Longident.t | Method_mismatch of string * type_expr * type_expr - | Unbound_value of Longident.t - | Unbound_constructor of Longident.t - | Unbound_label of Longident.t - | Unbound_module of Longident.t - | Unbound_class of Longident.t - | Unbound_modtype of Longident.t - | Unbound_cltype of Longident.t - | Ill_typed_functor_application - of Longident.t * Longident.t * Includemod.error list option - | Illegal_reference_to_recursive_module - | Wrong_use_of_module of Longident.t * [ `Structure_used_as_functor - | `Abstract_used_as_functor - | `Functor_used_as_structure - | `Abstract_used_as_structure - | `Generative_used_as_applicative - ] - | Cannot_scrape_alias of Longident.t * Path.t | Opened_object of Path.t option | Not_an_object of type_expr - | Unbound_value_missing_rec of Longident.t * Location.t exception Error of Location.t * Env.t * error exception Error_forward of Location.error @@ -74,149 +55,6 @@ module TyVarMap = Misc.Stdlib.String.Map type variable_context = int * type_expr TyVarMap.t -(* To update locations from Typemod.check_well_founded_module. *) - -let typemod_update_location = ref (fun _ -> assert false) - -(* Narrowing unbound identifier errors. *) - -let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a = - fun env loc lid make_error -> - let check_module mlid = - try ignore (Env.lookup_module ~load:true mlid env) with - | Not_found -> - narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid) - | Env.Recmodule -> - raise (Error (loc, env, Illegal_reference_to_recursive_module)) - in - let error e = raise (Error (loc, env, e)) in - begin match lid with - | Longident.Lident _ -> () - | Longident.Ldot (mlid, _) -> - check_module mlid; - let md = Env.find_module (Env.lookup_module ~load:true mlid env) env in - begin match Env.scrape_alias env md.md_type with - | Mty_functor _ -> - error (Wrong_use_of_module (mlid, `Functor_used_as_structure)) - | Mty_ident _ -> - error (Wrong_use_of_module (mlid, `Abstract_used_as_structure)) - | Mty_alias p -> error (Cannot_scrape_alias(mlid, p)) - | Mty_signature _ -> () - end - | Longident.Lapply (flid, mlid) -> - check_module flid; - let fmd = Env.find_module (Env.lookup_module ~load:true flid env) env in - let mty_param = - match Env.scrape_alias env fmd.md_type with - | Mty_signature _ -> - error (Wrong_use_of_module (flid, `Structure_used_as_functor)) - | Mty_ident _ -> - error (Wrong_use_of_module (flid, `Abstract_used_as_functor)) - | Mty_alias p -> error (Cannot_scrape_alias(flid, p)) - | Mty_functor (_, None, _) -> - error (Wrong_use_of_module (flid, `Generative_used_as_applicative)) - | Mty_functor (_, Some mty_param, _) -> mty_param - in - check_module mlid; - let mpath = Env.lookup_module ~load:true mlid env in - let mmd = Env.find_module mpath env in - begin match Env.scrape_alias env mmd.md_type with - | Mty_alias p -> error (Cannot_scrape_alias(mlid, p)) - | mty_arg -> - let details = - try Includemod.check_modtype_inclusion - ~loc env mty_arg mpath mty_param; - None (* should be impossible *) - with Includemod.Error e -> Some e - in - error (Ill_typed_functor_application (flid, mlid, details)) - end - end; - error (make_error lid) - -let find_component (lookup : ?loc:_ -> ?mark:_ -> _) make_error env loc lid = - try - match lid with - | Longident.Ldot (Longident.Lident "*predef*", s) -> - lookup ~loc (Longident.Lident s) Env.initial_safe_string - | _ -> - lookup ~loc lid env - with Not_found -> - narrow_unbound_lid_error env loc lid make_error - | Env.Recmodule -> - raise (Error (loc, env, Illegal_reference_to_recursive_module)) - | err -> - raise (!typemod_update_location loc err) - -let find_type env loc lid = - let path = - find_component Env.lookup_type (fun lid -> Unbound_type_constructor lid) - env loc lid - in - let decl = Env.find_type path env in - Builtin_attributes.check_alerts loc decl.type_attributes (Path.name path); - (path, decl) - -let find_constructor = - find_component Env.lookup_constructor (fun lid -> Unbound_constructor lid) -let find_all_constructors = - find_component Env.lookup_all_constructors - (fun lid -> Unbound_constructor lid) -let find_label = - find_component Env.lookup_label (fun lid -> Unbound_label lid) -let find_all_labels = - find_component Env.lookup_all_labels (fun lid -> Unbound_label lid) - -let find_class env loc lid = - let (path, decl) as r = - find_component Env.lookup_class (fun lid -> Unbound_class lid) env loc lid - in - Builtin_attributes.check_alerts loc decl.cty_attributes (Path.name path); - r - -let find_value env loc lid = - Env.check_value_name (Longident.last lid) loc; - let (path, decl) as r = - find_component Env.lookup_value (fun lid -> Unbound_value lid) env loc lid - in - Builtin_attributes.check_alerts loc decl.val_attributes (Path.name path); - r - -let lookup_module ?(load=false) env loc lid = - find_component - (fun ?loc ?mark lid env -> (Env.lookup_module ~load ?loc ?mark 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 - let decl = Env.find_module path env in - (* No need to check for alerts here, this is done in Env. *) - (path, decl) - -let find_modtype env loc lid = - let (path, decl) as r = - find_component Env.lookup_modtype (fun lid -> Unbound_modtype lid) - env loc lid - in - Builtin_attributes.check_alerts loc decl.mtd_attributes (Path.name path); - r - -let find_class_type env loc lid = - let (path, decl) as r = - find_component Env.lookup_cltype (fun lid -> Unbound_cltype lid) - env loc lid - in - Builtin_attributes.check_alerts loc decl.clty_attributes (Path.name path); - r - -let unbound_constructor_error env lid = - narrow_unbound_lid_error env lid.loc lid.txt - (fun lid -> Unbound_constructor lid) - -let unbound_label_error env lid = - narrow_unbound_lid_error env lid.loc lid.txt - (fun lid -> Unbound_label lid) - (* Support for first-class modules. *) let transl_modtype_longident = ref (fun _ -> assert false) @@ -375,7 +213,7 @@ and transl_type_aux env policy styp = let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in ctyp (Ttyp_tuple ctys) ty | Ptyp_constr(lid, stl) -> - let (path, decl) = find_type env lid.loc lid.txt in + let (path, decl) = Env.lookup_type ~loc:lid.loc lid.txt env in let stl = match stl with | [ {ptyp_desc=Ptyp_any} as t ] when decl.type_arity > 1 -> @@ -415,8 +253,7 @@ and transl_type_aux env policy styp = | Ptyp_class(lid, stl) -> let (path, decl, _is_variant) = try - let path = Env.lookup_type lid.txt env in - let decl = Env.find_type path env in + let path, decl = Env.find_type_by_name lid.txt env in let rec check decl = match decl.type_manifest with None -> raise Not_found @@ -429,6 +266,7 @@ and transl_type_aux env policy styp = in check decl; Location.deprecated styp.ptyp_loc "old syntax for polymorphic variant type"; + ignore(Env.lookup_type ~loc:lid.loc lid.txt env); (path, decl,true) with Not_found -> try let lid2 = @@ -437,11 +275,11 @@ and transl_type_aux env policy styp = | Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s) | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type" in - let path = Env.lookup_type lid2 env in - let decl = Env.find_type path env in + let path, decl = Env.find_type_by_name lid2 env in + ignore(Env.lookup_cltype ~loc:lid.loc lid.txt env); (path, decl, false) with Not_found -> - ignore (find_class env lid.loc lid.txt); assert false + ignore (Env.lookup_cltype ~loc:lid.loc lid.txt env); assert false in if List.length stl <> decl.type_arity then raise(Error(styp.ptyp_loc, env, @@ -478,7 +316,7 @@ and transl_type_aux env policy styp = in let row = { row_closed = true; row_fields = fields; row_bound = (); row_name = Some (path, ty_args); - row_fixed = false; row_more = newvar () } in + row_fixed = None; row_more = newvar () } in let static = Btype.static_row row in let row = if static then { row with row_more = newty Tnil } @@ -525,8 +363,8 @@ and transl_type_aux env policy styp = let t = instance t in let px = Btype.proxy t in begin match px.desc with - | Tvar None -> Btype.log_type px; px.desc <- Tvar (Some alias) - | Tunivar None -> Btype.log_type px; px.desc <- Tunivar (Some alias) + | Tvar None -> Btype.set_type_desc px (Tvar (Some alias)) + | Tunivar None -> Btype.set_type_desc px (Tunivar (Some alias)) | _ -> () end; { ty with ctyp_type = t } @@ -537,7 +375,7 @@ and transl_type_aux env policy styp = let mkfield l f = newty (Tvariant {row_fields=[l,f]; row_more=newvar(); row_bound=(); row_closed=true; - row_fixed=false; row_name=None}) in + row_fixed=None; row_name=None}) in let hfields = Hashtbl.create 17 in let add_typed_field loc l f = let h = Btype.hash_variant l in @@ -598,7 +436,7 @@ and transl_type_aux env policy styp = let row = Btype.row_repr row in row.row_fields | {desc=Tvar _}, Some(p, _) -> - raise(Error(sty.ptyp_loc, env, Unbound_type_constructor_2 p)) + raise(Error(sty.ptyp_loc, env, Undefined_type_constructor p)) | _ -> raise(Error(sty.ptyp_loc, env, Not_a_variant ty)) in @@ -634,7 +472,7 @@ and transl_type_aux env policy styp = let row = { row_fields = List.rev fields; row_more = newvar (); row_bound = (); row_closed = (closed = Closed); - row_fixed = false; row_name = !name } in + row_fixed = None; row_name = !name } in let static = Btype.static_row row in let row = if static then { row with row_more = newty Tnil } @@ -742,7 +580,7 @@ and transl_fields env policy o fields = OTinherit cty end | {desc=Tvar _}, Some p -> - raise (Error (sty.ptyp_loc, env, Unbound_type_constructor_2 p)) + raise (Error (sty.ptyp_loc, env, Undefined_type_constructor p)) | _ -> raise (Error (sty.ptyp_loc, env, Not_an_object t)) end in { of_desc; of_loc; of_attributes; } @@ -767,9 +605,10 @@ let rec make_fixed_univars ty = match ty.desc with | Tvariant row -> let row = Btype.row_repr row in - if Btype.is_Tunivar (Btype.row_more row) then + let more = Btype.row_more row in + if Btype.is_Tunivar more then ty.desc <- Tvariant - {row with row_fixed=true; + {row with row_fixed=Some(Univar more); row_fields = List.map (fun (s,f as p) -> match Btype.row_field_repr f with Reither (c, tl, _m, r) -> s, Reither (c, tl, true, r) @@ -866,38 +705,6 @@ let transl_type_scheme env styp = open Format open Printtyp -let spellcheck ppf fold env lid = - let choices ~path name = - let env = fold (fun x xs -> x::xs) path env [] in - Misc.spellcheck env name in - match lid with - | Longident.Lapply _ -> () - | Longident.Lident s -> - Misc.did_you_mean ppf (fun () -> choices ~path:None s) - | Longident.Ldot (r, s) -> - Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s) - -let fold_descr fold get_name f = fold (fun descr acc -> f (get_name descr) acc) -let fold_simple fold4 f = fold4 (fun name _path _descr acc -> f name acc) - -let fold_values f = - (* We only use "real" values while spellchecking (as opposed to "ghost" - values inserted in the environment to trigger the "missing rec" hint). - This is needed in order to avoid dummy suggestions like: - "unbound value x, did you mean x?" *) - Env.fold_values - (fun name _path descr acc -> - match descr.val_kind with - | Val_unbound _ -> acc - | _ -> f name acc) -let fold_types = fold_simple Env.fold_types -let fold_modules = fold_simple Env.fold_modules -let fold_constructors = fold_descr Env.fold_constructors (fun d -> d.cstr_name) -let fold_labels = fold_descr Env.fold_labels (fun d -> d.lbl_name) -let fold_classes = fold_simple Env.fold_classes -let fold_modtypes = fold_simple Env.fold_modtypes -let fold_cltypes = fold_simple Env.fold_cltypes - let report_error env ppf = function | Unbound_type_variable name -> let add_name name _ l = if name = "_" then l else ("'" ^ name) :: l in @@ -905,10 +712,7 @@ let report_error env ppf = function fprintf ppf "The type variable %s is unbound in this type declaration.@ %a" name did_you_mean (fun () -> Misc.spellcheck names name ) - | Unbound_type_constructor lid -> - fprintf ppf "Unbound type constructor %a" longident lid; - spellcheck ppf fold_types env lid; - | Unbound_type_constructor_2 p -> + | Undefined_type_constructor p -> fprintf ppf "The type constructor@ %a@ is not yet completely defined" path p | Type_arity_mismatch(lid, expected, provided) -> @@ -955,7 +759,6 @@ let report_error env ppf = function "which should be" !Oprint.out_type (tree_of_typexp false ty')) | Not_a_variant ty -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[The type %a@ does not expand to a polymorphic variant type@]" Printtyp.type_expr ty; @@ -986,61 +789,8 @@ let report_error env ppf = function fprintf ppf "Multiple constraints for type %a" longident s | Method_mismatch (l, ty, ty') -> wrap_printing_env ~error:true env (fun () -> - Printtyp.reset_and_mark_loops_list [ty; ty']; fprintf ppf "@[Method '%s' has type %a,@ which should be %a@]" l Printtyp.type_expr ty Printtyp.type_expr ty') - | Unbound_value lid -> - fprintf ppf "Unbound value %a" longident lid; - spellcheck ppf fold_values env lid; - | Unbound_module lid -> - fprintf ppf "Unbound module %a" longident lid; - spellcheck ppf fold_modules env lid; - | Unbound_constructor lid -> - fprintf ppf "Unbound constructor %a" longident lid; - spellcheck ppf fold_constructors env lid; - | Unbound_label lid -> - fprintf ppf "Unbound record field %a" longident lid; - spellcheck ppf fold_labels env lid; - | Unbound_class lid -> - fprintf ppf "Unbound class %a" longident lid; - spellcheck ppf fold_classes env lid; - | Unbound_modtype lid -> - fprintf ppf "Unbound module type %a" longident lid; - spellcheck ppf fold_modtypes env lid; - | Unbound_cltype lid -> - fprintf ppf "Unbound class type %a" longident lid; - spellcheck ppf fold_cltypes env lid; - | Ill_typed_functor_application (flid, mlid, details) -> - (match details with - | None -> - fprintf ppf "@[Ill-typed functor application %a(%a)@]" - longident flid longident mlid - | Some inclusion_error -> - fprintf ppf "@[The type of %a does not match %a's parameter@\n%a@]" - longident mlid longident flid Includemod.report_error inclusion_error) - | Illegal_reference_to_recursive_module -> - fprintf ppf "Illegal recursive module reference" - | Wrong_use_of_module (lid, details) -> - (match details with - | `Structure_used_as_functor -> - fprintf ppf "@[The module %a is a structure, it cannot be applied@]" - longident lid - | `Abstract_used_as_functor -> - fprintf ppf "@[The module %a is abstract, it cannot be applied@]" - longident lid - | `Functor_used_as_structure -> - fprintf ppf "@[The module %a is a functor, \ - it cannot have any components@]" longident lid - | `Abstract_used_as_structure -> - fprintf ppf "@[The module %a is abstract, \ - it cannot have any components@]" longident lid - | `Generative_used_as_applicative -> - fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \ - applied@ in@ type@ expressions@]" longident lid) - | Cannot_scrape_alias(lid, p) -> - fprintf ppf - "The module %a is an alias for module %a, which is missing" - longident lid path p | Opened_object nm -> fprintf ppf "Illegal open object type%a" @@ -1048,19 +798,8 @@ let report_error env ppf = function Some p -> fprintf ppf "@ %a" path p | None -> fprintf ppf "") nm | Not_an_object ty -> - Printtyp.reset_and_mark_loops ty; fprintf ppf "@[The type %a@ is not an object type@]" Printtyp.type_expr ty - | Unbound_value_missing_rec (lid, loc) -> - fprintf ppf - "Unbound value %a" longident lid; - spellcheck ppf fold_values env lid; - let (_, line, _) = Location.get_pos_info loc.Location.loc_start in - fprintf ppf - "@.@[%s@ %s %i@]" - "Hint: If this is a recursive definition," - "you should add the 'rec' keyword on line" - line let () = Location.register_error_of_exn diff --git a/typing/typetexp.mli b/typing/typetexp.mli index d726019b..5475abbc 100644 --- a/typing/typetexp.mli +++ b/typing/typetexp.mli @@ -42,8 +42,7 @@ exception Already_bound type error = Unbound_type_variable of string - | Unbound_type_constructor of Longident.t - | Unbound_type_constructor_2 of Path.t + | Undefined_type_constructor of Path.t | Type_arity_mismatch of Longident.t * int * int | Bound_type_variable of string | Recursive_type @@ -59,26 +58,8 @@ type error = | Cannot_quantify of string * type_expr | Multiple_constraints_on_type of Longident.t | Method_mismatch of string * type_expr * type_expr - | Unbound_value of Longident.t - | Unbound_constructor of Longident.t - | Unbound_label of Longident.t - | Unbound_module of Longident.t - | Unbound_class of Longident.t - | Unbound_modtype of Longident.t - | Unbound_cltype of Longident.t - | Ill_typed_functor_application - of Longident.t * Longident.t * Includemod.error list option - | Illegal_reference_to_recursive_module - | Wrong_use_of_module of Longident.t * [ `Structure_used_as_functor - | `Abstract_used_as_functor - | `Functor_used_as_structure - | `Abstract_used_as_structure - | `Generative_used_as_applicative - ] - | Cannot_scrape_alias of Longident.t * Path.t | Opened_object of Path.t option | Not_an_object of type_expr - | Unbound_value_missing_rec of Longident.t * Location.t exception Error of Location.t * Env.t * error @@ -93,34 +74,3 @@ val create_package_mty: Location.t -> Env.t -> Parsetree.package_type -> (Longident.t Asttypes.loc * Parsetree.core_type) list * Parsetree.module_type - -val find_type: - Env.t -> Location.t -> Longident.t -> Path.t * type_declaration -val find_constructor: - Env.t -> Location.t -> Longident.t -> constructor_description -val find_all_constructors: - Env.t -> Location.t -> Longident.t -> - (constructor_description * (unit -> unit)) list -val find_label: - Env.t -> Location.t -> Longident.t -> label_description -val find_all_labels: - Env.t -> Location.t -> Longident.t -> - (label_description * (unit -> unit)) list -val find_value: - Env.t -> Location.t -> Longident.t -> Path.t * value_description -val find_class: - Env.t -> Location.t -> Longident.t -> Path.t * class_declaration -val find_module: - Env.t -> Location.t -> Longident.t -> Path.t * module_declaration -val lookup_module: - ?load:bool -> Env.t -> Location.t -> Longident.t -> Path.t -val find_modtype: - Env.t -> Location.t -> Longident.t -> Path.t * modtype_declaration -val find_class_type: - Env.t -> Location.t -> Longident.t -> Path.t * class_type_declaration - -val unbound_constructor_error: Env.t -> Longident.t Location.loc -> 'a -val unbound_label_error: Env.t -> Longident.t Location.loc -> 'a - -(* To update location from typemod errors *) -val typemod_update_location: (Location.t -> exn -> exn) ref diff --git a/typing/untypeast.ml b/typing/untypeast.ml index f54ea60e..e7222ad4 100644 --- a/typing/untypeast.ml +++ b/typing/untypeast.ml @@ -96,8 +96,6 @@ let string_is_prefix sub str = let sublen = String.length sub in String.length str >= sublen && String.sub str 0 sublen = sub -let map_opt f = function None -> None | Some e -> Some (f e) - let rec lident_of_path = function | Path.Pident id -> Longident.Lident (Ident.name id) | Path.Pdot (p, s) -> Longident.Ldot (lident_of_path p, s) @@ -110,11 +108,8 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} let fresh_name s env = let rec aux i = let name = s ^ Int.to_string i in - try - let _ = Env.lookup_value (Lident name) env in - name - with - | Not_found -> aux (i+1) + if Env.bound_value name env then aux (i+1) + else name in aux 0 @@ -239,7 +234,7 @@ let type_declaration sub decl = decl.typ_cstrs) ~kind:(sub.type_kind sub decl.typ_kind) ~priv:decl.typ_private - ?manifest:(map_opt (sub.typ sub) decl.typ_manifest) + ?manifest:(Option.map (sub.typ sub) decl.typ_manifest) (map_loc sub decl.typ_name) let type_kind sub tk = match tk with @@ -259,7 +254,7 @@ let constructor_declaration sub cd = let attrs = sub.attributes sub cd.cd_attributes in Type.constructor ~loc ~attrs ~args:(constructor_arguments sub cd.cd_args) - ?res:(map_opt (sub.typ sub) cd.cd_res) + ?res:(Option.map (sub.typ sub) cd.cd_res) (map_loc sub cd.cd_name) let label_declaration sub ld = @@ -291,7 +286,7 @@ let extension_constructor sub ext = (match ext.ext_kind with | Text_decl (args, ret) -> Pext_decl (constructor_arguments sub args, - map_opt (sub.typ sub) ret) + Option.map (sub.typ sub) ret) | Text_rebind (_p, lid) -> Pext_rebind (map_loc sub lid) ) @@ -301,8 +296,10 @@ let pattern sub pat = let attrs = sub.attributes sub pat.pat_attributes in let desc = match pat with - { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> - Ppat_unpack name + { pat_extra=[Tpat_unpack, loc, _attrs]; pat_desc = Tpat_any; _ } -> + Ppat_unpack { txt = None; loc } + | { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> + Ppat_unpack { name with txt = Some name.txt } | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } -> Ppat_type (map_loc sub lid) | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } -> @@ -315,7 +312,7 @@ let pattern sub pat = begin match (Ident.name id).[0] with 'A'..'Z' -> - Ppat_unpack name + Ppat_unpack { name with txt = Some name.txt} | _ -> Ppat_var name end @@ -345,7 +342,7 @@ let pattern sub pat = ) )) | Tpat_variant (label, pato, _) -> - Ppat_variant (label, map_opt (sub.pat sub) pato) + Ppat_variant (label, Option.map (sub.pat sub) pato) | Tpat_record (list, closed) -> Ppat_record (List.map (fun (lid, _, pat) -> map_loc sub lid, sub.pat sub pat) list, closed) @@ -363,11 +360,11 @@ let exp_extra sub (extra, loc, attrs) sexp = match extra with Texp_coerce (cty1, cty2) -> Pexp_coerce (sexp, - map_opt (sub.typ sub) cty1, + Option.map (sub.typ sub) cty1, sub.typ sub cty2) | Texp_constraint cty -> Pexp_constraint (sexp, sub.typ sub cty) - | Texp_poly cto -> Pexp_poly (sexp, map_opt (sub.typ sub) cto) + | Texp_poly cto -> Pexp_poly (sexp, Option.map (sub.typ sub) cto) | Texp_newtype s -> Pexp_newtype (mkloc s loc, sexp) in Exp.mk ~loc ~attrs desc @@ -377,7 +374,7 @@ let cases sub l = List.map (sub.case sub) l let case sub {c_lhs; c_guard; c_rhs} = { pc_lhs = sub.pat sub c_lhs; - pc_guard = map_opt (sub.expr sub) c_guard; + pc_guard = Option.map (sub.expr sub) c_guard; pc_rhs = sub.expr sub c_rhs; } @@ -438,14 +435,14 @@ let expression sub exp = (Exp.tuple ~loc (List.map (sub.expr sub) args)) )) | Texp_variant (label, expo) -> - Pexp_variant (label, map_opt (sub.expr sub) expo) + Pexp_variant (label, Option.map (sub.expr sub) expo) | Texp_record { fields; extended_expression; _ } -> let list = Array.fold_left (fun l -> function | _, Kept _ -> l | _, Overridden (lid, exp) -> (lid, sub.expr sub exp) :: l) [] fields in - Pexp_record (list, map_opt (sub.expr sub) extended_expression) + Pexp_record (list, Option.map (sub.expr sub) extended_expression) | Texp_field (exp, lid, _label) -> Pexp_field (sub.expr sub exp, map_loc sub lid) | Texp_setfield (exp1, lid, _label, exp2) -> @@ -456,7 +453,7 @@ let expression sub exp = | Texp_ifthenelse (exp1, exp2, expo) -> Pexp_ifthenelse (sub.expr sub exp1, sub.expr sub exp2, - map_opt (sub.expr sub) expo) + Option.map (sub.expr sub) expo) | Texp_sequence (exp1, exp2) -> Pexp_sequence (sub.expr sub exp1, sub.expr sub exp2) | Texp_while (exp1, exp2) -> @@ -527,7 +524,7 @@ let module_type_declaration sub mtd = let loc = sub.location sub mtd.mtd_loc in let attrs = sub.attributes sub mtd.mtd_attributes in Mtd.mk ~loc ~attrs - ?typ:(map_opt (sub.module_type sub) mtd.mtd_type) + ?typ:(Option.map (sub.module_type sub) mtd.mtd_type) (map_loc sub mtd.mtd_name) let signature sub sg = @@ -604,6 +601,11 @@ let class_declaration sub = class_infos sub.class_expr sub let class_description sub = class_infos sub.class_type sub let class_type_declaration sub = class_infos sub.class_type sub +let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter = + function + | Unit -> Unit + | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype) + let module_type sub mty = let loc = sub.location sub mty.mty_loc in let attrs = sub.attributes sub mty.mty_attributes in @@ -611,9 +613,8 @@ let module_type sub mty = Tmty_ident (_path, lid) -> Pmty_ident (map_loc sub lid) | Tmty_alias (_path, lid) -> Pmty_alias (map_loc sub lid) | Tmty_signature sg -> Pmty_signature (sub.signature sub sg) - | Tmty_functor (_id, name, mtype1, mtype2) -> - Pmty_functor (name, map_opt (sub.module_type sub) mtype1, - sub.module_type sub mtype2) + | Tmty_functor (arg, mtype2) -> + Pmty_functor (functor_parameter sub arg, sub.module_type sub mtype2) | Tmty_with (mtype, list) -> Pmty_with (sub.module_type sub mtype, List.map (sub.with_constraint sub) list) @@ -643,9 +644,9 @@ let module_expr sub mexpr = let desc = match mexpr.mod_desc with Tmod_ident (_p, lid) -> Pmod_ident (map_loc sub lid) | Tmod_structure st -> Pmod_structure (sub.structure sub st) - | Tmod_functor (_id, name, mtype, mexpr) -> - Pmod_functor (name, Misc.may_map (sub.module_type sub) mtype, - sub.module_expr sub mexpr) + | Tmod_functor (arg, mexpr) -> + Pmod_functor + (functor_parameter sub arg, sub.module_expr sub mexpr) | Tmod_apply (mexp1, mexp2, _) -> Pmod_apply (sub.module_expr sub mexp1, sub.module_expr sub mexp2) | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) -> @@ -801,7 +802,7 @@ let class_field sub cf = let desc = match cf.cf_desc with Tcf_inherit (ovf, cl, super, _vals, _meths) -> Pcf_inherit (ovf, sub.class_expr sub cl, - map_opt (fun v -> mkloc v loc) super) + Option.map (fun v -> mkloc v loc) super) | Tcf_constraint (cty, cty') -> Pcf_constraint (sub.typ sub cty, sub.typ sub cty') | Tcf_val (lab, mut, _, Tcfk_virtual cty, _) -> diff --git a/utils/Makefile b/utils/Makefile index 687529b3..6b7febe4 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -29,51 +29,75 @@ else FLEXDLL_DIR = endif +FLEXLINK_FLAGS ?= + +# Escape special characters in the argument string. +# There are four characters that need escaping: +# - backslash and ampersand, which are special in the replacement text +# of sed's "s" command +# - exclamation mark, which is the delimiter we use for sed's "s" command +# - single quote, which interferes with shell quoting. We are inside +# single quotes already, so the proper escape is '\'' +# (close single quotation, insert single quote character, +# reopen single quotation). +SED_ESCAPE=$(subst ','\'',$(subst !,\!,$(subst &,\&,$(subst \,\\,$1)))) + +# Escape special characters in an OCaml string literal "..." +# There are two: backslash and double quote. +OCAML_ESCAPE=$(subst ",\",$(subst \,\\,$1)) + # SUBST generates the sed substitution for the variable *named* in $1 -# SUBST_QUOTE does the same, adding double-quotes around non-empty strings +SUBST=-e 's!%%$1%%!$(call SED_ESCAPE,$($1))!' + +# SUBST_STRING does the same, for a variable that occurs between "..." +# in config.mlp. Thus, backslashes and double quotes must be escaped. +SUBST_STRING=-e 's!%%$1%%!$(call SED_ESCAPE,$(call OCAML_ESCAPE,$($1)))!' + +# SUBST_QUOTE does the same, adding OCaml quotes around non-empty strings # (see FLEXDLL_DIR which must empty if FLEXDLL_DIR is empty but an OCaml # string otherwise) -SUBST_ESCAPE=$(subst ",\\",$(subst \,\\,$(if $2,$2,$($1)))) -SUBST=-e 's|%%$1%%|$(call SUBST_ESCAPE,$1,$2)|' -SUBST_QUOTE2=-e 's|%%$1%%|$(if $2,"$2")|' -SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$(call SUBST_ESCAPE,$1,$2)) +SUBST_QUOTE2=\ + -e 's!%%$1%%!$(if $2,$(call SED_ESCAPE,"$(call OCAML_ESCAPE,$2)"))!' +SUBST_QUOTE=$(call SUBST_QUOTE2,$1,$($1)) + FLEXLINK_LDFLAGS=$(if $(OC_LDFLAGS), -link "$(OC_LDFLAGS)") + config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile sed $(call SUBST,AFL_INSTRUMENT) \ $(call SUBST,ARCH) \ - $(call SUBST,ARCMD) \ - $(call SUBST,ASM) \ + $(call SUBST_STRING,ARCMD) \ + $(call SUBST_STRING,ASM) \ $(call SUBST,ASM_CFI_SUPPORTED) \ - $(call SUBST,BYTECCLIBS) \ - $(call SUBST,CC) \ - $(call SUBST,CCOMPTYPE) \ - $(call SUBST,OUTPUTOBJ) \ - $(call SUBST,EXT_ASM) \ - $(call SUBST,EXT_DLL) \ - $(call SUBST,EXE) \ - $(call SUBST,EXT_LIB) \ - $(call SUBST,EXT_OBJ) \ + $(call SUBST_STRING,BYTECCLIBS) \ + $(call SUBST_STRING,CC) \ + $(call SUBST_STRING,CCOMPTYPE) \ + $(call SUBST_STRING,OUTPUTOBJ) \ + $(call SUBST_STRING,EXT_ASM) \ + $(call SUBST_STRING,EXT_DLL) \ + $(call SUBST_STRING,EXE) \ + $(call SUBST_STRING,EXT_LIB) \ + $(call SUBST_STRING,EXT_OBJ) \ $(call SUBST,FLAMBDA) \ $(call SUBST,WITH_FLAMBDA_INVARIANTS) \ - $(call SUBST,FLEXLINK_FLAGS) \ + $(call SUBST_STRING,FLEXLINK_FLAGS) \ $(call SUBST_QUOTE,FLEXDLL_DIR) \ $(call SUBST,HOST) \ - $(call SUBST,LIBDIR) \ + $(call SUBST_STRING,LIBDIR) \ $(call SUBST,LIBUNWIND_AVAILABLE) \ $(call SUBST,LIBUNWIND_LINK_FLAGS) \ - $(call SUBST,MKDLL) \ - $(call SUBST,MKEXE) \ - $(call SUBST,FLEXLINK_LDFLAGS) \ - $(call SUBST,MKMAINDLL) \ + $(call SUBST_STRING,MKDLL) \ + $(call SUBST_STRING,MKEXE) \ + $(call SUBST_STRING,FLEXLINK_LDFLAGS) \ + $(call SUBST_STRING,MKMAINDLL) \ $(call SUBST,MODEL) \ - $(call SUBST,NATIVECCLIBS) \ - $(call SUBST,OCAMLC_CFLAGS) \ - $(call SUBST,OCAMLC_CPPFLAGS) \ - $(call SUBST,OCAMLOPT_CFLAGS) \ - $(call SUBST,OCAMLOPT_CPPFLAGS) \ - $(call SUBST,PACKLD) \ + $(call SUBST_STRING,NATIVECCLIBS) \ + $(call SUBST_STRING,OCAMLC_CFLAGS) \ + $(call SUBST_STRING,OCAMLC_CPPFLAGS) \ + $(call SUBST_STRING,OCAMLOPT_CFLAGS) \ + $(call SUBST_STRING,OCAMLOPT_CPPFLAGS) \ + $(call SUBST_STRING,PACKLD) \ $(call SUBST,PROFINFO_WIDTH) \ - $(call SUBST,RANLIBCMD) \ + $(call SUBST_STRING,RANLIBCMD) \ $(call SUBST,FORCE_SAFE_STRING) \ $(call SUBST,DEFAULT_SAFE_STRING) \ $(call SUBST,WINDOWS_UNICODE) \ @@ -86,6 +110,34 @@ config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile $(call SUBST,WITH_SPACETIME) \ $(call SUBST,ENABLE_CALL_COUNTS) \ $(call SUBST,FLAT_FLOAT_ARRAY) \ + $(call SUBST,FUNCTION_SECTIONS) \ $(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \ $(call SUBST,AS_HAS_DEBUG_PREFIX_MAP) \ $< > $@ + +# Test for the substitution functions above + +ALLCHARS= \ + !"\#\$\%&'()*+,-./ \ + 0123456789:;<=>? \ + @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_ \ + `abcdefghijklmnopqrstuvwxyz{|}~ + +TMPFILE=testdata.tmp +TMPSCRIPT=ocamlscript.tmp + +test-subst: + $(file >$(TMPFILE),$(ALLCHARS)) + echo '%%ALLCHARS%%' | sed $(call SUBST,ALLCHARS) | cmp $(TMPFILE) - + @rm $(TMPFILE) + @echo "Test passed" + +# This test assumes there is a working OCaml in the path + +test-subst-string: + $(file >$(TMPFILE),$(ALLCHARS)) + echo 'print_string "%%ALLCHARS%%"; print_newline();;' \ + | sed $(call SUBST_STRING,ALLCHARS) > $(TMPSCRIPT) && \ + ocaml $(TMPSCRIPT) | cmp $(TMPFILE) - + @rm $(TMPFILE) $(TMPSCRIPT) + @echo "Test passed" diff --git a/utils/ccomp.ml b/utils/ccomp.ml index 649faf38..9eecbb2e 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -58,9 +58,9 @@ let display_msvc_output file name = try let first = input_line c in if first <> Filename.basename name then - print_string first; + print_endline first; while true do - print_string (input_line c) + print_endline (input_line c) done with _ -> close_in c; @@ -181,33 +181,35 @@ let remove_Wl cclibs = else cclib) let call_linker mode output_name files extra = - let cmd = - if mode = Partial then - let l_prefix = - match Config.ccomp_type with - | "msvc" -> "/libpath:" - | _ -> "-L" - in - Printf.sprintf "%s%s %s %s %s" - Config.native_pack_linker - (Filename.quote output_name) - (quote_prefixed l_prefix (Load_path.get_paths ())) - (quote_files (remove_Wl files)) - extra - else - Printf.sprintf "%s -o %s %s %s %s %s %s" - (match !Clflags.c_compiler, mode with - | Some cc, _ -> cc - | None, Exe -> Config.mkexe - | None, Dll -> Config.mkdll - | None, MainDll -> Config.mkmaindll - | None, Partial -> assert false - ) - (Filename.quote output_name) - "" (*(Clflags.std_include_flag "-I")*) - (quote_prefixed "-L" (Load_path.get_paths ())) - (String.concat " " (List.rev !Clflags.all_ccopts)) - (quote_files files) - extra - in - command cmd = 0 + Profile.record_call "c-linker" (fun () -> + let cmd = + if mode = Partial then + let l_prefix = + match Config.ccomp_type with + | "msvc" -> "/libpath:" + | _ -> "-L" + in + Printf.sprintf "%s%s %s %s %s" + Config.native_pack_linker + (Filename.quote output_name) + (quote_prefixed l_prefix (Load_path.get_paths ())) + (quote_files (remove_Wl files)) + extra + else + Printf.sprintf "%s -o %s %s %s %s %s %s" + (match !Clflags.c_compiler, mode with + | Some cc, _ -> cc + | None, Exe -> Config.mkexe + | None, Dll -> Config.mkdll + | None, MainDll -> Config.mkmaindll + | None, Partial -> assert false + ) + (Filename.quote output_name) + "" (*(Clflags.std_include_flag "-I")*) + (quote_prefixed "-L" (Load_path.get_paths ())) + (String.concat " " (List.rev !Clflags.all_ccopts)) + (quote_files files) + extra + in + command cmd = 0 + ) diff --git a/utils/clflags.ml b/utils/clflags.ml index 5d85b6ca..cc376147 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -58,6 +58,7 @@ and no_check_prims = ref false (* -no-check-prims *) and bytecode_compatible_32 = ref false (* -compat-32 *) and output_c_object = ref false (* -output-obj *) and output_complete_object = ref false (* -output-complete-obj *) +and output_complete_executable = ref false (* -output-complete-exe *) and all_ccopts = ref ([] : string list) (* -ccopt *) and classic = ref false (* -nolabels *) and nopervasives = ref false (* -nopervasives *) @@ -178,6 +179,8 @@ let inlining_report = ref false (* -inlining-report *) let afl_instrument = ref Config.afl_instrument (* -afl-instrument *) let afl_inst_ratio = ref 100 (* -afl-inst-ratio *) +let function_sections = ref false (* -function-sections *) + let simplify_rounds = ref None (* -rounds *) let default_simplify_rounds = ref 1 (* -rounds *) let rounds () = diff --git a/utils/clflags.mli b/utils/clflags.mli index 1aaff70c..1743fc1c 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -85,6 +85,7 @@ val no_check_prims : bool ref val bytecode_compatible_32 : bool ref val output_c_object : bool ref val output_complete_object : bool ref +val output_complete_executable : bool ref val all_ccopts : string list ref val classic : bool ref val nopervasives : bool ref @@ -206,6 +207,7 @@ val dump_flambda_verbose : bool ref val classic_inlining : bool ref val afl_instrument : bool ref val afl_inst_ratio : int ref +val function_sections : bool ref val all_passes : string list ref val dumped_pass : string -> bool diff --git a/utils/config.mli b/utils/config.mli index b089f61d..560283f2 100644 --- a/utils/config.mli +++ b/utils/config.mli @@ -223,6 +223,10 @@ val flat_float_array : bool (** Whether the compiler and runtime automagically flatten float arrays *) +val function_sections : bool +(** Whether the compiler was configured to generate + each function in a separate section *) + val windows_unicode: bool (** Whether Windows Unicode runtime is enabled *) diff --git a/utils/config.mlp b/utils/config.mlp index a5619bde..4a3bea23 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -80,27 +80,28 @@ let supports_shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%% let flat_float_array = %%FLAT_FLOAT_ARRAY%% +let function_sections = %%FUNCTION_SECTIONS%% let afl_instrument = %%AFL_INSTRUMENT%% -let exec_magic_number = "Caml1999X026" +let exec_magic_number = "Caml1999X027" (* exec_magic_number is duplicated in runtime/caml/exec.h *) -and cmi_magic_number = "Caml1999I026" -and cmo_magic_number = "Caml1999O026" -and cma_magic_number = "Caml1999A026" +and cmi_magic_number = "Caml1999I027" +and cmo_magic_number = "Caml1999O027" +and cma_magic_number = "Caml1999A027" and cmx_magic_number = if flambda then - "Caml1999y026" + "Caml1999y027" else - "Caml1999Y026" + "Caml1999Y027" and cmxa_magic_number = if flambda then - "Caml1999z026" + "Caml1999z027" else - "Caml1999Z026" -and ast_impl_magic_number = "Caml1999M026" -and ast_intf_magic_number = "Caml1999N026" -and cmxs_magic_number = "Caml1999D026" -and cmt_magic_number = "Caml1999T026" + "Caml1999Z027" +and ast_impl_magic_number = "Caml1999M027" +and ast_intf_magic_number = "Caml1999N027" +and cmxs_magic_number = "Caml1999D027" +and cmt_magic_number = "Caml1999T027" let interface_suffix = ref ".mli" @@ -195,6 +196,7 @@ let configuration_variables = p_bool "safe_string" safe_string; p_bool "default_safe_string" default_safe_string; p_bool "flat_float_array" flat_float_array; + p_bool "function_sections" function_sections; p_bool "afl_instrument" afl_instrument; p_bool "windows_unicode" windows_unicode; p_bool "supports_shared_libraries" supports_shared_libraries; diff --git a/utils/domainstate.ml.c b/utils/domainstate.ml.c new file mode 100644 index 00000000..7ece1ad8 --- /dev/null +++ b/utils/domainstate.ml.c @@ -0,0 +1,34 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +type t = +#define DOMAIN_STATE(type, name) | Domain_##name +#include "domain_state.tbl" +#undef DOMAIN_STATE + +let idx_of_field = + let curr = 0 in +#define DOMAIN_STATE(type, name) \ + let idx__##name = curr in \ + let curr = curr + 1 in +#include "domain_state.tbl" +#undef DOMAIN_STATE + let _ = curr in + function +#define DOMAIN_STATE(type, name) \ + | Domain_##name -> idx__##name +#include "domain_state.tbl" +#undef DOMAIN_STATE diff --git a/utils/domainstate.mli.c b/utils/domainstate.mli.c new file mode 100644 index 00000000..1da60c94 --- /dev/null +++ b/utils/domainstate.mli.c @@ -0,0 +1,22 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* KC Sivaramakrishnan, Indian Institute of Technology, Madras */ +/* Stephen Dolan, University of Cambridge */ +/* */ +/* Copyright 2019 Indian Institute of Technology, Madras */ +/* Copyright 2019 University of Cambridge */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +type t = +#define DOMAIN_STATE(type, name) | Domain_##name +#include "domain_state.tbl" +#undef DOMAIN_STATE + +val idx_of_field : t -> int diff --git a/utils/dune b/utils/dune index e372dcf2..39c76af3 100644 --- a/utils/dune +++ b/utils/dune @@ -19,3 +19,27 @@ ../Makefile.config config.mlp) (action (system "make -f %{mk} %{targets}"))) + +(rule + (targets domainstate.ml) + (mode fallback) + (deps (:conf ../Makefile.config) + (:c domainstate.ml.c) + (:tbl ../runtime/caml/domain_state.tbl)) + (action + (with-stdout-to %{targets} + (bash + "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}" + )))) + +(rule + (targets domainstate.mli) + (mode fallback) + (deps (:conf ../Makefile.config) + (:c domainstate.mli.c) + (:tbl ../runtime/caml/domain_state.tbl)) + (action + (with-stdout-to %{targets} + (bash + "`grep '^CPP=' %{conf} | cut -d'=' -f2` -I ../runtime/caml %{c} %{tbl}" + )))) diff --git a/utils/misc.ml b/utils/misc.ml index 2b073ce5..f42b7935 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -182,11 +182,6 @@ module Stdlib = struct module Option = struct type 'a t = 'a option - let value_default f ~default a = - match a with - | None -> default - | Some a -> f a - let print print_contents ppf t = match t with | None -> Format.pp_print_string ppf "None" @@ -242,9 +237,6 @@ module Stdlib = struct external compare : 'a -> 'a -> int = "%compare" end -let may = Option.iter -let may_map = Option.map - (* File functions *) let find_in_path path name = @@ -926,13 +918,13 @@ module EnvLazy = struct | Raise e -> raise e | Thunk e -> match f e with - | None -> - x := Done None; + | (Error _ as err : _ result) -> + x := Done err; log := Cons(x, e, !log); - None - | Some _ as y -> - x := Done y; - y + err + | Ok _ as res -> + x := Done res; + res | exception e -> x := Raise e; raise e diff --git a/utils/misc.mli b/utils/misc.mli index 97d9fefa..1e24039a 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -76,8 +76,6 @@ val list_remove: 'a -> 'a list -> 'a list element equal to [x] removed. *) val split_last: 'a list -> 'a list * 'a (* Return the last element and the other elements of the given list. *) -val may: ('a -> unit) -> 'a option -> unit -val may_map: ('a -> 'b) -> 'a option -> 'b option type ref_and_value = R : 'a ref * 'a -> ref_and_value @@ -144,8 +142,6 @@ module Stdlib : sig module Option : sig type 'a t = 'a option - val value_default : ('a -> 'b) -> default:'b -> 'a t -> 'b - val print : (Format.formatter -> 'a -> unit) -> Format.formatter @@ -479,11 +475,13 @@ module EnvLazy: sig val create_forced : 'b -> ('a, 'b) t val create_failed : exn -> ('a, 'b) t - (* [force_logged log f t] is equivalent to [force f t] but if [f] returns - [None] then [t] is recorded in [log]. [backtrack log] will then reset all - the recorded [t]s back to their original state. *) + (* [force_logged log f t] is equivalent to [force f t] but if [f] + returns [Error _] then [t] is recorded in [log]. [backtrack log] + will then reset all the recorded [t]s back to their original + state. *) val log : unit -> log - val force_logged : log -> ('a -> 'b option) -> ('a,'b option) t -> 'b option + val force_logged : + log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result val backtrack : log -> unit end diff --git a/utils/warnings.ml b/utils/warnings.ml index c5044a3e..9c834854 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -91,6 +91,7 @@ type t = | Unsafe_without_parsing (* 64 *) | Redefining_unit of string (* 65 *) | Unused_open_bang of string (* 66 *) + | Unused_functor_parameter of string (* 67 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -168,9 +169,10 @@ let number = function | Unsafe_without_parsing -> 64 | Redefining_unit _ -> 65 | Unused_open_bang _ -> 66 + | Unused_functor_parameter _ -> 67 ;; -let last_warning_number = 66 +let last_warning_number = 67 ;; (* Must be the max number returned by the [number] function. *) @@ -391,7 +393,7 @@ let parse_options errflag s = current := {(!current) with error; active} (* If you change these, don't forget to change them in man/ocamlc.m *) -let defaults_w = "+a-4-6-7-9-27-29-32..42-44-45-48-50-60-66";; +let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67";; let defaults_warn_error = "-a+31";; let () = parse_options false defaults_w;; @@ -604,10 +606,14 @@ let message = function | Unused_module s -> "unused module " ^ s ^ "." | Unboxable_type_in_prim_decl t -> Printf.sprintf - "This primitive declaration uses type %s, which is unannotated and\n\ - unboxable. The representation of such types may change in future\n\ - versions. You should annotate the declaration of %s with [@@boxed]\n\ - or [@@unboxed]." t t + "This primitive declaration uses type %s, whose representation\n\ + may be either boxed or unboxed. Without an annotation to indicate\n\ + which representation is intended, the boxed representation has been\n\ + selected by default. This default choice may change in future\n\ + versions of the compiler, breaking the primitive implementation.\n\ + You should explicitly annotate the declaration of %s\n\ + with [@@boxed] or [@@unboxed], so that its external interface\n\ + remains stable in the future." t t | Constraint_on_gadt -> "Type constraints do not apply to GADT cases of variant types." | Erroneous_printed_signature s -> @@ -624,6 +630,7 @@ let message = function "This type declaration is defining a new '()' constructor\n\ which shadows the existing one.\n\ Hint: Did you mean 'type %s = unit'?" name + | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "." ;; let nerrors = ref 0;; diff --git a/utils/warnings.mli b/utils/warnings.mli index 4fe4964f..b80ab34c 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -93,6 +93,7 @@ type t = | Unsafe_without_parsing (* 64 *) | Redefining_unit of string (* 65 *) | Unused_open_bang of string (* 66 *) + | Unused_functor_parameter of string (* 67 *) ;; type alert = {kind:string; message:string; def:loc; use:loc} diff --git a/yacc/Makefile b/yacc/Makefile index d4a0c8cc..bbd8dcc4 100644 --- a/yacc/Makefile +++ b/yacc/Makefile @@ -18,12 +18,19 @@ ROOTDIR = .. include $(ROOTDIR)/Makefile.config +include $(ROOTDIR)/Makefile.common OC_CPPFLAGS += -I$(ROOTDIR)/runtime +ifeq "$(UNIX_OR_WIN32)" "win32" +WSTR_OBJ = wstr +else +WSTR_OBJ = +endif + ocamlyacc_SOURCES := $(addsuffix .c,\ - closure error lalr lr0 main mkpar output reader skeleton symtab verbose \ - warshall) + $(WSTR_OBJ) closure error lalr lr0 main mkpar output reader skeleton \ + symtab verbose warshall) ocamlyacc_OBJECTS := $(ocamlyacc_SOURCES:.c=.$(O)) @@ -31,12 +38,8 @@ generated_files := ocamlyacc$(EXE) $(ocamlyacc_OBJECTS) version.h all: ocamlyacc$(EXE) -ifeq ($(TOOLCHAIN),cc) -MKEXE_ANSI=$(MKEXE) -endif - ocamlyacc$(EXE): $(ocamlyacc_OBJECTS) - $(MKEXE_ANSI) -o $@ $^ $(EXTRALIBS) + $(MKEXE) -o $@ $^ $(EXTRALIBS) version.h : $(ROOTDIR)/VERSION echo "#define OCAML_VERSION \"`sed -e 1q $< | tr -d '\r'`\"" > $@ @@ -58,9 +61,3 @@ skeleton.$(O): defs.h symtab.$(O): defs.h verbose.$(O): defs.h warshall.$(O): defs.h - -# The following rule is similar to make's default one, except that it -# also works for .obj files. - -%.$(O): %.c - $(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $< diff --git a/yacc/defs.h b/yacc/defs.h index bb7305a2..91aadc3e 100644 --- a/yacc/defs.h +++ b/yacc/defs.h @@ -25,7 +25,13 @@ #include #include #include -#include "caml/s.h" +#include +#define CAML_INTERNALS +#include "caml/config.h" +#include "caml/mlvalues.h" +#include "caml/osdeps.h" + +#define caml_stat_strdup strdup /* machine-dependent definitions */ /* the following definitions are for the Tahoe */ @@ -69,11 +75,9 @@ /* defines for constructing filenames */ -#define CODE_SUFFIX ".code.c" -#define DEFINES_SUFFIX ".tab.h" -#define OUTPUT_SUFFIX ".ml" -#define VERBOSE_SUFFIX ".output" -#define INTERFACE_SUFFIX ".mli" +#define OUTPUT_SUFFIX T(".ml") +#define VERBOSE_SUFFIX T(".output") +#define INTERFACE_SUFFIX T(".mli") /* keyword codes */ @@ -205,7 +209,6 @@ struct action /* global variables */ -extern char dflag; extern char lflag; extern char rflag; extern char tflag; @@ -215,27 +218,31 @@ extern char sflag; extern char eflag; extern char big_endian; +/* myname should be UTF-8 encoded */ extern char *myname; extern char *cptr; extern char *line; extern int lineno; +/* virtual_input_file_name should be UTF-8 encoded */ extern char *virtual_input_file_name; extern int outline; -extern char *action_file_name; -extern char *entry_file_name; -extern char *code_file_name; -extern char *defines_file_name; -extern char *input_file_name; -extern char *output_file_name; -extern char *text_file_name; -extern char *verbose_file_name; -extern char *interface_file_name; +extern char_os *action_file_name; +extern char_os *entry_file_name; +extern char_os *code_file_name; +extern char_os *input_file_name; +extern char_os *output_file_name; +extern char_os *text_file_name; +extern char_os *verbose_file_name; +extern char_os *interface_file_name; + +/* UTF-8 versions of code_file_name and input_file_name */ +extern char *code_file_name_disp; +extern char *input_file_name_disp; extern FILE *action_file; extern FILE *entry_file; extern FILE *code_file; -extern FILE *defines_file; extern FILE *input_file; extern FILE *output_file; extern FILE *text_file; @@ -250,7 +257,7 @@ extern int ntokens; extern int nvars; extern int ntags; -extern char line_format[]; +#define line_format "# %d \"%s\"\n" extern int start_symbol; extern char **symbol_name; @@ -299,13 +306,6 @@ extern short final_state; /* global functions */ -#ifdef __GNUC__ -/* Works only in GCC 2.5 and later */ -#define Noreturn __attribute ((noreturn)) -#else -#define Noreturn -#endif - extern char *allocate(unsigned int n); extern bucket *lookup(char *name); extern bucket *make_bucket(char *name); @@ -330,7 +330,7 @@ extern void lr0 (void); extern void make_parser (void); extern void no_grammar (void) Noreturn; extern void no_space (void) Noreturn; -extern void open_error (char *filename) Noreturn; +extern void open_error (char_os *filename) Noreturn; extern void output (void); extern void prec_redeclared (void); extern void polymorphic_entry_point(char *s) Noreturn; diff --git a/yacc/error.c b/yacc/error.c index f116f2c8..b2750c97 100644 --- a/yacc/error.c +++ b/yacc/error.c @@ -19,6 +19,9 @@ #include "defs.h" +/* String displayed if we can't malloc a buffer for the UTF-8 conversion */ +static char *unknown = ""; + void fatal(char *msg) { fprintf(stderr, "%s: f - %s\n", myname, msg); @@ -33,9 +36,10 @@ void no_space(void) } -void open_error(char *filename) +void open_error(char_os *filename) { - fprintf(stderr, "%s: f - cannot open \"%s\"\n", myname, filename); + char *u8 = caml_stat_strdup_of_os(filename); + fprintf(stderr, "%s: f - cannot open \"%s\"\n", myname, (u8 ? u8 : unknown)); done(2); } diff --git a/yacc/main.c b/yacc/main.c index 9bb37861..a60f4676 100644 --- a/yacc/main.c +++ b/yacc/main.c @@ -24,7 +24,6 @@ #include "version.h" -char dflag; char lflag; char rflag; char tflag; @@ -34,12 +33,14 @@ char eflag; char sflag; char big_endian; -char *file_prefix = 0; +char_os *file_prefix = 0; char *myname = "yacc"; -char temp_form[] = "yacc.XXXXXXX"; +char_os temp_form[] = T("yacc.XXXXXXX"); #ifdef _WIN32 -char dirsep = '\\'; +wchar_t dirsep = L'\\'; +/* mingw provides an implementation of mkstemp, but it's ANSI only */ +#undef HAS_MKSTEMP #else char dirsep = '/'; #endif @@ -48,15 +49,16 @@ int lineno; char *virtual_input_file_name = NULL; int outline; -char *action_file_name; -char *entry_file_name; -char *code_file_name; -char *interface_file_name; -char *defines_file_name; -char *input_file_name = ""; -char *output_file_name; -char *text_file_name; -char *verbose_file_name; +char_os *action_file_name; +char_os *entry_file_name; +char_os *code_file_name; +char *code_file_name_disp; +char_os *interface_file_name; +char_os *input_file_name = T(""); +char *input_file_name_disp; +char_os *output_file_name; +char_os *text_file_name; +char_os *verbose_file_name; #ifdef HAS_MKSTEMP int action_fd = -1, entry_fd = -1, text_fd = -1; @@ -66,7 +68,6 @@ FILE *action_file; /* a temp file, used to save actions associated */ /* with rules until the parser is written */ FILE *entry_file; FILE *code_file; /* y.code.c (used when the -r option is specified) */ -FILE *defines_file; /* y.tab.h */ FILE *input_file; /* the input file */ FILE *output_file; /* y.tab.c */ FILE *text_file; /* a temp file, used to save text until all */ @@ -97,10 +98,6 @@ char *rassoc; short **derives; char *nullable; -#if !defined(HAS_MKSTEMP) -extern char *mktemp(char *); -#endif - void done(int k) { @@ -112,15 +109,15 @@ void done(int k) if (text_fd != -1) unlink(text_file_name); #else - if (action_file) { fclose(action_file); unlink(action_file_name); } - if (entry_file) { fclose(entry_file); unlink(entry_file_name); } - if (text_file) { fclose(text_file); unlink(text_file_name); } + if (action_file) { fclose(action_file); unlink_os(action_file_name); } + if (entry_file) { fclose(entry_file); unlink_os(entry_file_name); } + if (text_file) { fclose(text_file); unlink_os(text_file_name); } #endif if (output_file && k > 0) { - fclose(output_file); unlink(output_file_name); + fclose(output_file); unlink_os(output_file_name); } if (interface_file && k > 0) { - fclose(interface_file); unlink(interface_file_name); + fclose(interface_file); unlink_os(interface_file_name); } exit(k); } @@ -156,12 +153,13 @@ void usage(void) exit(1); } -void getargs(int argc, char **argv) +void getargs(int argc, char_os **argv) { register int i; - register char *s; + register char_os *s; - if (argc > 0) myname = argv[0]; + if (argc > 0) myname = caml_stat_strdup_of_os(argv[0]); + if (!myname) no_space(); for (i = 1; i < argc; ++i) { s = argv[i]; @@ -170,12 +168,12 @@ void getargs(int argc, char **argv) { case '\0': input_file = stdin; - file_prefix = "stdin"; + file_prefix = T("stdin"); if (i + 1 < argc) usage(); return; case '-': - if (!strcmp (argv[i], "--strict")){ + if (!strcmp_os (argv[i], T("--strict"))){ eflag = 1; goto end_of_option; } @@ -183,11 +181,11 @@ void getargs(int argc, char **argv) goto no_more_options; case 'v': - if (!strcmp (argv[i], "-version")){ + if (!strcmp_os (argv[i], T("-version"))){ printf ("The OCaml parser generator, version " OCAML_VERSION "\n"); exit (0); - }else if (!strcmp (argv[i], "-vnum")){ + }else if (!strcmp_os (argv[i], T("-vnum"))){ printf (OCAML_VERSION "\n"); exit (0); }else{ @@ -237,12 +235,14 @@ end_of_option:; no_more_options:; if (i + 1 != argc) usage(); input_file_name = argv[i]; + input_file_name_disp = caml_stat_strdup_of_os(input_file_name); + if (!input_file_name_disp) no_space(); if (file_prefix == 0) { int len; - len = strlen(argv[i]); - file_prefix = malloc(len + 1); + len = strlen_os(argv[i]); + file_prefix = MALLOC((len + 1) * sizeof(char_os)); if (file_prefix == 0) no_space(); - strcpy(file_prefix, argv[i]); + strcpy_os(file_prefix, argv[i]); while (len > 0) { len--; if (file_prefix[len] == '.') { @@ -272,30 +272,30 @@ allocate(unsigned int n) void create_file_names(void) { int i, len; - char *tmpdir; + char_os *tmpdir; #ifdef _WIN32 - tmpdir = getenv("TEMP"); - if (tmpdir == 0) tmpdir = "."; + tmpdir = _wgetenv(L"TEMP"); + if (tmpdir == 0) tmpdir = L"."; #else tmpdir = getenv("TMPDIR"); if (tmpdir == 0) tmpdir = "/tmp"; #endif - len = strlen(tmpdir); + len = strlen_os(tmpdir); i = len + sizeof(temp_form); if (len && tmpdir[len-1] != dirsep) ++i; - action_file_name = MALLOC(i); + action_file_name = MALLOC(i * sizeof(char_os)); if (action_file_name == 0) no_space(); - entry_file_name = MALLOC(i); + entry_file_name = MALLOC(i * sizeof(char_os)); if (entry_file_name == 0) no_space(); - text_file_name = MALLOC(i); + text_file_name = MALLOC(i * sizeof(char_os)); if (text_file_name == 0) no_space(); - strcpy(action_file_name, tmpdir); - strcpy(entry_file_name, tmpdir); - strcpy(text_file_name, tmpdir); + strcpy_os(action_file_name, tmpdir); + strcpy_os(entry_file_name, tmpdir); + strcpy_os(text_file_name, tmpdir); if (len && tmpdir[len - 1] != dirsep) { @@ -305,13 +305,13 @@ void create_file_names(void) ++len; } - strcpy(action_file_name + len, temp_form); - strcpy(entry_file_name + len, temp_form); - strcpy(text_file_name + len, temp_form); + strcpy_os(action_file_name + len, temp_form); + strcpy_os(entry_file_name + len, temp_form); + strcpy_os(text_file_name + len, temp_form); - action_file_name[len + 5] = 'a'; - entry_file_name[len + 5] = 'e'; - text_file_name[len + 5] = 't'; + action_file_name[len + 5] = L'a'; + entry_file_name[len + 5] = L'e'; + text_file_name[len + 5] = L't'; #ifdef HAS_MKSTEMP action_fd = mkstemp(action_file_name); @@ -324,35 +324,37 @@ void create_file_names(void) if (text_fd == -1) open_error(text_file_name); #else - mktemp(action_file_name); - mktemp(entry_file_name); - mktemp(text_file_name); + mktemp_os(action_file_name); + mktemp_os(entry_file_name); + mktemp_os(text_file_name); #endif - len = strlen(file_prefix); + len = strlen_os(file_prefix); - output_file_name = MALLOC(len + 7); + output_file_name = MALLOC((len + 7) * sizeof(char_os)); if (output_file_name == 0) no_space(); - strcpy(output_file_name, file_prefix); - strcpy(output_file_name + len, OUTPUT_SUFFIX); + strcpy_os(output_file_name, file_prefix); + strcpy_os(output_file_name + len, OUTPUT_SUFFIX); code_file_name = output_file_name; + code_file_name_disp = caml_stat_strdup_of_os(code_file_name); + if (!code_file_name_disp) no_space(); if (vflag) { - verbose_file_name = MALLOC(len + 8); + verbose_file_name = MALLOC((len + 8) * sizeof(char_os)); if (verbose_file_name == 0) no_space(); - strcpy(verbose_file_name, file_prefix); - strcpy(verbose_file_name + len, VERBOSE_SUFFIX); + strcpy_os(verbose_file_name, file_prefix); + strcpy_os(verbose_file_name + len, VERBOSE_SUFFIX); } - interface_file_name = MALLOC(len + 8); + interface_file_name = MALLOC((len + 8) * sizeof(char_os)); if (interface_file_name == 0) no_space(); - strcpy(interface_file_name, file_prefix); - strcpy(interface_file_name + len, INTERFACE_SUFFIX); + strcpy_os(interface_file_name, file_prefix); + strcpy_os(interface_file_name + len, INTERFACE_SUFFIX); } @@ -363,7 +365,7 @@ void open_files(void) if (input_file == 0) { - input_file = fopen(input_file_name, "r"); + input_file = fopen_os(input_file_name, T("r")); if (input_file == 0) open_error(input_file_name); } @@ -371,7 +373,7 @@ void open_files(void) #ifdef HAS_MKSTEMP action_file = fdopen(action_fd, "w"); #else - action_file = fopen(action_file_name, "w"); + action_file = fopen_os(action_file_name, T("w")); #endif if (action_file == 0) open_error(action_file_name); @@ -379,7 +381,7 @@ void open_files(void) #ifdef HAS_MKSTEMP entry_file = fdopen(entry_fd, "w"); #else - entry_file = fopen(entry_file_name, "w"); + entry_file = fopen_os(entry_file_name, T("w")); #endif if (entry_file == 0) open_error(entry_file_name); @@ -387,32 +389,25 @@ void open_files(void) #ifdef HAS_MKSTEMP text_file = fdopen(text_fd, "w"); #else - text_file = fopen(text_file_name, "w"); + text_file = fopen_os(text_file_name, T("w")); #endif if (text_file == 0) open_error(text_file_name); if (vflag) { - verbose_file = fopen(verbose_file_name, "w"); + verbose_file = fopen_os(verbose_file_name, T("w")); if (verbose_file == 0) open_error(verbose_file_name); } - if (dflag) - { - defines_file = fopen(defines_file_name, "w"); - if (defines_file == 0) - open_error(defines_file_name); - } - - output_file = fopen(output_file_name, "w"); + output_file = fopen_os(output_file_name, T("w")); if (output_file == 0) open_error(output_file_name); if (rflag) { - code_file = fopen(code_file_name, "w"); + code_file = fopen_os(code_file_name, T("w")); if (code_file == 0) open_error(code_file_name); } @@ -420,12 +415,16 @@ void open_files(void) code_file = output_file; - interface_file = fopen(interface_file_name, "w"); + interface_file = fopen_os(interface_file_name, T("w")); if (interface_file == 0) open_error(interface_file_name); } +#ifdef _WIN32 +int wmain(int argc, wchar_t **argv) +#else int main(int argc, char **argv) +#endif { set_signals(); getargs(argc, argv); diff --git a/yacc/output.c b/yacc/output.c index 4e871dec..384890ae 100644 --- a/yacc/output.c +++ b/yacc/output.c @@ -785,7 +785,7 @@ void output_stored_text(void) register FILE *in, *out; fclose(text_file); - text_file = fopen(text_file_name, "r"); + text_file = fopen_os(text_file_name, T("r")); if (text_file == NULL) open_error(text_file_name); in = text_file; @@ -802,7 +802,7 @@ void output_stored_text(void) putc(c, out); } if (!lflag) - fprintf(out, line_format, ++outline + 1, code_file_name); + fprintf(out, line_format, ++outline + 1, code_file_name_disp); } @@ -855,7 +855,7 @@ void output_trailing_text(void) if (!lflag) { ++outline; - fprintf(out, line_format, lineno, input_file_name); + fprintf(out, line_format, lineno, input_file_name_disp); } if (c == '\n') ++outline; @@ -867,7 +867,7 @@ void output_trailing_text(void) if (!lflag) { ++outline; - fprintf(out, line_format, lineno, input_file_name); + fprintf(out, line_format, lineno, input_file_name_disp); } do { putc(c, out); } while ((c = *++cptr) != '\n'); ++outline; @@ -890,18 +890,18 @@ void output_trailing_text(void) putc('\n', out); } if (!lflag) - fprintf(out, line_format, ++outline + 1, code_file_name); + fprintf(out, line_format, ++outline + 1, code_file_name_disp); } -void copy_file(FILE **file, char *file_name) +void copy_file(FILE **file, char_os *file_name) { register int c, last; register FILE *out = code_file; int state = 0; fclose(*file); - *file = fopen(file_name, "r"); + *file = fopen_os(file_name, T("r")); if (*file == NULL) open_error(file_name); @@ -915,7 +915,7 @@ void copy_file(FILE **file, char *file_name) case ' ': state = (state == 2) ? 3 : 0; break; case '0': if (state == 3){ - fprintf (out, "%d \"%s", outline+2, code_file_name); + fprintf (out, "%d \"%s", outline+2, code_file_name_disp); c = '"'; } state = 0; diff --git a/yacc/reader.c b/yacc/reader.c index ea1460b7..1b0a5f6b 100644 --- a/yacc/reader.c +++ b/yacc/reader.c @@ -49,8 +49,6 @@ bucket **plhs; int name_pool_size; char *name_pool; -char line_format[] = "# %d \"%s\"\n"; - static unsigned char caml_ident_start[32] = "\000\000\000\000\000\000\000\000\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377"; static unsigned char caml_ident_body[32] = @@ -234,6 +232,14 @@ int process_apostrophe(FILE *const f) && cptr[4] == '\'') { fwrite(cptr, 1, 5, f); cptr += 5; + } else if (cptr[0] == '\\' + && cptr[1] == 'o' + && cptr[2] >= '0' && cptr[2] <= '3' + && cptr[3] >= '0' && cptr[3] <= '7' + && cptr[4] >= '0' && cptr[4] <= '7' + && cptr[5] == '\'') { + fwrite(cptr, 1, 6, f); + cptr += 6; } else if (cptr[0] == '\\' && cptr[2] == '\'') { fwrite(cptr, 1, 3, f); cptr += 3; @@ -362,6 +368,9 @@ static void process_comment(FILE *const f) { process_open_curly_bracket(f); continue; default: + if (In_bitmap(caml_ident_start, c)) { + while (In_bitmap(caml_ident_body, *cptr)) cptr++; + } continue; } } @@ -554,7 +563,7 @@ void copy_text(void) if (line == 0) unterminated_text(t_lineno, t_line, t_cptr); } - fprintf(f, line_format, lineno, input_file_name); + fprintf(f, line_format, lineno, input_file_name_disp); loop: c = *cptr++; @@ -600,6 +609,12 @@ loop: goto loop; default: putc(c, f); + if (In_bitmap(caml_ident_start, c)) { + while (In_bitmap(caml_ident_body, *cptr)) { + putc(*cptr, f); + cptr++; + } + } need_newline = 1; goto loop; } @@ -1271,7 +1286,7 @@ void copy_action(void) item->name); } fprintf(f, " Obj.repr(\n"); - fprintf(f, line_format, lineno, input_file_name); + fprintf(f, line_format, lineno, input_file_name_disp); for (i = 0; i < cptr - line; i++) fputc(' ', f); fputc ('(', f); @@ -1805,8 +1820,8 @@ void print_grammar(void) void reader(void) { - virtual_input_file_name = substring (input_file_name, 0, - strlen (input_file_name)); + virtual_input_file_name = caml_stat_strdup_of_os(input_file_name); + if (!virtual_input_file_name) no_space(); create_symbol_table(); read_declarations(); output_token_type(); diff --git a/yacc/wstr.c b/yacc/wstr.c new file mode 100644 index 00000000..c22feeec --- /dev/null +++ b/yacc/wstr.c @@ -0,0 +1,60 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* David Allsopp, OCaml Labs, Cambridge. */ +/* */ +/* Copyright 2017 MetaStack Solutions Ltd. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +/* Need at least Windows Vista for WC_ERR_INVALID_CHARS */ +#define _WIN32_WINNT 0x600 +#define WINVER 0x600 +#include + +/* See corresponding values in runtime/win32.c */ +static int windows_unicode_enabled = WINDOWS_UNICODE; +static int windows_unicode_strict = 1; + +/* Adapted from runtime/win32.c */ +int win_wide_char_to_multi_byte(const wchar_t *s, int slen, + char *out, int outlen) +{ + int retcode; + + if (slen == 0) + return 0; + + if (windows_unicode_enabled != 0) + retcode = + WideCharToMultiByte(CP_UTF8, + windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0, + s, slen, out, outlen, NULL, NULL); + else + retcode = + WideCharToMultiByte(CP_ACP, 0, s, slen, out, outlen, NULL, NULL); + + if (retcode == 0) + return -1; + + return retcode; +} + +char* caml_stat_strdup_of_utf16(const wchar_t *s) +{ + char *out = NULL; + int retcode; + + retcode = win_wide_char_to_multi_byte(s, -1, NULL, 0); + if (retcode >= 0) { + out = (char *)malloc(retcode); + win_wide_char_to_multi_byte(s, -1, out, retcode); + } + + return out; +}