utils/consistbl.cmi : \
utils/misc.cmi
utils/diffing.cmo : \
+ utils/misc.cmi \
utils/diffing.cmi
utils/diffing.cmx : \
+ utils/misc.cmx \
+ utils/diffing.cmi
+utils/diffing.cmi : \
+ utils/misc.cmi
+utils/diffing_with_keys.cmo : \
+ utils/misc.cmi \
+ utils/diffing.cmi \
+ utils/diffing_with_keys.cmi
+utils/diffing_with_keys.cmx : \
+ utils/misc.cmx \
+ utils/diffing.cmx \
+ utils/diffing_with_keys.cmi
+utils/diffing_with_keys.cmi : \
utils/diffing.cmi
-utils/diffing.cmi :
utils/domainstate.cmo : \
utils/domainstate.cmi
utils/domainstate.cmx : \
typing/ident.cmi \
typing/errortrace.cmi \
typing/env.cmi \
+ typing/btype.cmi \
parsing/asttypes.cmi
typing/datarepr.cmo : \
typing/types.cmi \
utils/warnings.cmi \
typing/types.cmi \
typing/subst.cmi \
+ typing/shape.cmi \
typing/predef.cmi \
typing/persistent_env.cmi \
typing/path.cmi \
utils/warnings.cmx \
typing/types.cmx \
typing/subst.cmx \
+ typing/shape.cmx \
typing/predef.cmx \
typing/persistent_env.cmx \
typing/path.cmx \
utils/warnings.cmi \
typing/types.cmi \
typing/subst.cmi \
+ typing/shape.cmi \
typing/path.cmi \
utils/misc.cmi \
parsing/longident.cmi \
typing/includeclass.cmi
typing/includeclass.cmi : \
typing/types.cmi \
+ typing/printtyp.cmi \
parsing/location.cmi \
typing/env.cmi \
typing/ctype.cmi
typing/printtyp.cmi \
typing/primitive.cmi \
typing/path.cmi \
+ utils/misc.cmi \
typing/ident.cmi \
typing/errortrace.cmi \
typing/env.cmi \
+ utils/diffing_with_keys.cmi \
typing/ctype.cmi \
parsing/builtin_attributes.cmi \
typing/btype.cmi \
typing/printtyp.cmx \
typing/primitive.cmx \
typing/path.cmx \
+ utils/misc.cmx \
typing/ident.cmx \
typing/errortrace.cmx \
typing/env.cmx \
+ utils/diffing_with_keys.cmx \
typing/ctype.cmx \
parsing/builtin_attributes.cmx \
typing/btype.cmx \
parsing/location.cmi \
typing/ident.cmi \
typing/errortrace.cmi \
- typing/env.cmi
+ typing/env.cmi \
+ utils/diffing_with_keys.cmi
typing/includemod.cmo : \
typing/types.cmi \
typing/typedtree.cmi \
typing/subst.cmi \
+ typing/shape.cmi \
typing/printtyp.cmi \
typing/primitive.cmi \
typing/predef.cmi \
typing/types.cmx \
typing/typedtree.cmx \
typing/subst.cmx \
+ typing/shape.cmx \
typing/printtyp.cmx \
typing/primitive.cmx \
typing/predef.cmx \
typing/includemod.cmi : \
typing/types.cmi \
typing/typedtree.cmi \
+ typing/shape.cmi \
typing/path.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
typing/env.cmi \
typing/ctype.cmi \
- typing/btype.cmi \
parsing/asttypes.cmi \
typing/patterns.cmi
typing/patterns.cmx : \
typing/ident.cmx \
typing/env.cmx \
typing/ctype.cmx \
- typing/btype.cmx \
parsing/asttypes.cmi \
typing/patterns.cmi
typing/patterns.cmi : \
typing/types.cmi \
typing/typedtree.cmi \
parsing/printast.cmi \
+ parsing/pprintast.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/longident.cmi \
typing/types.cmx \
typing/typedtree.cmx \
parsing/printast.cmx \
+ parsing/pprintast.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
parsing/longident.cmx \
typing/rec_check.cmi : \
typing/typedtree.cmi \
typing/ident.cmi
+typing/shape.cmo : \
+ typing/path.cmi \
+ utils/misc.cmi \
+ utils/identifiable.cmi \
+ typing/ident.cmi \
+ typing/shape.cmi
+typing/shape.cmx : \
+ typing/path.cmx \
+ utils/misc.cmx \
+ utils/identifiable.cmx \
+ typing/ident.cmx \
+ typing/shape.cmi
+typing/shape.cmi : \
+ typing/path.cmi \
+ utils/identifiable.cmi \
+ typing/ident.cmi
typing/signature_group.cmo : \
typing/types.cmi \
typing/ident.cmi \
utils/misc.cmi \
parsing/location.cmi \
utils/local_store.cmi \
+ utils/lazy_backtrack.cmi \
typing/ident.cmi \
utils/clflags.cmi \
typing/btype.cmi \
utils/misc.cmx \
parsing/location.cmx \
utils/local_store.cmx \
+ utils/lazy_backtrack.cmx \
typing/ident.cmx \
utils/clflags.cmx \
typing/btype.cmx \
typing/subst.cmi : \
typing/types.cmi \
typing/path.cmi \
+ parsing/parsetree.cmi \
parsing/location.cmi \
typing/ident.cmi
typing/tast_iterator.cmo : \
typing/typedtree.cmi \
typing/typedecl.cmi \
typing/subst.cmi \
+ typing/shape.cmi \
typing/rec_check.cmi \
typing/printtyp.cmi \
typing/printpat.cmi \
typing/typedtree.cmx \
typing/typedecl.cmx \
typing/subst.cmx \
+ typing/shape.cmx \
typing/rec_check.cmx \
typing/printtyp.cmx \
typing/printpat.cmx \
typing/typecore.cmi : \
typing/types.cmi \
typing/typedtree.cmi \
+ typing/shape.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/longident.cmi \
typing/env.cmi
typing/typedecl_unboxed.cmo : \
typing/types.cmi \
- typing/predef.cmi \
typing/env.cmi \
typing/ctype.cmi \
typing/typedecl_unboxed.cmi
typing/typedecl_unboxed.cmx : \
typing/types.cmx \
- typing/predef.cmx \
typing/env.cmx \
typing/ctype.cmx \
typing/typedecl_unboxed.cmi
parsing/asttypes.cmi
typing/typedtree.cmo : \
typing/types.cmi \
+ typing/shape.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
typing/typedtree.cmi
typing/typedtree.cmx : \
typing/types.cmx \
+ typing/shape.cmx \
typing/primitive.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
typing/typedtree.cmi
typing/typedtree.cmi : \
typing/types.cmi \
+ typing/shape.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
typing/typeclass.cmi \
typing/subst.cmi \
typing/signature_group.cmi \
+ typing/shape.cmi \
typing/printtyp.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
typing/typeclass.cmx \
typing/subst.cmx \
typing/signature_group.cmx \
+ typing/shape.cmx \
typing/printtyp.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
typing/types.cmi \
typing/typedtree.cmi \
typing/typedecl.cmi \
+ typing/shape.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/longident.cmi \
typing/typeopt.cmo : \
typing/types.cmi \
typing/typedtree.cmi \
- typing/typedecl.cmi \
+ typing/typedecl_unboxed.cmi \
+ typing/type_immediacy.cmi \
typing/predef.cmi \
typing/path.cmi \
lambda/lambda.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/config.cmi \
+ utils/clflags.cmi \
parsing/asttypes.cmi \
typing/typeopt.cmi
typing/typeopt.cmx : \
typing/types.cmx \
typing/typedtree.cmx \
- typing/typedecl.cmx \
+ typing/typedecl_unboxed.cmx \
+ typing/type_immediacy.cmx \
typing/predef.cmx \
typing/path.cmx \
lambda/lambda.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/config.cmx \
+ utils/clflags.cmx \
parsing/asttypes.cmi \
typing/typeopt.cmi
typing/typeopt.cmi : \
typing/env.cmi
typing/types.cmo : \
typing/type_immediacy.cmi \
+ typing/shape.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
- utils/identifiable.cmi \
+ utils/local_store.cmi \
typing/ident.cmi \
utils/config.cmi \
parsing/asttypes.cmi \
typing/types.cmi
typing/types.cmx : \
typing/type_immediacy.cmx \
+ typing/shape.cmx \
typing/primitive.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
- utils/identifiable.cmx \
+ utils/local_store.cmx \
typing/ident.cmx \
utils/config.cmx \
parsing/asttypes.cmi \
typing/types.cmi
typing/types.cmi : \
typing/type_immediacy.cmi \
+ typing/shape.cmi \
typing/primitive.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
- utils/identifiable.cmi \
typing/ident.cmi \
parsing/asttypes.cmi
typing/typetexp.cmo : \
utils/numbers.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
+ parsing/location.cmi \
+ lambda/debuginfo.cmi \
asmcomp/dataflow.cmi \
asmcomp/cmm.cmi \
asmcomp/polling.cmi
utils/numbers.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
+ parsing/location.cmx \
+ lambda/debuginfo.cmx \
asmcomp/dataflow.cmx \
asmcomp/cmm.cmx \
asmcomp/polling.cmi
lambda/runtimedef.cmi :
lambda/simplif.cmo : \
utils/warnings.cmi \
+ lambda/tmc.cmi \
typing/primitive.cmi \
parsing/location.cmi \
lambda/lambda.cmi \
lambda/simplif.cmi
lambda/simplif.cmx : \
utils/warnings.cmx \
+ lambda/tmc.cmx \
typing/primitive.cmx \
parsing/location.cmx \
lambda/lambda.cmx \
lambda/switch.cmx : \
lambda/switch.cmi
lambda/switch.cmi :
+lambda/tmc.cmo : \
+ utils/warnings.cmi \
+ parsing/location.cmi \
+ lambda/lambda.cmi \
+ typing/ident.cmi \
+ lambda/debuginfo.cmi \
+ parsing/asttypes.cmi \
+ lambda/tmc.cmi
+lambda/tmc.cmx : \
+ utils/warnings.cmx \
+ parsing/location.cmx \
+ lambda/lambda.cmx \
+ typing/ident.cmx \
+ lambda/debuginfo.cmx \
+ parsing/asttypes.cmi \
+ lambda/tmc.cmi
+lambda/tmc.cmi : \
+ lambda/lambda.cmi
lambda/translattribute.cmo : \
utils/warnings.cmi \
typing/typedtree.cmi \
typing/types.cmi \
typing/typedtree.cmi \
typing/tast_mapper.cmi \
+ typing/shape.cmi \
utils/misc.cmi \
parsing/location.cmi \
utils/load_path.cmi \
typing/types.cmx \
typing/typedtree.cmx \
typing/tast_mapper.cmx \
+ typing/shape.cmx \
utils/misc.cmx \
parsing/location.cmx \
utils/load_path.cmx \
file_formats/cmt_format.cmi : \
typing/types.cmi \
typing/typedtree.cmi \
+ typing/shape.cmi \
utils/misc.cmi \
parsing/location.cmi \
typing/env.cmi \
typing/typemod.cmi \
typing/typedtree.cmi \
typing/typecore.cmi \
+ typing/shape.cmi \
utils/profile.cmi \
typing/printtyped.cmi \
typing/printtyp.cmi \
typing/typemod.cmx \
typing/typedtree.cmx \
typing/typecore.cmx \
+ typing/shape.cmx \
utils/profile.cmx \
typing/printtyped.cmx \
typing/printtyp.cmx \
typing/outcometree.cmi \
typing/env.cmi
toplevel/topcommon.cmo : \
+ typing/typedtree.cmi \
parsing/printast.cmi \
typing/predef.cmi \
parsing/pprintast.cmi \
driver/compmisc.cmi \
driver/compenv.cmi \
utils/clflags.cmi \
+ parsing/asttypes.cmi \
parsing/ast_helper.cmi \
toplevel/topcommon.cmi
toplevel/topcommon.cmx : \
+ typing/typedtree.cmx \
parsing/printast.cmx \
typing/predef.cmx \
parsing/pprintast.cmx \
driver/compmisc.cmx \
driver/compenv.cmx \
utils/clflags.cmx \
+ parsing/asttypes.cmi \
parsing/ast_helper.cmx \
toplevel/topcommon.cmi
toplevel/topcommon.cmi : \
utils/warnings.cmi \
typing/types.cmi \
+ typing/typedtree.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
typing/outcometree.cmi \
toplevel/topcommon.cmi \
bytecomp/symtable.cmi \
lambda/simplif.cmi \
+ typing/shape.cmi \
typing/printtyped.cmi \
typing/printtyp.cmi \
lambda/printlambda.cmi \
file_formats/cmo_format.cmi \
utils/clflags.cmi \
bytecomp/bytegen.cmi \
- parsing/asttypes.cmi \
toplevel/byte/topeval.cmi
toplevel/byte/topeval.cmx : \
utils/warnings.cmx \
toplevel/topcommon.cmx \
bytecomp/symtable.cmx \
lambda/simplif.cmx \
+ typing/shape.cmx \
typing/printtyped.cmx \
typing/printtyp.cmx \
lambda/printlambda.cmx \
file_formats/cmo_format.cmi \
utils/clflags.cmx \
bytecomp/bytegen.cmx \
- parsing/asttypes.cmi \
toplevel/byte/topeval.cmi
toplevel/byte/topeval.cmi : \
toplevel/topcommon.cmi \
parsing/parsetree.cmi
toplevel/byte/topmain.cmo : \
+ typing/types.cmi \
toplevel/byte/trace.cmi \
toplevel/toploop.cmi \
toplevel/byte/topeval.cmi \
utils/clflags.cmi \
toplevel/byte/topmain.cmi
toplevel/byte/topmain.cmx : \
+ typing/types.cmx \
toplevel/byte/trace.cmx \
toplevel/toploop.cmx \
toplevel/byte/topeval.cmx \
typing/typedtree.cmi \
typing/typecore.cmi \
lambda/translmod.cmi \
+ toplevel/native/tophooks.cmi \
toplevel/topcommon.cmi \
lambda/simplif.cmi \
- asmcomp/proc.cmi \
+ typing/shape.cmi \
typing/printtyped.cmi \
typing/printtyp.cmi \
lambda/printlambda.cmi \
utils/load_path.cmi \
lambda/lambda.cmi \
typing/includemod.cmi \
- middle_end/flambda/import_approx.cmi \
typing/ident.cmi \
- middle_end/flambda/flambda_middle_end.cmi \
typing/env.cmi \
utils/config.cmi \
driver/compmisc.cmi \
middle_end/compilenv.cmi \
- middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
- middle_end/backend_intf.cmi \
- parsing/asttypes.cmi \
- parsing/ast_helper.cmi \
asmcomp/asmlink.cmi \
- asmcomp/asmgen.cmi \
- asmcomp/arch.cmo \
toplevel/native/topeval.cmi
toplevel/native/topeval.cmx : \
utils/warnings.cmx \
typing/typedtree.cmx \
typing/typecore.cmx \
lambda/translmod.cmx \
+ toplevel/native/tophooks.cmx \
toplevel/topcommon.cmx \
lambda/simplif.cmx \
- asmcomp/proc.cmx \
+ typing/shape.cmx \
typing/printtyped.cmx \
typing/printtyp.cmx \
lambda/printlambda.cmx \
utils/load_path.cmx \
lambda/lambda.cmx \
typing/includemod.cmx \
- middle_end/flambda/import_approx.cmx \
typing/ident.cmx \
- middle_end/flambda/flambda_middle_end.cmx \
typing/env.cmx \
utils/config.cmx \
driver/compmisc.cmx \
middle_end/compilenv.cmx \
+ utils/clflags.cmx \
+ asmcomp/asmlink.cmx \
+ toplevel/native/topeval.cmi
+toplevel/native/topeval.cmi : \
+ toplevel/topcommon.cmi \
+ parsing/parsetree.cmi
+toplevel/native/tophooks.cmo : \
+ toplevel/topcommon.cmi \
+ asmcomp/proc.cmi \
+ utils/misc.cmi \
+ lambda/lambda.cmi \
+ middle_end/flambda/import_approx.cmi \
+ middle_end/flambda/flambda_middle_end.cmi \
+ utils/config.cmi \
+ middle_end/compilenv.cmi \
+ middle_end/closure/closure_middle_end.cmi \
+ utils/clflags.cmi \
+ middle_end/backend_intf.cmi \
+ asmcomp/asmlink.cmi \
+ asmcomp/asmgen.cmi \
+ asmcomp/arch.cmo \
+ toplevel/native/tophooks.cmi
+toplevel/native/tophooks.cmx : \
+ toplevel/topcommon.cmx \
+ asmcomp/proc.cmx \
+ utils/misc.cmx \
+ lambda/lambda.cmx \
+ middle_end/flambda/import_approx.cmx \
+ middle_end/flambda/flambda_middle_end.cmx \
+ utils/config.cmx \
+ middle_end/compilenv.cmx \
middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
middle_end/backend_intf.cmi \
- parsing/asttypes.cmi \
- parsing/ast_helper.cmx \
asmcomp/asmlink.cmx \
asmcomp/asmgen.cmx \
asmcomp/arch.cmx \
- toplevel/native/topeval.cmi
-toplevel/native/topeval.cmi : \
+ toplevel/native/tophooks.cmi
+toplevel/native/tophooks.cmi : \
toplevel/topcommon.cmi \
- parsing/parsetree.cmi
+ lambda/lambda.cmi
toplevel/native/topmain.cmo : \
toplevel/toploop.cmi \
toplevel/native/topeval.cmi \
# No header for text files (would be too obtrusive).
*.md typo.missing-header
README* typo.missing-header
+VERSION typo.missing-header
*.adoc typo.missing-header
api_docgen/*.mld typo.missing-header
api_docgen/alldoc.tex typo.missing-header
otherlibs/win32unix/symlink.c typo.long-line
runtime/sak.c typo.non-ascii
+runtime/caml/compatibility.h typo.very-long-line
stdlib/hashbang typo.white-at-eol typo.missing-lf
testsuite/tools/*.S typo.missing-header
testsuite/tools/*.asm typo.missing-header
testsuite/typing typo.missing-header
+testsuite/tests/messages/highlight_tabs.ml typo.tab
# prune testsuite reference files
testsuite/tests/**/*.reference typo.prune
tools/ocamlsize text eol=lf
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
MAKE_ARG=-j make distclean
- name: configure tree
run: |
- MAKE_ARG=-j XARCH=x64 CONFIG_ARG='--enable-flambda --enable-cmm-invariants --enable-dependency-generation' OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh configure
+ MAKE_ARG=-j XARCH=x64 CONFIG_ARG='--enable-flambda --enable-cmm-invariants --enable-dependency-generation --enable-native-toplevel' OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh configure
- name: Build
run: |
MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh build
/ocamlopt
/ocamlopt.opt
/ocamlnat
+/_opam
# specific files and patterns in sub-directories
/lex/parser.output
/manual/src/cmds/warnings-help.etex
+/manual/src/html_processing/src/common.ml
/manual/src/warnings-help.etex
/api_docgen/build
Wilfred Hughes <wilfred@fb.com> <wilfred@mantis>
John Skaller <skaller@mantis>
Eduardo Rafael <EduardoRFS@github>
+Runhang Li <objmagic@github>
# These contributors prefer to be referred to pseudonymously
whitequark <whitequark@whitequark.org>
-OCaml 4.13.1 (01 October 2021)
---------------------------------
+OCaml 4.14.0 (28 March 2022)
+----------------------------
+
+### Language features (highlights):
+
+- #10437: Allow explicit binders for type variables.
+ (Stephen Dolan, review by Leo White)
+
+- #181, #9760, #10740: opt-in tail-modulo-cons (TMC) transformation
+ let[@tail_mod_cons] rec map f li = ...
+ (Frédéric Bour, Gabriel Scherer, Basile Clément,
+ review by Basile Clément and Pierre Chambart,
+ tested by Konstantin Romanov)
+
+### Runtime system (highlights):
+
+- #10195, #10680: Speed up GC by prefetching during marking
+ (Stephen Dolan, review by Xavier Leroy, Guillaume Munch-Maccagnoni,
+ Jacques-Henri Jourdan, Damien Doligez and Leo White)
+
+### Code generation and optimizations (highlights):
+
+- #10595: Tail calls with up to 64 arguments are guaranteed to be compiled
+ as tail calls. To this end, memory locations in the domain state
+ are used for passing arguments that do not fit in registers.
+ (Xavier Leroy, review by Vincent Laviron)
+
+### Standard library (highlights):
+
+* #10710: Add UTF tools, codecs and validations to the Uchar, Bytes and
+ String modules.
+ (Daniel Bünzli, review by Florian Angeletti, Nicolás Ojeda Bär, Alain
+ Frisch and Gabriel Scherer)
+
+* #10482: mark the Stream and Genlex modules as deprecated, in preparation
+ for a future removal. These modules (without deprecation alert)
+ are now provided by the camlp-streams library.
+ (Xavier Leroy, review by Nicolás Ojeda Bär)
+
+- #10545: Add In_channel and Out_channel modules.
+ (Nicolás Ojeda Bär, review by Daniel Bünzli, Simon Cruanes, Gabriel Scherer,
+ Guillaume Munch-Maccagnoni, Alain Frisch and Xavier Leroy)
+
+### Compiler user-interface and warnings (highlights)
+
+- #10328, #10780: Give more precise error when disambiguation could not
+ possibly work.
+ (Leo White, review by Gabriel Scherer and Florian Angeletti)
+
+- #10361: Improve error messages for mismatched record and variant
+ definitions.
+ (Florian Angeletti, review by Gabriel Radanne and Gabriel Scherer)
+
+- #10407: Produce more detailed error messages that contain full error traces
+ when module inclusion fails.
+ (Antal Spector-Zabusky, review by Florian Angeletti)
+
+### Internal/compiler-libs changes (highlights):
+
+- #10718, #11012: Add "Shape" information to the cmt files. Shapes are an
+ abstraction of modules that can be used by external tooling to perform
+ definition-aware operations.
+ (Ulysse Gérard, Thomas Refis and Leo White, review by Florian Angeletti)
+
+
+### Language features:
+
+- #10462: Add attribute to produce a compiler error for polls.
+ (Sadiq Jaffer, review by Mark Shinwell, Stephen Dolan
+ and Guillaume Munch-Maccagnoni)
+
+- #10441: Remove unnecessary parentheses surrounding immediate objects.
+ Allow 'object ... end # f', 'f object ... end', etc.
+ (Yan Dong, review by Nicolás Ojeda Bär, Florian Angeletti and Gabriel Scherer)
+
+### Runtime system:
+
+* #9391, #9424: Fix failed assertion in runtime due to ephemerons *set_* and
+ *blit_* function during Mark phase
+ (François Bobot, reported by Stephen Dolan, reviewed by Damien Doligez)
+
+- #10549: Stack overflow detection and naked pointers checking for ARM64
+ (Xavier Leroy, review by Stephen Dolan)
+
+* #10675, #10937: Emit deprecation warnings when old C runtime function names
+ are used. This will break C stub code that uses these old names and
+ treats warnings as errors. The workaround is to use the new names.
+ (Xavier Leroy and David Allsopp, review by Sébastien Hinderer and
+ Damien Doligez)
+
+- #10698, #10726, #10891: Free the alternate signal stack when the main OCaml
+ code or an OCaml thread stops
+ (Xavier Leroy, review by David Allsopp and Damien Doligez)
+
+- #10730, 10731: Fix bug in `Obj.reachable_words` causing a slowdown when called
+ multiple time (Alain Frisch, report by ygrek, review by Xavier Leroy)
+
+### Code generation and optimizations:
+
+- #10578: Increase the number of integer registers used for
+ parameter passing on PowerPC (16 registers) and on s390x (8 registers).
+ (Xavier Leroy, review by Mark Shinwell)
+
+- #10591, #10615: Tune the heuristic for CSE of integer constants
+ so as to avoid excessive CSE on compiler-generated constants
+ and long register allocation times.
+ (Xavier Leroy, report by Edwin Török, review by Nicolás Ojeda Bär)
+
+- #10681: Enforce boolean conditions for the native backend
+ (Vincent Laviron, review by Gabriel Scherer)
+
+- #10719: Ensure that build_apply respects Lambda.max_arity
+ (Stephen Dolan, review by Xavier Leroy)
+
+- #10728: Ensure that functions are evaluated after their arguments
+ (Stephen Dolan, review by Mark Shinwell)
+
+- #10732: Ensure right-to-left evaluation of arguments in cmm_helpers
+ (Greta Yorsh, review by Xavier Leroy)
+
+### Standard library:
+
+* #10622: Annotate `Uchar.t` with immediate attribute
+ (Hongbo Zhang, reivew by Gabriel Scherer and Nicolás Ojeda Bär)
+
+* #7812, #10475: `Filename.chop_suffix name suff` now checks that `suff`
+ is actually a suffix of `name` and raises Invalid_argument otherwise.
+ (Xavier Leroy, report by whitequark, review by David Allsopp)
+
+- #10526: add Random.bits32, Random.bits64, Random.nativebits
+ (Xavier Leroy, review by Gabriel Scherer and François Bobot)
+
+* #10568: remove Obj.marshal and Obj.unmarshal
+ (these functions have been deprecated for a while and are superseded
+ by the functions from module Marshal)
+ (François Pottier, review by Gabriel Scherer and Kate Deplaix)
+
+- #10538: add Out_channel.set_buffered and Out_channel.is_buffered to control
+ the buffering mode of output channels.
+ (Nicolás Ojeda Bär, review by John Whitington, Daniel Bünzli, David Allsopp
+ and Xavier Leroy)
+
+* #10583, #10998: Add over 40 new functions in Seq.
+ (François Pottier and Simon Cruanes, review by Nicolás Ojeda Bär,
+ Daniel Bünzli, Naëla Courant, Craig Ferguson, Wiktor Kuchta,
+ Xavier Leroy, Guillaume Munch-Maccagnoni, Raphaël Proust, Gabriel Scherer
+ and Thierry Martinez)
+
+- #10596, #10978: Add with_open_bin, with_open_text and with_open_gen to
+ In_channel and Out_channel. Also, add In_channel.input_all.
+ (Nicolás Ojeda Bär, review by Daniel Bünzli, Jérémie Dimino, Damien Doligez
+ and Xavier Leroy)
+
+- #10658: add detailed information about the current version of OCaml
+ to the Sys module of the standard library.
+ (Sébastien Hinderer, review by Damien Doligez, Gabriel Scherer, David
+ Allsopp, Nicolás Ojeda Bär, Vincent Laviron)
+
+- #10642: On Windows, Sys.remove and Unix.unlink now remove symlinks
+ to directories instead of raising EACCES. Introduce
+ caml/winsupport.h to hold more common code between the runtime,
+ lib-sys, and win32unix.
+ (Antonin Décimo, review by David Allsopp and Xavier Leroy)
+
+- #10737: add new ephemeron API for forward compatibility with Multicore
+ OCaml.
+ (Damien Doligez, review by Stephen Dolan)
+
+* #10922: Add deprecation warnings on {Int32,Int64,Nativeint}.format.
+ (Nicolás Ojeda Bär, review by Xavier Leroy and Florian Angeletti)
+
+### Other libraries:
+
+- #10192: Add support for Unix domain sockets on Windows and use them
+ to emulate Unix.socketpair (only available on Windows 1803+)
+ (Antonin Décimo, review by David Allsopp)
+
+- #10469: Add Thread.set_uncaught_exception_handler and
+ Thread.default_uncaught_exception_handler.
+ (Enguerrand Decorne, review by David Allsopp)
+
+- #10697: Bindings of dup and dup2 in win32unix now correctly call
+ WSADuplicateSocket on sockets instead of DuplicateHandle.
+ (Antonin Décimo, review by Xavier Leroy and Nicolás Ojeda Bär)
+
+- #10951: Introduce the Thread.Exit exception as an alternative way to
+ terminate threads prematurely. This alternative way will become
+ the standard way in 5.00.
+ (Xavier Leroy, review by Florian Angeletti)
+
+### Tools:
+
+- #10839: Fix regression of #show when printing class type
+ (Élie Brami, review by Florian Angeletti)
+
+- #3959, #7202, #10476: ocaml, in script mode, directive errors
+ (`#use "missing_file";;`) use stderr and exit with an error.
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #10438: add a new toplevel cli argument `-e <script>` to
+ run script passed to the toplevel.
+ (Pavlo Khrystenko, review by Gabriel Scherer)
+
+- #10524: Directive argument type error now shows expected and received type.
+ (Wiktor Kuchta, review by Gabriel Scherer)
+
+- #10560: Disable colors if the env variable `NO_COLOR` is set. If
+ `OCAML_COLOR` is set, its setting takes precedence over `NO_COLOR`.
+ (Nicolás Ojeda Bär, report by Gabriel Scherer, review by Daniel Bünzli,
+ Gabriel Scherer and David Allsopp)
+
+- #10565: Toplevel value printing: truncate strings only after 8 bytes.
+ (Wiktor Kuchta, review by Xavier Leroy)
+
+- #10527: Show "#help;; for help" at toplevel startup
+ (Wiktor Kuchta, review by David Allsopp and Florian Angeletti)
+
+- #10846: add the `-shape` command-line option to ocamlobjinfo. When reading a
+ `cmt` file, shape information will only be shown if that option is used.
+ (Ulysse Gérard, review by Florian Angeletti)
+
+### Debugging:
+
+- #10517, #10594: when running ocamldebug on a program linked with the
+ threads library, don't fail immediately; instead, allow debugging
+ until the program creates a thread for the first time, then fail cleanly.
+ (Xavier Leroy, report by @anentropic, review by Gabriel Scherer)
+
+- #9621: Pack the ocamldebug modules to minimize clashes
+ (Raphael Sousa Santos, review by Vincent Laviron and Gabriel Scherer)
+
+### Manual and documentation:
+
+- #7812, #10475: reworded the description of the behaviors of
+ float->int conversions in case of overflow, and of iterators
+ in case of concurrent modifications.
+ (Xavier Leroy, report by whitequark, review by David Allsopp)
+
+- #8697, #10666: add M, m, n options of the OCAMLRUNPARAM to manual and man page
+ for ocamlrun command line options
+ (Dong An and Anukriti Kumar, review by David Allsopp, Gabriel Scherer
+ and Damien Doligez)
+
+- #10281, #10685: Add description of C compiler on macOS and Windows platforms.
+ (Dong An, review by Xavier Leroy and David Allsopp)
+
+- #10397: Document exceptions raised by Unix module functions on Windows
+ (Martin Jambon, review by Daniel Bünzli, David Alsopp, Damien Doligez,
+ Xavier Leroy, and Florian Angeletti)
+
+- #10589: Fix many typos (excess/inconsistent spaces) in the HTML manual.
+ (Wiktor Kuchta, review by Florian Angeletti)
+
+- #10605: manual, name few css classes to ease styling and maintainability.
+ (Florian Angeletti, review by Wiktor Kuchta and Gabriel Scherer)
+
+- #10668, #10669: the changelog (this file), LICENSE and README files are now
+ installed as part of the distribution. The destination directory can be
+ customized using the `--docdir` argument to `./configure`.
+ (Nicolás Ojeda Bär, report by Daniel Bünzli, review by David Allsopp,
+ Sébastien Hinderer, and Daniel Bünzli)
+
+- #10671, #10672: webman: Fix misalignments in unordered lists by changing the
+ CSS for coloring bullets
+ (Wiktor Kuchta, review by Florian Angeletti)
+
+- #11107: Lifted comments in the Parsetree module into actual documentation.
+ (Paul-Elliot Anglès d'Auriac, review by Florian Angeletti)
+
+- #11120, #11133: man pages, add missing warning entries and add mnemonic names
+ to the list of warnings.
+ (Florian Angeletti, report by Kate Deplaix, review by Gabriel Scherer)
+
+### Compiler user-interface and warnings:
+
+- #10531: add naked_pointers to ocamlc -config exporting NAKED_POINTERS from
+ Makefile.config.
+ (Damien Doligez, review by Mark Shinwell and Gabriel Scherer)
+
+- #9116, #9118, #10582: Fix single-line source highlighting in the
+ presence of tabs
+ (Armaël Guéneau, review by Gabriel Scherer,
+ split off from #9118 by Kate Deplaix, report by Ricardo M. Correia)
+
+- #10488: Improve type variable name generation and recursive type detection
+ when printing type errors; this ensures that the names given to type variables
+ are always reused in the following portion of the trace and also removes
+ spurious `as 'a`s in types.
+ (Antal Spector-Zabusky, review by Florian Angeletti)
+
+- #10794: Clarify warning 57 (Ambiguous or-pattern variables under guard)
+ (Wiktor Kuchta, review by Gabriel Scherer)
+
+### Internal/compiler-libs changes:
+
+- #1599: add unset directive to ocamltest to clear environment variables before
+ running tests.
+ (David Allsopp, review by Damien Doligez and Sébastien Hinderer)
+
+- #8516: Change representation of class signatures
+ (Leo White, review by Thomas Refis)
+
+- #9444: -dtypedtree, print more explictly extra nodes in pattern ast.
+ (Frédéric Bour, review by Gabriel Scherer)
+
+- #10337: Normalize type_expr nodes on access
+ One should now use accessors such as get_desc and get_level to access fields
+ of type_expr, rather than calling manually Btype.repr (which is now hidden
+ in Types.Transient_expr).
+ (Jacques Garrigue and Takafumi Saikawa,
+ review by Florian Angeletti and Gabriel Radanne)
+
+- #10474: Force normalization on access to row_desc
+ Similar to #10337. Make row_desc an abstract types, with constructor
+ create_row and accessors defined in Types rather than Btype.
+ A normalized view row_desc_repr is provided for convenience.
+ (Jacques Garrigue and Takafumi Saikawa,
+ review by Leo White and Florian Angeletti)
+
+- #10541: Make field_kind and commutable abstract, enforcing correct access
+ (Jacques Garrigue and Takafumi Saikawa,
+ review by Thomas Refis and Florian Angeletti)
+
+- #10575: add a -dump-dir flag, which redirects all debugging printer
+ (`-dprofile`, `-dlambda`, ...) to the target directory
+ (Florian Angeletti, review by Thomas Refis and Gabriel Scherer)
+
+* #10627: Make row_field abstract
+ Completes #10474 by making row_field abstract too.
+ An immutable view row_field_view is provided, and one converts between it
+ and row_field via inj_row_field and row_field_repr.
+ (Jacques Garrigue and Takafumi Saikawa, review by Florian Angeletti)
+
+- #10433: Remove the distinction between 32-bit aligned and 64-bit aligned
+ 64-bit floats in Cmm.memory_chunk.
+ (Greta Yorsh, review by Xavier Leroy)
+
+- #10434: Pun labelled arguments with type constraint in function applications.
+ (Greta Yorsh, review by Nicolas Chataing and Nicolás Ojeda Bär)
+
+- #10470: Remove unused `cstr_normal` field from the `constructor_description`
+ type
+ (Nicolas Chataing, review by Gabriel Scherer)
+
+- #10382: Don't repeat environment entries in Typemod.check_type_decl
+ (Leo White, review by Gabriel Scherer and Florian Angeletti)
+
+- #10472: refactor caml_sys_random_seed to ease future Multicore changes
+ (Gabriel Scherer, review by Xavier Leroy)
+
+- #10487: Move logic to get the type path from a constructor return type in
+ Types
+ (Nicolas Chataing, review by Jacques Garrigue)
+
+- #10555: Do not use ghost locations for type constraints
+ (Nicolás Ojeda Bär, report by Anton Bachin, review by Thomas Refis)
+
+- #10598, #10616: fix an exponential blow-up when typechecking nested module
+ types
+ (Florian Angeletti, report and review by Stephen Dolan)
+
+- #10559: Evaluate signature substitutions lazily
+ (Stephen Dolan, review by Leo White)
+
+- #8776, #10624: Fix compilation time regression introduced in 4.08
+ (Nicolás Ojeda Bär, fix by Leo White, report by Alain Frisch, review by Thomas
+ Refis)
+
+- #10618: Expose more Pprintast functions
+ (Guillaume Petiot, review by Gabriel Scherer)
+
+- #10637: Outcometree: introduce a record type for constructors
+ (Gabriel Scherer, review by Thomas Refis)
+
+- #10516: refactor the compilation of the 'switch' construct
+ (Gabriel Scherer, review by Wiktor Kuchta and Luc Maranget)
+
+- #10670: avoid global C state in the RE engine for the "str" library
+ (Xavier Leroy, review by Gabriel Scherer)
+
+- #10678: Expose descriptions in Warnings module
+ (Leo White, review by Gabriel Scherer and Alain Frisch)
+
+- #10690: Always build ocamltoplevel.cmxa
+ (David Allsopp, review by Gabriel Scherer)
+
+- #10692: Expose Parse.module_type and Parse.module_expr
+ (Guillaume Petiot, review by Gabriel Scherer)
+
+- #10714: Add X86_proc.with_internal_assembler for temporarily changing the
+ assembler used by the backend.
+ (David Allsopp, review by Gabriel Scherer)
+
+- #10715: Allow the assembler and loader to be substituted in ocamlnat, for
+ example to be replaced with a binary emitter.
+ (David Allsopp and Nathan Rebours, review by Louis Gesbert,
+ Nicolás Ojeda Bär and Gabriel Scherer)
+
+- #10742: strong call-by-need reduction for shapes
+ (Gabriel Scherer and Nathanaëlle Courant,
+ review by Florian Angeletti, Ulysse Gérard and Thomas Refis)
+
+### Build system:
+
+- #10828 Build native-code compilers on OpenBSD/aarch64
+ (Christopher Zimmermann)
+
+- #10835 Disable DT_TEXTREL warnings on x86 32 bit architecture by passing
+ -Wl,-z,notext in mksharedlib and mkmaindll. Fixes relocation issues, reported
+ in #9800, making local patches in Debian, Alpine, and FreeBSD superfluous.
+ (Hannes Mehnert with Kate Deplaix and Stéphane Glondu, review by Xavier Leroy)
+
+- #10717: Simplify the installation of man pages
+ (Sébastien Hinderer, review by David Allsopp)
+
+- #10739: Stop installing extract_crc
+ (Sébastien Hinderer, review by David Allsopp, Daniel Bünzli, Xavier Leroy
+ and Gabriel Scherer)
+
+- #10797: Compile with -d2VolatileMetadata- on supporting versions of Visual
+ Studio. This suppresses the addition of .voltbl sections and eliminates
+ linking errors in systhreads.
+ (David Allsopp, review by Jonah Beckford and Sébastien Hinderer)
+
+### Bug fixes:
+
+- #9214, #10709: Wrong unmarshaling of function pointers in debugger mode.
+ This was causing ocamldebug to crash when running some user-defined printers.
+ (Xavier Leroy, report by Rehan Malak, review by Gabriel Scherer and
+ Vincent Laviron)
+
+- #10473: Add CFI directives to RISC-V runtime and asmcomp.
+ This allows stacktraces to work in gdb through C and OCaml calls.
+ (Edwin Török, review by Nicolás Ojeda Bär and Xavier Leroy)
+
+- #10539: Field kinds should be kept when copying types
+ Losing the sharing meant that one could desynchronize them between several
+ occurrences of self, allowing a method to be both public and hidden,
+ which broke type soundness.
+ (Jacques Garrigue, review by Leo White)
+
+- #10542: Fix detection of immediate64 types through unboxed types.
+ (Leo White, review by Stephen Dolan and Gabriel Scherer)
+
+- #10590: Some typechecker optimisations
+ (Stephen Dolan, review by Gabriel Scherer and Leo White)
+
+- #10633: Stack overflow recovery in ocamlopt for AMD64/Linux and ARM/Linux
+ was not restoring the minor heap pointer correctly
+ (Stephen Dolan, review by Xavier Leroy)
+
+- #10659: Fix freshening substitutions on imported modules
+ (Leo White and Stephen Dolan, review by Matthew Ryan)
+
+- #10677, #10679: Fix detection of CC as gcc in configure (allow for
+ triplet-prefixed GCC) and fix all C compiler detection when CC is a path
+ rather than a basename.
+ (David Allsopp, report by Fabian @copy, review by Gabriel Scherer)
+
+- #10690: Add --enable-native-toplevel to configure to enable installing
+ ocamlnat as part of the main build (default is not to install it)
+ (David Allsopp, review by Gabriel Scherer)
+
+- #10693: Fix ident collision in includemod
+ (Leo White, review by Matthew Ryan)
+
+- #10702: Fix cast of more strictly aligned pointer in win32unix
+ implementation of stat
+ (Antonin Décimo, review by David Allsopp)
+
+- #10712: Type-check toplevel terms in the native toplevel in the same way as
+ the bytecode toplevel. In particular, this fixes the loss of type variable
+ names in the native toplevel.
+ (Leo White, review by David Allsopp and Gabriel Scherer)
+
+- #10735: Uncaught unify exception from `build_as_type`
+ (Jacques Garrigue, report and review by Leo White)
+
+- #10763, #10764: fix miscompilation of method delegation
+ (Alain Frisch, review by Vincent Laviron and Jacques Garrigue)
+
+- #10822, #10823: Bad interaction between ambivalent types and subtyping
+ coercions (Jacques Garrigue, report and review by Frédéric Bour)
+
+- #10836, #10952: avoid internal typechecker errors when checking signature
+ inclusion in presence of incompatible types.
+ (Florian Angeletti, report by Craig Ferguson, review by Gabriel Scherer)
+
+- #10849: Display the result of `let _ : <type> = <expr>` in the native
+ toplevel, as in the bytecode toplevel.
+ (David Allsopp, report by Nathan Rebours, review by Gabriel Scherer)
+
+- #10853: `Obj.reachable_words` could crash if called after a marshaling
+ operation in `NO_SHARING` mode.
+ (Xavier Leroy, report by Anil Madhavapeddy, review by Alain Frisch)
+
+- #10907, #10959: Wrong type inferred from existential types
+ (Jacques Garrigue and Gabriel Scherer, report by @dyzsr, review by Leo White)
+
+- #10688: Move frame descriptor table from `rodata` to `data` section on
+ RISC-V. Improves support for building DLLs and PIEs. In particular, this
+ applies to all binaries in distributions that build PIEs by default (eg
+ Gentoo and Alpine).
+ (Alex Fan, review by Gabriel Scherer)
+
+- #11031: Exception handlers restore the rbp register when using frame-pointers
+ on amd64.
+ (Fabrice Buoro, with help from Stephen Dolan, Tom Kelly and Mark Shinwell,
+ review by Xavier Leroy)
+
+- #11025, #11036: Do not pass -no-pie to the C compiler on musl/arm64
+ (omni, Kate Deplaix and Antonio Nuno Monteiro, review by Xavier Leroy)
+
+- #11101, #11109: A recursive type constraint fails on 4.14
+ (Jacques Garrigue, report and review by Florian Angeletti)
+
+- #11118: Fix integer overflow on 64-bit Windows when indexing bigarrays (which
+ could lead to a segmentation fault).
+ (Roven Gabriel, review by Nicolás Ojeda Bär and Xavier Leroy)
+
+OCaml 4.13 maintenance branch
+-----------------------------
### Bug fixes
- #10327: Add a subdirectories variable and a copy action to ocamltest
(Sébastien Hinderer, review by David Allsopp)
+* #10337: Normalize type_expr nodes on access
+ One should now use accessors such as get_desc and get_level to access fields
+ of type_expr, rather than calling manually Btype.repr (which is now hidden
+ in Types.Transient_expr).
+ (Jacques Garrigue and Takafumi Saikawa,
+ review by Florian Angeletti and Gabriel Radanne)
+
- #10358: Use a hash table for the load path.
(Leo White, review by Gabriel Scherer)
make html_doc
----
-and then opening link:./api_docgen/build/html/libref/index.html[] in a web browser.
+and then opening link:./api_docgen/ocamldoc/build/html/libref/index.html[] in a web browser.
+The documentation is located in
+link:./api_docgen/odoc/build/html/libref/index.html[] when `--with-odoc` is
+passed to the configure script.
=== Tools
opam custom-install --no-recompilations ocaml-variants -- make install
-----
-Note aout the first installation:
+Note about the first installation:
When you start from an empty switch, and install a compiler (in our case,
-tha `ocaml-variants` package provided by the compiler's `opam` file), then
+the `ocaml-variants` package provided by the compiler's `opam` file), then
a number of additional packages are installed to ensure that the switch
will work correctly. Mainly, the `ocaml` package needs to be installed,
and while it's done automatically when using regular `opam` commands, the
----
which will do a bytecode build of all the distribution (without linking
-the executables), using your OCaml compiler, and generate a .merlin
-file.
+the executables), using your OCaml compiler.
Merlin will be looking at the artefacts generated by dune (in `_build`), rather
than trying to open the incompatible artefacts produced by a Makefile build. In
== Prerequisites
-* A C Compiler is required.
- The GNU C Compiler (`gcc`) is recommended as the bytecode interpreter takes
- advantage of GCC-specific features to enhance performance. gcc is the standard
- compiler under Linux and many other systems.
- However `clang` - used in Mac OS, BSDs and others - also works fine.
+* A C compiler is required.
+
+ ** For GNU/Linux +
+ The GNU C Compiler (`gcc`) is recommended as the bytecode interpreter takes
+ advantage of GCC-specific features to enhance performance. GCC is the standard
+ compiler under Linux and many other systems.
+
+ ** For BSDs +
+ `clang` is the default C compiler on BSDs - also works fine.
+
+ ** For macOS +
+ `clang` is the default C compiler under macOS. If macOS complains
+ no C compiler was installed while OCaml is building, please run
+ command `xcode-select --install` to install command-line tools and
+ required libraries and header files.
+
+ ** For other Unix-like systems +
+ It is recommended to use `gcc` or `clang` instead of the C compiler
+ provided by the vendor of the system.
+
+ ** For Windows +
+ To produce native Windows executables from OCaml sources, you need to use
+ the MSVC or Mingw-w64 ports of OCaml, described in file
+ https://github.com/ocaml/ocaml/blob/trunk/README.win32.adoc[README.win32.adoc]. +
+ For a more Unix-like experience, you can use WSL, the
+ https://aka.ms/wsl[Windows Subsystem for Linux], or the
+ https://www.cygwin.com/[Cygwin environment]. You will need the
+ GCC compiler (package `gcc-core` or `gcc`).
* GNU `make`, as well as POSIX-compatible `awk` and `sed` are required.
* Under Cygwin, the `gcc-core` package is required. `flexdll` is also necessary
for shared library support.
+* Binutils including `ar`, `ranlib`, and `strip` are required if your
+ distribution does not already provide them with the C compiler.
+
== Configuration
From the top directory, do:
./configure
-+
+
This generates the three configuration files `Makefile.config`,
`runtime/caml/m.h` and `runtime/caml/s.h`.
-+
+
The `configure` script accepts options that can be discovered by running:
./configure --help
-+
+
Some options or variables like LDLIBS may not be taken into account
by the OCaml build system at the moment. Please report an issue if you
discover such a variable or option and this causes troubles to you.
-+
+
Examples:
* Standard installation in `/usr/{bin,lib,man}` instead of `/usr/local`:
You can now install the OCaml system. This will create the following commands
(in the binary directory selected during autoconfiguration):
-+
+
[width="70%",frame="topbot",cols="25%,75%"]
|===============================================================================
| `ocamlc` | the batch bytecode compiler
| `ocamlprof` | the execution count profiler
| `ocamlcp` | the bytecode compiler in profiling mode
|===============================================================================
-+
+
From the top directory, become superuser and do:
make install
the C locale (`export LC_ALL=C`) before compiling if you have strange errors
while compiling OCaml.
-* On HP 9000/700 machines under HP/UX 9, some versions of `cc` are unable to
- compile correctly the runtime system (wrong code is generated for `(x - y)`
- where `x` is a pointer and `y` an integer). Fix: use `gcc`.
-
* In the unlikely case that a platform does not offer all C99 float operations
that the runtime needs, a configuration error will result. Users
can work around this problem by calling `configure` with the flag
utils/domainstate.mli: utils/domainstate.mli.c runtime/caml/domain_state.tbl
$(CPP) -I runtime/caml $< > $@
-configure: configure.ac aclocal.m4 VERSION tools/autogen
+configure: configure.ac aclocal.m4 build-aux/ocaml_version.m4 tools/autogen
tools/autogen
.PHONY: partialclean
$(MAKE) ocamlopt.opt
$(MAKE) otherlibrariesopt
$(MAKE) ocamllex.opt ocamltoolsopt ocamltoolsopt.opt $(OCAMLDOC_OPT) \
- $(OCAMLTEST_OPT)
+ $(OCAMLTEST_OPT) ocamlnat
ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true"
$(MAKE) manpages
endif
INSTALL_FLEXDLLDIR = $(INSTALL_LIBDIR)/flexdll
FLEXDLL_MANIFEST = default$(filter-out _i386,_$(ARCH)).manifest
+DOC_FILES=\
+ Changes \
+ README.adoc \
+ README.win32.adoc \
+ LICENSE
+
# Installation
.PHONY: install
install:
$(MKDIR) "$(INSTALL_LIBDIR)"
$(MKDIR) "$(INSTALL_STUBLIBDIR)"
$(MKDIR) "$(INSTALL_COMPLIBDIR)"
+ $(MKDIR) "$(INSTALL_DOCDIR)"
$(MAKE) -C runtime install
$(INSTALL_PROG) ocaml$(EXE) "$(INSTALL_BINDIR)"
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
endif
$(MAKE) -C tools install
ifeq "$(UNIX_OR_WIN32)" "unix" # Install manual pages only on Unix
- $(MKDIR) "$(INSTALL_MANDIR)/man$(PROGRAMS_MAN_SECTION)"
- -$(MAKE) -C man install
+ $(MAKE) -C man install
endif
for i in $(OTHERLIBRARIES); do \
$(MAKE) -C otherlibs/$$i install || exit $$?; \
"$(INSTALL_FLEXDLLDIR)"
endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
$(INSTALL_DATA) Makefile.config "$(INSTALL_LIBDIR)"
+ $(INSTALL_DATA) $(DOC_FILES) "$(INSTALL_DOCDIR)"
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
if test -f ocamlopt$(EXE); then $(MAKE) installopt; else \
cd "$(INSTALL_BINDIR)"; \
endif
$(INSTALL_DATA) \
utils/*.cmx parsing/*.cmx typing/*.cmx bytecomp/*.cmx \
+ toplevel/*.cmx toplevel/native/*.cmx \
+ toplevel/native/tophooks.cmi \
file_formats/*.cmx \
lambda/*.cmx \
driver/*.cmx asmcomp/*.cmx middle_end/*.cmx \
$(INSTALL_DATA) \
$(BYTESTART:.cmo=.cmx) $(BYTESTART:.cmo=.$(O)) \
$(OPTSTART:.cmo=.cmx) $(OPTSTART:.cmo=.$(O)) \
+ $(TOPLEVELSTART:.cmo=.$(O)) \
"$(INSTALL_COMPLIBDIR)"
- if test -f ocamlnat$(EXE) ; then \
- $(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"; \
- $(INSTALL_DATA) \
- toplevel/*.cmx \
- toplevel/native/*.cmx \
- $(TOPLEVELSTART:.cmo=.$(O)) \
- "$(INSTALL_COMPLIBDIR)"; \
- fi
+ifeq "$(INSTALL_OCAMLNAT)" "true"
+ $(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"
+endif
cd "$(INSTALL_COMPLIBDIR)" && \
$(RANLIB) ocamlcommon.$(A) ocamlbytecomp.$(A) ocamloptcomp.$(A)
manual-pregen: opt.opt
cd manual; $(MAKE) clean && $(MAKE) pregen-etex
+clean::
+ $(MAKE) -C manual clean
+
# The clean target
clean:: partialclean
rm -f $(programs) $(programs:=.exe)
# Copy parsing/parser.ml from boot/
-parsing/parser.ml: boot/menhir/parser.ml parsing/parser.mly \
- tools/check-parser-uptodate-or-warn.sh
+PARSER_DEPS = boot/menhir/parser.ml parsing/parser.mly
+
+ifeq "$(OCAML_DEVELOPMENT_VERSION)" "true"
+PARSER_DEPS += tools/check-parser-uptodate-or-warn.sh
+endif
+
+parsing/parser.ml: $(PARSER_DEPS)
+ifeq "$(OCAML_DEVELOPMENT_VERSION)" "true"
@-tools/check-parser-uptodate-or-warn.sh
+endif
sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@
parsing/parser.mli: boot/menhir/parser.mli
sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@
.PHONY: html_doc
html_doc: ocamldoc
$(MAKE) -C api_docgen html
- @echo "documentation is in ./api_docgen/html/"
.PHONY: manpages
manpages:
# The native toplevel
-ocamlnat$(EXE): compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
- compilerlibs/ocamlbytecomp.cmxa \
- otherlibs/dynlink/dynlink.cmxa \
- compilerlibs/ocamltoplevel.cmxa \
- $(TOPLEVELSTART:.cmo=.cmx)
- $(CAMLOPT_CMD) $(LINKFLAGS) -linkall -I toplevel/native -o $@ $^
+ocamlnat_dependencies := \
+ compilerlibs/ocamlcommon.cmxa \
+ compilerlibs/ocamloptcomp.cmxa \
+ compilerlibs/ocamlbytecomp.cmxa \
+ otherlibs/dynlink/dynlink.cmxa \
+ compilerlibs/ocamltoplevel.cmxa \
+ $(TOPLEVELSTART:.cmo=.cmx)
+ocamlnat$(EXE): $(ocamlnat_dependencies)
+ $(CAMLOPT_CMD) $(LINKFLAGS) -linkall -I toplevel/native -o $@ $^
toplevel/topdirs.cmx: toplevel/topdirs.ml
$(CAMLOPT_CMD) $(COMPFLAGS) $(OPTCOMPFLAGS) -I toplevel/native -c $<
.PHONY: distclean
distclean: clean
+ $(MAKE) -C manual distclean
+ $(MAKE) -C runtime distclean
+ $(MAKE) -C stdlib distclean
rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
boot/ocamlruns boot/ocamlruns.exe \
boot/flexlink.byte boot/flexlink.byte.exe \
boot/flexdll_*.o boot/flexdll_*.obj \
boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
rm -f Makefile.config Makefile.build_config
- rm -f runtime/caml/m.h runtime/caml/s.h
rm -rf autom4te.cache flexdll-sources
rm -f config.log config.status libtool
rm -f tools/eventlog_metadata
INSTALL_DATA ?= @INSTALL_DATA@
INSTALL_PROG ?= @INSTALL_PROGRAM@
+# Whether to install the native toplevel (ocamlnat)
+INSTALL_OCAMLNAT = @install_ocamlnat@
+
# The command to generate C dependency information
DEP_CC=@DEP_CC@ -MM
COMPUTE_DEPS=@compute_deps@
# Git submodule)
FLEXDLL_SOURCES=@flexdir@
BOOTSTRAPPING_FLEXDLL=@bootstrapping_flexdll@
+
+### Where to install documentation
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+datarootdir = @datarootdir@
+DOCDIR=@docdir@
INSTALL_LIBDIR := $(DESTDIR)$(LIBDIR)
INSTALL_STUBLIBDIR := $(DESTDIR)$(STUBLIBDIR)
INSTALL_MANDIR := $(DESTDIR)$(MANDIR)
+INSTALL_PROGRAMS_MAN_DIR := $(DESTDIR)$(PROGRAMS_MAN_DIR)
+INSTALL_LIBRARIES_MAN_DIR := $(DESTDIR)$(LIBRARIES_MAN_DIR)
+INSTALL_DOCDIR := $(DESTDIR)$(DOCDIR)
FLEXDLL_SUBMODULE_PRESENT := $(wildcard $(ROOTDIR)/flexdll/Makefile)
BOOT_OCAMLLEX ?= $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
# Default value for OCAMLLEX
-# In those directories where this needs to be overriden, the overriding
+# In those directories where this needs to be overridden, the overriding
# should take place *before* Makefile.common is included.
OCAMLLEX ?= $(BEST_OCAMLLEX)
# The configuration Makefile
+## Variables defining the current version of OCaml
+OCAML_DEVELOPMENT_VERSION=@OCAML_DEVELOPMENT_VERSION@
+OCAML_VERSION_MAJOR=@OCAML_VERSION_MAJOR@
+OCAML_VERSION_MINOR=@OCAML_VERSION_MINOR@
+OCAML_VERSION_PATCHLEVEL=@OCAML_VERSION_PATCHLEVEL@
+OCAML_VERSION_EXTRA=@OCAML_VERSION_EXTRA@
+
## The EMPTY variable, used in other definitions
EMPTY=
STUBLIBDIR=@libdir@/stublibs
### Where to install the man pages
-# Man pages for commands go in $(MANDIR)/man$(PROGRAMS_MAN_SECTION)
-# Man pages for the library go in $(MANDIR)/man/man$(LIBRARIES_MAN_SECTION)
+# Man pages for commands go in $(MANDIR)/man1
+# Man pages for the library go in $(MANDIR)/man3
MANDIR=@mandir@
-PROGRAMS_MAN_SECTION=@programs_man_section@
-LIBRARIES_MAN_SECTION=@libraries_man_section@
+PROGRAMS_MAN_DIR=$(MANDIR)/man1
+LIBRARIES_MAN_DIR=$(MANDIR)/man3
### Do #! scripts work on your system?
### Beware: on some systems (e.g. SunOS 4), this will work only if
$(OUTPUTEXE)$(1) $(2)
endif # ifeq "$(TOOLCHAIN)" "msvc"
-# The following variables were defined only in the Windows-specific makefiles.
-# They were not defined by the configure script used on Unix systems,
-# so we also make sure to provide them only under Windows
-# User code should absolutely not rely on their presence because
-# in the future their definition may be moved to a more private part of
-# the compiler's build system
-ifeq "$(UNIX_OR_WIN32)" "win32"
- CYGPATH=cygpath -m
- DIFF=/usr/bin/diff -q --strip-trailing-cr
- FIND=/usr/bin/find
- SORT=/usr/bin/sort
- SET_LD_PATH=PATH="$(PATH):$(LD_PATH)"
-else # ifeq "$(UNIX_OR_WIN32)" "win32"
- # On Unix, make sure FLEXLINK is defined but empty
- SORT=sort
- CYGPATH=echo
- SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)"
-endif # ifeq "$(UNIX_OR_WIN32)" "win32"
-
FLEXLINK_FLAGS=@flexlink_flags@
FLEXLINK_CMD=flexlink
FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS)
== Installation
See the file link:INSTALL.adoc[] for installation instructions on
-machines running Unix, Linux, macOS and Cygwin. For native Microsoft
+machines running Unix, Linux, macOS, WSL and Cygwin. For native Microsoft
Windows, see link:README.win32.adoc[].
== Documentation
https://ocaml.org/community/
-In particular, the IRC channel `#ocaml` on https://freenode.net/[Freenode] has a
+In particular, the IRC channel `#ocaml` on https://libera.chat/[Libera] has a
long history and welcomes questions.
== Bug Reports and User Feedback
All the Windows ports require a Unix-like build environment. Although other
methods are available, the officially supported environment for doing this is
-32-bit (x86) Cygwin.
+64-bit (x86_64) Cygwin.
Only the `make` Cygwin package is required. `diffutils` is required if you wish
to be able to run the test suite.
-4.13.1
+4.14.0
-# The version string is the first line of this file.
-# It must be in the format described in stdlib/sys.mli
+# Starting with OCaml 4.14, although the version string that appears above is
+# still correct and this file can thus still be used to figure it out,
+# the version itself is actually defined in the build-aux/ocaml_version.m4
+# file (See the OCAML__VERSION* macros there.)
+# To update the present VERSION file:
+# 1. Update build-aux/ocaml_version.m4
+# 2. Run tools/autogen.
+# 3. If you are in a context where version control matters,
+# commit the changes to both build-aux/ocaml_version.m4 and VERSION.
+# The version string must be in the format described in stdlib/sys.mli
m4_include([build-aux/ax_func_which_gethostbyname_r.m4])
m4_include([build-aux/ax_pthread.m4])
+# OCaml version
+m4_include([build-aux/ocaml_version.m4])
+
# The following macro figures out which C compiler is used.
# It does so by checking for compiler-specific predefined macros.
# A list of such macros can be found at
CFLAGS="$saved_CFLAGS"
])
+AC_DEFUN([OCAML_CL_HAS_VOLATILE_METADATA], [
+ AC_MSG_CHECKING([whether the C compiler supports -d2VolatileMetadata-])
+ saved_CFLAGS="$CFLAGS"
+ CFLAGS="-d2VolatileMetadata- $CFLAGS"
+ AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE([int main() { return 0; }])],
+ [cl_has_volatile_metadata=true
+ AC_MSG_RESULT([yes])],
+ [cl_has_volatile_metadata=false
+ AC_MSG_RESULT([no])])
+ CFLAGS="$saved_CFLAGS"
+])
+
# Save C compiler related variables
AC_DEFUN([OCAML_CC_SAVE_VARIABLES], [
saved_CC="$CC"
+{0 Using the Format module}
+
{1 Principles}
Line breaking is based on three concepts:
the rest at first reading).
- {b horizontal box} ({i h} box, as obtained by the
- {!open_hbox} procedure): within this box, break hints do not
+ {!Format.open_hbox} procedure): within this box, break hints do not
lead to line breaks.
- {b vertical box} ({i v} box, as obtained by the
- {!open_vbox} procedure): within this box, every break hint lead
+ {!Format.open_vbox} procedure): within this box, every break hint lead
to a new line.
- {b vertical/horizontal box} ({i hv} box, as obtained by
- the {!open_hvbox} procedure): if it is possible, the entire box
+ the {!Format.open_hvbox} procedure): if it is possible, the entire box
is written on a single line; otherwise, every break hint within the box
leads to a new line.
- {b vertical or horizontal box} ({i hov} box, as obtained
- by the {!open_box} or {!open_hovbox} procedures): within this box, break
- hints are used to cut the line when there is no more room on the line.
- There are two kinds of "hov" boxes, you can find the details
- below. In first approximation, let me
- consider these two kinds of "hov" boxes as equivalent and
- obtained by calling the {!open_box} procedure.
+ by the {!Format.open_box} or {!Format.open_hovbox} procedures): within this
+ box, break hints are used to cut the line when there is no more room on the
+ line. There are two kinds of "hov" boxes, you can find the details below.
+ In first approximation, let me consider these two kinds of "hov" boxes as
+ equivalent and obtained by calling the {!Format.open_box} procedure.
Let me give an example. Suppose we can write 10 chars before
the right margin (that indicates no more room). We represent any
The "hov" box type is refined into two categories.
- {b the vertical or horizontal {i packing} box} (as obtained by the
-{!open_hovbox} procedure): break hints are used to cut the line when there is no
-more room on the line; no new line occurs if there is enough room on the line.
-- {b vertical or horizontal {i structural} box} (as obtained by the {!open_box}
-procedure): similar to the "hov" packing box, the break hints are used to cut
-the line when there is no more room on the line; in addition, break hints that
-can show the box structure lead to new lines even if there is enough room on
-the current line.
+{!Format.open_hovbox} procedure): break hints are used to cut the line when
+there is no more room on the line; no new line occurs if there is enough room
+on the line.
+- {b vertical or horizontal {i structural} box} (as obtained by the
+{!Format.open_box} procedure): similar to the "hov" packing box, the break
+hints are used to cut the line when there is no more room on the line; in
+addition, break hints that can show the box structure lead to new lines even if
+there is enough room on the current line.
The difference between a packing and a structural "hov" box is shown by a
routine that closes boxes and parentheses at the end of printing: with packing
lead to a new line. For instance, when printing
"\[(---\[(----\[(---b)\]b)\]b)\]", where "b" is a break hint without extra
indentation ([print_cut ()]). If "\[" means opening of a packing "hov" box
-({!open_hovbox}), "\[(---\[(----\[(---b)\]b)\]b)\]" is printed as follows:
+({!Format.open_hovbox}), "\[(---\[(----\[(---b)\]b)\]b)\]" is printed as
+follows:
{[
(---
(---)))
]}
-If we replace the packing boxes by structural boxes ({!open_box}), each break
-hint that precedes a closing parenthesis can show the boxes structure, if it
-leads to a new line; hence "\[(---\[(----\[(---b)\]b)\]b)\]" is printed like
+If we replace the packing boxes by structural boxes ({!Format.open_box}), each
+break hint that precedes a closing parenthesis can show the boxes structure, if
+it leads to a new line; hence "\[(---\[(----\[(---b)\]b)\]b)\]" is printed like
this:
{[
When writing a pretty-printing routine, follow these simple rules:
-+ Boxes must be opened and closed consistently ([open_*] and {!close_box} must
-be nested like parentheses).
++ Boxes must be opened and closed consistently ([open_*] and
+{!Format.close_box} must be nested like parentheses).
+ Never hesitate to open a box.
+ Output many break hints, otherwise the pretty-printer is in a bad situation
where it tries to do its best, which is always "worse than your bad".
short, it is often necessary to print unbreakable spaces; however, most of the
time a space should be considered a break hint.
+ Do not try to force new lines, let the pretty-printer do it for you: that's
-its only job. In particular, do not use {!force_newline}: this procedure
-effectively leads to a newline, but it also as the unfortunate side effect to
-partially reinitialise the pretty-printing engine, so that the rest of the
-printing material is noticeably messed up.
+its only job. In particular, do not use {!Format.force_newline}: this
+procedure effectively leads to a newline, but it also as the unfortunate side
+effect to partially reinitialise the pretty-printing engine, so that the rest
+of the printing material is noticeably messed up.
+ Never put newline characters directly in the strings to be printed: pretty
printing engine will consider this newline character as any other character
written on the current line and this will completely mess up the output.
#* special exception on linking described in the file LICENSE. *
#* *
#**************************************************************************
+# Used by included Makefiles
ROOTDIR = ..
--include $(ROOTDIR)/Makefile.build_config
-
-ifeq ($(DOCUMENTATION_TOOL),odoc)
- include odoc/Makefile
-else
- include ocamldoc/Makefile
-endif
+-include ../Makefile.build_config
odoc-%:
- $(MAKE) -C odoc $* ROOTDIR=../..
+ $(MAKE) -C odoc $*
ocamldoc-%:
- $(MAKE) -C ocamldoc $* ROOTDIR=../..
+ $(MAKE) -C ocamldoc $*
+
+ifeq ($(DOCUMENTATION_TOOL),odoc)
+man: odoc-man
+latex: odoc-latex
+html: odoc-html
+ @echo "documentation is in ./api_docgen/odoc/build/html/"
+all: html latex man
+install: odoc-install
+else
+man: ocamldoc-man
+latex: ocamldoc-latex
+html: ocamldoc-html
+ @echo "documentation is in ./api_docgen/ocamldoc/build/html/"
+texi: ocamldoc-texi
+pdf: ocamldoc-pdf
+all: html pdf man latex texi
+install: ocamldoc-install
+endif
clean:
rm -rf build odoc/build ocamldoc/build
+
+distclean: clean
+
+.PHONY: html latex man clean distclean install texi pdf
#* special exception on linking described in the file LICENSE. *
#* *
#**************************************************************************
-ROOTDIR = ..
DOCGEN= $(ROOTDIR)/api_docgen
include $(ROOTDIR)/Makefile.common
.PHONY: all
all: html pdf man
-DIRS = $(addprefix build/,libref compilerlibref man latex texi \
+DIRS = build/ $(addprefix build/,libref compilerlibref man latex texi \
html html/libref html/compilerlibref)
$(DIRS):
build/latex/alldoc.pdf: build/latex/stdlib_input.tex \
build/latex/compilerlibs_input.tex | build/latex/ifocamldoc.tex
-$(DOCGEN)/build/Compiler_libs.mld: $(DOCGEN)/Compiler_libs.pre.mld
+build/Compiler_libs.mld: $(DOCGEN)/Compiler_libs.pre.mld | build/
cp $< $@ && echo "{!modules:$(compilerlibref_C)}" >> $@
build/latex/ifocamldoc.tex: $(ROOTDIR)/Makefile.config | build/latex
build/latex/alldoc.tex:$(DOCGEN)/alldoc.tex | build/latex
cp $< $@
-$(compilerlibref_TEXT:%=build/%.mld) $(libref_TEXT:%=build/%.mld): \
-build/%.mld:$(DOCGEN)/%.mld
+build/%.mld: $(DOCGEN)/%.mld | build/
cp $< $@
-Precedence level and associativity of operators
+{0 Precedence level and associativity of operators}
The following table lists the precedence level of all operator classes
from the highest to the lowest precedence. A few other syntactic constructions
\documentclass{book}
-
\usepackage[colorlinks=true,breaklinks=true]{hyperref}
\usepackage{color}
\usepackage{lmodern}
\usepackage[T1]{fontenc}
-\usepackage[strings,nohyphen]{underscore}
\input{ifocamldoc}
\ifocamldoc
\usepackage{ocamldoc}
\else
\newcommand{\docitem}[2]{\input{#1/#2}}
\fi
+\usepackage[english]{babel}
+\usepackage[strings,nohyphen]{underscore}
\begin{document}
\chapter{Stdlib}
#* special exception on linking described in the file LICENSE. *
#* *
#**************************************************************************
-include $(ROOTDIR)/api_docgen/Makefile.common
-include $(ROOTDIR)/ocamldoc/Makefile.best_ocamldoc
-vpath %.mli $(ROOTDIR)/stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
+# Used by included Makefiles
+ROOTDIR = ../..
+include ../Makefile.common
+include ../../ocamldoc/Makefile.best_ocamldoc
+vpath %.mli ../../stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
man: build/man/Stdlib.3o
ALL_LATEX= $(ALL_DOC:%=build/latex/%.tex)
build/latex/ifocamldoc.tex: | build/latex
- printf '\\newif\ifocamldoc\ocamldoctrue\n' > $@
+ printf '\\newif\\ifocamldoc\\ocamldoctrue\n' > $@
$(libref:%=build/libref/%.odoc): build/libref/%.odoc: %.mli | build/libref
$(OCAMLDOC_RUN) -nostdlib -hide Stdlib -lib Stdlib \
-pp \
-"$(AWK) -v ocamldoc=true -f $(ROOTDIR)/stdlib/expand_module_aliases.awk" \
+"$(AWK) -v ocamldoc=true -f ../../stdlib/expand_module_aliases.awk" \
$(DOC_STDLIB_INCLUDES) $< -dump $@
$(compilerlibref:%=build/compilerlibref/%.odoc):\
$(DOC_ALL_INCLUDES) $< -dump $@
$(compilerlibref_TEXT:%=build/compilerlibref/%.odoc):\
-build/compilerlibref/%.odoc: $(DOCGEN)/build/%.mld | build/compilerlibref
+build/compilerlibref/%.odoc: build/%.mld | build/compilerlibref
$(OCAMLDOC_RUN) $(DOC_ALL_INCLUDES) -text $< -dump $@
$(libref_TEXT:%=build/libref/%.odoc):\
-build/libref/%.odoc: $(DOCGEN)/%.mld | build/libref
+build/libref/%.odoc: build/%.mld | build/libref
$(OCAMLDOC_RUN) $(DOC_STDLIB_INCLUDES) -text $< -dump $@
ALL_COMPILED_DOC=$(ALL_DOC:%=build/%.odoc)
$(OCAMLDOC_RUN) -html -d build/html/compilerlibref \
-nostdlib -hide Stdlib -t "OCaml compiler library" \
$(HTML_OPTIONS) \
- -intro $(DOCGEN)/build/Compiler_libs.mld \
+ -intro build/Compiler_libs.mld \
$(addprefix -load , $(ALL_COMPILERLIBREF:%=build/%.odoc))
build/texi/stdlib.texi: $(ALL_COMPILED_DOC) | build/texi
build/latex/alldoc.pdf: build/latex/Stdlib.tex build/latex/alldoc.tex \
| build/latex
cd build/latex && \
- TEXINPUTS=$${TEXINPUTS}:$(ROOTDIR)/ocamldoc pdflatex alldoc
+ TEXINPUTS=$${TEXINPUTS}:../../ocamldoc pdflatex alldoc
cd build/latex && \
- TEXINPUTS=$${TEXINPUTS}:$(ROOTDIR)/ocamldoc pdflatex alldoc
+ TEXINPUTS=$${TEXINPUTS}:../../ocamldoc pdflatex alldoc
stdlib_INPUT=$(foreach module,\
$(filter-out stdlib.mli camlinternal%,$(stdlib_UNPREFIXED)),\
build/latex/compilerlibs_input.tex: | build/latex
echo $(compilerlibs_INPUT) > $@
-INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
-.PHONY:install
+.PHONY: install
install:
- $(MKDIR) "$(INSTALL_MANODIR)"
+ $(MKDIR) "$(INSTALL_LIBRARIES_MAN_DIR)"
if test -d build/man; then \
- $(INSTALL_DATA) build/man/*.3o "$(INSTALL_MANODIR)"; \
- else : ; fi
+ $(INSTALL_DATA) build/man/*.3o "$(INSTALL_LIBRARIES_MAN_DIR)"; \
+ fi
#* special exception on linking described in the file LICENSE. *
#* *
#**************************************************************************
-include $(ROOTDIR)/api_docgen/Makefile.common
-vpath %.cmti $(ROOTDIR)/stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
-vpath %.cmt $(ROOTDIR)/stdlib
+# Used by included Makefiles
+ROOTDIR = ../..
+
+include ../Makefile.common
+
+vpath %.cmti ../../stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
+vpath %.cmt ../../stdlib
ifeq ($(DOCUMENTATION_TOOL),odoc)
odoc ?= $(DOCUMENTATION_TOOL_CMD)
# define the right conditional for the manual
build/latex/ifocamldoc.tex: | build/latex
- printf '\\newif\ifocamldoc\ocamldocfalse\n' > $@
+ printf '\\newif\\ifocamldoc\\ocamldocfalse\n' > $@
# \input{} all modules in the stdlib for the latex api manual
# rules for the mld files
$(libref_TEXT:%=build/libref/page-%.odoc):
-build/libref/page-%.odoc:$(DOCGEN)/%.mld | build/libref
+build/libref/page-%.odoc: build/%.mld | build/libref
$(odoc) compile -I build/libref --package libref $< -o $@
$(compilerlibref_TEXT:%=build/compilerlibref/page-%.odoc):\
-build/compilerlibref/page-%.odoc:$(DOCGEN)/build/%.mld | build/compilerlibref
+build/compilerlibref/page-%.odoc: build/%.mld | build/compilerlibref
$(odoc) compile -I build/libref --package compilerlibref $< -o $@
# rules for the stdlib and otherlibs .doc files
# rules for odocl generation
# Note that we are using a dependency on the whole phase 1 rather than tracking
# the individual file dependencies
-$(ALL_UNITS:%=build/%.odocl):%.odocl:%.odoc \
+%.odocl:%.odoc \
| $(ALL_PAGED_DOC:%=build/%.odoc)
- $(odoc) link -I build/libref -I build/compilerlibref $<
+ $(odoc) link -I build/libref -I build/compilerlibref $(ODOC_LINK_ARGS) $<
-$(ALL_PAGE_TEXT:%=build/%.odocl):%.odocl:%.odoc \
+%.odocl:%.odoc \
| $(ALL_PAGED_DOC:%=build/%.odoc)
- $(odoc) link -I build/libref -I build/compilerlibref $<
+ $(odoc) link -I build/libref -I build/compilerlibref $(ODOC_LINK_ARGS) $<
+
+build/libref/stdlib.odocl: ODOC_LINK_ARGS+=--open=""
# Rules for all three backends:
$(foreach m,$(stdlib_UNPREFIXED),$(call stdlib_prefix,$m))\
$(call capitalize, $(otherlibref))
build/libref.mld:
- echo {0 OCaml standard library} {!modules:$(stdlib_INDEX)} > $@
+ ( echo "{0 OCaml standard library}"; \
+ echo "{!modules:$(stdlib_INDEX)}" ) > $@
-build/libref/index.html.stamp: $(ALL_HTML) build/libref.mld | build/libref
+build/libref/index.html.stamp: $(ALL_HTML) build/libref.mld \
+| build/libref build/html/libref
$(odoc) compile --package libref build/libref.mld
$(odoc) link -I build/libref build/page-libref.odoc
$(odoc) html-generate build/page-libref.odocl --output-dir build/html
touch $@
build/compilerlibref/index.html.stamp: $(ALL_HTML) \
- build/compilerlibref/page-Compiler_libs.html.stamp | build/compilerlibref
+ build/compilerlibref/page-Compiler_libs.html.stamp | build/html/compilerlibref
cp build/html/compilerlibref/Compiler_libs.html \
build/html/compilerlibref/index.html
touch $@
touch $@
# Man pages are the only installed documentation
-INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
-.PHONY:install
+.PHONY: install
install:
- $(MKDIR) "$(INSTALL_MANODIR)"
+ $(MKDIR) "$(INSTALL_LIBRARIES_MAN_DIR)"
if test -d build/man/libref ; then \
- $(INSTALL_DATA) build/man/libref/* "$(INSTALL_MANODIR)"; \
- else : ; fi
+ $(INSTALL_DATA) build/man/libref/* "$(INSTALL_LIBRARIES_MAN_DIR)"; \
+ fi
if test -d build/man/compilerlibref ; then \
- $(INSTALL_DATA) build/man/libref/* "$(INSTALL_MANODIR)"; \
- else : ; fi
+ $(INSTALL_DATA) build/man/libref/* "$(INSTALL_LIBRARIES_MAN_DIR)"; \
+ fi
+
+# Dependencies for stdlib modules.
+# Use the same dependencies used for compiling .cmx files.
+# The existing rules look like this:
+# stdlib__X.cmx: x.ml \
+# stdlib__Y.cmx \
+# stdlib__X.cmi
+# We want:
+# build/libref/stdlib__X.odoc: \
+# build/libref/stdlib__Y.odoc \
+# stdlib__X.cmti
+build/.depend: ../../stdlib/.depend | build/
+ sed \
+ -e ':l; /\\ *$$/ { N; bl }; # Read lines separated by \\' \
+ -e '/^\S*\.cmx *:/! d; # Keep only rules to .cmx' \
+ -e 's#\<\(\w*\)\.cmx\>#build/libref/\1.odoc#g; # .cmx -> .odoc' \
+ -e 's/\.cmi\>/.cmti/g; # .cmi -> .cmti' \
+ -e 's/\<\S*\.ml\>//g; # .ml -> removed' \
+ $< > $@
+
+include build/.depend
let slot_offset env loc cl =
match loc with
- | Incoming n -> (frame_size env) + n
+ | Incoming n -> frame_size env + n
| Local n ->
if cl = 0
then env.stack_offset + n * 8
else env.stack_offset + (env.f.fun_num_stack_slots.(0) + n) * 8
| Outgoing n -> n
+ | Domainstate _ -> assert false (* not a stack slot *)
(* Symbols *)
(* Output a pseudo-register *)
+let x86_data_type_for_stack_slot = function
+ | Float -> REAL8
+ | _ -> QWORD
+
let reg env = function
| { loc = Reg.Reg r } -> register_name r
- | { loc = Stack s; typ = Float } as r ->
- let ofs = slot_offset env s (register_class r) in
- mem64 REAL8 ofs RSP
- | { loc = Stack s } as r ->
+ | { loc = Stack(Domainstate n); typ = ty } ->
+ let ofs = n + Domainstate.(idx_of_field Domain_extra_params) * 8 in
+ mem64 (x86_data_type_for_stack_slot ty) ofs R14
+ | { loc = Stack s; typ = ty } as r ->
let ofs = slot_offset env s (register_class r) in
- mem64 QWORD ofs RSP
+ mem64 (x86_data_type_for_stack_slot ty) ofs RSP
| { loc = Unknown } ->
assert false
let arg env i n = reg env i.arg.(n)
let res env i n = reg env i.res.(n)
+
(* Output a reference to the lower 8, 16 or 32 bits of a register *)
let reg_low_8_name = Array.map (fun r -> Reg8L r) int_reg_name
emit_call "caml_c_call";
record_frame env i.live (Dbg_other i.dbg);
if system <> S_win64 then begin
- (* TODO: investigate why such a diff.
- This comes from:
- http://caml.inria.fr/cgi-bin/viewvc.cgi?view=revision&revision=12664
- If we do the same for Win64, we probably need to change
- amd64nt.asm accordingly.
- *)
+ (* In amd64.S, "caml_c_call" tail-calls the C function (in order to
+ produce nicer backtraces), so we need to restore r15 manually after
+ it returns (note that this increases code size).
+
+ In amd64nt.asm (used for Win64), "caml_c_call" invokes the C
+ function via a regular call, and restores r15 itself, thus avoiding
+ the code size increase. *)
+
I.mov (domain_field Domainstate.Domain_young_ptr) r15
end
end else begin
I.movsxd (addressing addr DWORD i 0) dest
| Single ->
I.cvtss2sd (addressing addr REAL4 i 0) dest
- | Double | Double_u ->
+ | Double ->
I.movsd (addressing addr REAL8 i 0) dest
end
| Lop(Istore(chunk, addr, _)) ->
| Single ->
I.cvtsd2ss (arg i 0) xmm15;
I.movss xmm15 (addressing addr REAL4 i 1)
- | Double | Double_u ->
+ | Double ->
I.movsd (arg i 0) (addressing addr REAL8 i 1)
end
| Lop(Ialloc { bytes = n; dbginfo }) ->
done;
emit_named_text_section env.f.fun_name
| Lentertrap ->
- ()
+ if fp then begin
+ let delta = frame_size env - 16 (* retaddr + rbp *) in
+ I.lea (mem64 NONE delta RSP) rbp
+ end;
| Ladjust_trap_depth { delta_traps; } ->
(* each trap occupies 16 bytes on the stack *)
let delta = 16 * delta_traps in
stub saves them into the GC regs block).
*)
-let max_arguments_for_tailcalls = 10
-
let int_reg_name =
match Config.ccomp_type with
| "msvc" ->
(* Calling conventions *)
-let calling_conventions first_int last_int first_float last_float make_stack
+let size_domainstate_args = 64 * size_int
+
+let calling_conventions first_int last_int first_float last_float
+ make_stack first_stack
arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref first_stack in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| Val | Int | Addr as ty ->
ofs := !ofs + size_float
end
done;
- (loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 16) (* keep stack 16-aligned *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
let loc_arguments arg =
- calling_conventions 0 9 100 109 outgoing arg
+ calling_conventions 0 9 100 109 outgoing (- size_domainstate_args) arg
let loc_parameters arg =
let (loc, _ofs) =
- calling_conventions 0 9 100 109 incoming arg
- in
- loc
+ calling_conventions 0 9 100 109 incoming (- size_domainstate_args) arg
+ in loc
let loc_results res =
- let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
+ let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported 0 res
+ in loc
+
+let max_arguments_for_tailcalls = 10 (* in regs *) + 64 (* in domain state *)
(* C calling conventions under Unix:
first integer args in rdi, rsi, rdx, rcx, r8, r9
Return value in rax or xmm0. *)
let loc_external_results res =
- let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
+ let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc
let unix_loc_external_arguments arg =
- calling_conventions 2 7 100 107 outgoing arg
+ calling_conventions 2 7 100 107 outgoing 0 arg
let win64_int_external_arguments =
[| 5 (*rcx*); 4 (*rdx*); 6 (*r8*); 7 (*r9*) |]
self#select_floatarith false Idivf Ifloatdiv args
| Cextcall("sqrt", _, _, false) ->
begin match args with
- [Cop(Cload ((Double|Double_u as chunk), _), [loc], _dbg)] ->
+ [Cop(Cload ((Double as chunk), _), [loc], _dbg)] ->
let (addr, arg) = self#select_addressing chunk loc in
(Ispecific(Ifloatsqrtf addr), [arg])
| [arg] ->
method select_floatarith commutative regular_op mem_op args =
match args with
- [arg1; Cop(Cload ((Double|Double_u as chunk), _), [loc2], _)] ->
+ [arg1; Cop(Cload ((Double as chunk), _), [loc2], _)] ->
let (addr, arg2) = self#select_addressing chunk loc2 in
(Ispecific(Ifloatarithmem(mem_op, addr)),
[arg1; arg2])
- | [Cop(Cload ((Double|Double_u as chunk), _), [loc1], _); arg2]
+ | [Cop(Cload ((Double as chunk), _), [loc1], _); arg2]
when commutative ->
let (addr, arg1) = self#select_addressing chunk loc1 in
(Ispecific(Ifloatarithmem(mem_op, addr)),
| Ispecific _ -> Op_pure
| _ -> super#class_of_operation op
-method! is_cheap_operation op =
- match op with
- | Iconst_int n -> n <= 255n && n >= 0n
- | _ -> false
-
end
let fundecl f =
| Outgoing n ->
assert (n >= 0);
n
+ | Domainstate _ -> assert false (* not a stack slot *)
(* Output a stack reference *)
let emit_stack env r =
match r.loc with
+ | Stack (Domainstate n) ->
+ let ofs = n + Domainstate.(idx_of_field Domain_extra_params) * 8 in
+ `[domain_state_ptr, #{emit_int ofs}]`
| Stack s ->
- let ofs = slot_offset env s (register_class r) in `[sp, #{emit_int ofs}]`
+ let ofs = slot_offset env s (register_class r) in
+ `[sp, #{emit_int ofs}]`
| _ -> fatal_error "Emit_arm.emit_stack"
(* Output an addressing mode *)
| Lop(Iload(Single, addr, _mut)) when !fpu >= VFPv2 ->
` flds s14, {emit_addressing addr i.arg 0}\n`;
` fcvtds {emit_reg i.res.(0)}, s14\n`; 2
- | Lop(Iload((Double | Double_u), addr, _mut)) when !fpu = Soft ->
+ | Lop(Iload(Double, addr, _mut)) when !fpu = Soft ->
(* Use LDM or LDRD if possible *)
begin match i.res.(0), i.res.(1), addr with
{loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
| Byte_signed -> "ldrsb"
| Sixteen_unsigned -> "ldrh"
| Sixteen_signed -> "ldrsh"
- | Double
- | Double_u -> "fldd"
+ | Double -> "fldd"
| _ (* 32-bit quantities *) -> "ldr" in
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
| Lop(Istore(Single, addr, _)) when !fpu >= VFPv2 ->
` fcvtsd s14, {emit_reg i.arg.(0)}\n`;
` fsts s14, {emit_addressing addr i.arg 1}\n`; 2
- | Lop(Istore((Double | Double_u), addr, _)) when !fpu = Soft ->
+ | Lop(Istore(Double, addr, _)) when !fpu = Soft ->
(* Use STM or STRD if possible *)
begin match i.arg.(0), i.arg.(1), addr with
{loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
| Byte_signed -> "strb"
| Sixteen_unsigned
| Sixteen_signed -> "strh"
- | Double
- | Double_u -> "fstd"
+ | Double -> "fstd"
| _ (* 32-bit quantities *) -> "str" in
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
| Lop(Ialloc { bytes = n; dbginfo }) ->
(* Calling conventions *)
+let size_domainstate_args = 64 * size_int
+
let loc_int last_int make_stack int ofs =
if !int <= last_int then begin
let l = phys_reg !int in
[| stack_lower; stack_upper |]
end
-let calling_conventions first_int last_int first_float last_float make_stack
- arg =
+let calling_conventions first_int last_int first_float last_float
+ make_stack first_stack arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref first_stack in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| Val | Int | Addr ->
| Float ->
loc.(i) <- loc_float last_float make_stack float ofs
done;
- (loc, Misc.align !ofs 8) (* keep stack 8-aligned *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 8) (* keep stack 8-aligned *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
(* OCaml calling convention:
first integer args in r0...r7
first float args in d0...d15 (EABI+VFP)
- remaining args on stack.
+ remaining args in domain state area, then on stack.
Return values in r0...r7 or d0...d15. *)
-let max_arguments_for_tailcalls = 8
+let max_arguments_for_tailcalls = 8 (* in regs *) + 64 (* in domain state *)
let loc_arguments arg =
- calling_conventions 0 7 100 115 outgoing arg
+ calling_conventions 0 7 100 115 outgoing (- size_domainstate_args) arg
let loc_parameters arg =
- let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc
+ let (loc, _) =
+ calling_conventions 0 7 100 115 incoming (- size_domainstate_args) arg
+ in loc
let loc_results res =
- let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc
+ let (loc, _) = calling_conventions 0 7 100 115 not_supported 0 res in loc
(* C calling convention:
first integer args in r0...r3
external_calling_conventions 0 3 100 107 outgoing ty_args
let loc_external_results res =
- let (loc, _) = calling_conventions 0 1 100 100 not_supported res
+ let (loc, _) = calling_conventions 0 1 100 100 not_supported 0 res
in loc
let loc_exn_bucket = phys_reg 0
let is_offset chunk n =
match chunk with
(* VFPv{2,3} load/store have -1020 to 1020. Offset must be multiple of 4 *)
- | Single | Double | Double_u
+ | Single | Double
when !fpu >= VFPv2 ->
n >= -1020 && n <= 1020 && n mod 4 = 0
(* ARM load/store byte/word have -4095 to 4095 *)
method! is_cheap_operation op =
match op with
- | Iconst_int n -> n <= 65535n && n >= 0n
+ | Iconst_int n -> n <= 0x7FFF_FFFFn && n >= -0x8000_0000n
| _ -> false
end
| Outgoing n ->
assert (n >= 0);
n
+ | Domainstate _ -> assert false (* not a stack slot *)
(* Output a stack reference *)
let emit_stack env r =
match r.loc with
+ | Stack (Domainstate n) ->
+ let ofs = n + Domainstate.(idx_of_field Domain_extra_params) * 8 in
+ `[{emit_reg reg_domain_state_ptr}, #{emit_int ofs}]`
| Stack s ->
- let ofs = slot_offset env s (register_class r) in `[sp, #{emit_int ofs}]`
+ let ofs = slot_offset env s (register_class r) in
+ `[sp, #{emit_int ofs}]`
| _ -> fatal_error "Emit.emit_stack"
(* Output an addressing mode *)
| Single ->
` ldr s7, {emit_addressing addr base}\n`;
` fcvt {emit_reg dst}, s7\n`
- | Word_int | Word_val | Double | Double_u ->
+ | Word_int | Word_val | Double ->
` ldr {emit_reg dst}, {emit_addressing addr base}\n`
end
| Lop(Istore(size, addr, _)) ->
| Single ->
` fcvt s7, {emit_reg src}\n`;
` str s7, {emit_addressing addr base}\n`;
- | Word_int | Word_val | Double | Double_u ->
+ | Word_int | Word_val | Double ->
` str {emit_reg src}, {emit_addressing addr base}\n`
end
| Lop(Ialloc { bytes = n; dbginfo }) ->
(* Calling conventions *)
+let size_domainstate_args = 64 * size_int
+
let loc_int last_int make_stack int ofs =
if !int <= last_int then begin
let l = phys_reg !int in
end
let calling_conventions
- first_int last_int first_float last_float make_stack arg =
+ first_int last_int first_float last_float make_stack first_stack arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref first_stack in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| Val | Int | Addr ->
| Float ->
loc.(i) <- loc_float last_float make_stack float ofs
done;
- (loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 16) (* keep stack 16-aligned *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
(* OCaml calling convention:
first integer args in r0...r15
first float args in d0...d15
- remaining args on stack.
+ remaining args in domain state area, then on stack.
Return values in r0...r15 or d0...d15. *)
-let max_arguments_for_tailcalls = 16
+let max_arguments_for_tailcalls = 16 (* in regs *) + 64 (* in domain state *)
+
let last_int_register = if macosx then 7 else 15
let loc_arguments arg =
- calling_conventions 0 last_int_register 100 115 outgoing arg
+ calling_conventions 0 last_int_register 100 115
+ outgoing (- size_domainstate_args) arg
let loc_parameters arg =
let (loc, _) =
- calling_conventions 0 last_int_register 100 115 incoming arg
+ calling_conventions 0 last_int_register 100 115
+ incoming (- size_domainstate_args) arg
in
loc
let loc_results res =
let (loc, _) =
- calling_conventions 0 last_int_register 100 115 not_supported res
+ calling_conventions 0 last_int_register 100 115 not_supported 0 res
in
loc
external_calling_conventions 0 7 100 107 outgoing ty_args
let loc_external_results res =
- let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc
+ let (loc, _) = calling_conventions 0 1 100 100 not_supported 0 res in loc
let loc_exn_bucket = phys_reg 0
n land 1 = 0 && n lsr 1 < 0x1000
| Thirtytwo_unsigned | Thirtytwo_signed | Single ->
n land 3 = 0 && n lsr 2 < 0x1000
- | Word_int | Word_val | Double | Double_u ->
+ | Word_int | Word_val | Double ->
n land 7 = 0 && n lsr 3 < 0x1000)
let is_logical_immediate n =
| Word_val
| Single
| Double
- | Double_u
and operation =
Capply of machtype
fun_args: (Backend_var.With_provenance.t * machtype) list;
fun_body: expression;
fun_codegen_options : codegen_option list;
+ fun_poll: Lambda.poll_attribute;
fun_dbg : Debuginfo.t;
}
| Word_int (* integer or pointer outside heap *)
| Word_val (* pointer inside heap or encoded int *)
| Single
- | Double (* 64-bit-aligned 64-bit float *)
- | Double_u (* word-aligned 64-bit float *)
+ | Double (* word-aligned 64-bit float
+ see PR#10433 *)
and operation =
Capply of machtype
fun_args: (Backend_var.With_provenance.t * machtype) list;
fun_body: expression;
fun_codegen_options : codegen_option list;
+ fun_poll: Lambda.poll_attribute;
fun_dbg : Debuginfo.t;
}
| Cconst_natint (c1, _), Cconst_int (c2, _) ->
int_const dbg Nativeint.(compare c1 (of_int c2))
| a1, a2 -> begin
- bind "int_cmp" a1 (fun a1 ->
- bind "int_cmp" a2 (fun a2 ->
+ bind "int_cmp" a2 (fun a2 ->
+ bind "int_cmp" a1 (fun a1 ->
let op1 = Cop(Ccmpi(Cgt), [a1; a2], dbg) in
let op2 = Cop(Ccmpi(Clt), [a1; a2], dbg) in
tag_int(sub_int op1 op2 dbg) dbg))
end
let mk_compare_floats dbg a1 a2 =
- bind "float_cmp" a1 (fun a1 ->
- bind "float_cmp" a2 (fun a2 ->
+ bind "float_cmp" a2 (fun a2 ->
+ bind "float_cmp" a1 (fun a1 ->
let op1 = Cop(Ccmpf(CFgt), [a1; a2], dbg) in
let op2 = Cop(Ccmpf(CFlt), [a1; a2], dbg) in
let op3 = Cop(Ccmpf(CFeq), [a1; a1], dbg) in
| _ -> false
let safe_divmod_bi mkop is_safe mkm1 c1 c2 bi dbg =
- bind "dividend" c1 (fun c1 ->
bind "divisor" c2 (fun c2 ->
+ bind "dividend" c1 (fun c1 ->
let c = mkop c1 c2 is_safe dbg in
if Arch.division_crashes_on_overflow
&& (size_int = 4 || bi <> Primitive.Pint32)
| Some (Uconst_float x) ->
Cconst_float (x, dbg) (* or keep _dbg? *)
| _ ->
- Cop(Cload (Double_u, Immutable), [cmm], dbg)
+ Cop(Cload (Double, Immutable), [cmm], dbg)
end
- | cmm -> Cop(Cload (Double_u, Immutable), [cmm], dbg)
+ | cmm -> Cop(Cload (Double, 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),
+let complex_re c dbg = Cop(Cload (Double, Immutable), [c], dbg)
+let complex_im c dbg = Cop(Cload (Double, Immutable),
[Cop(Cadda, [c; Cconst_int (size_float, dbg)], dbg)],
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),
+ Cop(Cload (Double, 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)
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),
+ Cop(Cstore (Double, Lambda.Assignment),
[array_indexing log2_size_float arr ofs dbg; newval], dbg)
(* String length *)
let geint = Ccmpi Cge
let gtint = Ccmpi Cgt
- type act = expression
type loc = Debuginfo.t
+ type arg = expression
+ type test = expression
+ type act = expression
(* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
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_is_nonzero arg = arg
+ let arg_as_test arg = arg
let make_if cond ifso ifnot =
Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot,
Debuginfo.none)
fun_args = List.map (fun (arg, ty) -> VP.create arg, ty) fun_args;
fun_body = body;
fun_codegen_options = [];
+ fun_poll = Default_poll;
fun_dbg;
}
fun_args = List.map (fun arg -> (VP.create arg, typ_val)) all_args;
fun_body = body;
fun_codegen_options = [];
+ fun_poll = Default_poll;
fun_dbg;
}
:: access_components 0 @ [Cvar clos],
(dbg ()));
fun_codegen_options = [];
+ fun_poll = Default_poll;
fun_dbg;
}
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_poll = Default_poll;
fun_dbg;
}
Cvar arg; Cvar clos],
dbg ());
fun_codegen_options = [];
+ fun_poll = Default_poll;
fun_dbg;
}
::
fun_body = iter (num+1)
(List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
fun_codegen_options = [];
+ fun_poll = Default_poll;
fun_dbg;
}
in
type unary_primitive = expression -> Debuginfo.t -> expression
let floatfield n ptr dbg =
- Cop(Cload (Double_u, Mutable),
+ Cop(Cload (Double, Mutable),
[if n = 0 then ptr
else Cop(Cadda, [ptr; Cconst_int(n * size_float, dbg)], dbg)],
dbg)
let setfloatfield n init arg1 arg2 dbg =
return_unit dbg (
- Cop(Cstore (Double_u, init),
+ Cop(Cstore (Double, init),
[if n = 0 then arg1
else Cop(Cadda, [arg1; Cconst_int(n * size_float, dbg)], dbg);
arg2], dbg))
let stringref_safe arg1 arg2 dbg =
tag_int
- (bind "str" arg1 (fun str ->
- bind "index" (untag_int arg2 dbg) (fun idx ->
+ (bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "str" arg1 (fun str ->
Csequence(
make_checkbound dbg [string_length str dbg; idx],
Cop(Cload (Byte_unsigned, Mutable),
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 ->
+ (bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "str" arg1 (fun str ->
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"
+ (bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "ba" arg1 (fun ba ->
+ bind "ba_data"
(Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
(fun ba_data ->
check_bound unsafe size 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 ->
+ bind "index" arg2 (fun idx ->
+ bind "arr" arg1 (fun arr ->
Cifthenelse(is_addr_array_ptr arr dbg,
dbg,
addr_array_ref arr idx dbg,
let bytesset_safe arg1 arg2 arg3 dbg =
return_unit dbg
- (bind "str" arg1 (fun str ->
+ (bind "newval" (ignore_high_bit_int (untag_int arg3 dbg)) (fun newval ->
bind "index" (untag_int arg2 dbg) (fun idx ->
+ bind "str" arg1 (fun str ->
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)))))
+ [add_int str idx dbg; newval],
+ dbg))))))
let arrayset_unsafe kind arg1 arg2 arg3 dbg =
return_unit dbg (match (kind: Lambda.array_kind) with
let bytes_set size unsafe arg1 arg2 arg3 dbg =
return_unit dbg
- (bind "str" arg1 (fun str ->
+ (bind "newval" arg3 (fun newval ->
bind "index" (untag_int arg2 dbg) (fun idx ->
- bind "newval" arg3 (fun newval ->
+ bind "str" arg1 (fun str ->
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 "newval" arg3 (fun newval ->
bind "index" (untag_int arg2 dbg) (fun idx ->
- bind "newval" arg3 (fun newval ->
+ bind "ba" arg1 (fun ba ->
bind "ba_data"
(Cop(Cload (Word_int, Mutable), [field_address ba 1 dbg], dbg))
(fun ba_data ->
fun_args = [];
fun_body = body;
fun_codegen_options = [Reduce_code_size];
+ fun_poll = Default_poll;
fun_dbg;
}
let ifso_dbg = Debuginfo.none in
let ifnot_dbg = Debuginfo.none in
let dbg = Debuginfo.none in
- transl_if env Unknown dbg cond
- ifso_dbg (transl env ifso) ifnot_dbg (transl env ifnot)
+ let ifso = transl env ifso in
+ let ifnot = transl env ifnot in
+ let approx =
+ match ifso, ifnot with
+ | Cconst_int (1, _), Cconst_int (3, _) -> Then_false_else_true
+ | Cconst_int (3, _), Cconst_int (1, _) -> Then_true_else_false
+ | _, _ -> Unknown
+ in
+ transl_if env approx dbg cond
+ ifso_dbg ifso ifnot_dbg ifnot
| Usequence(exp1, exp2) ->
Csequence(remove_unit(transl env exp1), transl env exp2)
| Uwhile(cond, body) ->
fun_args = List.map (fun (id, _) -> (id, typ_val)) f.params;
fun_body = cmm_body;
fun_codegen_options;
+ fun_poll = f.poll;
fun_dbg = f.dbg}
(* Translate all function definitions *)
No_CSE;
]
else [ Reduce_code_size ];
+ fun_poll = Default_poll;
fun_dbg = Debuginfo.none }] in
let c2 = transl_clambda_constants constants c1 in
let c3 = transl_all_functions c2 in
(glob_files arm64/*.ml)
(glob_files i386/*.ml)
(glob_files power/*.ml)
+ (glob_files riscv/*.ml)
(glob_files s390x/*.ml))
(action (bash "cp `grep '^ARCH=' %{conf} | cut -d'=' -f2`/*.ml .")))
arm64/emit.mlp
i386/emit.mlp
power/emit.mlp
+ riscv/emit.mlp
s390x/emit.mlp)
(action
(progn
(* Operations that affect the floating-point stack cannot be factored *)
| Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Iintoffloat | Ifloatofint
- | Iload((Single | Double | Double_u), _, _) -> Op_other
+ | Iload((Single | Double), _, _) -> Op_other
(* Specific ops *)
| Ispecific(Ilea _) -> Op_pure
| Ispecific(Istore_int(_, _, is_asg)) -> Op_store is_asg
| Outgoing n ->
assert (n >= 0);
n
+ | Domainstate _ -> assert false (* not a stack slot *)
(* Record symbols used and defined - at the end generate extern for those
used but not defined *)
let load_domain_state r =
I.mov (sym32 "Caml_state") r
+let x86_data_type_for_stack_slot = function
+ | Float -> REAL8
+ | _ -> DWORD
+
+(* The Domainstate locations are mapped to a global array "caml_extra_params"
+ defined in runtime/i386*. We cannot access the domain state here
+ because in the i386 port there is no register that always point to the
+ domain state. A global array works because i386 does not
+ support multiple domains. *)
+
let reg env = function
| { loc = Reg r } -> register_name r
- | { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
- sym32 "caml_extra_params" ~ofs:(n + 64)
- | { loc = Stack s; typ = Float } as r ->
- let ofs = slot_offset env s (register_class r) in
- mem32 REAL8 ofs RSP
- | { loc = Stack s } as r ->
+ | { loc = Stack(Domainstate n); typ = ty } ->
+ mem_sym (x86_data_type_for_stack_slot ty)
+ (emit_symbol "caml_extra_params") ~ofs:n
+ | { loc = Stack s; typ = ty } as r ->
let ofs = slot_offset env s (register_class r) in
- mem32 DWORD ofs RSP
+ mem32 (x86_data_type_for_stack_slot ty) ofs RSP
| { loc = Unknown } ->
fatal_error "Emit_i386.reg"
I.movsx (addressing addr WORD i 0) (reg dest)
| Single ->
I.fld (addressing addr REAL4 i 0)
- | Double | Double_u ->
+ | Double ->
I.fld (addressing addr REAL8 i 0)
end
| Lop(Istore(chunk, addr, _)) ->
I.fld (reg i.arg.(0));
I.fstp (addressing addr REAL4 i 1)
end
- | Double | Double_u ->
+ | Double ->
if is_tos i.arg.(0) then
I.fstp (addressing addr REAL8 i 1)
else begin
(* Calling conventions *)
-(* To supplement the processor's meagre supply of registers, we also
- use some global memory locations to pass arguments beyond the 6th.
- These globals are denoted by Incoming and Outgoing stack locations
- with negative offsets, starting at -64.
- Unlike arguments passed on stack, arguments passed in globals
- do not prevent tail-call elimination. The caller stores arguments
- in these globals immediately before the call, and the first thing the
- callee does is copy them to registers or stack locations.
- Neither GC nor thread context switches can occur between these two
- times. *)
+let size_domainstate_args = 64 * size_int
let calling_conventions first_int last_int first_float last_float make_stack
arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref (-64) in
+ let ofs = ref (- size_domainstate_args) in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
Val | Int | Addr as ty ->
done;
(loc, Misc.align (max 0 !ofs) stack_alignment)
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
-(* Six arguments in integer registers plus eight in global memory. *)
-let max_arguments_for_tailcalls = 14
-
let loc_arguments arg =
calling_conventions 0 5 100 99 outgoing arg
let loc_parameters arg =
let (loc, _ofs) = calling_conventions 0 5 100 99 incoming arg in loc
let loc_results res =
let (loc, _ofs) = calling_conventions 0 5 100 100 not_supported res in loc
+
+let max_arguments_for_tailcalls =
+ 6 (* in registers *) + 64 (* in domain state *)
+
let loc_external_arguments _arg =
fatal_error "Proc.loc_external_arguments"
let loc_external_results res =
(* For floating-point operations and floating-point loads,
the result is always left at the top of the floating-point stack *)
| Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
- | Ifloatofint | Iload((Single | Double | Double_u), _, _)
+ | Ifloatofint | Iload((Single | Double ), _, _)
| Ispecific(Isubfrev | Idivfrev | Ifloatarithmem _ | Ifloatspecial _) ->
(arg, [| tos |], false) (* don't move it immediately *)
(* For storing a byte, the argument must be in eax...edx.
let chunk_double = function
Single -> false
| Double -> true
- | Double_u -> true
| _ -> assert false
(* The selector class *)
| Cop(Cload ((Word_int | Word_val as chunk), _), [loc], _) ->
let (addr, arg) = self#select_addressing chunk loc in
(Ispecific(Ipush_load addr), arg)
- | Cop(Cload (Double_u, _), [loc], _) ->
- let (addr, arg) = self#select_addressing Double_u loc in
+ | Cop(Cload (Double, _), [loc], _) ->
+ let (addr, arg) = self#select_addressing Double loc in
(Ispecific(Ipush_load_float addr), arg)
| _ -> (Ispecific(Ipush), exp)
fun_body: instruction;
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
+ fun_poll: Lambda.poll_attribute;
fun_num_stack_slots: int array;
fun_contains_calls: bool;
}
fun_body: instruction;
fun_codegen_options : Cmm.codegen_option list;
fun_dbg : Debuginfo.t;
+ fun_poll: Lambda.poll_attribute;
fun_num_stack_slots: int array;
fun_contains_calls: bool;
}
(**************************************************************************)
open Mach
+open Format
module Int = Numbers.Int
module String = Misc.Stdlib.String
String.starts_with ~prefix:"caml_apply" func
|| String.starts_with ~prefix:"caml_send" func
+(* These are used for the poll error annotation later on*)
+type polling_point = Alloc | Poll | Function_call | External_call
+type error = Poll_error of (polling_point * Debuginfo.t) list
+
+exception Error of error
+
(* Detection of recursive handlers that are not guaranteed to poll
at every loop iteration. *)
let add_poll i =
contains_polls := true;
- Mach.instr_cons (Iop (Ipoll { return_label = None })) [||] [||] i
+ Mach.instr_cons_debug (Iop (Ipoll { return_label = None })) [||] [||] i.dbg i
let instr_body handler_safe i =
let add_unsafe_handler ube (k, _) =
in
instr Int.Set.empty i
+let find_poll_alloc_or_calls instr =
+ let f_match i =
+ match i.desc with
+ | Iop(Ipoll _) -> Some (Poll, i.dbg)
+ | Iop(Ialloc _) -> Some (Alloc, i.dbg)
+ | Iop(Icall_ind | Icall_imm _ |
+ Itailcall_ind | Itailcall_imm _ ) -> Some (Function_call, i.dbg)
+ | Iop(Iextcall { alloc = true }) -> Some (External_call, i.dbg)
+ | Iop(Imove | Ispill | Ireload | Iconst_int _ | Iconst_float _ |
+ Iconst_symbol _ | Iextcall { alloc = false } | Istackoffset _ |
+ Iload _ | Istore _ | Iintop _ | Iintop_imm _ | Ifloatofint |
+ Iintoffloat | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf |
+ Iopaque | Ispecific _)-> None
+ | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ |
+ Itrywith _ | Iraise _ -> None
+ in
+ let matches = ref [] in
+ Mach.instr_iter
+ (fun i ->
+ match f_match i with
+ | Some(x) -> matches := x :: !matches
+ | None -> ())
+ instr;
+ List.rev !matches
+
let instrument_fundecl ~future_funcnames:_ (f : Mach.fundecl) : Mach.fundecl =
if function_is_assumed_to_never_poll f.fun_name then f
else begin
let handler_needs_poll = polled_loops_analysis f.fun_body in
contains_polls := false;
let new_body = instr_body handler_needs_poll f.fun_body in
+ begin match f.fun_poll with
+ | Error_poll -> begin
+ match find_poll_alloc_or_calls new_body with
+ | [] -> ()
+ | poll_error_instrs -> raise (Error(Poll_error poll_error_instrs))
+ end
+ | Default_poll -> () end;
let new_contains_calls = f.fun_contains_calls || !contains_polls in
{ f with fun_body = new_body; fun_contains_calls = new_contains_calls }
end
match potentially_recursive_tailcall ~future_funcnames i with
| Might_not_poll -> true
| Always_polls -> false
+
+(* Error report *)
+
+let instr_type p =
+ match p with
+ | Poll -> "inserted poll"
+ | Alloc -> "allocation"
+ | Function_call -> "function call"
+ | External_call -> "external call that allocates"
+
+let report_error ppf = function
+| Poll_error instrs ->
+ begin
+ let num_inserted_polls =
+ List.fold_left
+ (fun s (p,_) -> s + match p with Poll -> 1
+ | Alloc | Function_call | External_call -> 0
+ ) 0 instrs in
+ let num_user_polls = (List.length instrs) - num_inserted_polls in
+ if num_user_polls = 0 then
+ fprintf ppf "Function with poll-error attribute contains polling \
+ points (inserted by the compiler)\n"
+ else begin
+ fprintf ppf
+ "Function with poll-error attribute contains polling points:\n";
+ List.iter (fun (p,dbg) ->
+ begin match p with
+ | Poll -> ()
+ | Alloc | Function_call | External_call ->
+ fprintf ppf "\t%s at " (instr_type p);
+ Location.print_loc ppf (Debuginfo.to_location dbg);
+ fprintf ppf "\n"
+ end
+ ) instrs;
+ if num_inserted_polls > 0 then
+ fprintf ppf "\t(plus compiler-inserted polling point(s) in prologue \
+ and/or loop back edges)\n"
+ end
+ end
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error err -> Some (Location.error_of_printer_file report_error err)
+ | _ -> None
+ )
method! is_cheap_operation op =
match op with
- | Iconst_int n -> n <= 32767n && n >= -32768n
+ | Iconst_int n -> n <= 0x7FFF_FFFFn && n >= -0x8000_0000n
| _ -> false
end
let slot_offset env loc cls =
match loc with
- Local n ->
+ | Local n ->
reserved_stack_space + env.stack_offset +
(if cls = 0 then env.f.fun_num_stack_slots.(1) * size_float + n * size_int
else n * size_float)
| Incoming n ->
(* Callee's [reserved_stack_space] is included in [frame_size].
To access incoming arguments, add caller's [reserverd_stack_space]. *)
- frame_size env + reserved_stack_space + n
+ frame_size env + reserved_stack_space + n
| Outgoing n -> reserved_stack_space + n
+ | Domainstate _ -> assert false (* not a stack slot *)
let retaddr_offset env =
match abi with
let emit_stack env r =
match r.loc with
+ | Stack (Domainstate n) ->
+ let ofs = n + Domainstate.(idx_of_field Domain_extra_params) * 8 in
+ `{emit_int ofs}(30)`
| Stack s ->
- let ofs = slot_offset env s (register_class r) in `{emit_int ofs}(1)`
+ let ofs = slot_offset env s (register_class r) in
+ `{emit_int ofs}(1)`
| _ -> Misc.fatal_error "Emit.emit_stack"
(* Output the name of a symbol plus an optional offset *)
| Thirtytwo_signed -> if ppc64 then "lwa" else "lwz"
| Word_int | Word_val -> lg
| Single -> "lfs"
- | Double | Double_u -> "lfd" in
+ | Double -> "lfd" in
emit_load_store loadinstr addr i.arg 0 i.res.(0);
if chunk = Byte_signed then
` extsb {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
| Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
| Word_int | Word_val -> stg
| Single -> "stfs"
- | Double | Double_u -> "stfd" in
+ | Double -> "stfd" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc { bytes; dbginfo }) ->
emit_alloc env i bytes dbginfo false
(* Calling conventions *)
+let size_domainstate_args = 64 * size_int
+
let loc_int last_int make_stack reg_use_stack int ofs =
if !int <= last_int then begin
let l = phys_reg !int in
[| stack_lower; stack_upper |]
end
-let calling_conventions first_int last_int first_float last_float make_stack
- arg =
+let calling_conventions first_int last_int first_float last_float
+ make_stack first_stack arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref first_stack in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| Val | Int | Addr ->
| Float ->
loc.(i) <- loc_float last_float make_stack false int float ofs
done;
- (loc, Misc.align !ofs 16) (* keep stack 16-aligned *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 16) (* keep stack 16-aligned *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
-let max_arguments_for_tailcalls = 8
+let max_arguments_for_tailcalls = 16 (* in regs *) + 64 (* in domain state *)
let loc_arguments arg =
- calling_conventions 0 7 100 112 outgoing arg
+ calling_conventions 0 15 100 112 outgoing (- size_domainstate_args) arg
let loc_parameters arg =
- let (loc, _ofs) = calling_conventions 0 7 100 112 incoming arg
+ let (loc, _ofs) =
+ calling_conventions 0 15 100 112 incoming (- size_domainstate_args) arg
in loc
let loc_results res =
- let (loc, _ofs) = calling_conventions 0 7 100 112 not_supported res
+ let (loc, _ofs) = calling_conventions 0 15 100 112 not_supported 0 res
in loc
(* C calling conventions for ELF32:
(* Results are in GPR 3 and FPR 1 *)
let loc_external_results res =
- let (loc, _ofs) = calling_conventions 0 1 100 100 not_supported res
+ let (loc, _ofs) = calling_conventions 0 1 100 100 not_supported 0 res
in loc
(* Exceptions are in GPR 3 *)
| Word_val -> "val"
| Single -> "float32"
| Double -> "float64"
- | Double_u -> "float64u"
let phantom_defining_expr ppf defining_expr =
match defining_expr with
fprintf ppf "[si%i]" s
| Stack(Outgoing s) ->
fprintf ppf "[so%i]" s
+ | Stack(Domainstate s) ->
+ fprintf ppf "[ds%i]" s
end
let regs ppf v =
Local of int
| Incoming of int
| Outgoing of int
+ | Domainstate of int
type reg = t
Local of int
| Incoming of int
| Outgoing of int
+ | Domainstate of int
+
+(* The [stack_location] describes the location of pseudo-registers
+ that reside in memory.
+ - [Local] is a local variable or spilled register residing in the stack frame
+ of the current function
+ - [Incoming] is a function parameter that was passed on the stack.
+ This is the callee's view: the location is just above the callee's
+ stack frame, in the caller's stack frame.
+ - [Outgoing] is a function call argument that is passed on the stack.
+ This is the caller's view: the location is at the bottom of the
+ caller's stack frame.
+ - [Domainstate] is a function call argument that is passed not on stack
+ but in the [extra_params] section of the domain state
+ (see file [../runtime/caml/domain_state.*]). Unlike arguments passed
+ on stack, arguments passed via the domain state are compatible with
+ tail calls. However, domain state locations are shared between
+ all functions that run in a given domain, hence they are not preserved
+ by function calls or thread context switches. The caller stores
+ arguments in the domain state immediately before the call, and the
+ first thing the callee does is copy them to registers or [Local]
+ stack locations. Neither GC nor thread context switches can occur
+ between these two times. *)
val dummy: t
val create: Cmm.machtype_component -> t
({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_poll = f.fun_poll;
fun_contains_calls = f.fun_contains_calls;
fun_num_stack_slots = Array.copy num_stack_slots;
},
method! is_cheap_operation op =
match op with
- | Iconst_int n -> n <= 0x7FFn && n >= -0x800n
+ | Iconst_int n -> n <= 0x7FFF_FFFFn && n >= -0x8000_0000n
| _ -> false
end
let slot_offset env loc cls =
match loc with
| Local n ->
- if cls = 0
- then env.stack_offset + env.f.fun_num_stack_slots.(1) * size_float
- + n * size_int
- else env.stack_offset + n * size_float
- | Incoming n -> frame_size env + n
- | Outgoing n -> n
+ ("sp",
+ if cls = 0
+ then env.stack_offset + env.f.fun_num_stack_slots.(1) * size_float
+ + n * size_int
+ else env.stack_offset + n * size_float)
+ | Incoming n ->
+ ("sp", frame_size env + n)
+ | Outgoing n ->
+ ("sp", n)
+ | Domainstate n ->
+ ("s11", n + Domainstate.(idx_of_field Domain_extra_params) * 8)
(* Output a symbol *)
` li {emit_reg reg_tmp}, {emit_int n}\n`;
` add sp, sp, {emit_reg reg_tmp}\n`
-let emit_mem_op op src ofs =
+(* Adjust stack_offset and emit corresponding CFI directive *)
+
+let adjust_stack_offset env delta =
+ env.stack_offset <- env.stack_offset + delta;
+ cfi_adjust_cfa_offset delta
+
+let emit_mem_op ?(base = "sp") op src ofs =
if is_immediate ofs then
- ` {emit_string op} {emit_string src}, {emit_int ofs}(sp)\n`
+ ` {emit_string op} {emit_string src}, {emit_int ofs}({emit_string base})\n`
else begin
` li {emit_reg reg_tmp}, {emit_int ofs}\n`;
- ` add {emit_reg reg_tmp}, sp, {emit_reg reg_tmp}\n`;
+ ` add {emit_reg reg_tmp}, {emit_string base}, {emit_reg reg_tmp}\n`;
` {emit_string op} {emit_string src}, 0({emit_reg reg_tmp})\n`
end
-let emit_store src ofs =
- emit_mem_op "sd" src ofs
-
-let emit_load dst ofs =
- emit_mem_op "ld" dst ofs
-
let reload_ra n =
- emit_load "ra" (n - size_addr)
+ emit_mem_op "ld" "ra" (n - size_addr)
let store_ra n =
- emit_store "ra" (n - size_addr)
+ emit_mem_op "sd" "ra" (n - size_addr)
-let emit_store src ofs =
- emit_store (reg_name src) ofs
+let emit_store ?base src ofs =
+ emit_mem_op ?base "sd" (reg_name src) ofs
-let emit_load dst ofs =
- emit_load (reg_name dst) ofs
+let emit_load ?base dst ofs =
+ emit_mem_op ?base "ld" (reg_name dst) ofs
-let emit_float_load dst ofs =
- emit_mem_op "fld" (reg_name dst) ofs
+let emit_float_load ?base dst ofs =
+ emit_mem_op ?base "fld" (reg_name dst) ofs
-let emit_float_store src ofs =
- emit_mem_op "fsd" (reg_name src) ofs
+let emit_float_store ?base src ofs =
+ emit_mem_op ?base "fsd" (reg_name src) ofs
(* Record live pointers at call points *)
{typ = Val; loc = Reg r} ->
live_offset := (r lsl 1) + 1 :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset env s (register_class reg) :: !live_offset
+ let (base, ofs) = slot_offset env s (register_class reg) in
+ assert (base = "sp");
+ live_offset := ofs :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ()
assert (env.f.fun_prologue_required);
let n = frame_size env in
emit_stack_adjustment (-n);
- if env.f.fun_contains_calls then store_ra n
+ if n > 0 then cfi_adjust_cfa_offset n;
+ if env.f.fun_contains_calls then begin
+ store_ra n;
+ cfi_offset ~reg:1 (* ra *) ~offset:(-size_addr)
+ end;
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
if src.loc <> dst.loc then begin
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Val | Int | Addr)} ->
` fmv.x.d {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
- let ofs = slot_offset env s (register_class dst) in
- emit_store src ofs
+ let (base, ofs) = slot_offset env s (register_class dst) in
+ emit_store ~base src ofs
| {loc = Reg _; typ = Float}, {loc = Stack s} ->
- let ofs = slot_offset env s (register_class dst) in
- emit_float_store src ofs
+ let (base, ofs) = slot_offset env s (register_class dst) in
+ emit_float_store ~base src ofs
| {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
- let ofs = slot_offset env s (register_class src) in
- emit_load dst ofs
+ let (base, ofs) = slot_offset env s (register_class src) in
+ emit_load ~base dst ofs
| {loc = Stack s; typ = Float}, {loc = Reg _} ->
- let ofs = slot_offset env s (register_class src) in
- emit_float_load dst ofs
+ let (base, ofs) = slot_offset env s (register_class src) in
+ emit_float_load ~base dst ofs
| {loc = Stack _}, {loc = Stack _}
| {loc = Unknown}, _ | _, {loc = Unknown} ->
Misc.fatal_error "Emit: Imove"
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
emit_stack_adjustment (-n);
- env.stack_offset <- env.stack_offset + n
+ adjust_stack_offset env n
| Lop(Iload(Single, Iindexed ofs, _mut)) ->
` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
| Thirtytwo_signed -> "lw"
| Word_int | Word_val -> "ld"
| Single -> assert false
- | Double | Double_u -> "fld"
+ | Double -> "fld"
in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`
| Lop(Istore(Single, Iindexed ofs, _)) ->
| Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
| Word_int | Word_val -> "sd"
| Single -> assert false
- | Double | Double_u -> "fsd"
+ | Double -> "fsd"
in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
| Lop(Ialloc {bytes; dbginfo}) ->
| Ladjust_trap_depth { delta_traps } ->
(* each trap occupes 16 bytes on the stack *)
let delta = 16 * delta_traps in
- env.stack_offset <- env.stack_offset + delta
+ adjust_stack_offset env delta
| Lpushtrap {lbl_handler} ->
` la {emit_reg reg_tmp}, {emit_label lbl_handler}\n`;
` addi sp, sp, -16\n`;
- env.stack_offset <- env.stack_offset + 16;
+ adjust_stack_offset env 16;
emit_store reg_tmp size_addr;
emit_store reg_trap 0;
` mv {emit_reg reg_trap}, sp\n`
| Lpoptrap ->
emit_load reg_trap 0;
` addi sp, sp, 16\n`;
- env.stack_offset <- env.stack_offset - 16
+ adjust_stack_offset env (-16)
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
` .align 2\n`;
`{emit_symbol fundecl.fun_name}:\n`;
emit_debug_info fundecl.fun_dbg;
+ cfi_startproc();
emit_all env fundecl.fun_body;
List.iter emit_call_gc env.call_gc_sites;
List.iter emit_call_bound_error env.bound_error_sites;
+ cfi_endproc();
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
(* Emit the float literals *)
if env.float_literals <> [] then begin
`{emit_symbol lbl_end}:\n`;
` .quad 0\n`;
(* Emit the frame descriptors *)
- ` {emit_string rodata_space}\n`;
+ ` {emit_string data_space}\n`; (* not rodata because relocations inside *)
let lbl = Compilenv.make_symbol (Some "frametable") in
declare_global_data lbl;
`{emit_symbol lbl}:\n`;
(* Calling conventions *)
+let size_domainstate_args = 64 * size_int
+
let calling_conventions
- first_int last_int first_float last_float make_stack arg =
+ first_int last_int first_float last_float make_stack first_stack arg =
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref first_stack in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| Val | Int | Addr as ty ->
ofs := !ofs + size_float
end
done;
- (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 16) (* Keep stack 16-aligned. *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ = fatal_error "Proc.loc_results: cannot call"
-let max_arguments_for_tailcalls = 16
+let max_arguments_for_tailcalls = 16 (* in regs *) + 64 (* in domain state *)
(* OCaml calling convention:
first integer args in a0 .. a7, s2 .. s9
first float args in fa0 .. fa7, fs2 .. fs9
- remaining args on stack.
+ remaining args in domain state area, then on stack.
Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
let loc_arguments arg =
- calling_conventions 0 15 110 125 outgoing arg
+ calling_conventions 0 15 110 125 outgoing (- size_domainstate_args) arg
let loc_parameters arg =
let (loc, _ofs) =
- calling_conventions 0 15 110 125 incoming arg
+ calling_conventions 0 15 110 125 incoming (- size_domainstate_args) arg
in
loc
let loc_results res =
let (loc, _ofs) =
- calling_conventions 0 15 110 125 not_supported res
+ calling_conventions 0 15 110 125 not_supported 0 res
in
loc
external_calling_conventions 0 7 110 117 outgoing arg
let loc_external_results res =
- let (loc, _ofs) = calling_conventions 0 1 110 111 not_supported res
+ let (loc, _ofs) = calling_conventions 0 1 110 111 not_supported 0 res
in loc
(* Exceptions are in a0 *)
else env.stack_offset + n * size_float
| Incoming n -> frame_size env + n
| Outgoing n -> n
+ | Domainstate _ -> assert false (* not a stack slot *)
(* Output a symbol *)
let emit_stack env r =
match r.loc with
- Stack s ->
- let ofs = slot_offset env s (register_class r) in `{emit_int ofs}(%r15)`
+ | Stack (Domainstate n) ->
+ let ofs = n + Domainstate.(idx_of_field Domain_extra_params) * 8 in
+ `{emit_int ofs}(%r10)`
+ | Stack s ->
+ let ofs = slot_offset env s (register_class r) in
+ `{emit_int ofs}(%r15)`
| _ -> fatal_error "Emit.emit_stack"
| Thirtytwo_signed -> "lgf"
| Word_int | Word_val -> "lg"
| Single -> "ley"
- | Double | Double_u -> "ldy" in
+ | Double -> "ldy" in
emit_load_store loadinstr addr i.arg 0 i.res.(0);
if chunk = Single then
` ldebr {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
| Thirtytwo_unsigned | Thirtytwo_signed -> "sty"
| Word_int | Word_val -> "stg"
| Single -> assert false
- | Double | Double_u -> "stdy" in
+ | Double -> "stdy" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc { bytes = n; dbginfo }) ->
(* Calling conventions *)
+let size_domainstate_args = 64 * size_int
+
let calling_conventions
first_int last_int first_float last_float make_stack stack_ofs arg =
let loc = Array.make (Array.length arg) Reg.dummy in
ofs := !ofs + size_float
end
done;
- (loc, Misc.align !ofs 16)
- (* Keep stack 16-aligned. *)
-
-let incoming ofs = Incoming ofs
-let outgoing ofs = Outgoing ofs
+ (loc, Misc.align (max 0 !ofs) 16) (* Keep stack 16-aligned. *)
+
+let incoming ofs =
+ if ofs >= 0
+ then Incoming ofs
+ else Domainstate (ofs + size_domainstate_args)
+let outgoing ofs =
+ if ofs >= 0
+ then Outgoing ofs
+ else Domainstate (ofs + size_domainstate_args)
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
-let max_arguments_for_tailcalls = 5
+let max_arguments_for_tailcalls = 8 (* in regs *) + 64 (* in domain state *)
let loc_arguments arg =
- calling_conventions 0 4 100 103 outgoing 0 arg
+ calling_conventions 0 7 100 103 outgoing (- size_domainstate_args) arg
let loc_parameters arg =
- let (loc, _ofs) = calling_conventions 0 4 100 103 incoming 0 arg in loc
+ let (loc, _ofs) =
+ calling_conventions 0 7 100 103 incoming (- size_domainstate_args) arg
+ in loc
let loc_results res =
- let (loc, _ofs) = calling_conventions 0 4 100 103 not_supported 0 res in loc
+ let (loc, _ofs) = calling_conventions 0 7 100 103 not_supported 0 res in loc
(* C calling conventions under SVR4:
use GPR 2-6 and FPR 0,2,4,6 just like ML calling conventions.
| Cload (c, _) ->
begin match c with
| Word_val -> typ_val
- | Single | Double | Double_u -> typ_float
+ | Single | Double -> typ_float
| _ -> typ_int
end
| Calloc -> typ_val
Istore(_, _, _) ->
for i = 0 to Array.length regs - 1 do
let r = regs.(i) in
- let kind = if r.typ = Float then Double_u else Word_val in
+ let kind = if r.typ = Float then Double else Word_val in
self#insert env
(Iop(Istore(kind, !a, false)))
(Array.append [|r|] regs_addr) [||];
if Polling.requires_prologue_poll ~future_funcnames
~fun_name:f.Cmm.fun_name body
then
- instr_cons (Iop(Ipoll { return_label = None })) [||] [||] body
+ instr_cons_debug
+ (Iop(Ipoll { return_label = None })) [||] [||] f.Cmm.fun_dbg body
else
body
in
fun_body = body_with_prologue;
fun_codegen_options = f.Cmm.fun_codegen_options;
fun_dbg = f.Cmm.fun_dbg;
+ fun_poll = f.Cmm.fun_poll;
fun_num_stack_slots = Array.make Proc.num_register_classes 0;
fun_contains_calls = !contains_calls;
}
fun_args = f.fun_args;
fun_body = new_body;
fun_codegen_options = f.fun_codegen_options;
+ fun_poll = f.fun_poll;
fun_dbg = f.fun_dbg;
fun_num_stack_slots = f.fun_num_stack_slots;
fun_contains_calls = f.fun_contains_calls;
fun_args = new_args;
fun_body = new_body;
fun_codegen_options = f.fun_codegen_options;
+ fun_poll = f.fun_poll;
fun_dbg = f.fun_dbg;
fun_num_stack_slots = f.fun_num_stack_slots;
fun_contains_calls = f.fun_contains_calls;
let internal_assembler = ref None
let register_internal_assembler f = internal_assembler := Some f
+let with_internal_assembler assemble k =
+ Misc.protect_refs [ R (internal_assembler, Some assemble) ] k
(* Which asm conventions to use *)
let masm =
(** Support for plumbing a binary code emitter *)
val register_internal_assembler: (asm_program -> string -> unit) -> unit
+val with_internal_assembler:
+ (asm_program -> string -> unit) -> (unit -> 'a) -> 'a
(* In the legacy strategy, we call [reduce] instead of [announce_reduce],
apparently in an attempt to hide the reduction steps performed during
- error handling. This seems inconsistent, as the default reduction steps
- are still announced. In the simplified strategy, all reductions are
+ error handling. In the simplified strategy, all reductions steps are
announced. *)
match strategy with
else begin
(* The stack is nonempty. Pop a cell, updating the current state
- with that found in the popped cell, and try again. *)
+ to the state [cell.state] found in the popped cell, and continue
+ error handling there. *)
+
+ (* I note that if the new state [cell.state] has a default reduction,
+ then it is ignored. It is unclear whether this is intentional. It
+ could be a good thing, as it avoids a scenario where the parser
+ diverges by repeatedly popping, performing a default reduction of
+ an epsilon production, popping, etc. Still, the question of whether
+ to obey default reductions while error handling seems obscure. *)
let env = { env with
stack = next;
end
end
module StaticVersion = struct
-let require_20201216 = ()
+let require_20210419 = ()
end
and type nonterminal = int
end
module StaticVersion : sig
-val require_20201216: unit
+val require_20210419: unit
end
(* This generated code requires the following version of MenhirLib: *)
let () =
- MenhirLib.StaticVersion.require_20201216
+ MenhirLib.StaticVersion.require_20210419
module MenhirBasics = struct
let mkexp_constraint ~loc e (t1, t2) =
match t1, t2 with
- | Some t, None -> ghexp ~loc (Pexp_constraint(e, t))
- | _, Some t -> ghexp ~loc (Pexp_coerce(e, t1, t))
+ | Some t, None -> mkexp ~loc (Pexp_constraint(e, t))
+ | _, Some t -> mkexp ~loc (Pexp_coerce(e, t1, t))
| None, None -> assert false
let mkexp_opt_constraint ~loc e = function
let mkpat_opt_constraint ~loc p = function
| None -> p
- | Some typ -> ghpat ~loc (Ppat_constraint(p, typ))
+ | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
let syntax_error () =
raise Syntaxerr.Escape_error
let loc_lident (id : string Location.loc) : Longident.t Location.loc =
loc_map (fun x -> Lident x) id
-let exp_of_longident ~loc lid =
- let lid = make_ghost (loc_map (fun id -> Lident (Longident.last id)) lid) in
- ghexp ~loc (Pexp_ident lid)
+let exp_of_longident lid =
+ let lid = loc_map (fun id -> Lident (Longident.last id)) lid in
+ Exp.mk ~loc:lid.loc (Pexp_ident lid)
-let exp_of_label ~loc lbl =
- mkexp ~loc (Pexp_ident (loc_lident lbl))
+let exp_of_label lbl =
+ Exp.mk ~loc:lbl.loc (Pexp_ident (loc_lident lbl))
let pat_of_label lbl =
Pat.mk ~loc:lbl.loc (Ppat_var (loc_last lbl))
Obj.repr ()
and default_reduction =
- (16, "\000\000\000\000\000\000\002\253\002\252\002\251\002\250\002\249\002\204\002\248\002\247\002\246\002\245\002\244\002\243\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\203\002\229\002\228\002\227\002\226\002\225\002\224\002\223\002\222\002\221\002\220\002\219\002\218\002\217\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003B\001\172\001\151\001\169\001\168\001\167\001\173\001\177\000\000\003C\001\171\001\170\001\152\001\175\001\166\001\165\001\164\001\163\001\162\001\160\001\176\001\174\000\000\000\000\000\000\000\220\000\000\000\000\001\155\000\000\000\000\000\000\001\157\000\000\000\000\000\000\001\159\001\181\001\178\001\161\001\153\001\179\001\180\000\000\003A\003@\003D\000\000\000\000\000\024\001E\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\203\001\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003=\000\000\0038\000\000\000\000\003:\000\000\003<\000\000\0039\003;\000\000\0033\000\000\0032\003.\0027\000\000\0031\000\000\0028\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001Q\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\000e\000\000\000\000\000\000\000\000\001O\000\000\000\000\001R\001P\001X\000A\002\140\000\000\001\021\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\185\000\000\002k\002l\000\000\002i\002j\000\000\000\000\000\000\000\000\000\000\001h\001g\000\000\002\183\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\223\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\003\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002n\002m\000\000\000\000\000\000\001\185\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001W\000\000\001V\000\000\001F\001U\000\000\001D\000b\000\030\000\000\000\000\001\128\000\025\000\000\000\000\000\000\000\000\003-\000(\000\000\000\000\000\031\000\026\000\000\000\000\000\000\000\201\000\000\000\000\000\000\000\203\002A\0023\000\000\000\"\000\000\0024\000\000\000\000\001\182\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\023\000\000\003\024\000\000\000y\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(\000\000\000\000\000\000\000\000\000\000\000\000\000c\000\000\002\190\000f\000i\000d\002\179\003E\002\180\001\244\002\182\000\000\000\000\002\187\002h\002\189\000\000\000\000\000\000\002\196\002\193\000\000\000\000\000\000\001\240\001\226\000\000\000\000\000\000\000\000\001\230\000\000\001\225\000\000\001\243\002\202\000\000\000\000\000\000\000\000\001\130\000\000\000\000\001\242\002\188\000q\000\000\000\000\000p\000\000\002\197\002\181\000\000\001\236\000\000\000\000\002\200\000\000\002\199\002\198\000\000\001\232\000\000\000\000\001\228\001\227\001\241\001\233\000\000\000o\000\000\002\195\002\194\000\000\002\192\000\000\002p\002o\000\000\000\000\002K\002\191\000\000\000\000\000\000\000\000\001\187\0010\0011\002r\000\000\002s\002q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\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\0030\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\000\000\000\001N\001x\001M\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0021\000\000\000\000\0022\002%\002$\000\000\001p\001o\000\000\000\205\000\000\000\000\001a\000\000\000\000\001e\000\000\001\207\001\206\000\000\000\000\001\205\001\204\001d\001b\000\000\001f\000\000\000\000\000\000\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\144\001S\002\149\002\147\000\000\000\000\000\000\002\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\254\000\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\234\000\000\000\235\000\000\000\000\000\000\002\157\000\000\000\000\000\000\002\128\002w\000\000\000\000\000\000\000\000\003F\002\159\002\146\002\145\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\183\000\000\000\000\000\000\000\168\000\000\000\000\000\000\002R\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\003\000\000\000\003*\000\000\000\000\003)\000\000\000\000\000\000\000\000\000\000\000\195\000\194\000\244\000\000\003\001\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\000\000\002+\000\000\000\000\000\000\000\249\000\000\000\000\000\248\000\247\000\000\000\000\000\000\000\000\000\252\000\000\000\000\000\251\000\000\001\239\000\000\000\000\001\251\000\000\000\000\001\253\000\000\000\000\001\249\001\248\001\246\001\247\000\000\000\000\000\000\000\245\000\000\000\000\001\027\000\018\000\254\000\000\000\000\000\000\002\130\002y\000\000\000\000\002\129\002x\000\000\000\000\000\000\000\000\002\132\002{\000\000\000\000\002E\000\000\000\000\002\136\002\127\000\000\000\000\002\134\002}\002\153\000\000\000\000\000\000\000\000\000\000\002\131\000\000\000\000\000\000\000\000\000\000\002\135\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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&\000\167\000\000\002z\000\000\000\000\002~\000\000\000\000\002|\000\000\000z\000{\000\000\000\000\000\000\000\000\000\138\000\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\198\000\199\000\131\000\000\000\130\000\000\000\000\0013\000\000\0014\0012\002-\000\000\000\000\002.\002,\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\001\007\000\000\000\000\000\170\000\000\001\t\001\b\000\000\000\000\002\161\002\154\000\000\002\170\000\000\002\171\002\169\000\000\002\175\000\000\002\176\002\174\000\000\000\000\002\156\002\155\000\000\000\000\000\000\002\021\000\000\001\201\000\000\000\000\000\000\002N\002\020\000\000\002\165\002\164\000\000\000\000\000\000\001T\000\000\002\138\000\000\002\139\002\137\000\000\002\163\002\162\000\000\000\000\000\000\002H\002\152\000\000\002\151\002\150\000\000\002\173\002\172\000\128\000\000\000\000\000\000\000\000\000\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\000\000\001[\000\000\000\000\000\000\000k\000\000\000\000\000l\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\225\000\000\000\000\000u\000\000\000\228\000\226\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000~\000m\000\000\000\000\002\019\000\000\000\000\000\253\001\199\000\000\000\237\000\238\001\004\000\000\000\000\000\000\000\000\000\000\001\214\001\208\000\000\001\213\000\000\001\211\000\000\001\212\000\000\001\209\000\000\000\000\001\210\000\000\001\148\000\000\000\000\000\000\001\147\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\017\003\015\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\002\004\000\000\000\000\000\000\000\000\000\000\000\000\003\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\000\000\002\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\255\000\000\000\000\002S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\150\000\000\000\000\000\000\001\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\000\000\000\000\001j\000\000\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\019\002a\000\000\000\000\000\000\002_\000\000\000\000\000\000\002^\000\000\001]\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\003N\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\000\000\000\000\000\000\000\000\001\127\000\000\001~\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\017\000\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\000\000\000\000\000O\000M\000\000\000R\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000\000\000\000\000\000\000J\000\000\000Q\000P\000\000\000K\000L\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\015\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\001\r\002f\002W\000\000\002]\002X\002d\002c\002b\002`\001\030\000\000\002U\000\000\000\000\000\000\000\000\000\000\002\"\000\000\000\000\001\023\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\001\139\000\000\000\000\000\000\000\210\000\000\000\000\002\024\002\"\000\000\000\000\001\025\002\022\002\023\000\000\000\000\000\000\000\000\000\000\001\146\001\142\001\138\000\000\000\000\000\211\000\000\000\000\001\145\001\141\001\137\001\135\002Z\002V\002g\001\029\002\001\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\003K\000\000\0006\000\000\000\000\003Q\000\000\003P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003H\000\000\000\000\003J\000\000\000\000\000\000\002\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\001@\001>\000\000\0007\000\000\000\000\003T\000\000\003S\000\000\000\000\000\000\001<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001A\000\000\000\000\001?\001=\000\000\000\000\000\000\0009\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\000X\000\000\000\000\000\000\000\000\000\000\000\000\0003\000\000\000\000\000W\000\000\0001\001\001\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\189\000\000\0005\000\000\000\000\000\000\0004\000\000\000\000\000\000\0008\000\000\000Y\000\\\000\000\000:\000;\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\003\018\003\t\000\000\000\000\003\r\002\254\003\b\003\017\003\016\001\"\000\000\000\000\003\006\000\000\003\n\003\007\003\019\002\000\000\000\000\000\003\004\000\000\000\191\003\003\000\000\000\000\000\222\000\000\000\000\001!\001 \000\000\001_\001^\000\000\000\000\002\201\002\184\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\168\000\000\002\167\002\166\002\148\000\000\000\000\000\000\000\000\002\141\000\000\002\143\000\000\002\142\000\000\002u\002t\000\000\002v\000\000\000\000\000\134\000\000\000\000\002\t\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\012\002\029\002\030\002\025\002\027\002\026\002\028\000\000\000\000\000\000\000\190\000\000\000\000\002\"\000\000\000\214\000\000\000\000\000\000\000\000\003\011\000\000\000\187\000\000\000\000\000\000\000\000\001;\0015\000\000\000\000\0016\000\029\000\000\000\028\000\000\000\000\000\202\000\000\000\000\000\000\000 \000\027\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\000\001\144\001\140\000\000\001\136\003,\000\000\002\"\000\000\000\213\000\000\000\000\000\000\000\000\002\\\002!\002\031\002 \000\000\000\000\000\000\002\"\000\000\000\212\000\000\000\000\000\000\000\000\002[\000\000\001l\001k\000\000\000\022\000\000\003L\000\000\000+\000\000\000\000\000\000\000\000\000\137\000\000\000\218\000\001\000\000\000\000\000\221\000\002\000\000\000\000\000\000\001H\001I\000\003\000\000\000\000\000\000\000\000\001K\001L\001J\000\019\001G\000\020\000\000\001\215\000\000\000\004\000\000\001\216\000\000\000\005\000\000\001\217\000\000\000\000\001\218\000\006\000\000\000\007\000\000\001\219\000\000\000\b\000\000\001\220\000\000\000\t\000\000\001\221\000\000\000\000\001\222\000\n\000\000\000\000\001\223\000\011\000\000\000\000\000\000\000\000\000\000\003\031\003\026\003\027\003\030\003\028\000\000\003#\000\012\000\000\003\"\000\000\001(\000\000\000\000\003 \000\000\003!\000\000\000\000\000\000\000\000\001,\001-\000\000\000\000\001+\001*\000\r\000\000\000\000\000\000\003?\000\000\003>")
+ (16, "\000\000\000\000\000\000\003\004\003\003\003\002\003\001\003\000\002\211\002\255\002\254\002\253\002\252\002\251\002\250\002\249\002\248\002\247\002\246\002\245\002\244\002\243\002\242\002\241\002\240\002\239\002\238\002\237\002\210\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\223\002\222\002\221\002\220\002\219\002\218\002\217\002\216\002\215\002\214\002\213\002\212\000\000\000\000\000,\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\001\175\001\154\001\172\001\171\001\170\001\176\001\180\000\000\003J\001\174\001\173\001\155\001\178\001\169\001\168\001\167\001\166\001\165\001\163\001\179\001\177\000\000\000\000\000\000\000\222\000\000\000\000\001\158\000\000\000\000\000\000\001\160\000\000\000\000\000\000\001\162\001\184\001\181\001\164\001\156\001\182\001\183\000\000\003H\003G\003K\000\000\000\000\000\026\001H\000\188\000\000\000\218\000\219\000\000\000\000\000\000\001\206\001\205\000\000\000\000\000\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003D\000\000\003?\000\000\000\000\003A\000\000\003C\000\000\003@\003B\000\000\003:\000\000\0039\0035\002<\000\000\0038\000\000\002=\000\000\000\000\000\000\000\000\000l\000\000\000\000\000j\000\000\000\000\001F\000\000\000\000\000\000\000\000\000\000\000\184\001T\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\000g\000\000\000\000\000\000\000\000\000\000\002\192\000\000\002p\002q\000\000\002n\002o\000\000\000\000\000\000\000\000\000\000\001k\001j\000\000\002\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\225\000\017\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001R\000\000\000\000\001U\001S\001[\000C\002\145\000\000\001\024\003\029\003\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000i\000\000\000\233\000\000\002s\002r\000\000\000\000\000\000\001\188\000\000\000\000\000'\000\000\000\000\000\000\000\000\000\000\001Z\000\000\001Y\000\000\001I\001X\000\000\001G\000d\000 \000\000\000\000\001\131\000\027\000\000\000\000\000\000\000\000\0034\000*\000\000\000\000\000!\000\028\000\000\000\000\000\000\000\201\000\000\000\000\000\000\000\203\002F\0028\000\000\000$\000\000\0029\000\000\000\000\001\185\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\019\003\030\000\000\003\031\000\000\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-\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\002\197\000h\000k\000f\002\186\003L\002\187\001\249\002\189\000\000\000\000\002\194\002m\002\196\000\000\000\000\000\000\002\203\002\200\000\000\000\000\000\000\001\245\001\231\000\000\000\000\000\000\000\000\001\235\000\000\001\230\000\000\001\248\002\209\000\000\000\000\000\000\000\000\001\133\000\000\000\000\001\247\002\195\000s\000\000\000\000\000r\000\000\002\204\002\188\000\000\001\241\000\000\000\000\002\207\000\000\002\206\002\205\000\000\001\237\000\000\000\000\001\233\001\232\001\246\001\238\000\000\000q\000\000\002\202\002\201\000\000\002\199\000\000\002u\002t\000\000\000\000\002P\002\198\000\000\000\000\000\000\000\000\001\190\0013\0014\002w\000\000\002x\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\244\000\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001u\000\000\000\000\000\000\000\000\000\000\000\000\003c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0037\000\000\000\000\000\000\000\000\000\000\001t\000\000\000\000\000\000\001Q\001{\001P\001x\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\000\000\000\000\0027\002*\002)\000\000\001s\001r\000\000\000\205\000\000\000\000\001d\000\000\000\000\001h\000\000\001\210\001\209\000\000\000\000\001\208\001\207\001g\001e\000\000\001i\000\000\000\000\000\000\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\151\001V\002\156\002\154\000\000\000\000\000\000\002\167\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\185\000\000\002\184\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\004\000\000\000\000\000\000\000\000\000\000\000\000\000\242\002\003\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\0030\000\000\000\000\000\000\000\000\000\237\000\236\000\000\000\238\000\000\000\000\000\000\002\164\000\000\000\000\000\000\002\133\002|\000\000\000\000\000\000\000\000\003M\002\166\002\153\002\152\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\183\000\000\000\000\000\000\000\168\000\000\000\000\000\000\002W\002V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\003\007\000\000\000\000\000\195\000\194\000\247\000\000\003\b\003\t\000\000\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000\000\0020\000\000\000\000\000\000\000\252\000\000\000\000\000\251\000\250\000\000\000\000\000\000\000\000\000\255\000\000\000\000\000\254\000\000\001\244\000\000\000\000\002\000\000\000\000\000\002\002\000\000\000\000\001\254\001\253\001\251\001\252\000\000\000\000\000\000\000\248\000\000\000\000\001\030\000\020\001\001\000\000\000\000\000\000\002\135\002~\000\000\000\000\002\134\002}\000\000\000\000\000\000\000\000\002\137\002\128\000\000\000\000\002J\000\000\000\000\002\141\002\132\000\000\000\000\002\139\002\130\002\160\000\000\000\000\000\000\000\000\000\000\002\136\000\000\000\000\000\000\000\000\000\000\002\140\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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+\000\167\000\000\002\127\000\000\000\000\002\131\000\000\000\000\002\129\000\000\000|\000}\000\000\000\000\000\000\000\000\000\140\000\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\198\000\199\000\133\000\000\000\132\000\000\000\000\0016\000\000\0017\0015\0022\000\000\000\000\0023\0021\000\000\000\000\000\000\000\000\000\000\001\t\000\000\000\000\001\n\000\000\000\000\000\170\000\000\001\012\001\011\000\000\000\000\002\168\002\161\000\000\002\177\000\000\002\178\002\176\000\000\002\182\000\000\002\183\002\181\000\000\000\000\002\163\002\162\000\000\000\000\000\000\002\026\000\000\001\204\000\000\000\000\000\000\002S\002\025\000\000\002\172\002\171\000\000\000\000\000\000\001W\000\000\002\143\000\000\002\144\002\142\000\000\002\170\002\169\000\000\000\000\000\000\002M\002\159\000\000\002\158\002\157\000\000\002\180\002\179\000\130\000\000\000\000\000\000\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\127\000\000\001^\000\000\000\000\000\000\000m\000\000\000\000\000n\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\227\000\000\000\000\000w\000\000\000\230\000\228\000\000\000\000\000\000\000\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\128\000o\000\000\000\000\002\024\000\000\000\000\001\000\001\202\000\000\000\240\000\241\001\007\000\000\002\175\000\000\002\174\002\173\002\155\000\000\000\000\000\000\000\000\002\146\000\000\002\148\000\000\002\147\000\000\002z\002y\000\000\002{\000\000\000\000\000\000\000\000\001\217\001\211\000\000\001\216\000\000\001\214\000\000\001\215\000\000\001\212\000\000\000\000\001\213\000\000\001\151\000\000\000\000\000\000\001\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\020\003\022\000\000\000\000\003\021\000\000\000\000\000\000\000\000\000\000\002\t\000\000\000\000\000\000\000\000\000\000\000\000\003\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\135\000\000\002\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\006\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\152\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\001m\000\000\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\022\002f\000\000\000\000\000\000\002d\000\000\000\000\000\000\002c\000\000\001`\000\000\000\000\000\000\000\000\002j\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003U\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000\000\001\130\000\000\001\129\000\000\000\000\000\000\000\000\000J\000\000\000\000\000\000\002\022\000\000\002\021\000\000\000\000\000\000\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\000P\000\000\000\000\000\000\000Q\000O\000\000\000T\000\000\000\000\000\000\000\000\000\000\000I\000\000\000\000\000\000\000\000\000\000\000\000\000L\000\000\000S\000R\000\000\000M\000N\000\000\001'\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\018\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\000b\000a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\002k\002\\\000\000\002b\002]\002i\002h\002g\002e\001!\000\000\002Z\000\000\000\000\000\000\000\000\000\000\002'\000\000\000\000\001\026\002^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\146\001\142\000\000\000\000\000\000\000\212\000\000\000\000\002\029\002'\000\000\000\000\001\028\002\027\002\028\000\000\000\000\000\000\000\000\000\000\001\149\001\145\001\141\000\000\000\000\000\213\000\000\000\000\001\148\001\144\001\140\001\138\002_\002[\002l\001 \002\006\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003P\000\000\000\000\003R\000\000\0008\000\000\000\000\003X\000\000\003W\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003O\000\000\000\000\003Q\000\000\000\000\000\000\002\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001E\000\000\000\000\001C\001A\000\000\0009\000\000\000\000\003[\000\000\003Z\000\000\000\000\000\000\001?\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001D\000\000\000\000\001B\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\001\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Z\000\000\000\000\000\000\000\000\000\000\000\000\0005\000\000\000\000\000Y\000\000\0003\001\004\000\000\000B\000/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000\000\000X\000W\000\000\000\000\000]\000\\\000\000\000\000\001\192\000\000\0007\000\000\000\000\000\000\0006\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\001\014\003\025\003\016\000\000\000\000\003\020\003\005\003\015\003\024\003\023\001%\000\000\000\000\003\r\000\000\003\017\003\014\003\026\002\005\000\000\000\000\003\011\000\000\000\191\003\n\000\000\000\000\000\224\000\000\000\000\001$\001#\000\000\001b\001a\000\000\000\000\002\208\002\191\000\000\000D\000\000\000\000\000E\000\000\000\000\002\150\002\149\000\000\000\000\000\136\000\000\000\000\002\014\000\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\019\002\"\002#\002\030\002 \002\031\002!\000\000\000\000\000\000\000\190\000\000\000\000\002'\000\000\000\216\000\000\000\000\000\000\000\000\003\018\000\000\000\187\000\000\000\000\000\000\000\000\001>\0018\000\000\000\000\0019\000\031\000\000\000\030\000\000\000\000\000\202\000\000\000\000\000\000\000\"\000\029\000\000\000\000\000\000\000\023\000\000\000\000\000\000\000\000\001\147\001\143\000\000\001\139\0033\000\000\002'\000\000\000\215\000\000\000\000\000\000\000\000\002a\002&\002$\002%\000\000\000\000\000\000\002'\000\000\000\214\000\000\000\000\000\000\000\000\002`\000\000\001o\001n\000\000\000\024\000\000\003S\000\000\000-\000\000\000\000\000\000\000\000\000\139\000\000\000\220\000\001\000\000\000\000\000\223\000\002\000\000\000\000\000\000\001K\001L\000\003\000\000\000\000\000\000\000\000\001N\001O\001M\000\021\001J\000\022\000\000\001\218\000\000\000\004\000\000\001\219\000\000\000\005\000\000\001\220\000\000\000\000\001\221\000\006\000\000\000\007\000\000\001\222\000\000\000\b\000\000\001\223\000\000\000\t\000\000\001\224\000\000\000\n\000\000\001\225\000\000\000\011\000\000\001\226\000\000\000\000\001\227\000\012\000\000\000\000\001\228\000\r\000\000\000\000\000\000\000\000\000\000\003&\003!\003\"\003%\003#\000\000\003*\000\014\000\000\003)\000\000\001+\000\000\000\000\003'\000\000\003(\000\000\000\000\000\000\000\000\001/\0010\000\000\000\000\001.\001-\000\015\000\000\000\000\000\000\003F\000\000\003E")
and error =
- (124, "'\225 \197\138\173\2433\208\020\015\228\000\003\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224}\246D\b/\227P\000L\028\030\227\139\002\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\235f\245\155\175\2437\252\149\031\226\017\007\158\007\223d@\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\000#a\000E\130\141\241'\208\004\015\128\000\001\142\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\004\000\012\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\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\016(\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002\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\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\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\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\0000\000\007\001\002\012\\ \000\016\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\132\128 \128\b \002\020\000\016\000b\000\002\000\bH\002\b\000\130\000!\000\001\000\006 \000 \000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\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\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000 \000\002\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\002H\000@\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\002\000\000$\128\004\000\000\000\128\000\000\000\000\b\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\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\bH\002(\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\001\000\012\\(\000\016\b\002\000\001\000\003\000\bp\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\000\197\128\187\128\b2R\028\012\017 v\001f\017`0\000\006\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\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bP\t\026\000\001$!\192\192\018\001!\018\000\016}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\0000\000\002H\000L\000\000\b\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\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\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\253\155\239\247\255\252\157?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\136G\226\173\245#\211\230/\144@\025\174\184\018\016\132@\b\012\0189\000\000\024\000\000\024\192#a\000E\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\b@\000\b\004\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\003!\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\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\001\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\131!\136G\224,\229\"\211\227!\176@\025,\184\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\131\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\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\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\016\004\004\000\002\012\016\000\000\001\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\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\167\225 \197\138\173\2437\208\020\015\226\000\003\142\n~\018\012X\170\2233=\001@\254 \0008\224\167\225\"\197\138\173\2433\208\020\015\230\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\005\002\000@\000\000\129\000\000\000\016\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\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\0026\016\004\\(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\020@\003!\002@\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\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\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\b\000\001\016\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\003\000\002p\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\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\b\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\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\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\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\012H\003\184\000\131!!\192\193\018\007`\022!\022\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\011\184\000\131!!\192\193\018\007`\022!\022\003\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\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\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\012X\011\184\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\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000@\000\000@\000\002\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\002\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000 \000\000\000\017 \000\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\000\000\000\000\000\000\000\000\000\000\000\000 \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 \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\012H\003\184\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\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\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\b\000\001\016\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\003!\000@\192\004\193&\144\001\001\128\000\001\004\0002\016\004\b\000L\018i\000\016\024\000\000\016@\003!\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\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\147)\027P\144\020\193&\176\001\001\148 mU\000\000\016\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\000\t2\145\181\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\132\b\000L\018-\000\016\026\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\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\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\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131!\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\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\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\t2\017\180\b\001L\018m\000\016\027@\004\213P\131\161\136G\224,\229\"\211\227!\176@\025,\176\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\016\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\0002\016\004\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\b\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\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\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\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\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\128\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\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\b\000\000\128\000\000\000\000@\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\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\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\b\000\001 \000\000\000\000@\000\000\000\000\004\133\016\131!\002@\128\004\193\"\208\001\001\160\000\001D\000\000\000\000\000\000\000\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\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\016\000\000\004\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\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)\000P\144\004\193&\176\t\001\144\000M\021\128\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\128\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\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\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\128\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016D\012\130L\018m\000\016\026\000\000\016@\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\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\b\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\128\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 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000@\b\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\0000\000\007\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\001@0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\001\"\001LH\002\168\000\131\001!\192\001\016\007`\018 \004\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\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\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\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\000\196\128*\128\b0\146\028\000\017\000v\016\"\000@\016\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\012H\002\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\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\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\001\b\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\000&\000@P \132\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\b\000\000\128\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\001\000@@\000 \193\000\000\000\016\000\000\000\000\012\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\000\000\000\000\000\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*\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\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\002E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\000@\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\001!\000D\000\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000#a\000E\194\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018}\000@\248 \000\024\224#a\000E\130\141\241#\208\004\015\130\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\001!\000D\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\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\004\000\b\016\004\004\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\004\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\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b2\016\132\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\144\005\r\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\002\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\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\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\000\b:\024\132~\002\206R->2\027\004\001\146\203\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\003)\000P\144\020\193\"\176\001\001\128\000\005\004\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\196\148\187\131\232>\022\028\015\251`w\219~p\240\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\240\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\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\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\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\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\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\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\207\196\148\187\131\232>\022\028\015\251`w\219~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\188~\171\255s\253\255\214\255x\183\255\239}\246D\b/\227P\000L\028\030\227\139\002\131B6\016\004X(\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#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193&\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\135\169\"\208\152$\211>\176\025\001\246\000o\021H:\024\132~\002\206R->2\027\004\001\146\203\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\003)\000P\144\004\193\"\176\001\001\144\000%\004\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\000\000\000\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000 \000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\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\b8\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\016\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\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\001\000\004\129\016\131!\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\004\000\000\000\016\000H\017\b2\016\004\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\001\000\004\129\016\128\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\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\144\006`\000 \004\132\128\"\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\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\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\0026\016\004X(\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\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\176>\000\192@@>\002\001\000\005\134\003\163a\011E\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#a\000E\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\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\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\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\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\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\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\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\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\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\001\000\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\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\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\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\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\248\190\215?\191\251a\247\219\127\253\252[\219\189\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\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\0026\016\004X(\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#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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#a\000E\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#a\000E\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\000\000\000\000\000\000\000\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\136G\224,\229\"\211\227!\176@\025,\176\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\0002\144\005\t\001L\018+\000\016\024\000\000P@\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\001\004\000\000\000\016\000\000\000\000\000#a\000E\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\003)\000P\144\020\193\"\176\001\001\128\000\005\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\003)\000P\144\020\193\"\176\001\001\128\000\005\004\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\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\001\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\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\000@\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\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\b\000\000\000\000\000\1306\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\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\129!\bD\000\128\193#\144\000\001\128\000\001\140\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#a\000E\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\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\0026\016$X(\223\018=\000@\248\000\000\024\224\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\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\001!\000D\000\128\193#\144\000\001\128\000\001\140\004\000\000\000\000\000\000\000\000\0000\000\005\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\128\000\017\000\000\000\000\000\000\000\000\016\000$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\129\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\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\003\000\000P\000\000\000\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\003\000\016P$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\251`w\219~p\240\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\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\b\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\128\000\145\003\224\012\004\004\003\224`\016\000X 8\000\001\000\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\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\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\004\000\000\000@\000\000\000\000\000\000\000\003\000\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\128\000\000\000\000\016\000\004\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\000\000\000\016\000\004\000\000\000\016\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\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\128\000\000\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \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\b\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\b\000\000\000\004\000\0000\000\006\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\004\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\001\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\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\128\b R\028\000\025\000f\001\002\016@0\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\004\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\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\0002\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\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\003!\000@\128\004\193\"\208\001\001\128\000\001\004\bH\002(\000\130\001!\128\001\144\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\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\196\148\187\131\232>\022\028\015\249`w\139~p\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\128\000\136\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\b\016\004\004\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\004\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\b\016\004\004\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\004\000\000\128\000\001\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\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\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\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\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\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000v\000\002\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\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\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@0\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\b\000\000\000\000\001\000\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\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\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\0002\016\004\b\000L\018-\000\016\026\000\000\016@\016\000\002\000\000\000\000\004\000\000\000\000\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\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\000@\000\192\004\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\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\018(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \018\028\000\017\000v\000\006\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\b\000\bH\002(\000\130\001!\192\001\016\006a\000!\000\001\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\132\128\"\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\007\128\"\240\024 \199\210\000\017\000`\000\002\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\001\000\000\000@\000\000\004\000\000\000\000\000\000\b\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\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\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000v\000\018\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\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\128\000\000\000\000\016\000\020\000\b\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\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\003\000\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\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\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\128\000\000\000\000\016\000\004\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\132\128\"\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\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\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \002\028\000\016\000f\000\006\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002H\000@\000\000\b\000\000\000\000\000\128\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\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\b@\000\b\000\000(!@@\000\000 \016\000\000\132\000\000\128\000\002\130\016\004\000\000\002\001\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\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\132\000\000\128\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\004\004\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\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\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\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\000\128\000\004\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\001 \016\000\000\132\000\000\128\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\000\132\000\000\128\000\002\002\028\012\000\000\018\001\000\000\000\016\000\004\000 \005\016`\000\000\000\000\000\000\000\001\000\000@\002\000Q\002\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\004\000\000\000\000\000\000\b\000\016\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\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\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\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\132\128*\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\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\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002\168\000\130!!\192A\016\007`\016 \004\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\000\b@\000\b\000\000 !\128@\000\000 \016\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\132\000\000\128\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\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\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\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\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\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\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bX\n\168\000\131\004!\192\001\016\007`\000`\004\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\004\000\000\000\000\000@\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\133\128\170\128\b0B\028\000\017\000v\000\002\000HX\n\168\000\131\004!\192\001\016\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\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\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\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\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\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\000\bH\002(\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004\132\128\"\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\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\003 \000x\016\000\197\194\128\001\000\128 \000\016\0000\000'\001\000\012\\ \000\016\000\000\000\001@\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\133\160\"\128\b \146\026\000\017\000\230\001\002\000HH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\016@\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\001\002\000HH\002(\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\000\bH\002(\000\130\001!\192\001\016\007`\016 \004\001 \000\b\000\000\128\002\128\000\000\128 \000\016\000\018\000\000\000\000\b\000(\000\000\b\002\000\001\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\bH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\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\000\000\002\000\000\000\000\004\000\000\000\000\000\000\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\128\000\000\000\000\000@@\004\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\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000E\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\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\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\128\000\000\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\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\001\000\002@\000#a\000E\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\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000@\000\000\000\000\000\000\128\000\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\016\000\000\000\0026\016\004X(\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\132\000\000\128\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\b\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\016\000\000\000\0026\016\004X(\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#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\132\000\000\128\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\001\000\000@\002\000\209\006\000\000\004\000\000\000\b\000\016\000\004\000 \r\016`\000\000@\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003!\004@\200\004\193&\208\001\001\128\000\001\004\007\223d@\130\2545\000\004\193\193\2388\176(4\003!\004@\128\004\193&\208\001\001\128\000\001\004\0002\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\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\016\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\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\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\003)\000P\144\020\193\"\176\001\001\128\000\001\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bZ\146\173A\138-3\251\193\016\030`\016x\212\133\169*\212\024\162\211?\188\017\001\230\001\007\141@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\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\bH\002\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\000\132\128*\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\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@2\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\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\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\003\000\000p\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\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\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\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\`\000\016\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\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\132\000\000\128\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\b@\000\b\000\000 !\000\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\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\000\132\128\"\128\b \018\016\000\016\000f\000\002\000\0002\016D\012\000L\018m\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\132\128\"\128\b \018\016\000\017\000f\000\002\000HH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\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\000\000\000\000\000\000\000\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\"\128\b \018\016\000\025\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\bH\002(\000\130\001!\128\001\000\006`\000 \000\132\128\"\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\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\196\128*\128\b0\146\028\000\017\000v\000\"\000L\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\b\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\003\000\000p\016\000\197\194\000\001\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\b@\000\b\000\000 !\000\192\000\000 \016\000\000\128\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\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\129\002\000@@\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\004\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\004\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\b\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\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\b2\016\004\b\000L\018-\000\016\026\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\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\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\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\001\000\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000 \000\000\000\000\0000\000\006\000\000\012\\`\000\018\000\002\000\000\000\003\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000\000\000\003\000\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\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\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\016\000\000\000\000\000\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\004\004\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\bH\002(\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\003 \000x\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\000\132\128\"\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\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\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\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\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\000\132\128\"\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\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\000!\128\001\000\006`\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\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\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\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#a\000E\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#a\000E\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002\016\000\016\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 \000\000\000\000\192\002\000\000\000\128\000\000\000\b\000\b\128~\002\194@\000>\"\001\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\024(\176\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\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\128\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\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\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\128\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\000@\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\005\161 \128\b \210\016\016\017\000\228\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\004\128 \128\b \018\016\000\017\000d\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000H\002\b\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\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'\225 \197\138\173\2433\208\021\015\228\000\003\142\002~\018\012X\170\2233=\001P\254@\0008\224\004\128 \128\b \018\016\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\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\004\128 \128\b \018\024\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\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\000H\002\b\000\130\001!\128\001\016\006@\000 \000\004\128 \128\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
+ (124, "'\225 \197\138\173\2433\208\020\015\228\000\003\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224}\246D\b/\227P\000L\028\030\227\139\002\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\235f\245\155\175\2437\252\149\031\226\017\007\158\007\223d@\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\000#a\000E\130\141\241'\208\004\015\128\000\001\142\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\004\000\012\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\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\016(\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\002\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\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\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\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\179\160\b2R\028\012\025 v\017\"\017@\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\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\0000\000\007\001\002\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\132\128 \128\b \002\020\000\016\000b\000\002\000\bH\002\b\000\130\000!\000\001\000\006 \000 \000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\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\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000 \000\002\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\002H\000@\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\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\002\000\000$\128\004\000\000\000\128\000\000\000\000\b\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\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\bH\002(\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\001\000\012\\(\000\016\b\002\000\001\000\003\000\bp\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\000\197\128\187\128\b2R\028\012\017 v\001f\017`0\000\006\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\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\0000\000\002H\000L\000\000\b\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\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\001!\000D\002\128\193#\144\000\001\128\000\001\140\b@\000\b\004\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\003!\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\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\001\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\131!\136G\224,\229\"\211\227!\176@\025,\184\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\131\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\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\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\016\004\004\000\002\012\016\000\000\001\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\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\167\225 \197\138\173\2437\208\020\015\226\000\003\142\n~\018\012X\170\2233=\001@\254 \0008\224\167\225\"\197\138\173\2433\208\020\015\230\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\005\002\000@\000\000\129\000\000\000\016\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\253\155\239\247\255\252\157?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\n6\024\132~*\223R=>b\249\004\001\154\235\129!\bD\002\128\193#\144\000\001\128\000\001\140\0026\016\004X(\223\018=\000@\248\000\000\028\224\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\020@\003!\002@\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\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\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\b\000\001\016\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\003\000\002p\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\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\b\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\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\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\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\012H\003\184\000\131!!\192\193\018\007`\022!\022\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\011\184\000\131!!\192\193\018\007`\022!\022\003\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\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\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\012X\011\184\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\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000@\000\000@\000\002\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\002\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000 \000\000\000\017 \000\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\000\000\000\000\000\000\000\000\000\000\000\000 \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 \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\012H\003\184\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\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\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\b\000\001\016\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\003!\000@\192\004\193&\144\001\001\128\000\001\004\0002\016\004\b\000L\018i\000\016\024\000\000\016@\003!\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\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\147)\027P\144\020\193&\176\001\001\148 mU\000\000\016\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\000\t2\145\181\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\132\b\000L\018-\000\016\026\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\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\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\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131!\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\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\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\t2\017\180\b\001L\018m\000\016\027@\004\213P\131\161\136G\224,\229\"\211\227!\176@\025,\176\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\016\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\0002\016\004\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\b\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\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\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\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\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\128\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\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\b\000\000\128\000\000\000\000@\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\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\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\b\000\001 \000\000\000\000@\000\000\000\000\004\133\016\131!\002@\128\004\193\"\208\001\001\160\000\001D\000\000\000\000\000\000\000\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\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\016\000\000\004\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\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)\000P\144\004\193&\176\t\001\144\000M\021\128\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\128\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\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\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\128\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016D\012\130L\018m\000\016\026\000\000\016@\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\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\b\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\128\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 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000@\b\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\0000\000\007\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\001@0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\001\"\001LH\002\168\000\131\001!\192\001\016\007`\018 \004\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\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\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\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\000\196\128*\128\b0\146\028\000\017\000v\016\"\000@\016\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\012H\002\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\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\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\001\b\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\000&\000@P \132\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\b\000\000\128\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\001\000@@\000 \193\000\000\000\016\000\000\000\000\012\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\000\000\000\000\000\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*\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\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\002E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\000@\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\001!\000D\002\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000#a\000E\194\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018}\000@\248 \000\024\224#a\000E\130\141\241#\208\004\015\130\000\001\142\000\018\016\004D(\012\018y\000\000\024\000\000\024\192\001!\000D\002\128\193'\144\000\001\128\000\001\140\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\001!\000D\002\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\000\012[\219\189\127\171\237s\251\255\182\031}\183\255\223\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\004\000\b\016\004\004\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\004\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\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b2\016\132\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\144\005\r\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\002\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\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\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\000\b:\024\132~\002\206R->2\027\004\001\146\203\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\003)\000P\144\020\193\"\176\001\001\128\000\005\004\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004D(\012\018y\000\000\024\000\000\024\192\001!\000D\002\128\193'\144\000\001\128\000\001\140\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\196\148\187\131\232>\022\028\015\251`w\219~p\240\018\016\004@(\012\0189\000\000\024\000\000\024\192\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\250\190\215?\191\251a\247\219\127\252\240\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\002@\000\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\002\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b\000\001\144\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\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\018\016\004@(\012\0189\000\000\024\000\000\024\192\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\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\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\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\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\250\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237s\251\255\182\031}\183\255\207\196\148\187\131\232>\022\028\015\251`w\219~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\188~\171\255s\253\255\214\255x\183\255\239}\246D\b/\227P\000L\028\030\227\139\002\131B6\016\004X(\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#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193&\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\135\169\"\208\152$\211>\176\025\001\246\000o\021H:\024\132~\002\206R->2\027\004\001\146\203\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\003)\000P\144\004\193\"\176\001\001\144\000%\004\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\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\b8\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\016\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\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\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\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\001\000\004\129\016\131!\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\004\000\000\000\016\000H\017\b2\016\004\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\001\000\004\129\016\128\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\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\144\006`\000 \004\132\128\"\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\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\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\0026\016\004X(\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\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\176>\000\192@@>\002\001\000\005\134\003\163a\011E\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#a\000E\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\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\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\018\016\004@(\012\0189\000\000\024\000\000\024\192\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\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\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\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\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\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\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\001\000\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\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\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\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\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\250\190\215?\191\251a\247\219\127\253\252[\219\189\127\171\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\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\0026\016\004X(\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#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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#a\000E\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#a\000E\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\000\000\000\000\000\000\000\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\136G\224,\229\"\211\227!\176@\025,\176\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\0002\144\005\t\001L\018+\000\016\024\000\000P@\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\001\004\000\000\000\016\000\000\000\000\000#a\000E\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\003)\000P\144\020\193\"\176\001\001\128\000\005\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\003)\000P\144\020\193\"\176\001\001\128\000\005\004\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\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\001\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\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\000@\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\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\b\000\000\000\000\000\1306\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\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\129!\bD\002\128\193#\144\000\001\128\000\001\140\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#a\000E\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\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\0026\016$X(\223\018=\000@\248\000\000\024\224\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\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\001!\000D\002\128\193#\144\000\001\128\000\001\140\004\000\000\000\000\000\000\000\000\0000\000\005\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\128\000\017\000\000\000\000\000\000\000\000\016\000$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\129\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\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\003\000\000P\000\000\000\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\003\000\016P$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\251`w\219~p\240\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\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\b\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\128\000\145\003\224\012\004\004\003\224`\016\000X 8\000\001\000\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\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\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\004\000\000\000@\000\000\000\000\000\000\000\003\000\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\128\000\000\000\000\016\000\004\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\000\000\000\016\000\004\000\000\000\016\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\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\128\000\000\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \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\b\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\b\000\000\000\004\000\0000\000\006\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\004\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\001\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\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\128\b R\028\000\025\000f\001\002\016@0\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\004\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\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\0002\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\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\003!\000@\128\004\193\"\208\001\001\128\000\001\004\bH\002(\000\130\001!\128\001\144\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\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\196\148\187\131\232>\022\028\015\249`w\139~p\240\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\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002\000@@\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\004\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\004\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\b\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\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\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\248\000\b\128>\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\000\129\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\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\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\000@\000\b\000\000\016\000\004\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\004\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\bH\002(\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\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\000@\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000@\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\007`\000 \000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\001!\192\001\016\006`\000 \000\132\128\"\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\003\000\004\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\003\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\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\003\000\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\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\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\b\000\000\000\000\001\000\000@\000\132\128\"\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}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000 \000\000\000\000@\000\000\000\000\004\129\016#a\000E\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}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\001\002\000@@\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\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\004\000\012\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\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\128\"\128\b\"\018\028\012\017\000v\001\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\018(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130!!\192\193\016\007`\016 \000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000`\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \018\028\000\017\000f\016\002\016\000\016\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\132\128\"\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\132\128\"\128\b \018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000x\002/\001\130\012} \001\016\006\000\000 \000\132\128\"\128\b \002\016\000\016\000f\000\002\000\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\128\001\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\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\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\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\000@\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000@\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\007`\001 \000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\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\003\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\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\000\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\000f\000\002\000@0\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\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \004\132\128\"\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\b\000\000\000\000\001\000\000@\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\bH\002(\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\b\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\004\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\000!\192\001\000\006`\000`\000\b\128\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\128\000\000\000\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\004\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\004\000 \005\016 \000\000\000\000\000\000\000\132\000\000\128\000\002\130\020\004\000\000\002\001\000\000\b@\000\b\000\000(!\000@\000\000 \016\000\000\003\000\000p\016\000\197\194\000\001\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\b@\000\b\000\000 !\000@\000\000 \016\000\000\b\000\000\000\000@@\004\000\000\000\000\000\000\000\000\128\000\000\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000@\000\000\000\000\000\000\000\b\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\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\000\001\000\000@\002\000Q\006\000\000\000\000\000\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\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\b\000\000\016\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\004\000\000\000\000\002\000\000\000\000\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\bH\002\168\000\130!!\192A\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\132\128*\128\b\"\018\028\004\017\000v\001\002\000H@\000\b\000\000 !\192@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\`\000\016\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\000\132\000\000\128\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\000\128\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\b@\000\b\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\000\132\000\000\128\000\002\002\016\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\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\016\000\000\000\000\016\000\004\000 \005\016 \000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000HH\002(\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\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\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\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\133\128\170\128\b0B\028\000\017\000v\000\006\000@0\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\020\000\000\000 \000\000\000\000@\000\000\000\000\004\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bX\n\168\000\131\004!\192\001\016\007`\000 \004\133\128\170\128\b0B\028\000\017\000v\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b \002\028\000\016\000v\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\bH\002(\000\130\000!\128\001\000\006`\000 \004\132\128\"\128\b \002\016\000\016\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\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\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\000 \004\132\128\"\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\000\132\128\"\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\"\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\000\132\128\"\128\b \002\016\000\016\000f\000\002\000@ \000\002H\000L\000@\b\000\000\000\000\000\128\002\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000HH\002(\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\132\128\"\128\b \002\016\000\016\000f\000\002\000@ \000\002H\000L\000@\b\000\000\000\000\000\128\002\000\000$\128\004\192\000\000\128\000\000\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\016\000\0002\000\007\129\000\012\\(\000\016\b\002\000\001\000\003\000\002p\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\004\004\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\bZ\002(\000\130\t!\160\001\016\014`\016 \004\132\128\"\128\012 \018\028\000\017\000f\001\006\016HH\002(\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016!\004\001 \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\bH\002(\000\130\000!\128\001\000\006`\016 \004\132\128\"\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\000\132\128\"\128\b \018\028\000\017\000v\001\002\000@\018\000\000\128\000\b\000(\000\000\b\002\000\001\000\001 \000\000\000\000\128\002\128\000\000\128 \000\016\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\012 \018\028\000\017\000f\001\006\016HH\002(\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\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\b\128\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\b@\000\b\000\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\016\012\000\000\002\001\000\000\b@\000\b\000\000 !\000\192\000\000 \016\000\000\b\000\000\000\000@@\004\000\000\000\000\000\000\b\000\000\000\000\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\004\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\004X(\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\001\000\000\000\000#a\000E\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\132\000\000\128\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\b\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\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\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\016\000$\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\b\000\000\b\000\000@\004\000\000\000\000\000\000\b\000\000\000\000\128\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\003\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\b@\000\b\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\128\000\000\128\000\004\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\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\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\003\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\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\001\000\000\000\000#a\000E\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\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\b@\000\b\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\016\000\004\000 \r\016`\000\000@\000\000\000\128\001\000\000@\002\000\209\006\000\000\004\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\0002\016D\012\128L\018m\000\016\024\000\000\016@}\246D\b/\227P\000L\028\030\227\139\002\131@2\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\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\001\000\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\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\128\000\001\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193\"\176\001\001\128\000\001\004\0002\144\005\t\001L\018+\000\016\024\000\000\016@\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\001\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\000\133\169*\212\026\162\211?\188\017\001\230\001\007\141HZ\146\173A\170-3\251\193\016\030`\016x\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\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\000\132\128*\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\bH\002\168\000\130!!\192\193\016\006`\016`\020\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\003!\004@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\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\128\000\b\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\0000\000\007\001 \r\\ \000\016\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\b@\000\b\000\000 !\192\192\000\000 \016\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\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\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\016\132\000\000\128\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\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\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\128\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\b@\000\b\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\000\000\000\000\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000@0\000\007\001 \r\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000@2\144\005\t\000L\018+\000\016\025\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\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\bH\002(\000\130\001!\000\001\000\006`\000 \000\003!\004@\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\000\bH\002(\000\130\001!\000\001\016\006`\000 \004\132\128\"\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\132\128\"\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\000\006`\000 \000\132\128\"\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\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\bH\002(\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\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\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\000\128\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\012H\002\168\000\131\t!\192\001\016\007`\002 \004\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\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\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\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\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\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\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\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\001\000\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000 \000\000\000\000\0000\000\006\000\000\012\\`\000\018\000\002\000\000\000\003\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000\000\000\003\000\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\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\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\016\000\000\000\000\000\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\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\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\004\004\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\bH\002(\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\003 \000x\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\000\132\128\"\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\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\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\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\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\000\132\128\"\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\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\000!\128\001\000\006`\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\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\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\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#a\000E\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#a\000E\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002\016\000\016\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 \000\000\000\000\192\002\000\000\000\128\000\000\000\b\000\b\128~\002\194@\000>\"\001\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\024(\176\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\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\128\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\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\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\128\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\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\128\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\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\016\000\004\000\000\000\004\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\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\000@\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\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\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\005\161 \128\b \210\016\016\017\000\228\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\004\128 \128\b \018\016\000\017\000d\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\000H\002\b\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\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'\225 \197\138\173\2433\208\021\015\228\000\003\142\002~\018\012X\170\2233=\001P\254@\0008\224\004\128 \128\b \018\016\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\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\004\128 \128\b \018\024\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\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\000H\002\b\000\130\001!\128\001\016\006@\000 \000\004\128 \128\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
and start =
- 13
+ 15
and action =
- ((16, "C\170R\004Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021HFf\000\000\000\000\020XFfC\170\020\182\000-\000[\\\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\238\004\184\000F\000\000\001v\t|\000\000\005R\002d\nt\000\000\000\244\002\204\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\002BU2\000\000\000\000\000\000\001\148\000\000\000\000\000\000\002\238\004\026\000\000\000\000U2J\014\020X\021\178]`\020Xf\166R\004\020XN`\000\000\005\144\000\000Dp\b\160\000\000C\146\000\000\027\158\000\000\000\000\003\224\000\000\001\148\000\000\000\000\000\000\006B\000\000C\146\000\000\0046w@_ e\002\000\000\132\182\134f\000\000Mr`\202\000\000Y~\026\206p\158\001\148q&FfC\170\000\000\000\000R\004\020XSNDp\005.w@\000\000\128\252FfC\170R\004\020X\000\000\000\000\016x\023\022\001N\006&\000\000\005&\007\030\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\228C\170\000\000\000\000Q\240\020XG\030X\234\000\000\004\002\000\000\000\000\004\250\000\000\000\000I\182\004\002\024\138\003\130\0020\000\000\000\000\003\014\000\000\021\178\006\030\006P\020X\028\254\020XC\170C\170\000\000R\012Q\182\020X\028\254A\248\020X\000\000\000\000\000\000R\004\020X\000\000\000\248\000\000X\234z\006z\148\000\000\006&\000\000\006\228\000\000\000\000C,U2\134\178\000\000h\206\134\178\000\000h\206h\206\000b\002\236\0008\000\000\020\190\000\000\b\004\000\000\000\000\bZ\000\000\000\000\000\000h\206\001\148\000\000\000\000X\000U2U\166`\202\000\000\000\000OL\000b\000\000\000\000`\202\b\004U2\000\000PB`\202Q8\000\000\000\000\000\000\004Z\000\000h\206\000\000\001\000\137J\000\000U2\005\216U2\000\000\022\\\t$\001\148\000\000\000\000\023\224\000\000\006\208\000\000Z\162\b\006\000\000\b\244h\206\n\198\000\000\011\190\000\000\007\200\000\000\000\000\007\160\000\000\000\000\000\000\021 4X\234Q\240\020XX\234\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\\\027v\000\000\000\000\000\000\001\244&\174t\134\000\000\000\000Q\240\020XX\234\000\000\000\000rvX\234{\178z\148\000\000\136x\000\000X\234\000\000\000\000Y\214I\182\001\154\001\154\000\000\n\156X\234\000\000\000\000\000\000\004\250\011*\000\000A\012\000\000\000\000{ \000\000\136\192h\206\000\000\004b\000\000\000\000{h\000\000\137\026\t\002\000\000\000\000\000\000\000\000\011\128\000\000\022\168\000\000\000\000{ \000\000\005\242\000\000\000\000DHu\018\000\000\000\000Bn\023|\019\252\023\174\000\000\000\000\000\000\000\000\001F\000\000\000\000[l\b\164\011h\000\017U2\002\204\011\196\000\000\000\000\b\200\011h\b\156\000\000i\250R,Q\182\020X\028\254\000-\000\018\0020\000\000\012.\021\178\021\178\000-\000\018\000\018\021\178\000\000j\140\t\012Dp\006&\006d\137\164\000\000U2e\162U2`\000fBU2\006`U2f\220\000\000\t\238\b\252\tL\021\178k&\000\000\005B\t\190]\130\000\000\000\000\000\000\000\000\021\178k\192\021\178lZ\020d\0008`\160\007\030\0008`\248\000\000l\244\t\012\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\004\172\028\254\000\000^@A\248\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000\\$\000\000\003\184\000\000Vr\001\130\006\026\000\000\0226W\204R\004\020XH<R\004\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000R\184SlRZ\020X\028\254\007h\021\178\000\000\004*\000\000T T\212|\000G\nU2\006p\000\000R\004\020X\000\000uZ\020Xz\006X\234E\186\000\000R\004\020Xw\166\005v\000\000X\234DHU2\003x\b\156\012\242\000\000\000\000\000\000J\162\001\154\r\022q\168\000\000Q\240\020XX\234\025R\000\000R\004\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\r\218\000\000\r\248\000\000\016x\003\224\0142\000\000'\166\000\000\nX\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\t\190\000\000\000\000\027\014\000\000\028\006\000\000\028\254\000\000\018h\024&\000\000\000\000\000\000Ff\000\000\000\000\000\000\000\000\029\246\000\000\030\238\000\000\031\230\000\000 \222\000\000!\214\000\000\"\206\000\000#\198\000\000$\190\000\000%\182\000\000&\174\000\000'\166\000\000(\158\000\000)\150\000\000*\142\000\000+\134\000\000,~\000\000-v\000\000.n\000\000/f\000\0000^\020XX\234GPK\142\001\154\014\138m\128X\234\000\000\000\000\000\000\134f\000\000\028\018\135\250\000\000\026\"U2\029\220\014\190\000\000\000\000\000\000\000\000m\128\000\000\000\000\131z\001\154\015\"U2\007\170\000\000\000\000\t\180\001\148\000\000U2\t\154\000\000\000\000\015L\000\000\000\000\000\000G\"U2\n@\000\000\000\000\030*\000\000\000\000|H\000\000\031\"|\212\000\000 \026}\028\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nX\234#\002\000\000q\246q\246\000\000\000\000\000\0001V\000\000\006\212\000\000\000\000\000\000\012\018\000\000\000\000\011,\023\248\000\000\n\210\000\000\000\000^\226H<\000\000\000\000\n\180\000\000\000\000\000\000\012\180\000\000\000\000\000\000\016x\004\216\024\232\000\000\011\026\000\000\005\208\000\0002N\000\000\011\216\000\000\006\200\000\0003F\000\000\r\n\000\000\007\192\000\0004>(\158\000\000\012H\b\184\000\00056\000\000\012\160\t\176\000\0006.\000\000\r\172\n\168\000\0007&\012$\025\016\000\000\r@\011\160\000\0008\030\000\000\r\152\012\152\000\0009\022\000\000\014\002\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\r\186\000\000\000\000\r\156\000\000\000\000\014`\000\000\b\026\000\000\000\000\000\000\015^\000\000\015\130\000\000\000\000Lz\001\154\016Dq\168`\202\000b\000\000\000\000q\168\000\000\000\000\000\000q\168\000\000\016&\000\000\000\000\000\000\000\000\000\000\000\000;\254X\234\000\000\000\000\016j\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\011\210\000\000\000\000X\234\000\000\000\000}\180\014\018\000\000\000\000H\240\000\000\b\240\000\000\000\000W6\000\000\r\178\000\000\000\000\001\130\n\244\000\000\000\000\0226\022\028\006&\000\000A\214\000\000!,\023\176\021\220\000\000\000\000\014|\000\000\000\000\001\238\025\030W\214\000\000\025\030\000\000\rD\000\000\000\000\014\164\000\000\000\000g~\005\212\004H\000\000\000\000\012\186\000\000\000\000\014\144\000\000\000\000\000\000\020X\028\254\004\176\000\000\000\000\023&\003\130\0020\b`\028\254x.\021\178\001B\028\254x\172\015\242\000\000\000\000\b`\000\000I\248\019\248\021\204\000\000\n@\016l\000\000\016v\000V`\202\003\130\000\000\016J\015\214p\158\012\156U2\030\128\020F\t\142\004\248\000\000\031x\016\148\000\000\tT\000\000\000\000\016\170`\202a\152\000\000g\208`\202\016\138`\202n\024b8\001N\016R\000\000\000\000\000\000\020X\129F\000\000X\234q\246\000\000\000\000\016\210\000\000\000\000\000\000>\230\017\030z\006?\222h|\000\000\000\000F\138\000\000\006\026\000\000IZ\000\000\020X\000\000\021\178\006x\000\000\128\252\000\000\020X\028\254\128\252\000\000\025D\023\022\001N\001\148\130\218\021\178~Bq\246\000\000\007b\n\160\0020\b`q\246\133*\003\130\0020\b`q\246\133*\000\000\000\000\b`q\246\000\000FfC\170X\234\027B\000\000\000\000FfC\170Q\182\020X\028\254\128\252\000\000\020\182\000-\000[\016HU2\rt\017\006\131\154\000\000q\246\000\000I\248\019\248\021\204y\004\023\228\012\030~v\bj\016d\020Xq\246\000\000\020Xq\246\000\000h\206f\166\019\134\002\222\001N\0008P\012\000\000\001N\0008P\012\000\000\0274\023\022\001N\001\148Q\002\021\178q\246\000\000\007b\011\152\0212\014~\000\000P\012\000\000\0020\016h\021\178q\246\135(\003\130\0020\016n\021\178q\246\135(\000\000\000\000\tX\000\000\128\208\000\000\021\178\131\206P\012\000\000\tX\000\000J\014\020X\021\178q\246\000\000I\248\019\248\021\204r\144B\138\026\222\019\170\002\142\000\000\014^C\146\000\017\000\000\017\002\016\176\024\196\020XU\218U2\tH\000\000X\184\001N\007\188\r\230\000\000\r\212\000\000\017\018\016\156U2PJ\000\000\0032\002:\014\192\000\000\014\204\000\000\017\022\016\162p\158\014 U2MzPJ\000\000Vr\020X\024\196\017D\007~\001N\000\000\014b\024\196U2\n\224\000b\000\000U2\004\018\005\n\000\000\000\000nr\000\000\000\000\014\192\024\196n\240PJ\000\000\020XU2\014 U2W~PJ\000\000\0154\000\000\000\000PJ\000\000\000\000X\184\000\000q\246\1338\019\170\002\142\014^\0178\016\238\024\196q\246\1338\000\000\000\000\019\170\002\142\014^\017F\016\224O\030Mh`\202\017fO\030h\206\020\184\017hO\030`\202\017lO\030o\144p\016\000\000\129\214\000\000\000\000q\246\1356\019\170\002\142\014^\017l\016\250O\030q\246\1356\000\000\000\000\000\000f\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000P\012\000\000\133\202\020XDp\017vw@\000\000\128\252\133\202\000\000\000\000\135\130\020XDp\017~\017\012_ \135\250\003\130\017\196\000\000\000\000p\142r\144\020X\000\000\127\018\021\204\000\000\000\000\128\252\135\130\000\000\000\000\000\000y\128D\228F\134\003\130\017\220\000\000\000\000\000\000r\144\020X\000\000\003\130\017\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015XB\138\019\170\002\142\014^\017\180s\000\023\204\020XG\030[:\020(\001N\003\130\017\182\nt\000\000\000\000\017d\000\000\000\000e0\000\000\n\254\014\222\000\000\015*\000\000\017\186\017NU2dn\017\210\n\158\000\000\000\000\017\132\000\000\000\000\020F\0032\015\020\000\000\017\222s\130\138\022\001\154\017\150U2\015\024\000\000\000\000\017\168\000\000\000\000\000\000e0\000\000\0070\015j\000\000\015\214\000\000\018\n\017\148p\158\000\000\018\014t\004\138,\001\154\017\174U2\015j\000\000\000\000\017\196\000\000\000\000\000\000\020X\000\000e0\000\000\020z\020X\023\204\023\204u\242Ff\020X\129FX\234\021\162\000\000\012\020\001N\000\000\015\004\023\204U2\012~\006&\000\000\020XX\234s\000\023\204\015\142\023\204\000\000D\142Et\000\000b\146\000\000\000\000c.\000\000\000\000c\202\000\000\015\184\023\204df\129FX\234\021\162\000\000\000\"\000\000\000\000O\030\015\242\000\000\000\000a\198\018\"\000\000e0\000\000\023\204a\198e0\000\000\020XU2e0\000\000\015\136\000\000\000\000e0\000\000\000\000[:\000\000\130\nO\030\017\212\023\204\130\166s\000\000\000q\246\133\216\019\170\002\142\014^\0180s\000q\246\133\216\000\000\000\000\000\000\136BQ\240\000\000\000\000\000\000\000\000\000\000\000\000\132`q\246\000\000\133\202\000\000\000\000\000\000\000\000q\246\136B\000\000\018p\000\000\000\000\132`\018t\000\000q\246\136B\000\000\000\000\016,\000\000\000\000it\0032\000\000\000\000B\158\000\000U2\rz\000\000[:\016\198\000\000\000\000\000\000\015\184\000\000\000\000\000\000RZ\020X\028\254\007\170\000\000N\150\000\000\007p\000\000\000*\000\000\000\000\018\138\000\000\018\178z\006\000\000@\214\018\138\000\000\000\000\018~\026R\028B\021\204vz\023\228\020X\000\000q\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000v\130\023\228\020X\000\000\n<w@\000\000\128\252\000\000\018\138\026R\028Bq\246\000\000\018\160\000\000\000\238\015\132\020Xz<\000\000\000\000\028\190\138n\000\000\000\000\018,\000\000\018\130U2\000\000\014\226\011\174\000b\000\000\000\000U2\004R\007:\000\000U2\012\018\003\130\018\172\000\000\000\000\127l\000\000\000\000_ \000\000\128\252\000\000\018\174\026R\029:P\012\000\000\000\000\000\000\000\000\016\182\128\006_ \000\000\128\252\000\000\018\198\026R\029:P\012\000\000\016\214\000\000\000\000\bh\000\000q\246\000\000\018\220\000\000\000\000\018B\000\000\018H\000\000\018X\000\000\000\000f\166\018Z\000\000\000\000%\182\\\200\018\248\000\000\000\000\000\000\014\140\012<_h\019\004\000\000\000\000\000\000\000\000\000\000\000\000\018x\000\000\023\228\000\000\018~\000\000U2\000\000\005h\000\000\000\000\018\154\000\000\000\000\0008\000\000\011\158\000\000\000\000\000\000\016X\000\000\b\252\000\000\018\156\000\000X\234\022\168\000\000\000\000\r$\018\170\000\000\000\000\018\160\r4H<\001\148\128\132\000\000\000\000\000\000\000\000\000\000Zn\000\000\000\000\019D\000\000\138\178\000\000\016\184\019H\000\000\019N\000\000H\240H\240\\^\\^\000\000\000\000q\246\\^\000\000\000\000\000\000q\246\\^\018\194\000\000\018\200\000\000"), (16, "\t=\t=\000\006\001\002\001\190\t=\002\186\002\190\t=\002\234\002\130\t=\003\145\t=\018\230\002\246\t=\023\234\t=\t=\t=\025\146\t=\t=\t=\001\210\004M\004M\004F\002\250\t=\003>\003B\nJ\t=\001\206\t=\023\238\003F\000\238\002\254\025\150\t=\t=\003\214\003\218\t=\003\222\0032\003\234\003\242\007\030\007Z\t=\t=\002\178\001\206\007:\003:\t=\t=\t=\bz\b~\b\138\b\158\001*\005v\t=\t=\t=\t=\t=\t=\t=\t=\t=\t\018\000\238\t=\015\198\t=\t=\003\145\t\030\t6\t\130\005\130\005\134\t=\t=\t=\r\234\t=\t=\t=\t=\002j\002\154\014\026\t=\006\250\t=\t=\0035\t=\t=\t=\t=\t=\t=\005\138\b\146\t=\t=\t=\b\170\004r\t\150\0035\t=\t=\t=\t=\r\r\r\r\023\242\011&\004\154\r\r\0112\r\r\r\r\001j\r\r\r\r\r\r\r\r\004M\r\r\r\r\001f\r\r\r\r\r\r\003i\r\r\r\r\r\r\r\r\004M\r\r\016&\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\b\030\007f\006\226\r\r\004\226\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\004M\r\r\003\238\r\r\r\r\r\r\000\238\b\"\r\r\r\r\r\r\r\r\r\r\r\r\r\r\000\238\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\007\226\r\r\r\r\001r\004M\001\218\004M\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\r\r\r\r\r\r\000\238\r\r\r\r\006\001\r\r\r\r\000\238\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\b\130\004M\r\r\r\r\r\r\r\r\001\181\001\181\001\181\001\222\015\134\001\181\006\018\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\0152\001\181\006\230\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003\134\003\138\001\181\019B\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\007>\001\181\001\181\001\181\006\001\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\019J\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\130\001\181\001\181\018\214\bZ\007f\b1\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\246\b\194\001\181\005\186\001\181\001\181\b^\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\182\001\181\001\181\001\181\001\181\001\181\nu\nu\002\225\007\226\r1\nu\003\149\nu\nu\001\146\nu\nu\nu\nu\001\186\nu\nu\r1\nu\nu\nu\000\238\nu\nu\nu\nu\001\198\nu\000\n\nu\nu\nu\nu\nu\nu\nu\nu\025*\007f\003\146\nu\004M\nu\nu\nu\nu\nu\000\238\nu\nu\004B\nu\001\234\nu\nu\nu\002\225\025.\nu\nu\nu\nu\nu\nu\nu\004M\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\003\149\nu\nu\007\226\nu\nu\004M\004M\007f\004M\nu\nu\nu\nu\nu\004\t\nu\nu\nu\nu\t\174\000\238\t\222\nu\004^\nu\nu\b*\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\015\206\nu\nu\nu\nu\nu\003\173\003\173\005\225\007\226\003\150\003\173\002N\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\153\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\002R\003\173\b>\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\153\007f\004\t\003\173\000\238\003\173\003\173\003\173\003\173\003\173\b\213\003\173\003\173\001\206\003\173\t\025\003\173\003\173\003\173\bv\b\242\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006^\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\233\t\166\t\214\007\226\003\173\003\173\004\210\003^\006b\000\238\003\173\003\173\003\173\003\173\003\173\002v\003\173\003\173\003\173\003\173\t\174\000\238\t\222\003\173\b\130\003\173\003\173\003b\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\003\173\003\161\003\161\000\238\001f\003i\003\161\b\213\003\161\003\161\t\025\003\161\003\161\003\161\003\161\001\238\003\161\003\161\006\165\003\161\003\161\003\161\b2\003\161\003\161\003\161\003\161\007:\003\161\b>\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\165\b\233\004M\003\161\000\238\003\161\003\161\003\161\003\161\003\161\b\209\003\161\003\161\001\206\003\161\004\214\003\161\003\161\003\161\015^\004M\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004M\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\t\166\t\214\001f\003\161\003\161\003i\003j\tF\000\238\003\161\003\161\003\161\003\161\003\161\002\214\003\161\003\161\003\161\003\161\t\174\012\209\t\222\003\161\004B\003\161\003\161\003n\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\012\209\003\161\003\161\003\161\003\161\003\161\t\229\t\229\t\021\tJ\tf\t\229\b\209\t\229\t\229\000\238\t\229\t\229\t\229\t\229\003\018\t\229\t\229\006\166\t\229\t\229\t\229\015*\t\229\t\229\t\229\t\229\004M\t\229\007\194\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\006\253\007f\006\170\t\229\027\215\t\229\t\229\t\229\t\229\t\229\003\158\t\229\t\229\002\190\t\229\012\178\t\229\t\229\t\229\006\253\016\162\t\229\t\229\t\229\t\229\t\229\t\229\t\229\000\238\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\002f\t\229\t\229\007\226\t\229\t\229\t\021\002&\007f\004M\t\229\t\229\t\229\t\229\t\229\003\n\t\229\t\229\t\229\t\229\t\229\000\238\t\229\t\229\003\162\t\229\t\229\016\190\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\006\253\004M\t\229\t\229\t\229\t\229\t\245\t\245\004\242\007\226\b\134\t\245\0126\t\245\t\245\000\238\t\245\t\245\t\245\t\245\004\014\t\245\t\245\000\238\t\245\t\245\t\245\000\238\t\245\t\245\t\245\t\245\t\005\t\245\012:\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004\018\002j\007\154\t\245\007v\t\245\t\245\t\245\t\245\t\245\t\014\t\245\t\245\003\022\t\245\012\202\t\245\t\245\t\245\022\206\007~\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\238\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\026\154\t\245\t\245\022\214\t\245\t\245\004M\004M\007f\t\005\t\245\t\245\t\245\t\245\t\245\003\026\t\245\t\245\t\245\t\245\t\245\004M\t\245\t\245\b)\t\245\t\245\025\138\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\000\238\t\005\t\245\t\245\t\245\t\245\t\237\t\237\019\022\007\226\b>\t\237\005R\t\237\t\237\025z\t\237\t\237\t\237\t\237\000\238\t\237\t\237\000\238\t\237\t\237\t\237\000\238\t\237\t\237\t\237\t\237\005F\t\237\000\238\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\b>\026\158\019\030\t\237\004V\t\237\t\237\t\237\t\237\t\237\005\233\t\237\t\237\000\238\t\237\012\226\t\237\t\237\t\237\r\178\005&\t\237\t\237\t\237\t\237\t\237\t\237\t\237\b\230\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004\174\t\237\t\237\011z\t\237\t\237\019\134\004V\007f\005J\t\237\t\237\t\237\t\237\t\237\003\022\t\237\t\237\t\237\t\237\t\237\025~\t\237\t\237\004r\t\237\t\237\027.\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\012\213\004\214\t\237\t\237\t\237\t\237\t\217\t\217\004b\007\226\007:\t\217\007\021\t\217\t\217\017\190\t\217\t\217\t\217\t\217\012\213\t\217\t\217\r\182\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\001\t\217\014\142\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006v\006\242\007\n\t\217\002\006\t\217\t\217\t\217\t\217\t\217\015v\t\217\t\217\007j\t\217\012\250\t\217\t\217\t\217\007\018\016r\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015~\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\007\026\t\217\t\217\005\002\t\217\t\217\001\222\007\166\001\002\001\190\t\217\t\217\t\217\t\217\t\217\019\006\t\217\t\217\t\217\t\217\t\217\006e\t\217\t\217\003\137\t\217\t\217\0022\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\006e\015\206\t\217\t\217\t\217\t\217\t\225\t\225\015\242\005\225\007:\t\225\003}\t\225\t\225\000\238\t\225\t\225\t\225\t\225\007\198\t\225\t\225\014\146\t\225\t\225\t\225\005.\t\225\t\225\t\225\t\225\001v\t\225\011\134\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\011\246\002\190\007\170\t\225\007\178\t\225\t\225\t\225\t\225\t\225\018~\t\225\t\225\000\238\t\225\r\014\t\225\t\225\t\225\001\222\007\218\t\225\t\225\t\225\t\225\t\225\t\225\t\225\018\138\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\001\206\t\225\t\225\011\150\t\225\t\225\n\022\t\234\001\002\001\190\t\225\t\225\t\225\t\225\t\225\002\142\t\225\t\225\t\225\t\225\t\225\006m\t\225\t\225\011\142\t\225\t\225\t\238\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\006m\026\018\t\225\t\225\t\225\t\225\t\221\t\221\003\134\003\138\n\250\t\221\012z\t\221\t\221\000\238\t\221\t\221\t\221\t\221\006\030\t\221\t\221\017\006\t\221\t\221\t\221\012^\t\221\t\221\t\221\t\221\001\134\t\221\012~\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\0056\014\178\011\186\t\221\012b\t\221\t\221\t\221\t\221\t\221\022B\t\221\t\221\019\158\t\221\r\"\t\221\t\221\t\221\015\182\012\170\t\221\t\221\t\221\t\221\t\221\t\221\t\221\022\"\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\012\174\t\221\t\221\011&\t\221\t\221\0112\022J\0066\022j\t\221\t\221\t\221\t\221\t\221\005\225\t\221\t\221\t\221\t\221\t\221\006u\t\221\t\221\011&\t\221\t\221\0112\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\006u\014\182\t\221\t\221\t\221\t\221\t\233\t\233\003\134\0182\006\138\t\233\004\214\t\233\t\233\019\166\t\233\t\233\t\233\t\233\001\206\t\233\t\233\018F\t\233\t\233\t\233\006\246\t\233\t\233\t\233\t\233\001\150\t\233\012\194\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\005>\007\006\012R\t\233\003\018\t\233\t\233\t\233\t\233\t\233\004B\t\233\t\233\012\198\t\233\r>\t\233\t\233\t\233\002\154\012F\t\233\t\233\t\233\t\233\t\233\t\233\t\233\004M\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\b\237\t\233\t\233\012J\t\233\t\233\002\142\t\234\007\198\026\130\t\233\t\233\t\233\t\233\t\233\027\247\t\233\t\233\t\233\t\233\t\233\004R\t\233\t\233\014^\t\233\t\233\012\246\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\000\238\000\238\t\233\t\233\t\233\t\233\t\249\t\249\027\146\001\222\0126\t\249\004\214\t\249\t\249\023z\t\249\t\249\t\249\t\249\012\138\t\249\t\249\015:\t\249\t\249\t\249\014f\t\249\t\249\t\249\t\249\r\n\t\249\011\134\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\012\142\b\237\r.\t\249\003\018\t\249\t\249\t\249\t\249\t\249\0062\t\249\t\249\023b\t\249\rR\t\249\t\249\t\249\007F\012\218\t\249\t\249\t\249\t\249\t\249\t\249\t\249\tb\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\002\190\t\249\t\249\012\222\t\249\t\249\tz\012^\003\022\015\014\t\249\t\249\t\249\t\249\t\249\019\166\t\249\t\249\t\249\t\249\t\249\015>\t\249\t\249\015\226\t\249\t\249\r:\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\001\002\001\190\t\249\t\249\t\249\t\249\t\241\t\241\001\002\001\190\012z\t\241\012\194\t\241\t\241\025B\t\241\t\241\t\241\t\241\012F\t\241\t\241\014\162\t\241\t\241\t\241\012\170\t\241\t\241\t\241\t\241\rN\t\241\r\158\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\r\030\019\"\014\166\t\241\r\146\t\241\t\241\t\241\t\241\t\241\000\238\t\241\t\241\000\238\t\241\rf\t\241\t\241\t\241\015\018\012\138\t\241\t\241\t\241\t\241\t\241\t\241\t\241\014z\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\017\138\t\241\t\241\rb\t\241\t\241\005\237\019\026\014~\t\194\t\241\t\241\t\241\t\241\t\241\005\241\t\241\t\241\t\241\t\241\t\241\011\134\t\241\t\241\t\202\t\241\t\241\012\218\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\014\234\018:\t\241\t\241\t\241\t\241\na\na\001\206\r\170\015F\na\t\218\na\na\000\238\na\na\na\na\015\026\na\na\014\238\na\na\na\011\018\na\na\na\na\015J\na\002\253\na\na\na\na\na\na\na\na\015\030\019N\019\230\na\018\222\na\na\na\na\na\019b\na\na\004B\na\rr\na\na\na\019F\019\146\na\na\na\na\na\na\na\026~\na\na\na\na\na\na\na\na\na\na\na\b9\na\na\007\246\na\na\b5\022F\022N\019\250\na\na\na\na\na\r9\na\na\na\na\na\022\138\na\na\027\142\na\na\019\202\na\na\na\na\na\na\na\na\na\na\na\na\na\011J\b)\na\na\na\na\003\157\003\157\b\005\007\246\024:\003\157\005\229\003\157\003\157\000\238\003\157\003\157\003\157\003\157\023n\003\157\003\157\022\210\003\157\003\157\003\157\026F\003\157\003\157\003\157\003\157\026\142\003\157\025^\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\007\246\rE\022\170\003\157\000\238\003\157\003\157\003\157\003\157\003\157\022\218\003\157\003\157\000\238\003\157\011r\003\157\003\157\003\157\019\254\023\250\003\157\003\157\003\157\003\157\003\157\003\157\003\157\011\162\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\023\254\t\166\t\214\023\n\003\157\003\157\023\150\004\225\r\194\025\026\003\157\003\157\003\157\003\157\003\157\b-\003\157\003\157\003\157\003\157\t\174\024>\t\222\003\157\r\202\003\157\003\157\023\206\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\222\003\157\003\157\003\157\003\157\003\157\001\237\001\237\014\014\007\246\n\250\001\237\014:\002\190\001\237\015\146\002\130\001\237\t\190\001\237\015\186\002\246\001\237\025b\001\237\001\237\001\237\003\254\001\237\001\237\001\237\001\210\015\214\t\198\015\218\002\250\001\237\001\237\001\237\001\237\001\237\t\206\001\237\016\002\001\206\025N\002\254\016\022\001\237\001\237\001\237\001\237\001\237\027\"\0032\001\190\004e\001\237\016.\001\237\001\237\002\178\025\030\016B\003:\001\237\001\237\001\237\bz\b~\b\138\016n\012\150\005v\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\028\007\t\166\t\214\026\246\001\237\001\237\007\246\016\130\017\130\017\142\005\130\005\134\001\237\001\237\001\237\002\226\001\237\001\237\001\237\001\237\012\158\006\134\012\234\001\237\018N\001\237\001\237\018f\001\237\001\237\001\237\001\237\001\237\001\237\005\138\b\146\001\237\001\237\001\237\b\170\004r\018\238\018\242\001\237\001\237\001\237\001\237\nI\nI\019*\019.\019V\nI\019Z\002\190\nI\025R\002\130\nI\nI\nI\019\130\002\246\nI\027&\nI\nI\nI\020.\nI\nI\nI\001\210\0202\nI\020V\002\250\nI\nI\nI\nI\nI\nI\nI\020Z\020j\020z\002\254\020\134\nI\nI\nI\nI\nI\020\186\0032\001\190\020\190\nI\021\014\nI\nI\002\178\0216\021:\003:\nI\nI\nI\bz\b~\b\138\021J\nI\005v\nI\nI\nI\nI\nI\nI\nI\nI\nI\021\154\nI\nI\021\186\nI\nI\021\250\022\030\022.\022V\005\130\005\134\nI\nI\nI\022Z\nI\nI\nI\nI\nI\022f\nI\nI\022v\nI\nI\022\146\nI\nI\nI\nI\nI\nI\005\138\b\146\nI\nI\nI\b\170\004r\022\162\022\182\nI\nI\nI\nI\nE\nE\022\226\022\230\022\242\nE\023\002\002\190\nE\023\022\002\130\nE\nE\nE\024\n\002\246\nE\024b\nE\nE\nE\024\138\nE\nE\nE\001\210\024\242\nE\025\002\002\250\nE\nE\nE\nE\nE\nE\nE\025\158\025\166\025\182\002\254\025\194\nE\nE\nE\nE\nE\026&\0032\001\190\026:\nE\026j\nE\nE\002\178\026r\026\174\003:\nE\nE\nE\bz\b~\b\138\026\214\nE\005v\nE\nE\nE\nE\nE\nE\nE\nE\nE\027\014\nE\nE\027>\nE\nE\027J\027R\027[\027k\005\130\005\134\nE\nE\nE\027~\nE\nE\nE\nE\nE\027\154\nE\nE\027\183\nE\nE\027\199\nE\nE\nE\nE\nE\nE\005\138\b\146\nE\nE\nE\b\170\004r\027\227\028\023\nE\nE\nE\nE\0029\0029\0283\028>\028s\0029\028\135\002\190\0029\028\143\002\130\0029\t\190\0029\028\203\002\246\0029\028\211\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\t\198\000\000\002\250\0029\0029\0029\0029\0029\t\206\0029\000\000\000\000\000\000\002\254\004M\0029\0029\0029\0029\0029\000\000\0032\001\190\000\000\0029\000\n\0029\0029\002\178\000\000\000\000\003:\0029\0029\0029\bz\b~\b\138\000\000\012\150\005v\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\185\0029\002\225\0029\0029\004M\006\202\002\190\004M\005\130\005\134\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004M\0029\004\185\0029\0029\004M\0029\0029\0029\0029\0029\0029\005\138\b\146\0029\0029\0029\b\170\004r\000\000\004M\0029\0029\0029\0029\004M\007f\004M\003\n\004M\004M\004M\004M\004M\004M\004M\017\230\004M\000\238\004M\004M\000\000\004M\004M\004M\016\178\004M\004M\004M\004M\004M\004M\004M\004M\004M\000\000\004M\004M\000\000\000\000\004M\004M\000\238\004M\004M\004M\004M\004M\007\226\004M\004M\004M\004M\004M\004M\004M\004M\000\238\004M\004M\004M\004M\004M\004M\004M\004M\000\238\004M\004M\004M\004M\004M\004M\004M\004M\b\209\004N\004M\000\000\000\000\004M\004M\004M\000\238\004M\000\n\000\000\004M\004M\004M\004M\004M\004M\004M\004M\004M\000\000\022\018\004M\004M\002\225\002\225\007\238\004M\004B\006\249\000\000\004M\004M\000\000\007\246\016\182\022\130\002\225\000\238\004M\004M\004M\007\250\000\000\004M\004M\004M\004M\006\249\000\161\004M\000\161\006\249\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\0236\000\161\000\161\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\161\000\161\000\161\000\161\000\000\000\161\004R\000\161\000\161\b\209\000\000\000\161\000\161\005\153\000\161\000\161\000\161\000\238\000\161\t\005\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\b\234\000\161\000\161\000\000\000\000\000\161\000\161\002\006\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\002\n\006\249\000\161\015\174\t1\000\161\002\130\000\161\001\210\000\161\005\153\002\190\000\000\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\000\000\000\000\161\003\154\0186\t1\005\153\000\222\000\000\007J\001\222\000\161\000\000\002\226\000\000\014\194\002\178\000\161\000\161\000\161\000\161\000\000\015\178\000\161\000\161\000\161\000\161\002)\002)\004e\000\000\003\n\002)\000\000\002\190\002)\015\190\002\130\002)\001b\002)\000\000\002\246\002)\007N\002)\002)\002)\000\000\002)\002)\002)\001\210\001z\000\000\001\138\002\250\002)\002)\002)\002)\002)\005\134\002)\000\000\000\000\000\000\002\254\b\189\002)\002)\002)\002)\002)\004e\0032\b\142\000\000\002)\000\000\002)\002)\002\178\000\000\006\146\003:\002)\002)\002)\bz\b~\b\138\t\166\t\214\005v\002)\002)\002)\002)\002)\002)\002)\002)\002)\006\150\t\166\t\214\b\189\002)\002)\000\000\t\174\000\000\t\222\005\130\005\134\002)\002)\002)\000\000\002)\002)\002)\002)\t\174\000\000\t\222\002)\b\189\002)\002)\000\000\002)\002)\002)\002)\002)\002)\005\138\b\146\002)\002)\002)\b\170\004r\000\238\002\225\002)\002)\002)\002)\002E\002E\002\225\002\225\000\000\002E\000\000\000\000\002E\000\000\b\189\002E\000\000\002E\004\254\000\000\002E\b\189\002E\002E\002E\000\n\002E\002E\002E\000\000\028#\000\000\000\000\000\n\002E\002E\002E\002E\002E\000\000\002E\002\225\006F\004\181\000\000\005\234\002E\002E\002E\002E\002E\000\000\006f\002\225\000\000\002E\006r\002E\002E\000\000\000\000\002\225\006\198\002E\002E\002E\004\181\000\000\006\229\t-\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\t\166\t\214\000\000\002E\002E\006\206\014\218\000\000\002\190\006\229\t-\002E\002E\002E\000\000\002E\002E\002E\002E\t\174\002\190\t\222\002E\002\130\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\185\000\000\002E\002E\002E\000\000\022\002\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\023>\003\n\002A\023B\003\022\002A\000\000\002\178\002A\000\000\002A\000\000\017\178\002A\023r\002A\002A\002A\t\178\002A\002A\002A\012V\b\185\000\000\000\000\015\190\002A\002A\002A\002A\002A\r\150\002A\r\162\000\000\012r\023\130\012\130\002A\002A\002A\002A\002A\b\185\b\198\001\190\001*\002A\000\000\002A\002A\005\134\002\225\002\225\014\130\002A\002A\002A\014\150\014\170\014\186\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\t\166\t\214\b\185\002A\002A\000\n\004\254\000\000\001\206\b\185\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\t\174\000\000\t\222\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\246\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002\154\002-\019~\003\022\002-\000\000\002\178\002-\000\000\002-\000\000\000\000\002-\019\150\002-\002-\002-\012\162\002-\002-\002-\002\225\002\225\016\222\000\000\000\000\002-\002-\002-\002-\002-\012\186\002-\012\210\000\000\000\000\002\225\r2\002-\002-\002-\002-\002-\000\000\b\198\014\250\000\000\002-\000\n\002-\002-\rF\000\000\rZ\014\130\002-\002-\002-\014\150\014\170\014\186\000\000\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\t\166\t\214\002\225\002-\002-\000\000\000\000\000\000\000\000\000\238\000\000\002-\002-\002-\000\000\002-\002-\002-\002-\t\174\000\000\t\222\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\000\000\000\002-\002-\002-\000\000\t\146\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\000\000\000\000\002=\012\149\006F\002=\000\000\005\234\002=\000\000\002=\000\000\000\000\002=\006f\002=\002=\002=\006r\002=\002=\002=\012\149\012\149\000\000\000\000\012\149\002=\002=\002=\002=\002=\000\000\002=\b)\000\000\000\000\b)\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\022\138\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\238\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b)\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b)\002=\002=\002=\002=\012\149\000\000\005\t\002=\000\000\002=\002=\002\225\t\246\002=\002=\002=\002=\002=\005\t\011>\002=\002=\002=\000\000\000\000\b)\000\000\002=\002=\002=\002=\t9\t9\000\000\000\000\000\000\t9\000\000\000\000\t9\000\n\000\000\t9\000\000\t9\000\000\000\000\n\"\005\t\t9\nF\t9\b)\t9\t9\t9\002\225\002\225\018\014\000\000\017N\nZ\nr\nz\nb\n\130\000\000\t9\002\225\002\225\000\000\002\225\000\000\t9\t9\n\138\n\146\t9\005\t\b\t\000\000\005\t\t9\000\n\n\154\t9\000\000\000\000\000\000\000\000\t9\t9\000\238\000\000\000\000\000\000\000\000\000\000\002\246\t9\t9\n*\nj\n\162\n\170\n\186\t9\t9\002\166\012\217\t9\002\225\t9\n\194\000\000\003Z\000\000\000\000\000\238\000\000\t9\t9\n\202\000\000\t9\t9\t9\t9\003f\012\217\000\000\t9\000\000\t9\t9\002B\n\234\t9\n\242\n\178\t9\t9\000\000\000\000\t9\n\210\t9\000\000\002F\000\000\005v\t9\t9\n\218\n\226\002q\002q\000\000\000\000\000\000\002q\012\157\006F\002q\000\000\005\234\002q\000\000\002q\000\000\005\130\002q\006f\002q\002q\002q\006r\002q\002q\002q\012\157\012\157\000\000\000\000\012\157\002q\002q\002q\002q\002q\000\000\002q\015\174\000\000\005\138\002\130\000\000\002q\002q\002q\002q\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\000\000\000\238\002q\002q\n*\002q\002q\002q\002q\002q\002q\000\000\015\178\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015\190\002q\002q\002q\002q\012\157\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\026Z\000\000\002q\002q\002q\000\000\000\000\005\134\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\190\002Y\000\000\000\000\002Y\000\000\002Y\003\170\000\000\002Y\002\154\002Y\002Y\002Y\025\202\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015\174\000\000\000\000\002\130\000\000\002Y\002Y\002Y\002Y\002Y\004\154\003\202\000\000\004\229\002Y\000\000\002Y\002Y\002\178\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\n*\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015\178\002Y\000\000\002Y\002Y\0072\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015\190\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\153\000\000\002Y\002Y\002Y\000\000\000\000\005\134\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\153\012\153\002e\000\000\012\153\002e\000\000\002e\000\000\000\000\n\"\000\000\002e\002e\002e\021f\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\nb\002e\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\238\000\000\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\n*\nj\002e\002e\002e\002e\002e\000\000\012\153\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\029\002e\002e\002e\b\029\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\011\198\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\029\011\206\002u\000\000\011\218\002u\000\000\002u\000\000\000\000\002u\011\230\002u\002u\002u\011\242\002u\002u\002u\000\000\000\000\b\029\000\000\000\000\002u\002u\002u\002u\002u\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\002u\002u\002u\000\000\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\002u\002u\002u\000\000\000\000\004\254\000\000\000\000\000\000\002u\002u\n*\002u\002u\002u\002u\002u\002u\000\000\bJ\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\025\002u\002u\002u\b\025\002u\002u\002u\002u\000\000\bN\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\002u\002u\002u\000\000\000\000\002u\002u\002u\000\000\007\181\000\000\000\000\002u\002u\002u\002u\002U\002U\b>\000\000\000\000\002U\b\025\007\181\002U\000\000\005\234\002U\000\000\002U\000\000\000\238\002U\007\181\002U\002U\002U\007\181\002U\002U\002U\000\000\000\000\b\025\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\007\r\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\007\r\002U\002U\002U\007\r\bR\004\254\000\000\000\000\000\000\002U\002U\n*\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\209\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\000\007\209\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005f\007\209\002a\000\000\005\234\002a\000\000\002a\000\000\000\000\n\"\007\209\002a\002a\002a\007\209\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\nb\002a\000\000\002a\000\000\000\000\006\253\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\006\253\002a\002a\002a\006\253\000\000\000\000\000\000\000\000\000\000\002a\002a\n*\nj\002a\002a\002a\002a\002a\000\000\000\000\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\000\000\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\002a\000\000\007\237\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b\134\006F\002]\000\000\005\234\002]\000\000\002]\000\000\000\000\n\"\007\237\002]\002]\002]\007\237\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\nb\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]\n*\nj\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\229\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\007\229\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\012\n\002\133\000\000\007\229\002\133\000\000\002\133\000\000\000\000\n\"\007\229\002\133\002\133\002\133\007\229\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n\138\n\146\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n\194\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\n\202\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\002\133\002\133\002\133\n\178\002\133\002\133\000\000\000\000\002\133\n\210\002\133\000\000\007\177\000\000\000\000\002\133\002\133\n\218\n\226\002m\002m\000\000\000\000\000\000\002m\000\000\007\177\002m\000\000\005\234\002m\000\000\002m\000\000\000\000\n\"\007\177\002m\002m\002m\007\177\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\nb\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\n*\nj\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\238\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\014R\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\206\002i\000\000\011\218\002i\000\000\002i\000\000\000\000\n\"\011\230\002i\002i\002i\011\242\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\nb\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\n*\nj\002i\002i\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\002i\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002}\002}\000\000\000\000\000\000\002}\000\000\002\006\002}\000\000\002\130\002}\000\000\002}\000\000\000\000\n\"\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n\138\n\146\002}\000\000\027v\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015\190\000\000\000\000\000\000\000\000\000\000\002}\002}\n*\nj\n\162\n\170\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005\134\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\178\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\003\022\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\n\"\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\nb\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\190\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\246\002Q\002Q\002Q\006\154\000\000\004\002\000\000\000\000\000\000\002Q\002Q\n*\nj\002Q\002Q\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\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\000\000\000\000\002M\000\000\002\190\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\n\"\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n\138\n\146\002M\000\000\t\226\003\n\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\012.\000\000\012>\000\000\000\000\000\000\002M\002M\n*\nj\n\162\n\170\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\178\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\190\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\n\"\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\138\n\146\002\169\000\000\012\238\003\n\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\r\002\000\000\r\022\000\000\000\000\000\000\002\169\002\169\n*\nj\n\162\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\n\178\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\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\n\"\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n\138\n\146\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\n*\nj\n\162\n\170\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\178\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\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\n\"\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\138\n\146\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n*\nj\n\162\n\170\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\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\178\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\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\n\"\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n\138\n\146\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n*\nj\n\162\n\170\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\n\178\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\137\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\n\"\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\138\n\146\002\137\000\000\000\000\000\000\000\000\002\137\000\000\n\154\002\137\000\000\000\000\000\000\000\000\002\137\002\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n*\nj\n\162\n\170\n\186\002\137\002\137\000\000\000\000\002\137\000\000\002\137\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\202\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\n\178\002\137\002\137\000\000\000\000\002\137\n\210\002\137\000\000\000\000\000\000\000\000\002\137\002\137\n\218\n\226\002\141\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\n\"\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\138\n\146\002\141\000\000\000\000\000\000\000\000\002\141\000\000\n\154\002\141\000\000\000\000\000\000\000\000\002\141\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n*\nj\n\162\n\170\n\186\002\141\002\141\000\000\000\000\002\141\000\000\002\141\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\202\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\002\141\002\141\002\141\n\178\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\n\218\n\226\002\145\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\n\"\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\138\n\146\002\145\000\000\000\000\000\000\000\000\002\145\000\000\n\154\002\145\000\000\000\000\000\000\000\000\002\145\002\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n*\nj\n\162\n\170\n\186\002\145\002\145\000\000\000\000\002\145\000\000\002\145\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\202\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\n\178\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\n\218\n\226\b\245\b\245\000\000\000\000\000\000\b\245\000\000\000\000\b\245\000\000\000\000\b\245\000\000\b\245\000\000\000\000\n\"\000\000\b\245\b\245\b\245\000\000\b\245\b\245\b\245\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\b\245\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n\138\n\146\b\245\000\000\000\000\000\000\000\000\b\245\000\000\n\154\b\245\000\000\000\000\000\000\000\000\b\245\b\245\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n*\nj\n\162\n\170\n\186\b\245\b\245\000\000\000\000\b\245\000\000\b\245\n\194\000\000\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n\202\000\000\b\245\b\245\b\245\b\245\000\000\000\000\000\000\b\245\000\000\b\245\b\245\000\000\b\245\b\245\b\245\n\178\b\245\b\245\000\000\000\000\b\245\n\210\b\245\000\000\000\000\000\000\000\000\b\245\b\245\n\218\n\226\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\n\"\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\138\n\146\002\149\000\000\000\000\000\000\000\000\002\149\000\000\n\154\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n*\nj\n\162\n\170\n\186\002\149\002\149\000\000\000\000\002\149\000\000\002\149\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\202\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\n\234\002\149\n\242\n\178\002\149\002\149\000\000\000\000\002\149\n\210\002\149\000\000\000\000\000\000\000\000\002\149\002\149\n\218\n\226\b\241\b\241\000\000\000\000\000\000\b\241\000\000\000\000\b\241\000\000\000\000\b\241\000\000\b\241\000\000\000\000\n\"\000\000\b\241\b\241\b\241\000\000\b\241\b\241\b\241\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\b\241\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n\138\n\146\b\241\000\000\000\000\000\000\000\000\b\241\000\000\n\154\b\241\000\000\000\000\000\000\000\000\b\241\b\241\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n*\nj\n\162\n\170\n\186\b\241\b\241\000\000\000\000\b\241\000\000\b\241\n\194\000\000\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n\202\000\000\b\241\b\241\b\241\b\241\000\000\000\000\000\000\b\241\000\000\b\241\b\241\000\000\b\241\b\241\b\241\n\178\b\241\b\241\000\000\000\000\b\241\n\210\b\241\000\000\000\000\000\000\000\000\b\241\b\241\n\218\n\226\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\n\"\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\138\n\146\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\202\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\234\002\193\n\242\n\178\002\193\002\193\000\000\000\000\002\193\n\210\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n\218\n\226\002\209\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\000\000\000\000\002\209\000\000\002\209\000\000\000\000\n\"\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\138\n\146\002\209\000\000\000\000\000\000\000\000\002\209\000\000\n\154\002\209\000\000\000\000\000\000\000\000\002\209\002\209\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n*\nj\n\162\n\170\n\186\002\209\002\209\000\000\000\000\002\209\000\000\002\209\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\202\000\000\002\209\002\209\002\209\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\n\234\002\209\n\242\n\178\002\209\002\209\000\000\000\000\002\209\n\210\002\209\000\000\000\000\000\000\000\000\002\209\002\209\n\218\n\226\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\n\"\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\138\n\146\002\201\000\000\000\000\000\000\000\000\002\201\000\000\n\154\002\201\000\000\000\000\000\000\000\000\002\201\002\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n*\nj\n\162\n\170\n\186\002\201\002\201\000\000\000\000\002\201\000\000\002\201\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\202\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\n\234\002\201\n\242\n\178\002\201\002\201\000\000\000\000\002\201\n\210\002\201\000\000\000\000\000\000\000\000\002\201\002\201\n\218\n\226\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\n\"\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\138\n\146\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\202\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\234\002\181\n\242\n\178\002\181\002\181\000\000\000\000\002\181\n\210\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n\218\n\226\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\n\"\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\138\n\146\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\202\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\234\002\189\n\242\n\178\002\189\002\189\000\000\000\000\002\189\n\210\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n\218\n\226\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\n\"\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\138\n\146\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\202\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\234\002\185\n\242\n\178\002\185\002\185\000\000\000\000\002\185\n\210\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n\218\n\226\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\n\"\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\138\n\146\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\202\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\234\002\197\n\242\n\178\002\197\002\197\000\000\000\000\002\197\n\210\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n\218\n\226\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\n\"\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\138\n\146\002\213\000\000\000\000\000\000\000\000\002\213\000\000\n\154\002\213\000\000\000\000\000\000\000\000\002\213\002\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n*\nj\n\162\n\170\n\186\002\213\002\213\000\000\000\000\002\213\000\000\002\213\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\202\000\000\002\213\002\213\002\213\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\n\234\002\213\n\242\n\178\002\213\002\213\000\000\000\000\002\213\n\210\002\213\000\000\000\000\000\000\000\000\002\213\002\213\n\218\n\226\002\205\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\000\000\000\000\002\205\000\000\002\205\000\000\000\000\n\"\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\138\n\146\002\205\000\000\000\000\000\000\000\000\002\205\000\000\n\154\002\205\000\000\000\000\000\000\000\000\002\205\002\205\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n*\nj\n\162\n\170\n\186\002\205\002\205\000\000\000\000\002\205\000\000\002\205\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\202\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\n\234\002\205\n\242\n\178\002\205\002\205\000\000\000\000\002\205\n\210\002\205\000\000\000\000\000\000\000\000\002\205\002\205\n\218\n\226\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\n\"\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\138\n\146\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\202\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\234\002\177\n\242\n\178\002\177\002\177\000\000\000\000\002\177\n\210\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n\218\n\226\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\002\001\000\000\000\000\000\000\000\000\000\000\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\000\000\000\000\000\000\002\001\000\000\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\000\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\000\000\002\001\002\001\014*\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\029\002\029\000\000\000\000\000\000\002\029\000\000\000\000\002\029\000\000\000\000\002\029\000\000\002\029\000\000\000\000\n\"\000\000\002\029\002\029\002\029\000\000\002\029\002\029\002\029\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\138\n\146\002\029\000\000\000\000\000\000\000\000\002\029\000\000\n\154\002\029\000\000\000\000\000\000\000\000\002\029\002\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n*\nj\n\162\n\170\n\186\002\029\002\029\000\000\000\000\002\029\000\000\002\029\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\202\000\000\002\029\002\029\014B\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\n\234\002\029\n\242\n\178\002\029\002\029\000\000\000\000\002\029\n\210\002\029\000\000\000\000\000\000\000\000\002\029\002\029\n\218\n\226\002\025\002\025\000\000\000\000\000\000\002\025\000\000\000\000\002\025\000\000\000\000\002\025\000\000\002\025\000\000\000\000\n\"\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\138\n\146\002\025\000\000\000\000\000\000\000\000\002\025\000\000\n\154\002\025\000\000\000\000\000\000\000\000\002\025\002\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n*\nj\n\162\n\170\n\186\002\025\002\025\000\000\000\000\002\025\000\000\002\025\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\202\000\000\002\025\002\025\002\025\002\025\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\n\234\002\025\n\242\n\178\002\025\002\025\000\000\000\000\002\025\n\210\002\025\000\000\000\000\000\000\000\000\002\025\002\025\n\218\n\226\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\n\"\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\138\n\146\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n\154\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\n*\nj\n\162\n\170\n\186\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\202\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\234\002\173\n\242\n\178\002\173\002\173\000\000\000\000\002\173\n\210\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n\218\n\226\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\002\r\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\002\r\014*\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\017\002\017\000\000\000\000\000\000\002\017\000\000\000\000\002\017\000\000\000\000\002\017\000\000\002\017\000\000\000\000\002\017\000\000\002\017\002\017\002\017\000\000\002\017\002\017\002\017\000\000\000\000\006>\000\000\000\000\002\017\002\017\002\017\002\017\002\017\000\000\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\006B\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\238\002\017\002\017\002\017\000\000\002\017\002\017\002\017\002\017\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\002\017\014*\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\007\029\000\000\002\186\002\190\006F\002\234\002\130\005\234\006R\000\000\000\000\002\246\001\n\000\000\006f\000\000\002\142\000\000\006r\007\029\000\000\001\210\003\206\007\029\002\190\0036\001\018\b\206\b\210\001\030\001\"\003\170\000\000\000\000\003F\000\000\002\254\bB\025j\000\000\b\246\b\250\001\210\003\222\0032\003\234\b\254\007\030\000\000\001:\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\003\202\001>\001B\001F\001J\001N\000\000\002\178\t\018\001R\000\000\007\017\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\007\029\000\000\001^\002\225\007\017\000\000\000\000\018\202\007\017\0072\000\000\000\000\001\154\0062\000\000\011&\005\138\b\146\0112\001\158\000\000\014r\004r\t\150\001\006\001\166\000\006\001\170\001\174\0256\002\186\002\190\000\n\002\234\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\b\202\000\000\000\238\000\000\002\225\001\210\000\000\000\000\000\000\0036\001\018\b\206\b\210\001\030\001\"\000\000\002\225\002\225\003F\000\000\002\254\000\000\b\214\000\000\b\246\b\250\000\238\003\222\0032\003\234\b\254\007\030\000\000\001:\000\000\002\178\006\245\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\b\158\006F\005v\000\000\005\234\001>\001B\001F\001J\001N\006\245\006f\t\018\001R\006\245\006r\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\006F\001Z\000\000\005\234\025:\000\000\000\000\001^\000\000\000\000\006f\000\000\000\000\000\000\006r\000\000\000\000\001\154\006\134\000\000\000\000\005\138\b\146\012\205\001\158\000\000\014r\004r\t\150\004y\001\166\000\006\001\170\001\174\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\012\205\002\246\000\000\002\030\003\178\000\000\002\"\000\000\004y\000\000\003\182\001\210\000\000\017F\006\245\002\250\000\000\003>\003B\002.\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\004\026\003\222\0032\003\234\003\242\007\030\000\000\000\000\017>\002\178\000\000\000\000\003:\017V\002:\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\t\018\000\000\t!\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\000\004y\004y\000\000\000\000\000\000\006\178\004\005\000\000\t!\000\000\000\000\002>\012\205\012\185\000\000\000\000\017\218\021\230\005\138\b\146\025V\000\173\000\000\b\170\004r\t\150\000\173\000\000\002\190\000\173\000\000\002\130\012\205\t\190\000\000\002\030\002\246\000\000\002\"\000\173\000\000\000\173\000\000\000\173\000\000\000\173\001\210\000\238\t\198\000\000\002\250\002.\000\000\000\000\0026\012\185\t\206\000\173\000\000\000\000\000\000\002\254\000\000\000\173\000\000\000\000\000\000\000\173\000\000\0032\001\190\015\174\000\173\000\000\002\130\000\173\002\178\004\005\002:\003:\000\173\000\173\000\173\bz\b~\b\138\000\000\012\150\005v\000\173\000\173\006F\021\142\000\000\005\234\tR\000\173\000\000\000\000\t!\000\173\006f\000\000\000\000\000\000\006r\000\000\000\000\005\130\005\134\000\173\000\173\015\178\000\000\000\173\000\173\000\000\000\000\000\000\000\000\000\000\000\000\002>\000\000\000\173\000\000\015\190\000\000\021\178\000\000\000\173\000\173\005\138\b\146\000\000\000\000\000\197\b\170\004r\000\000\000\173\000\197\000\173\002\190\000\197\000\000\002\130\000\000\t\190\000\000\000\000\002\246\005\134\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\210\021\190\t\198\000\000\002\250\000\000\000\000\000\000\000\000\000\000\t\206\000\197\000\000\t2\000\000\002\254\000\000\000\197\021R\000\000\000\000\000\197\000\000\0032\001\190\000\000\000\197\000\000\000\000\000\197\002\178\000\000\000\000\003:\000\197\000\197\000\197\bz\b~\b\138\000\000\012\150\005v\000\197\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\014\022\000\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\197\000\197\000\000\000\000\000\197\000\197\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\197\005\138\b\146\000\000\000\000\000\000\b\170\004r\000\000\000\197\000\000\000\197\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\000\000\000>\016\154\006F\000\000\000B\005\234\015\174\000\000\002\006\002\130\000\000\000F\006f\000\000\000\000\000\000\006r\000J\002\n\000N\000R\000V\000Z\000^\000b\000f\001\210\000\000\000\000\000j\000n\000\000\000r\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\154\000\000\000\000\000\000\015\178\000z\007J\001\222\000~\000\130\000\000\000\000\000\000\002\178\000\000\000\134\000\138\000\142\015\190\000\000\021\146\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\001\r\000\000\000\174\000\178\000\182\001\r\000\000\000\000\000\186\007N\000\190\000\194\005\134\000\000\000\000\000\000\000\000\000\000\000\198\000\000\000\202\000\000\021\158\000\000\001\r\003\213\000\206\000\210\000\000\000\214\003\213\003V\002\190\003\213\000\000\002\130\000\000\006\238\000\000\021R\002\246\000\000\000\000\003\213\000\000\000\000\001\r\003\213\003R\003\213\001\210\007\189\007\014\000\000\001\r\000\000\000\000\003Z\000\000\001\r\tB\003\213\000\000\n\205\000\000\000\000\000\000\003\213\001\r\001\r\003f\000\000\000\000\011\006\001\190\000\000\003\213\000\000\000\000\003\213\002\178\007\189\000\000\003\246\003\213\003\213\n\201\003\250\000\000\004\002\000\000\011\022\005v\n\205\001\r\007\189\000\000\000\000\007\189\t\006\003\213\003\213\000\000\001\r\005z\007\189\000\000\n\205\000\000\007\189\n\205\011\178\005\130\005\134\003\213\003\213\011\030\n\205\003\213\003\213\000\000\n\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\201\011&\000\000\n\201\011f\003\213\005\138\000\000\000\000\000\000\n\201\000\000\004r\t\r\n\201\000\006\003\213\000\000\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\004\153\000\000\t\r\000\000\t\r\t\r\003\182\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\000\000\017>\002\178\000\000\000\000\003:\017V\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\t\018\000\000\028F\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\006\028g\015\006\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\028\150\000\000\021\230\005\138\b\146\t\r\003\182\001\210\b\170\004r\t\150\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\016\170\017>\002\178\000\000\000\000\003:\017V\002\006\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\002\n\000\000\000\000\000\000\000\000\017^\000\000\t\018\001\210\028F\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\000\004\161\000\000\003\154\000\000\000\000\000\000\001\006\000\000\007J\001\222\000\000\000\000\003V\002\190\006\014\002\178\002\130\021\230\005\138\b\146\014\134\002\246\001\n\b\170\004r\t\150\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\007N\000\000\000\000\002\225\000\000\003z\002\225\001.\006.\000\000\000\000\003r\001\190\0016\002\225\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\n\005v\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005z\000\000\002\225\001V\000\000\000\000\000\000\002\225\005\130\005\134\000\000\005\202\001Z\002\225\002\225\002\225\002\225\000\000\001^\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\002\225\001\170\001\174\003V\002\190\tr\002\225\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003V\002\190\011\n\000\000\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003V\002\190\r\214\000\000\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\000\000\005\t\001\166\000\000\001\170\001\174\005\t\005\t\005\t\005\t\b\021\005\t\000\000\005\t\005\t\b\021\000\000\005\t\000\000\005\t\000\000\005\t\005\t\005\t\005\t\005\t\005\t\000\000\005\t\005\t\005\t\000\000\000\000\000\000\b\021\000\000\000\000\005\t\000\000\000\000\000\000\000\000\005\t\005\t\005\t\000\000\000\000\000\000\005\t\005\t\005\t\000\000\005\t\000\000\000\000\005\t\b\021\005\t\000\000\000\000\005\t\005\t\005\t\000\000\b\021\005\t\005\t\005\t\000\000\b\021\b\021\000\238\000\000\000\000\005\t\005\t\005\t\000\000\b\021\b\021\005\t\005\t\000\000\000\000\000\000\005\t\000\000\000\000\005\t\000\000\005\t\005\t\005\t\000\000\005\t\005\t\005\t\005\t\000\000\005\t\005\t\b\021\000\000\000\000\b\021\000\000\000\000\000\000\000\000\005\t\020b\005\t\005\t\b\021\000\000\002\150\005\t\000\000\000\000\000\000\000\000\005\t\005\t\n\229\000\000\005\t\n\229\005\t\005\t\n\229\n\229\012\205\012\185\n\229\000\000\n\229\000\000\000\000\n\229\000\000\000\000\000\000\n\229\n\229\000\000\n\229\n\229\000\000\n\229\000\000\n\229\012\205\025\130\000\000\002\030\n\229\000\000\002\"\n\229\002\006\000\000\000\000\000\000\000\000\002*\000\000\n\229\000\000\n\229\002\n\002.\n\229\n\229\0026\012\185\000\000\000\000\001\210\n\229\000\000\000\000\n\229\000\000\000\000\n\229\n\229\000\000\n\229\000\000\n\229\n\229\000\000\000\000\000\000\003\154\000\000\000\000\002:\000\000\000\000\007J\001\222\n\229\000\000\000\000\000\000\000\000\002\178\000\000\000\000\n\229\n\229\000\000\000\000\n\229\000\000\n\229\000\000\000\000\000\000\000\000\005\166\000\000\000\000\000\000\000\000\001\202\001\206\n\229\n\229\000\000\n\229\n\229\000\000\n\229\007N\n\229\000\000\n\229\000\000\n\229\002>\n\229\b\249\b\249\001\210\001\214\001\230\b\249\000\000\001\206\b\249\000\000\000\000\000\000\001\242\000\000\000\000\018\246\b\249\000\000\b\249\b\249\b\249\000\000\b\249\b\249\b\249\001\246\020^\000\000\019~\000\000\002\158\000\000\002\178\004\030\004*\000\000\b\249\000\000\000\000\020n\000\000\000\000\b\249\b\249\000\000\000\000\b\249\000\000\000\000\002\154\000\000\b\249\000\000\000\000\b\249\000\000\004:\000\000\000\000\b\249\b\249\b\249\000\000\000\000\000\000\000\000\000\000\000\000\b\249\b\249\000\000\000\000\000\000\000\000\000\000\b\249\000\000\000\000\000\000\004\154\000\000\000\000\b\249\000\000\000\000\000\000\000\000\000\000\000\000\b\249\b\249\b\249\000\000\b\249\b\249\000\000\004e\000\000\000\000\000\000\000\000\004e\000\000\b\249\004e\b\249\b\249\000\000\000\000\000\000\b\249\000\000\000\000\000\000\004e\b\249\000\000\000\000\004e\b\249\004e\b\249\b\249\012\141\012\141\000\000\000\000\004e\012\141\000\000\001\206\012\141\004e\000\000\000\000\000\000\000\000\000\000\004e\004\186\000\000\012\141\012\141\012\141\004B\012\141\012\141\012\141\000\000\000\000\004e\004e\000\000\000\000\000\000\004e\002\226\000\000\000\000\012\141\000\000\000\000\000\000\000\000\000\000\012\141\012\141\000\000\000\000\012\141\000\000\004e\002\154\004e\012\141\000\000\000\000\012\141\000\000\000\000\000\000\004e\012\141\012\141\012\141\004e\004e\002\226\000\238\004e\004e\012\141\012\141\000\000\000\000\004R\004e\000\000\012\141\000\000\000\000\000\000\004\154\000\000\000\000\012\141\004e\000\000\000\000\000\000\000\000\021f\012\141\012\141\012\141\000\000\012\141\012\141\000\000\007\005\000\000\004e\000\000\000\000\007\005\000\000\012\141\007\005\012\141\012\141\004e\000\000\000\000\012\141\000\000\000\000\000\000\007\005\012\141\000\000\000\000\007\005\012\141\007\005\012\141\012\141\b\253\b\253\000\000\000\000\000\000\b\253\000\000\001\206\b\253\007\005\000\000\000\000\000\000\000\000\000\000\007\005\b\253\000\000\b\253\b\253\b\253\000\000\b\253\b\253\b\253\000\000\000\000\007\005\000\000\000\000\000\000\000\000\007\005\007\005\000\000\000\000\b\253\000\000\000\000\000\000\000\000\000\000\b\253\b\253\000\000\000\000\b\253\000\000\007\005\002\154\000\000\b\253\000\000\000\000\b\253\000\000\000\000\000\000\000\000\b\253\b\253\b\253\007\005\007\005\016\238\000\000\007\005\007\005\b\253\b\253\002\225\000\000\000\000\000\000\000\000\b\253\000\000\002\225\000\000\004\154\018\030\000\000\b\253\007\005\000\000\000\000\000\000\000\000\002\225\b\253\b\253\b\253\002\225\b\253\b\253\000\000\000\n\002\225\002\225\002\225\000\000\000\000\002\225\b\253\002\225\b\253\b\253\002\225\002\225\002\225\b\253\002\225\002\225\002\225\002\225\b\253\002\225\002\225\002\225\b\253\002\225\b\253\b\253\000\000\002\225\000\n\000\000\002\225\002\225\002\225\000\000\002\225\000\000\002\225\002\225\000\n\002\225\002\225\002\225\000\n\002\225\002\225\002\225\000\000\000\000\001*\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\n\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\n\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\006\157\002\225\0009\002\225\002\225\000\000\0009\0009\002\225\0009\0009\002\225\000\000\002\225\002\225\0009\000\000\002\225\000\000\000\000\006\157\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\003\190\0009\0009\000\000\000\000\000\000\002\225\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\007&\0009\0009\0009\0009\0009\000\000\000\000\000\000\0009\000\000\000\000\0009\000\000\000\000\000\000\0009\0009\0009\0009\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\012\205\012\185\000\000\0009\0009\0009\0009\0009\000\000\006\153\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\012\205\000\000\000\000\002\030\0005\000\000\002\"\000\000\000\000\006\153\0009\0009\000\000\002\206\0005\0009\0009\0009\0005\002.\0005\0005\0026\012\185\000\000\000\000\000\000\0005\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\0005\0005\0005\000\000\000\000\000\000\0005\000\000\002:\0005\000\000\000\000\000\000\0005\0005\0005\0005\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\0005\0005\0005\0005\0005\000\000\006\169\000\000\012U\000\000\000\000\000\000\012U\012U\000\000\012U\012U\002>\000\000\000\000\000\000\012U\000\000\000\000\000\000\000\000\006\169\0005\0005\000\000\000\000\012U\0005\0005\0005\012U\000\000\012U\012U\000\000\000\000\000\000\000\000\000\000\012U\000\000\012U\000\000\000\000\000\000\012U\012U\000\000\012U\012U\012U\012U\012U\000\000\000\000\000\000\012U\000\000\000\000\012U\000\000\000\000\000\000\012U\012U\012U\012U\000\000\012U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012U\000\000\000\000\000\000\000\000\000\000\000\000\012U\012U\012U\012U\012U\000\000\006\165\000\000\012Q\000\000\000\000\000\000\012Q\012Q\000\000\012Q\012Q\000\000\000\000\000\000\000\000\012Q\000\000\000\000\000\000\000\000\006\165\012U\012U\000\000\000\000\012Q\012U\012U\012U\012Q\000\000\012Q\012Q\000\000\000\000\000\000\000\000\000\000\012Q\000\000\012Q\000\000\000\000\000\000\012Q\012Q\000\000\012Q\012Q\012Q\012Q\012Q\000\000\001\202\001\206\012Q\000\000\000\000\012Q\000\000\000\000\000\000\012Q\012Q\012Q\012Q\000\000\012Q\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\012Q\000\000\000\000\000\000\000\000\001\242\000\000\012Q\012Q\012Q\012Q\012Q\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\000\000\002\158\000\000\002\178\004\030\004*\012\145\012\145\000\000\000\000\0046\012\145\012Q\012Q\012\145\000\000\000\000\012Q\012Q\012Q\000\000\000\000\004\138\000\000\012\145\012\145\012\145\004:\012\145\012\145\012\145\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\012\145\000\000\000\000\000\000\001\021\012\145\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\001\021\000\000\018\254\012\145\000\000\000\000\000\000\012\145\001\021\000\000\012\145\000\000\000\000\001\021\000\000\000\000\000\000\012\145\012\145\012\145\000\000\012\145\012\145\001\021\000\000\000\000\000\000\000\000\000\000\000\000\b\017\012\145\000\006\012\145\012\145\b\017\002\186\002\190\012\145\002\234\002\130\000\000\000\000\012\145\000\000\002\246\000\000\012\145\001\021\012\145\012\145\000\000\003\254\000\000\b\017\001\210\000\000\001\021\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\000\000\000\000\003F\000\000\002\254\000\000\000\000\000\000\003\214\003\218\b\017\003\222\0032\003\234\003\242\007\030\000\000\000\000\b\017\002\178\000\000\000\000\003:\b\017\b\017\000\238\bz\b~\b\138\b\158\000\000\005v\b\017\b\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\018\000\000\000\000\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\b\017\000\000\000\000\b\017\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\b\017\002\186\002\190\000\000\002\234\002\130\000\000\000\000\005\138\b\146\002\246\000\000\000\000\b\170\004r\t\150\000\000\014\154\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\001\197\000\000\003F\000\000\002\254\001\197\000\000\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\001\197\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0059\r\r\t\018\000\000\000\000\005=\r\r\001\197\000\000\t\030\t6\t\130\005\130\005\134\000\000\001\197\000\000\000\000\000\000\0059\001\197\001\197\000\238\0059\005=\000\000\003\029\003\029\005=\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005\138\b\146\000\000\000\000\000\000\b\170\004r\t\150\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\003\029\000\000\001\197\000\000\000\000\000\000\003\029\004\130\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\r\r\r\r\003\029\000\000\000\000\r\r\r\r\003\029\003\029\003\029\000\000\000\000\000\000\0059\000\000\000\000\003\029\003\029\005=\r\r\000\000\r\r\000\000\003\029\r\r\000\000\r\r\003\029\0059\000\000\003\029\0059\000\000\005=\000\000\000\000\005=\003\029\003\029\003\029\004\137\003\029\003\029\000\000\000\000\019\014\000\000\000\000\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\003\182\n\241\000\000\003\029\n\241\003\029\003\029\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\n\241\n\241\019:\n\241\n\241\000\000\001\210\000\000\007\014\000\000\017>\000\000\000\000\003Z\000\000\017V\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\241\019v\003f\000\000\000\000\003r\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\241\003\250\000\000\004\002\005j\011\022\005v\000\000\004\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\218\005z\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\n\241\000\000\n\241\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\241\000\000\000\000\n\241\n\241\000\000\005\138\000\000\n\241\000\000\n\241\000\000\004r\n\237\n\241\000\000\n\237\001\246\002\162\003V\002\190\000\000\002\158\002\130\002\178\004\030\004*\000\000\002\246\000\000\000\000\0046\n\237\n\237\000\000\n\237\n\237\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\026b\000\000\000\000\000\000\000\000\n\237\000\000\003f\000\000\000\000\006\n\001\190\000\000\000\000\000\000\000\000\026N\002\178\000\000\000\000\003\246\000\000\000\000\n\237\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\012q\000\000\000\000\012q\000\000\000\000\005\130\005\134\000\000\005\202\n\237\000\000\n\237\012q\000\000\000\000\000\000\000\000\000\000\012q\000\000\001\221\001\221\000\000\n\237\000\000\001\221\n\237\n\237\001\221\005\138\012q\n\237\000\000\n\237\000\000\004r\012q\n\237\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012q\000\000\000\000\012q\000\000\000\000\000\000\000\000\012q\000\000\000\000\001\221\000\000\000\000\000\000\000\000\000\000\001\221\001\221\000\000\000\000\001\221\000\000\000\000\012q\000\000\001\221\000\000\012q\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012q\012q\000\000\000\000\012q\001\221\001\221\000\000\000\000\000\000\028>\000\000\001\221\004\145\000\000\000\000\001\221\000\000\022\014\001\221\000\000\012q\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\001\221\001\221\000\000\000\000\000\000\000\000\000\000\003\182\000\000\000\000\001\221\000\000\001\221\001\221\003V\002\190\000\000\001\221\002\130\000\000\006\238\000\000\001\221\002\246\000\000\000\000\004\254\000\000\001\221\022~\000\000\000\000\000\000\001\210\000\000\007\014\000\000\017>\000\000\000\000\003Z\000\000\017V\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\"\0232\003f\000\000\000\000\011\006\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\201\003\250\000\000\004\002\000\000\011\022\005v\000\000\004\145\000\000\000\000\000\000\000\000\000\000\000\000\004\017\000\000\024&\005z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\000\000\011\030\005\137\005\137\000\000\000\000\000\000\005\137\000\000\000\000\005\137\000\000\000\000\000\000\000\000\n\201\000\000\000\000\n\201\n\201\005\137\005\138\005\137\000\000\005\137\n\201\005\137\004r\000\000\n\201\004\017\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005\137\002\194\000\000\000\000\000\000\000\000\005\137\005\137\000\000\000\000\000\000\028\150\005\137\000\000\000\000\005\137\000\000\003\182\005\137\000\000\000\000\000\000\000\000\005\137\005\137\005\137\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\000\000\000\000\000\000\005\137\005\137\000\000\000\000\005\137\024\166\000\000\001\006\017>\000\000\000\000\000\000\000\000\017V\005\137\005\137\005\137\000\000\005\137\005\137\000\000\000\000\000\000\001\n\007\246\000\000\000\000\002\142\000\000\017^\000\000\005\137\000\000\028F\005\137\005\137\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017r\017\158\000\000\005\137\004\161\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\021\230\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\003]\003]\001R\000\000\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\003]\003]\000\000\003]\001^\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\000\000\001\154\027z\000\000\000\000\003]\003]\003]\001\158\003]\001\162\003]\003]\003]\001\166\000\000\001\170\001\174\005\017\000\000\000\000\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\005\021\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\003]\000\000\003]\000\000\000\000\005\017\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\003]\003]\005}\005}\000\000\000\000\005\021\005}\000\000\000\000\005}\003]\000\000\003]\003]\000\000\000\000\003]\000\000\000\000\005}\000\000\005}\000\000\005}\000\000\005}\000\000\003]\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\005}\005}\000\000\000\000\000\000\000\000\b>\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\005}\005}\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}\005}\000\000\000\000\005}\000\000\t\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\005}\005}\000\000\000\000\n\"\000\000\000\000\012j\t\t\000\000\t\t\t\t\000\000\005}\000\000\000\000\005}\005}\nZ\nr\nz\nb\n\130\000\000\000\000\001\202\002~\000\000\005}\002\130\000\000\000\000\n\138\n\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\000\000\001\210\001\214\001\230\002\134\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\n*\nj\n\162\n\170\n\186\000\000\000\000\000\000\000\000\002\138\002\146\000\000\n\194\001\n\002\158\000\000\002\178\004\030\004*\000\000\000\000\n\202\000\000\021>\000\000\021B\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n\234\000\000\n\242\n\178\001&\004:\001.\0012\t\t\n\210\000\000\000\000\0016\000\000\005\134\001:\000\000\n\218\n\226\000\000\000\000\000\000\000\000\000\000\021N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\b\133\b\133\001R\021R\000\000\b\133\001V\000\000\b\133\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\b\133\000\000\b\133\001^\b\133\000\000\b\133\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027\150\000\000\000\000\000\000\b\133\000\000\001\158\000\000\001\162\000\000\b\133\b\133\001\166\000\000\001\170\001\174\000\000\000\000\000\000\b\133\000\000\000\000\b\133\000\000\000\000\000\000\000\000\b\133\b\133\b\133\000\000\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\133\000\000\000\000\000\000\b\133\rY\rY\000\000\000\000\000\000\rY\000\000\000\000\rY\b\133\b\133\b\133\000\000\b\133\b\133\000\000\000\000\000\000\rY\000\000\rY\000\000\rY\b\133\rY\000\000\b\133\001\202\001\206\000\000\b\133\000\000\000\000\000\000\000\000\000\000\rY\000\000\000\000\004\254\000\000\b\133\rY\rY\r]\r]\001\210\001\214\004B\r]\000\000\rY\r]\000\000\rY\000\000\000\000\000\000\000\000\rY\rY\rY\r]\000\000\r]\000\000\r]\000\000\r]\001\246\002\154\000\000\000\000\000\000\002\158\rY\002\178\004\030\004*\rY\r]\000\000\000\000\0046\000\000\015\202\r]\r]\000\000\rY\rY\rY\004B\rY\rY\r]\000\000\000\000\r]\004R\004:\000\000\000\000\r]\r]\r]\rY\000\000\000\000\000\000\rY\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r]\000\000\rY\000\000\r]\001\205\000\000\000\000\000\000\000\000\001\205\000\000\001\206\001\205\r]\r]\r]\000\000\r]\r]\000\000\b\229\000\000\001\205\004R\000\000\000\000\001\205\006\237\001\205\000\000\r]\000\000\006\237\000\000\r]\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\r]\001\205\001\205\000\000\000\000\000\000\006\237\000\000\002\154\000\000\001\205\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\237\000\000\000\000\000\000\000\000\000\000\001\205\001\205\006\237\000\000\004\154\003A\000\000\006\237\006\237\000\238\003A\000\000\001\206\003A\001\205\001\205\006\237\006\237\001\205\001\205\000\000\b\225\000\000\003A\000\000\000\000\000\000\003A\001\205\003A\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\003A\006\237\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\006\237\000\000\000\000\002\154\000\181\003A\000\000\000\181\003A\000\000\000\000\000\000\000\000\003A\003A\003A\024\006\000\181\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\000\000\000\000\000\000\000\003A\003A\000\000\000\000\004\154\000\000\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\000\003A\003A\000\181\000\000\003A\003A\000\000\000\181\000\000\000\000\000\181\000\000\000\000\000\000\003A\000\181\000\181\000\238\000\000\000\000\000\000\003A\000\000\000\000\000\181\000\181\003A\000\000\000\000\000\000\000\000\000\181\003A\000\000\000\249\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\181\000\181\000\000\000\000\000\181\000\181\000\000\000\249\000\000\000\249\000\000\000\249\000\000\000\249\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\181\000\249\000\181\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\189\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\249\000\249\000\000\000\000\000\249\000\249\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\189\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\249\000\189\000\249\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\185\000\189\000\000\000\000\r\025\000\185\000\000\000\000\000\185\r\025\000\000\000\189\000\189\000\000\000\000\000\189\000\189\000\000\000\185\000\000\000\185\000\000\000\185\000\000\000\185\000\189\000\000\000\000\r\025\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\185\000\000\000\000\000\000\000\000\000\189\000\185\000\189\000\000\000\000\000\185\000\000\000\000\000\000\r\025\000\185\000\000\000\000\000\185\000\000\000\000\000\000\r\025\000\185\000\185\000\238\000\000\r\025\r\025\000\238\000\000\000\000\000\185\000\185\000\000\000\000\r\025\r\025\000\000\000\185\000\000\000\000\001\169\000\185\000\000\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\185\000\185\000\000\000\000\000\185\000\185\000\000\001\169\000\000\r\025\000\000\001\169\004e\001\169\000\185\000\000\000\000\004e\r\025\000\000\000\185\000\185\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\185\001\169\000\185\000\000\000\000\000\000\004e\005\017\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\000\000\000\001\169\001\169\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004e\000\000\000\000\000\000\000\000\000\000\001\169\000\000\004e\000\000\001\169\rU\rU\004e\002\226\000\000\rU\000\000\000\000\rU\001\169\001\169\004e\004e\001\169\001\169\000\000\000\000\000\000\rU\005\017\rU\000\000\rU\001\169\rU\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\rU\004e\000\000\000\000\000\000\001\169\rU\rU\000\000\000\000\004e\000\000\000\000\000\000\000\000\rU\000\000\000\000\rU\000\000\000\000\000\000\000\000\rU\rU\rU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rU\000\000\000\000\000\000\rU\rQ\rQ\000\000\000\000\000\000\rQ\000\000\000\000\rQ\rU\rU\rU\000\000\rU\rU\000\000\000\000\000\000\rQ\000\000\rQ\000\000\rQ\000\000\rQ\000\000\rU\000\000\000\000\000\000\rU\000\000\000\000\000\000\000\000\000\000\rQ\000\000\000\000\004\254\000\000\rU\rQ\rQ\000\000\000\000\000\000\000\000\000\000\000\000\004m\rQ\000\000\000\000\rQ\000\246\000\000\000\000\002\018\rQ\rQ\rQ\000\000\000\000\000\000\000\000\000\000\000\000\017\222\000\000\000\000\000\000\004m\000\000\003\182\rQ\000\000\b\137\b\137\rQ\000\000\000\000\b\137\000\000\000\000\b\137\017\226\000\000\000\000\rQ\rQ\rQ\018\n\rQ\rQ\b\137\000\000\b\137\000\000\b\137\000\000\b\137\000\000\007\146\017>\000\000\rQ\000\000\000\000\017V\rQ\000\000\000\000\b\137\000\000\000\000\000\000\000\000\000\000\b\137\b\137\rQ\000\000\000\000\000\000\018\162\000\000\000\000\b\137\000\000\000\000\b\137\000\000\000\000\000\000\000\000\b\137\b\137\000\238\017r\018\182\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\137\000\000\000\000\000\000\b\137\000\000\007\001\000\000\018\198\000\000\000\000\000\000\000\000\000\000\b\137\b\137\b\137\000\000\b\137\b\137\000\000\000\000\n\"\000\000\000\000\007\001\000\000\000\000\b\137\007\001\000\000\b\137\000\000\000\000\000\000\b\137\nZ\nr\nz\nb\n\130\000\000\000\000\000\000\000\000\000\000\b\137\001\201\000\000\000\000\n\138\n\146\001\201\000\000\001\206\001\201\000\000\000\000\000\000\n\154\000\000\000\000\000\000\b\225\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\n*\nj\n\162\n\170\n\186\000\000\000\000\001\201\000\000\000\000\000\000\007\001\n\194\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002\154\n\202\001\201\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\001\201\001\201\000\000\000\000\n\234\000\000\n\242\n\178\000\000\000\000\000\000\000\000\000\000\n\210\000\000\001\201\001\201\000\000\000\000\004\154\000\000\n\218\n\226\000\000\000\000\000\000\016\142\000\000\000\000\001\201\001\201\000\000\000\000\001\201\001\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\001\201\000\000\000\000\016\146\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\nZ\nr\nz\nb\n\130\001\201\000\000\000\000\000\000\000\000\000\000\006V\000\000\000\000\n\138\n\146\000\246\001\202\001\206\002\018\000\000\000\000\000\000\n\154\000\000\000\000\000\000\000\000\000\000\017\222\000\000\000\238\000\000\004m\000\000\003\182\001\210\001\214\001\230\000\000\n*\nj\n\162\n\170\n\186\000\000\001\242\017\226\000\000\000\000\000\000\000\000\n\194\018\n\000\000\000\000\000\000\000\000\000\000\001\246\002\146\n\202\000\000\000\000\002\158\017>\002\178\004\030\004*\000\000\017V\000\000\000\000\0046\000\000\n\234\016\150\n\242\n\178\016\166\000\000\000\000\000\000\000\000\n\210\000\000\018\162\000\000\000\000\000\000\004:\000\000\n\218\n\226\005\181\005\181\000\000\000\000\000\000\005\181\017r\018\182\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\181\000\000\005\181\000\000\005\181\000\000\005\181\000\000\000\000\018\198\000\000\000\000\000\000\000\000\004n\000\000\004r\000\000\005\181\000\000\000\000\000\000\000\000\000\000\005\181\005\181\000\000\000\000\000\000\000\000\b>\000\000\000\000\005\181\000\000\000\000\005\181\000\000\006Y\000\000\000\000\005\181\005\181\000\238\000\000\002\190\000\000\000\000\002\130\000\000\000\000\000\000\000\000\002\246\000\000\002\225\002\225\005\181\006Y\002\225\000\000\005\181\000\000\001\210\002\225\000\000\000\000\002\250\000\000\000\000\002\225\005\181\005\181\005\181\002\225\005\181\005\181\000\000\002\254\000\000\000\000\002\225\000\n\000\000\000\000\007\"\0032\001\190\005\181\000\000\000\000\015f\005\181\002\178\002\225\000\000\003:\002\225\002\225\000\000\bz\b~\b\138\005\181\002\225\005v\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\005\177\007f\000\000\005\130\005\134\005\177\002\225\000\000\005\177\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015\162\005\177\000\000\005\177\000\000\005\177\000\000\005\177\000\000\000\000\005\138\b\146\000\000\000\000\000\000\b\170\004r\000\000\000\000\005\177\000\000\002\225\000\000\000\000\000\000\005\177\007\226\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\000\000\000\000\000\000\005\177\005\177\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\177\000\000\ra\ra\005\177\000\000\000\000\ra\000\000\000\000\ra\000\000\000\000\000\000\005\177\005\177\005\177\000\000\005\177\005\177\ra\000\000\ra\000\000\ra\000\000\ra\000\000\000\000\000\000\000\000\005\177\000\000\000\000\000\000\005\177\000\000\000\000\ra\000\000\000\000\000\000\000\000\000\000\ra\ra\005\177\000\000\000\000\000\000\000\000\000\000\000\000\ra\000\000\000\000\ra\000\000\000\000\000\000\000\000\ra\ra\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\ra\000\000\re\re\ra\000\000\000\000\re\000\000\000\000\re\000\000\000\000\000\000\ra\ra\ra\000\000\ra\ra\re\000\000\re\000\000\re\000\000\re\000\000\000\000\000\000\000\000\ra\000\000\000\000\000\000\ra\000\000\000\000\re\000\000\000\000\000\000\000\000\000\000\re\007\226\ra\000\000\000\000\000\000\000\000\000\000\000\000\re\000\000\000\000\re\000\000\000\000\000\000\000\000\re\re\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\re\000\000\005\201\007f\re\000\000\000\000\005\201\000\000\000\000\005\201\000\000\000\000\000\000\re\re\re\000\000\re\re\005\201\000\000\005\201\000\000\005\201\000\000\005\201\000\000\000\000\000\000\000\000\re\000\000\000\000\000\000\re\000\000\000\000\005\201\000\000\000\000\000\000\000\000\000\000\005\201\007\226\re\000\000\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\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\201\000\000\005\205\005\205\005\201\000\000\000\000\005\205\000\000\000\000\005\205\000\000\000\000\000\000\005\201\005\201\005\201\000\000\005\201\005\201\005\205\000\000\005\205\000\000\005\205\000\000\005\205\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\005\201\000\000\000\000\005\205\000\000\000\000\000\000\000\000\000\000\005\205\005\205\005\201\000\000\000\000\000\000\000\000\000\000\000\000\005\205\000\000\000\000\005\205\000\000\000\000\000\000\000\000\005\205\005\205\005\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\205\003V\002\190\000\000\005\205\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\005\205\005\205\005\205\000\000\005\205\005\205\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\005\205\000\000\000\000\000\000\005\205\000\000\000\000\000\000\000\000\003f\000\000\000\000\011\006\001\190\000\000\b\n\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003=\000\000\000\000\005z\000\000\003=\000\000\001\206\003=\000\000\000\000\005\130\005\134\000\000\000\000\011\030\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\000\000\011&\000\000\000\000\0112\000\000\005\138\003=\000\000\000\000\000\000\000\000\004r\003=\000\000\000\000\001M\000\000\000\000\000\000\002\154\001M\003=\000\000\001M\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\001M\000\000\001M\000\000\001M\000\000\001M\000\000\000\000\000\000\000\000\000\000\003=\003=\000\000\000\000\004\154\000\000\001M\000\000\000\000\000\000\000\000\000\000\001M\000\000\003=\003=\001M\000\000\003=\003=\000\000\001M\000\000\000\000\001M\000\000\000\000\000\000\003=\001M\001M\000\238\000\000\001I\000\000\003=\000\000\000\000\001I\001M\003=\001I\000\000\000\000\000\000\001M\003=\000\000\000\000\001M\000\000\001I\000\000\001I\000\000\001I\000\000\001I\000\000\001M\001M\001M\000\000\001M\001M\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001M\000\000\001I\000\000\000\000\000\000\001I\001M\000\000\000\000\000\000\001I\000\000\000\000\001I\000\000\000\000\000\000\001M\001I\001I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001I\001\133\000\000\000\000\000\000\000\000\001\133\000\000\012\177\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\177\000\000\001\133\000\000\001\133\000\000\001\133\001I\001\133\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001I\001\133\012\177\000\000\000\000\000\000\000\000\000\000\012\177\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001\133\001\133\001\133\000\000\000\000\0019\000\000\000\000\000\000\000\000\0019\000\000\000\157\0019\000\000\000\000\001\133\000\000\000\000\000\000\012\177\000\157\000\000\0019\000\000\0019\000\000\0019\000\000\0019\001\133\001\133\001\133\000\000\001\133\001\133\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\0019\000\157\000\000\000\000\001\133\000\000\000\000\000\157\000\000\000\000\000\000\000\000\0019\000\000\000\000\001\133\000\000\0019\0019\0019\000\000\001\213\000\000\000\000\000\000\000\000\001\213\000\000\015\174\001\213\000\000\002\130\000\000\0019\000\000\001\202\001\206\000\157\000\000\001\213\000\000\000\000\000\000\001\213\000\000\001\213\000\000\0019\0019\0019\000\000\0019\0019\000\000\001\210\002\170\001\230\001\213\000\000\000\000\000\000\000\000\000\000\001\213\001\242\000\000\000\000\000\000\0019\015\178\000\000\000\000\001\213\000\000\000\000\001\213\000\000\001\246\002\146\0019\001\213\001\213\002\158\015\190\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\001\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\004:\005\134\001\213\001\213\000\000\000Y\001\213\001\213\000Y\000\000\000\000\000\000\000Y\000Y\000\000\b\165\001\213\000\000\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000\000\001\213\000Y\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000Y\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000Y\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000Y\002\246\000\000\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000Y\007\014\000\000\000Y\000\000\000\000\003Z\000\000\b\165\tB\000\000\000\000\000Y\004e\007f\000Y\000\000\t~\004e\003f\000\000\004e\r\210\001\190\000\000\000\000\000\000\000\000\000Y\002\178\000\000\004e\003\246\000\000\000\000\004e\003\250\004e\004\002\000\000\011\022\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004e\000\000\000\000\000\000\005z\000\000\004e\007\226\000\000\000\000\004e\000\000\005\130\005\134\000\000\004e\000\000\000\000\004e\000\000\000\000\000\000\000\000\004e\002\226\000\238\000\000\000\000\007\145\000\000\000\000\007\145\004e\004e\r\226\000\000\005\138\000\000\000\000\004e\004e\0035\004r\004e\000\000\000\000\0035\007\145\007\145\0035\007\145\007\145\000\000\004e\004e\000\000\000\000\004e\004e\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\004e\000\000\000\000\000\000\007\145\000\000\000\000\004e\000\000\000\000\0035\015\198\025\202\000\000\000\000\000\000\0035\000\000\004e\000\000\000\000\000\000\007\145\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\0035\000\000\000\000\007\145\0035\007\145\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003Z\0035\0035\tB\005\226\0035\0035\007\145\007\145\000\000\000\000\023\142\007\145\003f\007\145\0035\003r\001\190\007\145\000\000\000\000\016&\0035\002\178\000\000\000\000\003\246\0035\000\000\000\000\003\250\000\000\004\002\0035\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\021\254\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024Z\003f\005\138\000\000\011\006\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\011\030\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\150\003f\005\138\000\000\011\006\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005\194\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\000\000\000\000\005z\002\246\000\000\000\000\000\000\000\000\005\198\000\000\005\130\005\134\000\000\001\210\011\030\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\246\003f\005\138\000\000\003r\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\t%\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\t%\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\006\134\000\000\000\000\005\138\002\225\002\225\000\000\003f\002\225\004r\003r\001\190\000\000\002\225\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\000\005v\002\225\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\002\225\000\000\000\000\002\225\002\225\000\000\005\130\005\134\000\000\005\202\002\225\000\000\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\000\000\t%\000\000\002\225\000\000\004r\004M\004M\000\000\000\000\004M\002\225\002\225\000\000\002\225\004M\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\000\000\000\004M\023F\000\000\002\225\023^\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004M\000\000\000\000\004M\004M\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\004M\000\000\000\000\000\238\004M\000\000\004M\004M\000\000\004M\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004M\0035\000\000\000\000\000\000\000\000\000\000\0035\004M\004M\000\000\0035\000\000\0035\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\015\198\000\000\000\000\0035\015\198\0035\004M\000\000\000\000\0035\000\000\000\000\004M\000\000\0035\000\000\000\000\0035\0035\000\000\000\000\0035\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\025\210\000\000\0035\0035\026\002\000\000\0035\0035\012\169\000\000\000\000\000\000\000\000\012\169\000\000\000\000\012\169\000\000\016&\0035\000\000\000\000\016&\0035\0035\000\000\012\169\000\000\0035\000\000\012\169\000\000\012\169\000\000\000\000\000\000\000\000\000\000\005\t\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\012\169\000\000\000\000\003V\002\190\012\169\012\169\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\001\210\000\000\007\014\012\169\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\012\169\012\169\002z\000\000\012\169\012\169\000\000\003f\000\000\000\000\tn\001\190\000\000\000\000\012\169\000\000\000\000\002\178\026\194\000\000\003\246\012\169\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\005a\000\000\012\169\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\005z\000\000\000\000\000\000\000\000\000\000\000\000\005a\005\130\005\134\000\000\005a\000\000\005a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005a\000\000\000\000\000\000\000\000\000\000\005a\005\138\000\000\000\000\000\000\000\000\b>\004r\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005e\000\000\000\000\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\005a\005a\000\000\000\000\005a\000\000\005e\000\000\000\000\000\000\005e\000\000\005e\000\000\005a\005a\000\000\000\000\005a\005a\000\000\000\000\000\000\000\000\005e\000\000\000\000\000\000\000\000\000\000\005e\000\000\0035\000\000\000\000\005a\b>\0035\000\000\005e\0035\000\000\005e\000\000\000\000\000\000\005a\005e\005e\000\238\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\005e\005e\000\000\000\000\005e\0035\015\198\000\000\000\000\000\000\000\000\0035\000\000\000\000\005e\005e\000\000\000\000\005e\005e\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\017\000\000\000\000\000\000\005e\006\017\000\000\000\000\006\017\000\000\000\000\000\000\000\000\0035\000\000\005e\000\000\0035\006\017\000\000\000\000\000\000\006\017\000\000\006\017\000\000\000\000\0035\0035\017\174\000\000\0035\0035\000\000\000\000\000\000\006\017\000\000\000\000\000\000\000\000\000\000\006\017\000\000\000\000\000\000\000\000\016&\0035\000\000\000\000\006\017\000\000\000\000\006\017\000\000\000\000\000\000\000\000\006\017\006\017\000\238\000\000\000\000\000\000\000\000\000\000\025\170\000\000\000\000\000\000\000\000\000\000\003V\002\190\006\017\000\000\002\130\000\000\006\017\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\006\017\006\017\021\138\001\210\006\017\006\017\000\000\000\000\000\000\000\000\003Z\001\202\001\206\000\000\006\017\000\000\000\000\000\000\000\000\000\000\000\000\006\017\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\001\210\001\214\006\017\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\005\238\000\000\000\000\000\000\001\246\002\162\003V\002\190\005z\002\158\002\130\002\178\004\030\004*\000\000\002\246\005\130\005\134\0046\005\202\000\000\000\000\003\254\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\004\217\000\000\005\138\000\000\006\218\000\000\t*\003f\004r\000\000\003r\001\190\000\000\000\000\000\000\000\000\026N\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\006J\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\006\158\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\006j\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\007\165\000\000\000\000\007\165\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\007\165\007\165\003\246\007\165\007\165\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006]\000\000\000\000\005z\007\165\004r\003V\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006]\000\000\000\238\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\005\138\011\210\000\000\000\000\000\000\000\000\004r\003V\002\190\000\000\003f\002\130\000\000\003r\001\190\000\000\002\246\007\165\000\000\007\165\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\007\165\005v\003Z\005\234\007\165\000\000\000\000\000\000\007\165\000\000\007\165\000\000\000\000\005z\007\165\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\011\222\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\005z\002\130\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\011\234\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006\129\000\000\000\000\005z\000\000\004r\000\000\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006\129\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\000\000\000\000\000\000\000\000\005\138\000\000\000\000\000\000\000\000\002\254\004r\000\000\000\000\000\000\000\000\000\000\000\000\0032\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\000\000\000\000\005v\000\000\000\000\000\000\007\t\007f\000\000\000\000\000\000\007\t\000\000\000\000\007\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\007\t\000\000\000\000\000\000\007\t\000\000\007\t\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\007\t\000\000\000\000\000\000\005\138\b\146\007\t\007\226\001\181\b\170\004r\000\000\001\181\000\000\001\181\007\t\000\000\000\000\007\t\000\000\000\000\000\000\000\000\007\t\007\t\000\238\001\181\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\000\000\000\000\000\000\007\t\000\000\001\181\000\000\007\t\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\007\t\007\t\000\000\000\000\007\t\007\t\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\217\001\181\000\000\000\000\000\000\001\217\007\t\000\000\001\217\000\000\000\000\001\181\001\181\000\000\000\000\001\181\001\181\000\000\001\217\000\000\000\000\017\186\001\217\000\000\001\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\001\217\001\181\000\000\000\000\000\000\000\000\001\217\000\000\000\000\006\021\000\000\000\000\000\000\000\000\006\021\001\217\000\000\006\021\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\021\000\000\000\000\000\000\006\021\000\000\006\021\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\021\000\000\000\000\000\000\000\000\000\000\006\021\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\021\000\000\000\000\006\021\000\000\000\000\000\000\001\217\006\021\006\021\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\021f\000\000\000\000\000\000\000\000\006\021\001\217\012\169\000\000\006\021\000\000\000\000\012\169\000\000\000\000\012\169\000\000\000\000\000\000\006\021\006\021\000\000\000\000\006\021\006\021\012\169\000\000\000\000\000\000\012\169\000\000\012\169\000\000\006\021\000\000\000\000\000\000\005\t\000\000\000\000\006\021\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\012\169\000\000\006\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\012\169\012\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012a\000\000\002\190\012a\000\000\028N\000\000\012\169\000\000\000\000\028R\000\000\000\000\012a\000\000\000\000\000\000\000\000\000\000\012a\000\000\012\169\012\169\002z\000\000\012\169\012\169\000\000\000\000\000\000\000\000\012a\000\000\004e\000\000\012\169\000\000\012a\004e\026\250\000\000\004e\012\169\001\002\001\190\000\000\012a\000\000\000\000\012a\000\000\004e\000\000\012\169\012a\004e\000\000\004e\000\000\000\000\004e\000\000\028V\004e\000\000\000\000\000\000\000\000\000\000\004e\012a\000\000\000\000\004e\012a\004e\000\000\004e\000\000\004e\000\000\000\000\000\000\028Z\012a\012a\000\000\004e\012a\000\000\000\000\004e\004e\002\226\000\000\000\000\000\000\004e\bE\bE\000\000\000\000\bE\b>\000\000\012a\004e\bE\004e\004e\000\000\000\000\000\000\016V\004e\002\226\000\238\bE\000\000\000\000\000\000\000\000\004e\004e\bE\000\000\004e\004e\000\000\000\000\004e\000\000\007\246\000\000\004e\000\000\000\000\bE\000\000\000\000\bE\bE\000\000\004e\004e\004e\000\000\bE\004e\004e\bE\000\000\000\000\000\000\bE\000\000\bE\bE\007\146\bE\000\000\000\000\000\000\000\000\001q\004e\000\000\000\000\000\000\001q\000\000\bE\001q\000\000\000\000\000\000\004e\000\000\000\000\bE\bE\000\000\001q\000\000\001q\000\000\001q\000\000\001q\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\237\000\000\001q\000\000\000\000\bE\000\000\000\000\001q\000\000\000\237\bE\000\000\000\000\000\237\000\000\000\237\000\000\000\000\000\000\001q\000\000\000\000\000\000\000\000\001q\001q\000\238\000\237\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\237\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\237\000\238\000\000\001q\001q\001q\000\000\001q\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\241\000\237\000\000\000\000\000\000\000\241\001q\000\000\000\241\000\000\000\000\000\237\000\237\000\000\000\000\000\237\000\237\001q\000\241\000\000\000\000\000\000\000\241\000\000\000\241\000\000\007\005\000\000\000\000\000\000\000\000\007\005\000\237\000\000\007\005\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\007\005\000\000\000\000\000\000\007\005\000\000\007\005\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\007\005\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\007\005\000\000\000\241\007\005\000\000\000\000\000\000\000\000\007\005\007\005\000\000\000\000\000\241\000\241\000\000\000\000\000\241\000\241\000\000\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\000\000\007\005\0116\000\000\000\000\000\000\000\241\000\000\001\202\001\206\011j\007\005\007\005\016\238\000\000\007\005\007\005\000\241\006\t\000\000\000\000\000\000\000\000\006\t\000\000\000\000\006\t\001\210\002\170\001\230\000\000\000\000\007\005\017\142\000\000\000\000\006\t\001\242\000\000\000\000\006\t\000\000\006\t\000\000\005m\007f\000\000\000\000\000\000\005m\001\246\002\146\005m\000\000\006\t\002\158\000\000\002\178\004\030\004*\006\t\000\000\005m\000\000\0046\000\000\005m\000\000\005m\006\t\000\000\000\000\006\t\000\000\000\000\000\000\000\000\006\t\006\t\000\000\005m\004:\000\000\000\000\000\000\000\000\005m\007\226\000\000\000\000\000\000\000\000\000\000\006\t\000\000\000\000\000\000\006\t\005m\000\000\000\000\000\000\000\000\005m\005m\000\238\000\000\006\t\006\t\000\000\000\000\006\t\006\t\000\000\000\000\000\000\000\000\012\017\000\000\005m\000\000\000\000\012\017\000\000\000\000\012\017\000\000\000\000\006\t\000\000\000\000\000\000\000\000\005m\005m\012\017\000\000\005m\005m\012\017\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\017\005m\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002~\012\017\000\000\002\130\012\017\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\012\017\n\022\000\000\001\242\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\017\012\017\002\138\002\146\012\017\012\017\000\000\002\158\000\000\002\178\004\030\004*\004=\000\000\000\000\000\000\021>\004=\026\166\0045\004=\012\017\000\000\000\000\0045\000\000\000\000\0045\000\000\000\000\004=\000\000\n\250\004:\004=\000\000\004=\0045\000\000\000\000\000\000\0045\005\134\0045\000\000\000\000\000\000\000\000\004=\000\000\000\000\000\000\026\178\000\000\004=\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\004=\000\000\000\000\004=\000\000\000\000\021R\0045\004=\000\000\0045\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004=\000\000\000\000\000\000\004=\004U\000\000\0045\000\000\000\000\004U\0045\004%\004U\004=\004=\000\000\004%\004=\004=\004%\0045\0045\004U\000\000\0045\0045\004U\000\000\004U\004%\000\000\000\000\000\000\004%\004=\004%\000\000\000\000\000\000\000\000\004U\0045\000\000\000\000\000\000\017\022\004U\004%\000\000\000\000\000\000\000\000\020\030\004%\000\000\004U\000\000\000\000\004U\000\000\000\000\000\000\004%\004U\000\000\004%\000\000\000\000\000\000\000\000\004%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004U\000\000\000\000\011*\004U\000\000\000\000\004%\000\000\001\202\001\206\004%\000\000\000\000\004U\004U\000\000\000\000\004U\004U\000\000\004%\004%\002\142\000\000\004%\004%\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004U\000\000\000\000\001\242\000\000\000\000\000\000\004%\000\000\000\000\001\250\021\002\006\221\006\221\000\000\000\000\001\246\002\146\024z\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\004.\000\000\0046\006\221\006\221\006\221\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\221\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\000\000\006\221\006\221\000\000\000\000\000\000\006\221\000\000\006\221\006\221\006\221\000\000\004E\000\000\000\000\006\221\000\000\004E\000\000\004-\004E\000\000\000\000\015\182\004-\000\000\000\000\004-\000\000\000\000\004E\000\000\006\221\000\000\004E\000\000\004E\004-\000\000\000\000\000\000\004-\000\000\004-\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004-\000\000\004]\000\000\000\000\000\000\004-\004]\000\000\000\000\004]\004E\000\000\004\"\000\000\006\221\004E\000\000\004-\000\000\004]\000\000\000\000\004-\004]\000\000\004]\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004]\004-\000\000\000\000\000\000\000\000\004]\000\000\004E\004E\000\000\000\000\004E\004E\000\000\004-\004-\000\000\004]\004-\004-\000\000\000\000\004]\0116\000\000\000\000\000\000\000\000\004E\001\202\001\206\000\000\000\000\000\000\000\000\004-\000\000\000\000\004]\018Z\000\000\000\000\000\000\000\000\000\000\003\254\020\170\000\000\001\210\001\214\001\230\000\000\004]\004]\000\000\000\000\004]\004]\001\242\004y\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\001\246\002\146\004]\000\000\000\000\002\158\003\178\002\178\004\030\004*\004y\000\000\003\182\021*\0046\007}\000\000\000\000\007}\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\004:\000\000\000\000\007}\007}\000\000\007}\007}\024\166\000\000\000\000\017>\000\000\000\000\000\000\000\000\017V\000\000\000\000\000\000\007\169\000\000\000\000\007\169\000\000\000\000\000\000\007}\000\000\000\000\000\000\000\000\017^\000\000\000\000\000\000\004n\000\000\004r\007\169\007\169\000\000\007\169\007\169\000\000\007}\017r\017\158\000\000\000\000\004y\004y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\169\000\000\007\153\000\000\021\230\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007}\000\000\007}\000\000\000\000\000\000\000\238\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007}\000\000\000\000\005\234\007}\000\000\006\217\006\217\007}\000\000\007}\000\000\000\000\000\000\007}\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007\169\000\000\007\169\006\217\006\217\006\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\217\007\169\000\238\000\000\005\234\007\169\000\000\000\000\000\000\007\169\000\000\007\169\000\000\006\217\006\217\007\169\ri\ri\006\217\000\000\006\217\006\217\006\217\000\000\000\000\000\000\000\000\006\217\000\000\000\000\000\000\000\000\007\153\000\000\007\153\ri\ri\ri\007z\000\000\000\000\000\000\000\000\000\000\006\217\ri\006F\000\000\000\000\005\234\007\153\000\000\000\000\000\000\007\153\000\000\007\153\000\000\ri\ri\007\153\000\000\000\000\ri\000\000\ri\ri\ri\000\000\000\000\000\000\000\000\ri\001\202\001\206\022\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\022\250\004\230\000\000\ri\000\000\000\000\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\001\246\002\146\001\202\001\206\000\000\002\158\000\000\002\178\004\030\004*\000\000\001\246\002\146\000\000\0046\000\000\002\158\000\000\002\178\004\030\004*\001\210\001\214\000\000\000\000\0046\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\004:\000\000\001\246\002\162\000\000\000\000\004\153\002\158\000\000\002\178\004\030\004*\003\182\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\000\000\000\000\004:\000\000\000\000\004\221\000\000\000\000\024\166\000\000\000\000\017>\000\000\000\000\000\000\000\000\017V\000\000\000\000\000\000\000\000\026N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017r\017\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\230"))
+ ((16, "C\170R\004Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021HFf\000\000\000\000\020XFfC\170\020\182\000-\000[]\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\238\001\208\001d\000\000\002t\001\188\000\000\003\214\003$\007\140\000\000\005\244\003\132\b\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\003\190l*\000\000\000\000\000\000\005.\000\000\000\000R\232\004\196\006&\000\000\000\000V&\005.\000\000J\014\020X\021\178^T\020Xh:R\004\020XN`\000\000\005\144\000\000Dp\006\136\000\000C\146\000\000\027\158\000\000\000\000\003\224\000\000\005.\000\000\000\000\000\000\005\\\000\000C\146\000\000\006&|4`\020f\150\000\000\1340\136\022\000\000Mra\190\000\000Zr\026\206l*FfC\170\000\000\000\000R\004\020XTBDp\006\214x\"\000\000\130\142FfC\170R\004\020X\000\000\000\000\016xQ\254\020XG\030Y\222\000\000\001\026\000\000\000\000\004\250\000\000\000\000I\182\001\026\024\138\005\200\tR\000\000\000\000\002\026\000\000\021\178\007X\007\136\020X\028\254\020XC\170C\170\000\000\000\000\000\000R\012Q\182\020X\028\254A\248\020X\000\000\023\022\bZ\007\012\000\000\000\220\007\030\000\000\000\000\000\000\000\000\000\000\020X\000\000\000\000\000\000R\004\020X\000\000A\206x\168C\170\000\248\000\000Y\222{\230|\206\000\000\007\012\000\000\005J\000\000\000\000C,V&\136b\000\000jb\136b\000\000jbjb\000b\006\n\0008\000\000\020\190\000\000\b\004\000\000\000\000\b\004\000\000\000\000\000\000jb\005.\000\000\000\000X\244V&V\154a\190\000\000\000\000OL\000b\000\000\000\000a\190\n\236V&\000\000PBa\190Q8\000\000\000\000\000\000\003b\000\000jb\000\000\001\000m\"\000\000V&\005\216V&\000\000\022\\\011p\005.\000\000\000\000\023\224\000\000\006\208\000\000[\150\006\230\000\000\n\204jb\007\222\000\000\t\206\000\000\t\184\000\000\000\000\006\168\000\000\000\000\000\000\021 4Y\222Q\240\020XY\222\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\\\027v\000\000\000\000\000\000\001\244&\174u\242\000\000\000\000Q\240\020XY\222\000\000\000\000\138(Y\222\138p|\206\000\000\138\202\000\000Y\222\000\000\000\000Z\202I\182\001\154\001\154\000\000\012tY\222\000\000\000\000\000\000\004\250\014\014\000\000A\012\000\000\000\000}\022\000\000\139\012jb\000\000\004R\000\000\000\000}\162\000\000\139f\n\242\000\000\000\000\000\000\000\000\014\152\000\000\022\168\000\000\000\000}\162\000\000\005\220\000\000\000\000DHv~\000\000\000\000Bn\023|\019\252\023\174\000\000\000\000\000\000\000\000\002>\000\000\000\000\\`\t\192\014x\000\017V&\000\226\014\196\000\000\000\000\n\184\014x\003x\000\000R\004R\144Q\182\020X\028\254\000-\000\018\011\154\000\000\014x\021\178\021\178\000-\000\018\000\018\021\178\000\000k`\nXDp\007\012\011\020\139\156\000\000V&g6V&`\244g\214V&\003\202V&hp\000\000\012\002\b\022\0124\021\178l\000\000\000\b*\bL^v\000\000\000\000\000\000\000\000\021\178lX\021\178l\248\020d\0008a\148\007\030\0008a\236\000\000mP\nX\000\000\000\000\000\000\002\152\000\000\000\000\006x\000\000\tb\028\254\000\000_4A\248\000\000\031\138\000\000\000\000\021\178\003\144\000\000\000\000\000\000\000\000]\024\000\000\001\248\000\000Wf\n\024\0032\000\000\0226R\144R\004\020XH<R\004\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000S\172T`Up\020X\028\254\007h\021\178\000\000\007p\000\000U\020U\200}\234G\nV&\006`\000\000R\004\020X\000\000Q\240\020X{\230Y\222N6\000\000R\004\020Xy*\001\b\000\000Y\222DHV&\002\210\003x\015N\000\000\000\000\000\000J\162\001\154\015zr\028\000\000Q\240\020XY\222\025R\000\000R\004\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\r4\015V\000*\137\170\000\000\028\018\139\246\000\000\026\"V&\029\220\015\192\000\000\000\000\015\196\000\000\016x\003\224\015\214\000\000'\166\000\000\007:\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\004\230\000\000\000\000\027\014\000\000\028\006\000\000\028\254\000\000\018h\024&\000\000\000\000\000\000Ff\000\000\000\000\000\000\000\000\029\246\000\000\030\238\000\000\031\230\000\000 \222\000\000!\214\000\000\"\206\000\000#\198\000\000$\190\000\000%\182\000\000&\174\000\000'\166\000\000(\158\000\000)\150\000\000*\142\000\000+\134\000\000,~\000\000-v\000\000.n\000\000/f\000\0000^\020XY\222GPK\142\001\154\016\"n\004Y\222\000\000\000\000\000\000\015\236\000\000\000\000\000\000\000\000n\004\000\000\000\000l*\001\154\015\230V&\006p\000\000\000\000\b\246\005.\000\000V&\bP\000\000\000\000\015\250\000\000\000\000\000\000G\"V&\b\162\000\000\000\000\030*\000\000\000\000~v\000\000\031\"~\190\000\000 \026\127J\000\000!\018\012\226\000\000\000\000\000\000\000\000\"\nY\222#\002\000\000rjrj\000\000\000\000\000\0001V\000\000\t\166\000\000\000\000\000\000\b2\000\000\000\000\000\220\023\248\000\000\n\156\000\000\000\000_\214H<\000\000\000\000\t\232\000\000\000\000\000\000\r\172\000\000\000\000\000\000\016x\004\216\024\232\000\000\011\148\000\000\005\208\000\0002N\000\000\n\176\000\000\006\200\000\0003F\000\000\014\002\000\000\007\192\000\0004>(\158\000\000\011\172\b\184\000\00056\000\000\n\202\t\176\000\0006.\000\000\014\164\n\168\000\0007&\004J\025\016\000\000\012\164\011\160\000\0008\030\000\000\n\224\012\152\000\0009\022\000\000\014\250\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\r\156\000\000\000\000\012\186\000\000\000\000\015X\000\000\n:\000\000\000\000\000\000\016\016\000\000\0162\000\000\000\000Lz\001\154\016\246r\028a\190\000b\000\000\000\000r\028\000\000\000\000\000\000r\028\000\000\016\236\000\000\000\000\000\000\000\000\000\000\000\000;\254Y\222\000\000\000\000\017.\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\005\134\000\000\000\000Y\222\000\000\000\000y\164\015L\000\000\000\000H\240\000\000\007\248\000\000\000\000X*\000\000\r\178\000\000\000\000\005@\011\254\000\000\000\000\0226\022\028\007\012\000\000A\214\000\000!,\023\176\021\220\000\000\000\000\015\156\000\000\000\000\001\238\025\030X\192\000\000\025\030\000\000\011\238\000\000\000\000\015\242\000\000\000\000i\018\t\002\005@\000\000\000\000\012\246\000\000\000\000\r\200\000\000\000\000\000\000\020X\028\254\003\202\000\000\000\000\023&\005\200\tR\004\128\028\254z2\021\178\020X\028\254z\138\016\206\000\000\000\000\004\128\000\000I\248\019\248\021\204\000\000\t*\017P\000\000\017P\000Va\190\000\244\000\000\017*\016\184l*\011\164V&\030\128\020F\r\018\003\b\000\000\031x\017l\000\000\000\244\000\000\000\000\017\136a\190b\140\000\000idg$\r\028a\190\017da\190n\156c,\017ha\190o\026c\204\001\024\017*\000\000\000\000\000\000\020X\130\216\000\000Y\222rj\000\000\000\000\017\166\000\000\000\000\000\000>\230\000\000\014\170\000\000\000\000\000\000Up\020X\028\254\003\202\000\000F\138\000\000\bh\000\000\000*\000\000\000\000\017\172\000\000\017\214{\230?\222j\016\000\000\000\000IZ\000\000\t`\000\000N\150\000\000\020X\000\000\021\178\nX\000\000\130\142\000\000\020X\028\254\130\142\000\000\025D\023\022\bZ\005.\132\202\021\178\127\144rj\000\000\005\200\tR\tR\004\128rj\134\164\005\200\tR\004\128rj\134\164\000\000\000\000\004\128rj\000\000FfC\170Y\222\027B\000\000\000\000FfC\170Q\182\020X\028\254\130\142\000\000\020\182\000-\000[\017\bl*\r(V&s\004\017<\017\236\133H\000\000rj\000\000s\128I\248\019\248\021\204{\b\023\228\tZ\128\012\014:\0178\020Xrj\000\000\020Xrj\000\000jbh:\019\134\003\214\005\200\0008P\012\000\000\005\200\0008P\012\000\000\0274\023\022\bZ\005.Q\002\021\178\130b\000\000\005\200\nJ\0212\005\236\000\000P\012\000\000\tR\017<\021\178\131\030\136\216\005\200\tR\017>\021\178\131\030\136\216\000\000\000\000\b`\000\000\135\158\000\000\021\178\133\160P\012\000\000\b`\000\000J\014\020X\021\178\130b\000\000I\248\019\248\021\204s\252B\138\026\222\019\170\002\142\000\000\014ZC\146\000\017\000\000\017\184\017f\024\196\020XV\206V&\015\n\000\000Y\172\n\254\007\188\011\246\000\000\011\234\000\000\017\198\017ZV&PJ\000\000\0032\002\228\014\192\000\000\r\000\000\000\017\216\017fl*PJ\000\000\020X\024\196\018\020\011\028\005\200\000\000\015\184\024\196V&\012\208\000b\000\000V&\004\018\004\176\000\000\000\000ot\000\000\000\000\015\212\024\196o\242PJ\000\000\020XV&\r\218V&MzPJ\000\000\0154\000\000\000\000PJ\000\000\000\000Y\172\000\000rj\134\178\019\170\002\142\014Z\017\252\017\182\024\196rj\134\178\000\000\000\000\019\170\002\142\014Z\018\012\017\150O\030Mha\190\018\030O\030jb\020\184\018$O\030a\190\018.O\030p\146q\018\000\000\131\156\000\000\000\000rj\136\230\019\170\002\142\014Z\018(\017\184O\030rj\136\230\000\000\000\000\000\000h:\000\000\000\000\000\000\000\000\000\000\000\000\000\000P\012\000\000\135D\020XDp\018:x\"\000\000\130\142\135D\000\000\000\000\1372\020XDp\018>\017\220`\020\137\170\000\244\018\136\000\000\000\000q\144s\252\020X\000\000\128d\021\204\000\000\000\000\130\142\1372\000\000\000\000\000\000{`D\228F\134\000\244\018\140\000\000\000\000\000\000s\252\020X\000\000\000\244\018\152\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\028B\138\019\170\002\142\014Z\018jtl\023\204\020XG\030\\.\020(\003\b\000\244\018n\n\152\000\000\000\000\018\"\000\000\000\000b\186\000\000\t\172\014\222\000\000\r\248\000\000\018x\018\016V&Xr\018\160\011l\000\000\000\000\018R\000\000\000\000\020F\0032\015|\000\000\018\172t\238\140B\001\154\018JV&\015\024\000\000\000\000\018\\\000\000\000\000\000\000b\186\000\000\0068\015\202\000\000\015&\000\000\018\178\018Fl*\000\000\018\202up\140t\001\154\018lV&\015\202\000\000\000\000\018\130\000\000\000\000\000\000\020X\000\000b\186\000\000\020z\020X\023\204\023\204v\198Ff\020X\130\216Y\222\021\162\000\000\012V\005\200\000\000\015\252\023\204V&\015\184\007\012\000\000\020XY\222tl\023\204\015\146\023\204\000\000D\142Et\000\000d&\000\000\000\000d\194\000\000\000\000e^\000\000\016R\023\204e\250\130\216Y\222\021\162\000\000\000\"\000\000\000\000O\030\015\170\000\000\000\000Wf\018\242\000\000b\186\000\000\023\204Wfb\186\000\000\020XV&b\186\000\000\016\026\000\000\000\000b\186\000\000\000\000\\.\000\000\131\244O\030\018\160\023\204\132rtl\000\000rj\135R\019\170\002\142\014Z\019\002tlrj\135R\000\000\000\000\000\000\137\242Q\240\000\000\000\000\000\000\000\000\000\000\000\000\133\218rj\000\000\135D\000\000\000\000\000\000\000\000rj\137\242\000\000\019:\000\000\000\000\133\218\019<\000\000rj\137\242\000\000\000\000\016\198\000\000\000\000k\b\004\136\000\000\000\000B\158\000\000V&\016\234\000\000\\.\016\232\000\000\000\000\019j{\230\000\000@\214\019F\000\000\000\000\019@\026R\028B\021\204wN\023\228\020X\000\000rj\000\000\000\000\000\000\000\000\000\000\000\000\000\000wb\023\228\020X\000\000\014*x\"\000\000\130\142\000\000\019F\026R\028Brj\000\000\019^\000\000\004\206\t\166\020X\140\146\000\000\000\000\028\190\140\234\000\000\000\000\018\244\000\000\019TV&\000\000\016\162\007\206\000b\000\000\000\000V&\r@\014\020\000\000V&\0148\000\244\019\128\000\000\000\000\128\254\000\000\000\000`\020\000\000\130\142\000\000\019\130\026R\029:P\012\000\000\000\000\000\000\000\000\016\026\129\152`\020\000\000\130\142\000\000\019\136\026R\029:P\012\000\000\017$\000\000\000\000\012H\000\000rj\000\000\019\164\000\000\000\000\019\006\000\000\019\026\000\000\019@\000\000\000\000R\214\019^\000\000\000\000%\182]\188\019\250\000\000\000\000\000\000\012T\012,`\\\020$\000\000\000\000\000\000\000\000\000\000\000\000\019\190\000\000\023\228\000\000\019\218\000\000V&\000\000\016f\000\000\000\000\019\224\000\000\000\000\0008\000\000\b\170\000\000\000\000\000\000\016v\000\000\028\254\000\000\r\218\000\000\021\178\000\000\0040\000\000\b\022\000\000\019\226\000\000Y\222\022\168\000\000\000\000\r$\0200\000\000\000\000\020&\014\028H<\005.\130\022\000\000\000\000\000\000\000\000\000\000[b\000\000\000\000\020\214\000\000n\004\000\000\016\254\020\254\000\000\021\004\000\000H\240H\240]R]R\000\000\000\000rj]R\000\000\000\000\000\000rj]R\020\130\000\000\020\164\000\000"), (16, "\tQ\tQ\000\006\001\002\001\190\tQ\002\186\002\190\tQ\002\234\002\138\tQ\003\153\tQ\019j\002\246\tQ\024^\tQ\tQ\tQ\016\226\tQ\tQ\tQ\001\210\004Y\004Y\004F\002\250\tQ\003r\003v\nz\tQ\001\206\tQ\024b\002\254\000\238\003\150\016\230\tQ\tQ\003\202\003\206\tQ\003\210\003\222\003\234\003\242\007\030\007Z\tQ\tQ\002\178\001\206\007:\003\230\tQ\tQ\tQ\bz\b~\b\138\b\158\001*\005v\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\tQ\t\018\000\238\tQ\015\214\tQ\tQ\003\153\t\030\t6\t\130\005\130\005\134\tQ\tQ\tQ\r\250\tQ\tQ\tQ\tQ\002r\002\162\014*\tQ\006\250\tQ\tQ\0035\tQ\tQ\tQ\tQ\tQ\tQ\005\138\b\146\tQ\tQ\tQ\b\170\004r\t\150\0035\tQ\tQ\tQ\tQ\r)\r)\024f\t\202\004\154\r)\t\214\r)\r)\003\157\r)\r)\r)\r)\tF\r)\r)\006\165\r)\r)\r)\003\145\r)\r)\r)\r)\004Y\r)\0166\r)\r)\r)\r)\r)\r)\r)\r)\006\165\r)\015\222\r)\004\226\r)\r)\r)\r)\r)\005\237\r)\r)\000\238\r)\003\238\r)\r)\r)\tJ\tf\r)\r)\r)\r)\r)\r)\r)\000\238\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\000\238\r)\r)\003\157\r)\r)\012b\003\022\003\170\004Y\r)\r)\r)\r)\r)\004Y\r)\r)\r)\r)\r)\006q\r)\r)\006\r\r)\r)\003\026\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\r)\006q\004Y\r)\r)\r)\r)\001\189\001\189\001\189\001f\003q\001\189\006\018\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001v\001\189\001j\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\006\226\001\189\003J\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\b>\001\189\001\189\001\189\006\r\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\000\238\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\bv\001\189\001\189\019Z\b\030\007f\001r\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\015\006\b\194\001\189\005\186\001\189\001\189\b\"\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\189\001\182\001\189\001\189\001\189\001\189\001\189\n\145\n\145\019\198\007\226\rM\n\145\003N\n\145\n\145\004\021\n\145\n\145\n\145\n\145\001\186\n\145\n\145\rM\n\145\n\145\n\145\000\238\n\145\n\145\n\145\n\145\019\206\n\145\006\230\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\007\t\n\145\004Y\n\145\004Y\n\145\n\145\n\145\n\145\n\145\bE\n\145\n\145\000\238\n\145\001\130\n\145\n\145\n\145\007\t\004Y\n\145\n\145\n\145\n\145\n\145\n\145\n\145\004Y\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\000\238\n\145\n\145\004\021\n\145\n\145\004\210\bZ\007f\004Y\n\145\n\145\n\145\n\145\n\145\007!\n\145\n\145\n\145\n\145\t\174\000\238\n\014\n\145\001\146\n\145\n\145\b^\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\n\145\007\t\n\145\n\145\n\145\n\145\n\145\003\185\003\185\002\225\007\226\b\134\003\185\002V\003\185\003\185\016\202\003\185\003\185\003\185\003\185\001f\003\185\003\185\003q\003\185\003\185\003\185\000\238\003\185\003\185\003\185\003\185\002Z\003\185\000\n\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\b>\003\185\007\026\003\185\007f\003\185\003\185\003\185\003\185\003\185\b\233\003\185\003\185\000\238\003\185\004\214\003\185\003\185\003\185\002\225\006^\003\185\003\185\003\185\003\185\003\185\003\185\003\185\015n\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\006b\t\166\n\006\007\154\003\185\003\185\007\226\025\158\007f\000\238\003\185\003\185\003\185\003\185\003\185\001\198\003\185\003\185\003\185\003\185\t\174\016\206\n\014\003\185\000\238\003\185\003\185\025\162\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\003\185\000\238\003\185\003\185\003\185\003\185\003\185\003\169\003\169\b\229\007\226\007:\003\169\b\233\003\169\003\169\028O\003\169\003\169\003\169\003\169\004Y\003\169\003\169\006\177\003\169\003\169\003\169\000\238\003\169\003\169\003\169\003\169\r>\003\169\003\170\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\006\177\003\169\001\234\003\169\000\238\003\169\003\169\003\169\003\169\003\169\015\134\003\169\003\169\001\218\003\169\t-\003\169\003\169\003\169\000\238\004\014\003\169\003\169\003\169\003\169\003\169\003\169\003\169\015\142\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\004Y\t\166\n\006\004\018\003\169\003\169\nF\003\"\b\229\002n\003\169\003\169\003\169\003\169\003\169\001\222\003\169\003\169\003\169\003\169\t\174\012\237\n\014\003\169\b\130\003\169\003\169\003&\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\012\237\003\169\003\169\003\169\003\169\003\169\t\249\t\249\004Y\004Y\011*\t\249\006\166\t\249\t\249\t-\t\249\t\249\t\249\t\249\018\190\t\249\t\249\004Y\t\249\t\249\t\249\001\206\t\249\t\249\t\249\t\249\004Y\t\249\006\170\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\001f\t\249\014n\t\249\003q\t\249\t\249\t\249\t\249\t\249\002r\t\249\t\249\001\206\t\249\012\194\t\249\t\249\t\249\023B\000\238\t\249\t\249\t\249\t\249\t\249\t\249\t\249\000\238\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\004B\t\249\t\249\023J\t\249\t\249\014v\002.\007f\004Y\t\249\t\249\t\249\t\249\t\249\002~\t\249\t\249\t\249\t\249\t\249\012\241\t\249\t\249\b=\t\249\t\249\b*\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\012\241\004Y\t\249\t\249\t\249\t\249\n\t\n\t\004\242\007\226\004^\n\t\005R\n\t\n\t\000\238\n\t\n\t\n\t\n\t\001\206\n\t\n\t\000\238\n\t\n\t\n\t\000\238\n\t\n\t\n\t\n\t\t\025\n\t\001\238\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\005&\n\t\t\014\n\t\002\190\n\t\n\t\n\t\n\t\n\t\011\138\n\t\n\t\003\174\n\t\012\218\n\t\n\t\n\t\002\214\n\026\n\t\n\t\n\t\n\t\n\t\n\t\n\t\000\238\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\030\n\t\n\t\003V\n\t\n\t\003\162\002:\007f\t\025\n\t\n\t\n\t\n\t\n\t\003\178\n\t\n\t\n\t\n\t\n\t\006y\n\t\n\t\004r\n\t\n\t\b\242\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\006y\t\025\n\t\n\t\n\t\n\t\n\001\n\001\019\154\007\226\b>\n\001\t\021\n\001\n\001\003Z\n\001\n\001\n\001\n\001\001\206\n\001\n\001\000\238\n\001\n\001\n\001\000\238\n\001\n\001\n\001\n\001\001\134\n\001\014\158\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\0056\n\001\019\162\n\001\004V\n\001\n\001\n\001\n\001\n\001\005\245\n\001\n\001\002\014\n\001\012\242\n\001\n\001\n\001\002\162\012V\n\001\n\001\n\001\n\001\n\001\n\001\n\001\b\230\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\007\198\n\001\n\001\012Z\n\001\n\001\004b\004Y\007f\026\170\n\001\n\001\n\001\n\001\n\001\001\222\n\001\n\001\n\001\n\001\n\001\006\129\n\001\n\001\004B\n\001\n\001\016\218\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\006\129\001\222\n\001\n\001\n\001\n\001\t\237\t\237\004Y\007\226\007:\t\237\004\214\t\237\t\237\000\238\t\237\t\237\t\237\t\237\000\238\t\237\t\237\014\162\t\237\t\237\t\237\000\238\t\237\t\237\t\237\t\237\001\150\t\237\007\194\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t)\t\237\011\166\t\237\004B\t\237\t\237\t\237\t\237\t\237\019\002\t\237\t\237\000\238\t\237\r\n\t\237\t\237\t\237\015:\011\150\t\237\t\237\t\237\t\237\t\237\t\237\t\237\019\014\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\002\150\t\237\t\237\011\202\t\237\t\237\003>\003B\007f\028\031\t\237\t\237\t\237\t\237\t\237\004R\t\237\t\237\t\237\t\237\t\237\017z\t\237\t\237\002\150\t\237\t\237\017\022\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\t)\012F\t\237\t\237\t\237\t\237\t\245\t\245\022\182\007\226\b2\t\245\011\158\t\245\t\245\007:\t\245\t\245\t\245\t\245\026n\t\245\t\245\012J\t\245\t\245\t\245\000\238\t\245\t\245\t\245\t\245\005F\t\245\012\138\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\005>\t\245\022\190\t\245\015\198\t\245\t\245\t\245\t\245\t\245\005\237\t\245\t\245\012\142\t\245\r\030\t\245\t\245\t\245\006\242\007\n\t\245\t\245\t\245\t\245\t\245\t\245\t\245\0062\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004\237\t\245\t\245\r\194\t\245\t\245\003>\018\182\007f\005J\t\245\t\245\t\245\t\245\t\245\007j\t\245\t\245\t\245\t\245\t\245\018\202\t\245\t\245\b\130\t\245\t\245\0172\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\012n\004\214\t\245\t\245\t\245\t\245\t\241\t\241\007\166\007\226\012\210\t\241\004\214\t\241\t\241\015B\t\241\t\241\t\241\t\241\012r\t\241\t\241\012F\t\241\t\241\t\241\000\238\t\241\t\241\t\241\t\241\012\214\t\241\012\138\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\006v\t\241\r\026\t\241\r\198\t\241\t\241\t\241\t\241\t\241\004Y\t\241\t\241\r^\t\241\r2\t\241\t\241\t\241\007\018\016\154\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004Y\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004\174\t\241\t\241\b\025\t\241\t\241\022\150\004Y\001\002\001\190\t\241\t\241\t\241\t\241\t\241\004Y\t\241\t\241\t\241\t\241\t\241\t\202\t\241\t\241\t\214\t\241\t\241\000\238\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\012\186\000\238\t\241\t\241\t\241\t\241\t\253\t\253\005\002\003>\003B\t\253\n\026\t\253\t\253\005.\t\253\t\253\t\253\t\253\012\190\t\253\t\253\007>\t\253\t\253\t\253\007v\t\253\t\253\t\253\t\253\r\006\t\253\011\150\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\007~\t\253\015\030\t\253\019\166\t\253\t\253\t\253\t\253\t\253\014\194\t\253\t\253\019\250\t\253\rN\t\253\t\253\t\253\002\190\007\170\t\253\t\253\t\253\t\253\t\253\t\253\t\253\022\222\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\007\198\t\253\t\253\t\202\t\253\t\253\t\214\019\158\007f\005\249\t\253\t\253\t\253\t\253\t\253\005\253\t\253\t\253\t\253\t\253\t\253\004Y\t\253\t\253\015\242\t\253\t\253\027V\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\t\253\027\186\001\222\t\253\t\253\t\253\t\253\n\r\n\r\006\030\007\226\014\198\n\r\012n\n\r\n\r\015\"\n\r\n\r\n\r\n\r\004B\n\r\n\r\012\210\n\r\n\r\n\r\000\238\n\r\n\r\n\r\n\r\rJ\n\r\000\238\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\012\006\n\r\r\174\n\r\007\178\n\r\n\r\n\r\n\r\n\r\015J\n\r\n\r\020\018\n\r\rb\n\r\n\r\n\r\019\210\007\218\n\r\n\r\n\r\n\r\n\r\n\r\n\r\027\182\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\002\190\n\r\n\r\016\002\n\r\n\r\023\214\003\133\001\002\001\190\n\r\n\r\n\r\n\r\n\r\011\150\n\r\n\r\n\r\n\r\n\r\011\150\n\r\n\r\bI\n\r\n\r\b\253\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\001\002\001\190\n\r\n\r\n\r\n\r\n\005\n\005\t\194\t\242\015N\n\005\012\186\n\005\n\005\020\026\n\005\n\005\n\005\n\005\012\154\n\005\n\005\014\178\n\005\n\005\n\005\000\238\n\005\n\005\n\005\n\005\r\162\n\005\015V\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\012\158\n\005\014\182\n\005\016>\n\005\n\005\n\005\n\005\n\005\017\254\n\005\n\005\015Z\n\005\rv\n\005\n\005\n\005\022\194\012\234\n\005\n\005\n\005\n\005\n\005\n\005\n\005\b\253\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\003\174\n\005\n\005\012\238\n\005\n\005\0066\001\206\b>\026\194\n\005\n\005\n\005\n\005\n\005\003\174\n\005\n\005\n\005\n\005\n\005\000\238\n\005\n\005\005\241\n\005\n\005\t\001\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\n\005\001\002\001\190\n\005\n\005\n\005\n\005\n}\n}\026:\000\238\020Z\n}\028?\n}\n}\018B\n}\n}\n}\n}\012V\n}\n}\016\174\n}\n}\n}\000\238\n}\n}\n}\n}\002\253\n}\006\138\n}\n}\n}\n}\n}\n}\n}\n}\r.\n}\019b\n}\006\246\n}\n}\n}\n}\n}\026\198\n}\n}\007\006\n}\r\130\n}\n}\n}\019\202\012\154\n}\n}\n}\n}\n}\n}\n}\t\001\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\bM\n}\n}\rr\n}\n}\023N\022\186\019\138\020n\n}\n}\n}\n}\n}\rU\n}\n}\n}\n}\n}\014\138\n}\n}\007F\n}\n}\012\234\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\n}\014\142\tb\n}\n}\n}\n}\003\165\003\165\000\238\r\186\bA\003\165\016\178\003\165\003\165\000\238\003\165\003\165\003\165\003\165\014\250\003\165\003\165\tz\003\165\003\165\003\165\024n\003\165\003\165\003\165\003\165\022\254\003\165\t\198\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\014\254\003\165\023\030\003\165\024r\003\165\003\165\003\165\003\165\003\165\b=\003\165\003\165\023\238\003\165\t\238\003\165\003\165\003\165\020r\015*\003\165\003\165\003\165\003\165\003\165\003\165\003\165\023F\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\024\174\t\166\n\006\015.\003\165\003\165\t\250\001\206\024\n\ra\003\165\003\165\003\165\003\165\003\165\n\n\003\165\003\165\003\165\003\165\t\174\000\238\n\014\003\165\011B\003\165\003\165\020\006\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\003\165\020>\003\165\003\165\003\165\003\165\003\165\001\245\001\245\027\030\007\246\023~\001\245\011*\002\190\001\245\020\026\002\138\001\245\t\190\001\245\023\226\002\246\001\245\007\246\001\245\001\245\001\245\011Z\001\245\001\245\001\245\001\210\011\130\t\246\011\178\002\250\001\245\001\245\001\245\001\245\001\245\t\254\001\245\007\246\002\254\025\142\003\150\026\166\001\245\001\245\001\245\001\245\001\245\024\178\003\222\001\190\r\210\001\245\000\238\001\245\001\245\002\178\025\194\024B\003\230\001\245\001\245\001\245\bz\b~\b\138\r\218\012\166\005v\001\245\001\245\001\245\001\245\001\245\001\245\001\245\001\245\001\245\025\182\t\166\n\006\007\246\001\245\001\245\r\238\027\255\004q\027J\005\130\005\134\001\245\001\245\001\245\028/\001\245\001\245\001\245\001\245\012\174\007\246\012\250\001\245\014\030\001\245\001\245\014J\001\245\001\245\001\245\001\245\001\245\001\245\005\138\b\146\001\245\001\245\001\245\b\170\004r\000\238\015\162\001\245\001\245\001\245\001\245\ne\ne\026\182\002\226\015\202\ne\003\254\002\190\ne\025\146\002\138\ne\ne\ne\015\230\002\246\ne\015\234\ne\ne\ne\016\018\ne\ne\ne\001\210\025\198\ne\016&\002\250\ne\ne\ne\ne\ne\ne\ne\016F\002\254\016V\003\150\016j\ne\ne\ne\ne\ne\016\150\003\222\001\190\016\238\ne\016\246\ne\ne\002\178\027N\017\246\003\230\ne\ne\ne\bz\b~\b\138\018\n\ne\005v\ne\ne\ne\ne\ne\ne\ne\ne\ne\018\014\ne\ne\006\134\ne\ne\018\210\018\234\019r\019v\005\130\005\134\ne\ne\ne\019\174\ne\ne\ne\ne\ne\019\178\ne\ne\019\218\ne\ne\019\222\ne\ne\ne\ne\ne\ne\005\138\b\146\ne\ne\ne\b\170\004r\019\246\020\162\ne\ne\ne\ne\na\na\020\166\020\202\020\206\na\020\222\002\190\na\020\238\002\138\na\na\na\020\250\002\246\na\021.\na\na\na\0212\na\na\na\001\210\021\130\na\021\170\002\250\na\na\na\na\na\na\na\021\174\002\254\021\190\003\150\022\014\na\na\na\na\na\022.\003\222\001\190\022n\na\022\146\na\na\002\178\022\162\022\202\003\230\na\na\na\bz\b~\b\138\022\206\na\005v\na\na\na\na\na\na\na\na\na\022\218\na\na\022\234\na\na\023\006\023\022\023*\023V\005\130\005\134\na\na\na\023Z\na\na\na\na\na\023f\na\na\023v\na\na\023\138\na\na\na\na\na\na\005\138\b\146\na\na\na\b\170\004r\024~\024\214\na\na\na\na\0029\0029\024\254\025f\025v\0029\025\206\002\190\0029\025\222\002\138\0029\t\190\0029\025\234\002\246\0029\026N\0029\0029\0029\026b\0029\0029\0029\001\210\002\225\t\246\026\146\002\250\0029\0029\0029\0029\0029\t\254\0029\026\154\002\254\026\214\003\150\004Y\0029\0029\0029\0029\0029\026\254\003\222\001\190\0276\0029\000\n\0029\0029\002\178\027f\027r\003\230\0029\0029\0029\bz\b~\b\138\027z\012\166\005v\0029\0029\0029\0029\0029\0029\0029\0029\0029\027\131\004\197\0029\002\225\0029\0029\004Y\006\202\002\190\004Y\005\130\005\134\0029\0029\0029\027\147\0029\0029\0029\0029\027\166\000\238\004Y\0029\004\197\0029\0029\004Y\0029\0029\0029\0029\0029\0029\005\138\b\146\0029\0029\0029\b\170\004r\027\194\004Y\0029\0029\0029\0029\004Y\007f\004Y\003\162\004Y\004Y\004Y\004Y\004Y\004Y\004Y\018j\004Y\000\238\004Y\004Y\027\223\004Y\004Y\004Y\017&\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\027\239\004Y\004Y\028\011\028_\004Y\004Y\000\238\004Y\004Y\004Y\004Y\004Y\007\226\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\000\238\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\000\238\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\b\229\004N\004Y\028{\028\134\004Y\004Y\004Y\000\238\004Y\000\n\028\187\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\015\150\022\134\004Y\004Y\002\225\002\225\007\238\004Y\004B\007\005\028\207\004Y\004Y\028\215\007\246\017*\022\246\002\225\000\238\004Y\004Y\004Y\007\250\029\019\004Y\004Y\004Y\004Y\007\005\000\169\004Y\000\169\007\005\000\169\000\169\000\169\000\169\000\169\000\169\000\169\029\027\000\169\023\170\000\169\000\169\000\000\000\169\000\169\000\000\000\000\000\169\000\169\000\000\000\169\000\169\000\169\000\169\000\000\000\169\004R\000\169\000\169\b\229\000\000\000\169\000\169\005\165\000\169\000\169\000\169\000\238\000\169\t\025\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\000\b\234\000\169\000\169\000\000\000\000\000\169\000\169\002\014\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\169\002\018\007\005\000\169\015\190\tE\000\169\002\138\000\169\001\210\000\169\005\165\002\190\000\000\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\169\000\000\000\000\000\000\000\169\003R\018\186\tE\005\165\000\222\000\000\007J\001\222\000\169\000\000\002\226\000\000\014\210\002\178\000\169\000\169\000\169\000\169\000\000\015\194\000\169\000\169\000\169\000\169\0021\0021\004q\000\000\003\162\0021\000\000\002\190\0021\015\206\002\138\0021\001b\0021\000\000\002\246\0021\007N\0021\0021\0021\000\000\0021\0021\0021\001\210\001z\000\000\001\138\002\250\0021\0021\0021\0021\0021\005\134\0021\000\000\002\254\000\000\003\150\b\209\0021\0021\0021\0021\0021\004q\003\222\b\142\000\000\0021\000\000\0021\0021\002\178\000\000\006\146\003\230\0021\0021\0021\bz\b~\b\138\t\166\n\006\005v\0021\0021\0021\0021\0021\0021\0021\0021\0021\006\150\t\166\n\006\b\209\0021\0021\000\000\t\174\000\000\n\014\005\130\005\134\0021\0021\0021\000\000\0021\0021\0021\0021\t\174\000\000\n\014\0021\b\209\0021\0021\000\000\0021\0021\0021\0021\0021\0021\005\138\b\146\0021\0021\0021\b\170\004r\000\238\002\225\0021\0021\0021\0021\002E\002E\002\225\002\225\000\000\002E\000\000\000\000\002E\000\000\b\209\002E\000\000\002E\004\254\000\000\002E\b\209\002E\002E\002E\000\n\002E\002E\002E\000\000\028k\000\000\000\000\000\n\002E\002E\002E\002E\002E\000\000\002E\002\225\006F\004\193\000\000\005\234\002E\002E\002E\002E\002E\000\000\006f\002\225\000\000\002E\006r\002E\002E\000\000\000\000\002\225\006\198\002E\002E\002E\004\193\000\000\006\241\tA\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\t\166\n\006\000\000\002E\002E\006\206\014\234\000\000\002\190\006\241\tA\002E\002E\002E\000\000\002E\002E\002E\002E\t\174\002\190\n\014\002E\002\138\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\205\000\000\002E\002E\002E\000\000\022v\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\023\178\003\162\002A\023\182\003\174\002A\000\000\002\178\002A\000\000\002A\000\000\0186\002A\023\230\002A\002A\002A\t\178\002A\002A\002A\012f\b\205\000\000\000\000\015\206\002A\002A\002A\002A\002A\r\166\002A\r\178\000\000\012\130\023\246\012\146\002A\002A\002A\002A\002A\b\205\b\198\001\190\001*\002A\000\000\002A\002A\005\134\002\225\002\225\014\146\002A\002A\002A\014\166\014\186\014\202\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\t\166\n\006\b\205\002A\002A\000\n\004\254\000\000\001\206\b\205\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\t\174\000\000\n\014\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\019z\000\000\000\000\002A\002A\002A\002A\0025\0025\000\000\000\000\002\162\0025\019\242\003\174\0025\000\000\002\178\0025\000\000\0025\000\000\000\000\0025\020\n\0025\0025\0025\012\178\0025\0025\0025\002\225\002\225\017R\000\000\000\000\0025\0025\0025\0025\0025\012\202\0025\012\226\000\000\000\000\002\225\rB\0025\0025\0025\0025\0025\000\000\b\198\015\n\000\000\0025\000\n\0025\0025\rV\000\000\rj\014\146\0025\0025\0025\014\166\014\186\014\202\000\000\000\000\000\000\0025\0025\0025\0025\0025\0025\0025\0025\0025\000\000\t\166\n\006\002\225\0025\0025\000\000\000\000\000\000\000\000\000\238\000\000\0025\0025\0025\000\000\0025\0025\0025\0025\t\174\000\000\n\014\0025\000\000\0025\0025\000\000\0025\0025\0025\0025\0025\0025\000\000\000\000\0025\0025\0025\000\000\t\146\000\000\000\000\0025\0025\0025\0025\002=\002=\000\000\000\000\000\000\002=\012\177\006F\002=\000\000\005\234\002=\000\000\002=\000\000\000\000\002=\006f\002=\002=\002=\006r\002=\002=\002=\012\177\012\177\000\000\000\000\012\177\002=\002=\002=\002=\002=\000\000\002=\b=\000\000\000\000\b=\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\022\254\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\238\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b=\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b=\002=\002=\002=\002=\012\177\000\000\005\021\002=\000\000\002=\002=\002\225\n&\002=\002=\002=\002=\002=\005\021\t\226\002=\002=\002=\000\000\000\000\b=\000\000\002=\002=\002=\002=\tM\tM\000\000\000\000\000\000\tM\000\000\000\000\tM\000\n\000\000\tM\000\000\tM\000\000\000\000\nR\005\021\tM\nv\tM\b=\tM\tM\tM\002\225\002\225\018\146\000\000\017\194\n\138\n\162\n\170\n\146\n\178\000\000\tM\002\225\002\225\000\000\002\225\000\000\tM\tM\n\186\n\194\tM\005\021\b\029\000\000\005\021\tM\000\n\n\202\tM\000\000\000\000\000\000\000\000\tM\tM\000\238\000\000\000\000\000\000\000\000\000\000\002\246\tM\tM\nZ\n\154\n\210\n\218\n\234\tM\tM\002\174\012\245\tM\002\225\tM\n\242\000\000\003\018\000\000\000\000\000\238\000\000\tM\tM\n\250\000\000\tM\tM\tM\tM\003\030\012\245\000\000\tM\000\000\tM\tM\002J\011\026\tM\011\"\n\226\tM\tM\000\000\000\000\tM\011\002\tM\000\000\002N\000\000\005v\tM\tM\011\n\011\018\002q\002q\000\000\000\000\000\000\002q\012\185\006F\002q\000\000\005\234\002q\000\000\002q\000\000\005\130\002q\006f\002q\002q\002q\006r\002q\002q\002q\012\185\012\185\000\000\000\000\012\185\002q\002q\002q\002q\002q\000\000\002q\015\190\000\000\005\138\002\138\000\000\002q\002q\002q\002q\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\000\000\000\238\002q\002q\nZ\002q\002q\002q\002q\002q\002q\000\000\015\194\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015\206\002q\002q\002q\002q\012\185\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\026\130\000\000\002q\002q\002q\000\000\000\000\005\134\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\190\002Y\000\000\000\000\002Y\000\000\002Y\003b\000\000\002Y\002\162\002Y\002Y\002Y\025\242\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015\190\000\000\000\000\002\138\000\000\002Y\002Y\002Y\002Y\002Y\004\154\003\138\000\000\004\241\002Y\000\000\002Y\002Y\002\178\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\nZ\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015\194\002Y\000\000\002Y\002Y\0072\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015\206\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\181\000\000\002Y\002Y\002Y\000\000\000\000\005\134\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\181\012\181\002e\000\000\012\181\002e\000\000\002e\000\000\000\000\nR\000\000\002e\002e\002e\021\218\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\n\146\002e\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\238\000\000\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\nZ\n\154\002e\002e\002e\002e\002e\000\000\012\181\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b1\002e\002e\002e\b1\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\011\214\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b1\011\222\002u\000\000\011\234\002u\000\000\002u\000\000\000\000\002u\011\246\002u\002u\002u\012\002\002u\002u\002u\000\000\000\000\b1\000\000\000\000\002u\002u\002u\002u\002u\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\002u\002u\002u\000\000\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\002u\002u\002u\000\000\000\000\004\254\000\000\000\000\000\000\002u\002u\nZ\002u\002u\002u\002u\002u\002u\000\000\bJ\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b-\002u\002u\002u\b-\002u\002u\002u\002u\000\000\bN\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\002u\002u\002u\000\000\000\000\002u\002u\002u\000\000\007\201\000\000\000\000\002u\002u\002u\002u\002U\002U\b>\000\000\000\000\002U\b-\007\201\002U\000\000\005\234\002U\000\000\002U\000\000\000\238\002U\007\201\002U\002U\002U\007\201\002U\002U\002U\000\000\000\000\b-\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\007\025\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\007\025\002U\002U\002U\007\025\bR\004\254\000\000\000\000\000\000\002U\002U\nZ\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\229\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\000\007\229\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005f\007\229\002a\000\000\005\234\002a\000\000\002a\000\000\000\000\nR\007\229\002a\002a\002a\007\229\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\n\146\002a\000\000\002a\000\000\000\000\007\t\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\007\t\002a\002a\002a\007\t\000\000\000\000\000\000\000\000\000\000\002a\002a\nZ\n\154\002a\002a\002a\002a\002a\000\000\000\000\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\000\000\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\002a\000\000\b\001\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b\134\006F\002]\000\000\005\234\002]\000\000\002]\000\000\000\000\nR\b\001\002]\002]\002]\b\001\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\n\146\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]\nZ\n\154\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\249\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\007\249\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\012\026\002\133\000\000\007\249\002\133\000\000\002\133\000\000\000\000\nR\007\249\002\133\002\133\002\133\007\249\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n\186\n\194\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n\242\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\n\250\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\002\133\002\133\002\133\n\226\002\133\002\133\000\000\000\000\002\133\011\002\002\133\000\000\007\197\000\000\000\000\002\133\002\133\011\n\011\018\002m\002m\000\000\000\000\000\000\002m\000\000\007\197\002m\000\000\005\234\002m\000\000\002m\000\000\000\000\nR\007\197\002m\002m\002m\007\197\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\n\146\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\nZ\n\154\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\238\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\014b\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\222\002i\000\000\011\234\002i\000\000\002i\000\000\000\000\nR\011\246\002i\002i\002i\012\002\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\n\146\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\nZ\n\154\002i\002i\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\002i\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002}\002}\000\000\000\000\000\000\002}\000\000\002\014\002}\000\000\002\138\002}\000\000\002}\000\000\000\000\nR\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n\186\n\194\002}\000\000\027\158\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015\206\000\000\000\000\000\000\000\000\000\000\002}\002}\nZ\n\154\n\210\n\218\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005\134\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\226\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\003\174\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\nR\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\n\146\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\190\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\246\002Q\002Q\002Q\006\154\000\000\004\002\000\000\000\000\000\000\002Q\002Q\nZ\n\154\002Q\002Q\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\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\000\000\000\000\002M\000\000\002\190\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\nR\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n\186\n\194\002M\000\000\n\018\003\162\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\012>\000\000\012N\000\000\000\000\000\000\002M\002M\nZ\n\154\n\210\n\218\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\226\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\190\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\nR\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\186\n\194\002\169\000\000\012\254\003\162\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\r\018\000\000\r&\000\000\000\000\000\000\002\169\002\169\nZ\n\154\n\210\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\n\226\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\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\nR\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n\186\n\194\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\nZ\n\154\n\210\n\218\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\226\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\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\nR\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\186\n\194\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\nZ\n\154\n\210\n\218\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\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\226\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\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\nR\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n\186\n\194\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\nZ\n\154\n\210\n\218\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\n\226\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\137\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\nR\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\186\n\194\002\137\000\000\000\000\000\000\000\000\002\137\000\000\n\202\002\137\000\000\000\000\000\000\000\000\002\137\002\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\nZ\n\154\n\210\n\218\n\234\002\137\002\137\000\000\000\000\002\137\000\000\002\137\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\250\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\n\226\002\137\002\137\000\000\000\000\002\137\011\002\002\137\000\000\000\000\000\000\000\000\002\137\002\137\011\n\011\018\002\141\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\nR\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\186\n\194\002\141\000\000\000\000\000\000\000\000\002\141\000\000\n\202\002\141\000\000\000\000\000\000\000\000\002\141\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\nZ\n\154\n\210\n\218\n\234\002\141\002\141\000\000\000\000\002\141\000\000\002\141\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\250\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\002\141\002\141\002\141\n\226\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\011\n\011\018\002\145\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\nR\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\186\n\194\002\145\000\000\000\000\000\000\000\000\002\145\000\000\n\202\002\145\000\000\000\000\000\000\000\000\002\145\002\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\nZ\n\154\n\210\n\218\n\234\002\145\002\145\000\000\000\000\002\145\000\000\002\145\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\250\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\n\226\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\011\n\011\018\t\t\t\t\000\000\000\000\000\000\t\t\000\000\000\000\t\t\000\000\000\000\t\t\000\000\t\t\000\000\000\000\nR\000\000\t\t\t\t\t\t\000\000\t\t\t\t\t\t\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\t\t\000\000\000\000\000\000\000\000\000\000\t\t\t\t\n\186\n\194\t\t\000\000\000\000\000\000\000\000\t\t\000\000\n\202\t\t\000\000\000\000\000\000\000\000\t\t\t\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\t\t\t\nZ\n\154\n\210\n\218\n\234\t\t\t\t\000\000\000\000\t\t\000\000\t\t\n\242\000\000\000\000\000\000\000\000\000\000\000\000\t\t\t\t\n\250\000\000\t\t\t\t\t\t\t\t\000\000\000\000\000\000\t\t\000\000\t\t\t\t\000\000\t\t\t\t\t\t\n\226\t\t\t\t\000\000\000\000\t\t\011\002\t\t\000\000\000\000\000\000\000\000\t\t\t\t\011\n\011\018\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\nR\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\186\n\194\002\149\000\000\000\000\000\000\000\000\002\149\000\000\n\202\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\nZ\n\154\n\210\n\218\n\234\002\149\002\149\000\000\000\000\002\149\000\000\002\149\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\250\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\011\026\002\149\011\"\n\226\002\149\002\149\000\000\000\000\002\149\011\002\002\149\000\000\000\000\000\000\000\000\002\149\002\149\011\n\011\018\t\005\t\005\000\000\000\000\000\000\t\005\000\000\000\000\t\005\000\000\000\000\t\005\000\000\t\005\000\000\000\000\nR\000\000\t\005\t\005\t\005\000\000\t\005\t\005\t\005\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\t\005\000\000\000\000\000\000\000\000\000\000\t\005\t\005\n\186\n\194\t\005\000\000\000\000\000\000\000\000\t\005\000\000\n\202\t\005\000\000\000\000\000\000\000\000\t\005\t\005\000\238\000\000\000\000\000\000\000\000\000\000\000\000\t\005\t\005\nZ\n\154\n\210\n\218\n\234\t\005\t\005\000\000\000\000\t\005\000\000\t\005\n\242\000\000\000\000\000\000\000\000\000\000\000\000\t\005\t\005\n\250\000\000\t\005\t\005\t\005\t\005\000\000\000\000\000\000\t\005\000\000\t\005\t\005\000\000\t\005\t\005\t\005\n\226\t\005\t\005\000\000\000\000\t\005\011\002\t\005\000\000\000\000\000\000\000\000\t\005\t\005\011\n\011\018\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\nR\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\186\n\194\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\250\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\011\026\002\193\011\"\n\226\002\193\002\193\000\000\000\000\002\193\011\002\002\193\000\000\000\000\000\000\000\000\002\193\002\193\011\n\011\018\002\209\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\000\000\000\000\002\209\000\000\002\209\000\000\000\000\nR\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\186\n\194\002\209\000\000\000\000\000\000\000\000\002\209\000\000\n\202\002\209\000\000\000\000\000\000\000\000\002\209\002\209\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\nZ\n\154\n\210\n\218\n\234\002\209\002\209\000\000\000\000\002\209\000\000\002\209\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\250\000\000\002\209\002\209\002\209\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\011\026\002\209\011\"\n\226\002\209\002\209\000\000\000\000\002\209\011\002\002\209\000\000\000\000\000\000\000\000\002\209\002\209\011\n\011\018\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\nR\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\186\n\194\002\201\000\000\000\000\000\000\000\000\002\201\000\000\n\202\002\201\000\000\000\000\000\000\000\000\002\201\002\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\nZ\n\154\n\210\n\218\n\234\002\201\002\201\000\000\000\000\002\201\000\000\002\201\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\250\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\011\026\002\201\011\"\n\226\002\201\002\201\000\000\000\000\002\201\011\002\002\201\000\000\000\000\000\000\000\000\002\201\002\201\011\n\011\018\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\nR\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\186\n\194\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\250\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\011\026\002\181\011\"\n\226\002\181\002\181\000\000\000\000\002\181\011\002\002\181\000\000\000\000\000\000\000\000\002\181\002\181\011\n\011\018\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\nR\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\186\n\194\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\250\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\011\026\002\189\011\"\n\226\002\189\002\189\000\000\000\000\002\189\011\002\002\189\000\000\000\000\000\000\000\000\002\189\002\189\011\n\011\018\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\nR\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\186\n\194\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\250\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\011\026\002\185\011\"\n\226\002\185\002\185\000\000\000\000\002\185\011\002\002\185\000\000\000\000\000\000\000\000\002\185\002\185\011\n\011\018\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\nR\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\186\n\194\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\250\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\011\026\002\197\011\"\n\226\002\197\002\197\000\000\000\000\002\197\011\002\002\197\000\000\000\000\000\000\000\000\002\197\002\197\011\n\011\018\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\nR\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\186\n\194\002\213\000\000\000\000\000\000\000\000\002\213\000\000\n\202\002\213\000\000\000\000\000\000\000\000\002\213\002\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\nZ\n\154\n\210\n\218\n\234\002\213\002\213\000\000\000\000\002\213\000\000\002\213\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\250\000\000\002\213\002\213\002\213\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\011\026\002\213\011\"\n\226\002\213\002\213\000\000\000\000\002\213\011\002\002\213\000\000\000\000\000\000\000\000\002\213\002\213\011\n\011\018\002\205\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\000\000\000\000\002\205\000\000\002\205\000\000\000\000\nR\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\186\n\194\002\205\000\000\000\000\000\000\000\000\002\205\000\000\n\202\002\205\000\000\000\000\000\000\000\000\002\205\002\205\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\nZ\n\154\n\210\n\218\n\234\002\205\002\205\000\000\000\000\002\205\000\000\002\205\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\250\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\011\026\002\205\011\"\n\226\002\205\002\205\000\000\000\000\002\205\011\002\002\205\000\000\000\000\000\000\000\000\002\205\002\205\011\n\011\018\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\nR\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\186\n\194\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\250\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\011\026\002\177\011\"\n\226\002\177\002\177\000\000\000\000\002\177\011\002\002\177\000\000\000\000\000\000\000\000\002\177\002\177\011\n\011\018\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\002\t\000\000\002\t\002\t\002\t\000\000\002\t\002\t\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\002\t\002\t\002\t\000\000\002\t\000\000\000\000\000\000\000\000\000\000\002\t\002\t\002\t\002\t\002\t\000\000\000\000\000\000\000\000\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\002\t\002\t\002\t\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\002\t\002\t\002\t\002\t\002\t\002\t\002\t\000\000\000\000\002\t\000\000\002\t\002\t\000\000\000\000\000\000\000\000\000\000\000\000\002\t\002\t\002\t\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\002\t\002\t\002\t\002\t\002\t\002\t\000\000\000\000\002\t\002\t\014:\000\000\000\000\000\000\000\000\002\t\002\t\002\t\002\t\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\nR\000\000\002%\002%\002%\000\000\002%\002%\002%\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002%\000\000\000\000\000\000\000\000\000\000\002%\002%\n\186\n\194\002%\000\000\000\000\000\000\000\000\002%\000\000\n\202\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%\nZ\n\154\n\210\n\218\n\234\002%\002%\000\000\000\000\002%\000\000\002%\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002%\002%\n\250\000\000\002%\002%\014R\002%\000\000\000\000\000\000\002%\000\000\002%\002%\000\000\011\026\002%\011\"\n\226\002%\002%\000\000\000\000\002%\011\002\002%\000\000\000\000\000\000\000\000\002%\002%\011\n\011\018\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\nR\000\000\002!\002!\002!\000\000\002!\002!\002!\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002!\000\000\000\000\000\000\000\000\000\000\002!\002!\n\186\n\194\002!\000\000\000\000\000\000\000\000\002!\000\000\n\202\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!\nZ\n\154\n\210\n\218\n\234\002!\002!\000\000\000\000\002!\000\000\002!\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002!\002!\n\250\000\000\002!\002!\002!\002!\000\000\000\000\000\000\002!\000\000\002!\002!\000\000\011\026\002!\011\"\n\226\002!\002!\000\000\000\000\002!\011\002\002!\000\000\000\000\000\000\000\000\002!\002!\011\n\011\018\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\nR\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\n\138\n\162\n\170\n\146\n\178\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\186\n\194\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n\202\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\nZ\n\154\n\210\n\218\n\234\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n\242\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\250\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\011\026\002\173\011\"\n\226\002\173\002\173\000\000\000\000\002\173\011\002\002\173\000\000\000\000\000\000\000\000\002\173\002\173\011\n\011\018\002\021\002\021\000\000\000\000\000\000\002\021\000\000\000\000\002\021\000\000\000\000\002\021\000\000\002\021\000\000\000\000\002\021\000\000\002\021\002\021\002\021\000\000\002\021\002\021\002\021\000\000\000\000\000\000\000\000\000\000\002\021\002\021\002\021\002\021\002\021\000\000\002\021\000\000\000\000\000\000\000\000\000\000\002\021\002\021\002\021\002\021\002\021\000\000\000\000\000\000\000\000\002\021\000\000\002\021\002\021\000\000\000\000\000\000\000\000\002\021\002\021\002\021\000\000\000\000\000\000\000\000\000\000\000\000\002\021\002\021\002\021\002\021\002\021\002\021\002\021\002\021\002\021\000\000\000\000\002\021\000\000\002\021\002\021\000\000\000\000\000\000\000\000\000\000\000\000\002\021\002\021\002\021\000\000\002\021\002\021\002\021\002\021\000\000\000\000\000\000\002\021\000\000\002\021\002\021\000\000\002\021\002\021\002\021\002\021\002\021\002\021\000\000\000\000\002\021\002\021\014:\000\000\000\000\000\000\000\000\002\021\002\021\002\021\002\021\002\025\002\025\000\000\000\000\000\000\002\025\000\000\000\000\002\025\000\000\000\000\002\025\000\000\002\025\000\000\000\000\002\025\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\000\000\006>\000\000\000\000\002\025\002\025\002\025\002\025\002\025\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\002\025\002\025\002\025\006B\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\000\000\000\000\000\000\002\025\002\025\002\025\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\002\025\000\000\000\000\002\025\000\000\002\025\002\025\000\000\000\000\000\000\000\000\000\000\000\238\002\025\002\025\002\025\000\000\002\025\002\025\002\025\002\025\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\002\025\002\025\002\025\002\025\002\025\002\025\000\000\000\000\002\025\002\025\014:\000\000\000\000\000\000\000\000\002\025\002\025\002\025\002\025\001\006\000\000\000\006\000\000\007)\000\000\002\186\002\190\006F\002\234\002\138\005\234\006R\000\000\000\000\002\246\001\n\000\000\006f\000\000\002\150\000\000\006r\007)\000\000\001\210\003\142\007)\002\190\003\226\001\018\b\206\b\210\001\030\001\"\003b\000\000\000\000\002\254\000\000\003\150\bB\016\186\000\000\b\246\b\250\001\210\003\210\003\222\003\234\b\254\007\030\000\000\001:\000\000\002\178\000\000\000\000\003\230\000\000\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\003\138\001>\001B\001F\001J\001N\000\000\002\178\t\018\001R\000\000\007\029\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\007)\000\000\001^\002\225\007\029\000\000\000\000\019N\007\029\0072\000\000\000\000\001\154\0062\000\000\t\202\005\138\b\146\t\214\001\158\000\000\014\130\004r\t\150\001\006\001\166\000\006\001\170\001\174\025\170\002\186\002\190\000\n\002\234\002\138\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\b\202\000\000\000\238\000\000\002\225\001\210\000\000\000\000\000\000\003\226\001\018\b\206\b\210\001\030\001\"\000\000\002\225\002\225\002\254\000\000\003\150\000\000\b\214\000\000\b\246\b\250\000\238\003\210\003\222\003\234\b\254\007\030\000\000\001:\000\000\002\178\007\001\000\000\003\230\000\000\000\000\000\000\bz\b~\b\138\b\158\006F\005v\000\000\005\234\001>\001B\001F\001J\001N\007\001\006f\t\018\001R\007\001\006r\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\006F\001Z\000\000\005\234\025\174\000\000\000\000\001^\000\000\000\000\006f\000\000\000\000\000\000\006r\000\000\000\000\001\154\006\134\000\000\000\000\005\138\b\146\012\233\001\158\000\000\014\130\004r\t\150\004\133\001\166\000\006\001\170\001\174\000\246\002\186\002\190\002\194\002\234\002\138\000\000\000\000\000\000\012\233\002\246\000\000\002&\003j\000\000\002*\000\000\004\133\000\000\003n\001\210\000\000\017\186\007\001\002\250\000\000\003r\003v\0026\000\000\000\000\003z\000\000\002\254\000\000\003\150\000\000\017N\000\000\003\202\003\206\004\026\003\210\003\222\003\234\003\242\007\030\000\000\000\000\017\178\002\178\000\000\000\000\003\230\017\202\002B\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\210\000\000\t\018\000\000\t5\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017\230\018\"\000\000\000\000\004\133\004\133\000\000\000\000\000\000\006\178\004\017\000\000\t5\000\000\000\000\002F\012\233\012\213\000\000\000\000\018^\022Z\005\138\b\146\016\166\000\181\000\000\b\170\004r\t\150\000\181\000\000\002\190\000\181\000\000\002\138\012\233\t\190\000\000\002&\002\246\000\000\002*\000\181\000\000\000\181\000\000\000\181\000\000\000\181\001\210\000\238\t\246\000\000\002\250\0026\000\000\000\000\002>\012\213\t\254\000\181\000\000\002\254\000\000\003\150\000\000\000\181\000\000\000\000\000\000\000\181\000\000\003\222\001\190\015\190\000\181\000\000\002\138\000\181\002\178\004\017\002B\003\230\000\181\000\181\000\181\bz\b~\b\138\000\000\012\166\005v\000\181\000\181\006F\022\002\000\000\005\234\tR\000\181\000\000\000\000\t5\000\181\006f\000\000\000\000\000\000\006r\000\000\000\000\005\130\005\134\000\181\000\181\015\194\000\000\000\181\000\181\000\000\000\000\000\000\000\000\000\000\000\000\002F\000\000\000\181\000\000\015\206\000\000\022&\000\000\000\181\000\181\005\138\b\146\000\000\000\000\000\205\b\170\004r\000\000\000\181\000\205\000\181\002\190\000\205\000\000\002\138\000\000\t\190\000\000\000\000\002\246\005\134\000\000\000\205\000\000\000\205\000\000\000\205\000\000\000\205\001\210\0222\t\246\000\000\002\250\000\000\000\000\000\000\000\000\000\000\t\254\000\205\000\000\002\254\000\000\003\150\000\000\000\205\021\198\000\000\000\000\000\205\000\000\003\222\001\190\000\000\000\205\000\000\000\000\000\205\002\178\000\000\000\000\003\230\000\205\000\205\000\205\bz\b~\b\138\000\000\012\166\005v\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\205\000\205\000\000\000\000\000\205\000\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\205\000\000\000\000\000\000\000\000\000\000\000\205\000\205\005\138\b\146\000\000\000\000\000\000\b\170\004r\000\000\000\205\000\000\000\205\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\000\000\000>\016\210\000\000\000\000\000B\000\000\015\190\000\000\002\014\002\138\000\000\000F\000\000\000\000\000\000\000\000\000\000\000J\002\018\000N\000R\000V\000Z\000^\000b\000f\001\210\000\000\000\000\000j\000n\000\000\000r\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003R\000\000\000\000\000\000\015\194\000z\007J\001\222\000~\000\130\000\000\000\000\000\000\002\178\000\000\000\134\000\138\000\142\015\206\000\000\022\006\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\001\021\000\000\000\174\000\178\000\182\001\021\000\000\000\000\000\186\007N\000\190\000\194\005\134\000\000\000\000\000\000\000\000\000\000\000\198\000\000\000\202\000\000\022\018\000\000\001\021\003\225\000\206\000\210\000\000\000\214\003\225\003\014\002\190\003\225\000\000\002\138\000\000\006\238\000\000\021\198\002\246\000\000\000\000\003\225\000\000\000\000\001\021\003\225\003\n\003\225\001\210\007\209\007\014\000\000\001\021\000\000\000\000\003\018\000\000\001\021\tB\003\225\000\000\n\233\000\000\000\000\000\000\003\225\001\021\001\021\003\030\000\000\000\000\0116\001\190\000\000\003\225\000\000\000\000\003\225\002\178\007\209\000\000\003\246\003\225\003\225\n\229\003\250\000\000\004\002\000\000\011F\005v\n\233\001\021\007\209\000\000\000\000\007\209\t\006\003\225\003\225\000\000\001\021\005z\007\209\000\000\n\233\000\000\007\209\n\233\011\194\005\130\005\134\003\225\003\225\011N\n\233\003\225\003\225\000\000\n\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\229\t\202\000\000\n\229\011v\003\225\005\138\000\000\000\000\000\000\n\229\000\000\004r\t!\n\229\000\006\003\225\000\000\000\246\002\186\002\190\002\194\002\234\002\138\000\000\000\000\000\000\000\000\002\246\000\000\000\000\004\165\000\000\t!\000\000\t!\t!\003n\001\210\000\000\000\000\000\000\002\250\000\000\003r\003v\000\000\000\000\000\000\003z\000\000\002\254\000\000\003\150\000\000\017N\000\000\003\202\003\206\000\000\003\210\003\222\003\234\003\242\007\030\000\000\000\000\017\178\002\178\000\000\000\000\003\230\017\202\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\210\000\000\t\018\000\000\028\142\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017\230\018\"\000\000\000\006\028\175\015\022\000\246\002\186\002\190\002\194\002\234\002\138\000\000\000\000\000\000\000\000\002\246\000\000\000\000\028\222\000\000\022Z\005\138\b\146\t!\003n\001\210\b\170\004r\t\150\002\250\000\000\003r\003v\000\000\000\000\000\000\003z\000\000\002\254\000\000\003\150\000\000\017N\000\000\003\202\003\206\000\000\003\210\003\222\003\234\003\242\007\030\000\000\017\014\017\178\002\178\000\000\000\000\003\230\017\202\002\014\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\002\018\000\000\000\000\000\000\000\000\017\210\000\000\t\018\001\210\028\142\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017\230\018\"\000\000\000\000\004\173\000\000\003R\000\000\000\000\000\000\001\006\000\000\007J\001\222\000\000\000\000\003\014\002\190\006\014\002\178\002\138\022Z\005\138\b\146\014\150\002\246\001\n\b\170\004r\t\150\002\150\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003.\001\030\001\"\000\000\000\000\007N\000\000\000\000\002\225\000\000\0032\002\225\001.\006.\000\000\000\000\003*\001\190\0016\002\225\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\n\005v\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005z\000\000\002\225\001V\000\000\000\000\000\000\002\225\005\130\005\134\000\000\005\202\001Z\002\225\002\225\002\225\002\225\000\000\001^\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\002\225\001\170\001\174\003\014\002\190\tr\002\225\002\138\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\150\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003.\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\001.\006.\000\000\000\000\003*\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003\014\002\190\011:\000\000\002\138\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\150\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003.\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\001.\006.\000\000\000\000\003*\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003\014\002\190\r\230\000\000\002\138\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\150\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003.\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\001.\006.\000\000\000\000\003*\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\000\000\005\021\001\166\000\000\001\170\001\174\005\021\005\021\005\021\005\021\001\205\005\021\000\000\005\021\005\021\001\205\000\000\005\021\000\000\005\021\000\000\005\021\005\021\005\021\005\021\005\021\005\021\000\000\005\021\005\021\005\021\000\000\000\000\000\000\001\205\000\000\000\000\005\021\000\000\000\000\000\000\000\000\005\021\005\021\005\021\000\000\000\000\000\000\005\021\005\021\005\021\000\000\005\021\000\000\000\000\005\021\001\205\005\021\000\000\000\000\005\021\005\021\005\021\000\000\001\205\005\021\005\021\005\021\000\000\001\205\001\205\000\238\000\000\000\000\005\021\005\021\005\021\000\000\001\205\001\205\005\021\005\021\000\000\000\000\000\000\005\021\000\000\000\000\005\021\000\000\005\021\005\021\005\021\000\000\005\021\005\021\005\021\005\021\000\000\005\021\005\021\000\000\000\000\000\000\001\205\000\000\000\000\t2\000\000\005\021\020\214\005\021\005\021\001\205\000\000\002\158\005\021\000\000\000\000\000\000\000\000\005\021\005\021\011\001\000\000\005\021\011\001\005\021\005\021\011\001\011\001\012\233\012\213\011\001\000\000\011\001\000\000\000\000\011\001\000\000\000\000\000\000\011\001\011\001\000\000\011\001\011\001\014&\011\001\000\000\011\001\012\233\017\030\000\000\002&\011\001\000\000\002*\011\001\002\014\000\000\000\000\000\000\000\000\0022\000\238\011\001\000\000\011\001\002\018\0026\011\001\011\001\002>\012\213\000\000\000\000\001\210\011\001\000\000\000\000\011\001\000\000\000\000\011\001\011\001\000\000\011\001\000\000\011\001\011\001\000\000\000\000\000\000\003R\000\000\000\000\002B\000\000\000\000\007J\001\222\011\001\000\000\000\000\000\000\000\000\002\178\000\000\006F\011\001\011\001\005\234\000\000\011\001\000\000\011\001\000\000\000\000\006f\000\000\005\166\000\000\006r\000\000\000\000\001\202\001\206\011\001\011\001\000\000\011\001\011\001\000\000\011\001\007N\011\001\000\000\011\001\000\000\011\001\002F\011\001\t\r\t\r\001\210\001\250\001\230\t\r\000\000\001\206\t\r\000\000\000\000\000\000\001\242\000\000\000\000\019z\t\r\000\000\t\r\t\r\t\r\000\000\t\r\t\r\t\r\001\246\020\210\000\000\019\242\000\000\002\166\000\000\002\178\004\030\004*\000\000\t\r\000\000\000\000\020\226\000\000\000\000\t\r\t\r\000\000\000\000\t\r\000\000\000\000\002\162\000\000\t\r\000\000\000\000\t\r\000\000\004:\000\000\000\000\t\r\t\r\t\r\000\000\000\000\000\000\000\000\000\000\000\000\t\r\t\r\000\000\000\000\000\000\000\000\000\000\t\r\000\000\000\000\000\000\004\154\000\000\000\000\t\r\000\000\000\000\000\000\000\000\000\000\000\000\t\r\t\r\t\r\000\000\t\r\t\r\000\000\004q\000\000\000\000\000\000\000\000\004q\000\000\t\r\004q\t\r\t\r\000\000\000\000\000\000\t\r\000\000\000\000\000\000\004q\t\r\000\000\000\000\004q\t\r\004q\t\r\t\r\012\169\012\169\000\000\000\000\004q\012\169\000\000\001\206\012\169\004q\000\000\000\000\000\000\000\000\000\000\004q\004\186\000\000\012\169\012\169\012\169\004B\012\169\012\169\012\169\000\000\000\000\004q\004q\000\000\000\000\000\000\004q\002\226\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\012\169\012\169\000\000\000\000\012\169\000\000\004q\002\162\004q\012\169\000\000\000\000\012\169\000\000\000\000\000\000\004q\012\169\012\169\012\169\004q\004q\002\226\000\238\004q\004q\012\169\012\169\000\000\000\000\004R\004q\000\000\012\169\000\000\000\000\000\000\004\154\000\000\000\000\012\169\004q\000\000\000\000\000\000\000\000\021\218\012\169\012\169\012\169\000\000\012\169\012\169\000\000\007\017\000\000\004q\000\000\000\000\007\017\000\000\012\169\007\017\012\169\012\169\004q\000\000\000\000\012\169\000\000\000\000\000\000\007\017\012\169\000\000\000\000\007\017\012\169\007\017\012\169\012\169\t\017\t\017\000\000\000\000\000\000\t\017\000\000\001\206\t\017\007\017\000\000\000\000\000\000\000\000\000\000\007\017\t\017\000\000\t\017\t\017\t\017\000\000\t\017\t\017\t\017\000\000\000\000\007\017\000\000\000\000\000\000\000\000\007\017\007\017\000\000\000\000\t\017\000\000\000\000\000\000\000\000\000\000\t\017\t\017\000\000\000\000\t\017\000\000\007\017\002\162\000\000\t\017\000\000\000\000\t\017\000\000\000\000\000\000\000\000\t\017\t\017\t\017\007\017\007\017\017b\000\000\007\017\007\017\t\017\t\017\002\225\000\000\000\000\000\000\000\000\t\017\000\000\002\225\000\000\004\154\018\162\000\000\t\017\007\017\000\000\000\000\000\000\000\000\002\225\t\017\t\017\t\017\000\000\t\017\t\017\000\000\000\n\000\000\002\225\002\225\000\000\000\000\002\225\t\017\002\225\t\017\t\017\002\225\002\225\002\225\t\017\002\225\002\225\002\225\002\225\t\017\000\000\002\225\002\225\t\017\002\225\t\017\t\017\002\225\002\225\000\n\000\000\002\225\002\225\002\225\000\000\002\225\000\n\002\225\002\225\000\n\000\000\002\225\007\"\000\n\002\225\002\225\002\225\000\000\015v\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\005E\r)\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\005E\015\178\002\225\000\000\005E\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\000\000\000\n\000\000\002\225\000\000\002\225\000\000\000\000\000\246\002\225\002\225\002\026\000a\000\000\002\225\002\225\002\225\000a\003~\000a\000a\018b\000\000\002\225\000\000\000\000\000\000\003n\000a\002\225\000a\000a\000\000\000\000\000a\000a\000a\000\000\b\185\018f\000\000\000\000\000\000\000\000\000\000\018\142\r)\r)\000a\000\000\000\000\002\225\000\000\000\000\000a\000a\000\000\017\178\000a\005E\000\000\000a\017\202\000a\000\000\r)\000a\r)\000\000\000\000\000\000\000a\000a\000a\005E\000\000\000\000\005E\019&\000\000\000a\000a\000\000\000\000\007&\000\000\000\000\000a\000a\000\000\000\000\000a\017\230\019:\000a\000\000\004y\000\000\000\000\000\000\000\000\000a\000a\000a\000\000\000a\000a\000\000\000\000\000\000\006\169\b\185\000A\019J\000\000\000a\000A\000A\000a\000A\000A\000\000\000a\000\000\000\000\000A\000\000\000a\000\000\000\000\006\169\000a\000\000\000a\000\000\000A\000\000\000\000\000\000\000A\000\000\000A\000A\000\000\000\000\000\000\000\000\000\000\000A\000\000\000A\000\000\000\000\000\000\000A\000A\000\000\000A\000A\000A\000A\000A\000\000\000\000\000\000\000A\000\000\000\000\000A\000\000\000\000\000\000\000A\000A\000A\000A\000\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\012\233\012\213\000\000\000A\000A\000A\000A\000A\000\000\006\165\000\000\000=\000\000\000\000\000\000\000=\000=\000\000\000=\000=\012\233\000\000\000\000\002&\000=\000\000\002*\000\000\000\000\006\165\000A\000A\000\000\002\206\000=\000A\000A\000A\000=\0026\000=\000=\002>\012\213\000\000\000\000\000\000\000=\000\000\000=\000\000\000\000\000\000\000=\000=\000\000\000=\000=\000=\000=\000=\000\000\000\000\000\000\000=\000\000\002B\000=\000\000\000\000\000\000\000=\000=\000=\000=\000\000\000=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\181\000\000\012q\000\000\000\000\000\000\012q\012q\000\000\012q\012q\002F\000\000\000\000\000\000\012q\000\000\000\000\000\000\000\000\006\181\000=\000=\000\000\000\000\012q\000=\000=\000=\012q\000\000\012q\012q\000\000\000\000\000\000\000\000\000\000\012q\000\000\012q\000\000\000\000\000\000\012q\012q\001*\012q\012q\012q\012q\012q\000\000\002\225\000\000\012q\000\000\000\000\012q\000\000\002\225\000\000\012q\012q\012q\012q\000\000\012q\000\000\000\000\000\000\002\225\000\000\000\000\000\000\000\000\000\000\012q\000\000\000\n\000\000\000\000\000\000\000\000\012q\012q\012q\012q\012q\000\000\006\177\000\000\012m\000\000\002\225\000\000\012m\012m\000\000\012m\012m\002\225\000\000\000\000\000\000\012m\000\000\002\225\000\000\000\000\006\177\012q\012q\000\000\000\000\012m\012q\012q\012q\012m\000\000\012m\012m\000\000\000\000\000\000\000\000\000\000\012m\002\225\012m\000\000\000\000\000\000\012m\012m\000\000\012m\012m\012m\012m\012m\000\000\001\202\001\206\012m\000\000\000\000\012m\000\000\000\000\000\000\012m\012m\012m\012m\000\000\012m\000\000\000\000\000\000\000\000\001\210\001\250\001\230\000\000\000\000\012m\000\000\000\000\000\000\000\000\001\242\000\000\012m\012m\012m\012m\012m\002\002\000\000\000\000\000\000\000\000\000\000\001\246\002\154\000\000\000\000\000\000\002\166\000\000\002\178\004\030\004*\012\173\012\173\000\000\000\000\0046\012\173\012m\012m\012\173\000\000\000\000\012m\012m\012m\000\000\000\000\004\138\000\000\012\173\012\173\012\173\004:\012\173\012\173\012\173\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\012\173\000\000\000\000\000\000\000\000\000\000\012\173\012\173\000\000\000\000\012\173\000\000\000\000\000\000\001\029\012\173\000\000\000\000\012\173\000\000\000\000\000\000\000\000\012\173\012\173\012\173\000\000\000\000\000\000\000\000\000\000\000\000\012\173\012\173\000\000\000\000\001\029\000\000\019\130\012\173\000\000\000\000\000\000\012\173\001\029\000\000\012\173\000\000\000\000\001\029\000\000\000\000\000\000\012\173\012\173\012\173\000\000\012\173\012\173\001\029\000\000\000\000\000\000\000\000\000\000\000\000\006\249\012\173\000\006\012\173\012\173\006\249\002\186\002\190\012\173\002\234\002\138\000\000\000\000\012\173\000\000\002\246\000\000\012\173\001\029\012\173\012\173\000\000\003\254\000\000\006\249\001\210\000\000\001\029\000\000\002\250\000\000\003r\003v\000\000\000\000\000\000\000\000\000\000\002\254\000\000\003\150\000\000\000\000\000\000\003\202\003\206\006\249\003\210\003\222\003\234\003\242\007\030\000\000\000\000\006\249\002\178\000\000\000\000\003\230\006\249\006\249\000\238\bz\b~\b\138\b\158\000\000\005v\006\249\006\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\018\000\000\000\000\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\000\000\000\000\000\000\006\249\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\006\249\002\186\002\190\000\000\002\234\002\138\000\000\000\000\005\138\b\146\002\246\000\000\000\000\b\170\004r\t\150\024z\014\170\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003r\003v\000\000\000\000\000\000\r5\000\000\002\254\000\000\003\150\r5\000\000\000\000\003\202\003\206\000\000\003\210\003\222\003\234\003\242\007\030\000\000\000\000\000\000\002\178\000\000\000\000\003\230\000\000\r5\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005I\r)\t\018\000\000\000\000\000\000\000\000\r5\000\000\t\030\t6\t\130\005\130\005\134\000\000\r5\000\000\000\000\000\000\005I\r5\r5\000\238\005I\000\000\000\000\003\029\003\029\000\000\r5\r5\003\029\000\000\000\000\003\029\000\000\005\138\b\146\000\000\000\000\000\000\b\170\004r\t\150\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\r5\000\000\000\000\000\000\000\000\000\000\000\000\003\029\000\000\r5\000\000\000\000\000\000\003\029\004\130\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\r)\r)\003\029\000\000\000\000\000\000\000\000\003\029\003\029\003\029\000\000\000\000\000\000\005I\000\000\000\000\003\029\003\029\000\000\r)\000\000\r)\000\000\003\029\000\000\000\000\000\000\003\029\005I\000\000\003\029\005I\000\000\000\000\000\000\000\000\000\000\003\029\003\029\003\029\004\149\003\029\003\029\000\000\000\000\019\146\000\000\000\000\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\003n\011\r\000\000\003\029\011\r\003\029\003\029\003\014\002\190\000\000\000\000\002\138\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\011\r\011\r\019\190\011\r\011\r\000\000\001\210\000\000\007\014\000\000\017\178\000\000\000\000\003\018\000\000\017\202\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\r\019\234\003\030\000\000\000\000\003*\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\011\r\003\250\000\000\004\002\005j\011F\005v\000\000\004\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020N\005z\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\011\r\000\000\011\r\000\000\000\000\000\000\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\011\r\000\000\000\000\011\r\011\r\000\000\005\138\000\000\011\r\000\000\011\r\000\000\004r\011\t\011\r\000\000\011\t\001\246\002\170\003\014\002\190\000\000\002\166\002\138\002\178\004\030\004*\000\000\002\246\000\000\000\000\0046\011\t\011\t\000\000\011\t\011\t\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\004:\000\000\000\000\026\138\000\000\000\000\000\000\000\000\011\t\000\000\003\030\000\000\000\000\006\n\001\190\000\000\000\000\000\000\000\000\026v\002\178\000\000\000\000\003\246\000\000\000\000\011\t\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\012\141\000\000\000\000\012\141\000\000\000\000\005\130\005\134\000\000\005\202\011\t\000\000\011\t\012\141\000\000\000\000\000\000\000\000\000\000\012\141\000\000\001\229\001\229\000\000\011\t\000\000\001\229\011\t\011\t\001\229\005\138\012\141\011\t\000\000\011\t\000\000\004r\012\141\011\t\001\229\001\229\001\229\000\000\001\229\001\229\001\229\012\141\000\000\000\000\012\141\000\000\000\000\000\000\000\000\012\141\000\000\000\000\001\229\000\000\000\000\000\000\000\000\000\000\001\229\001\229\000\000\000\000\001\229\000\000\000\000\012\141\000\000\001\229\000\000\012\141\001\229\000\000\000\000\000\000\000\000\001\229\001\229\001\229\000\000\012\141\012\141\000\000\000\000\012\141\001\229\001\229\000\000\000\000\000\000\028\134\000\000\001\229\004\157\000\000\000\000\001\229\000\000\022\130\001\229\000\000\012\141\000\000\000\000\000\000\000\000\001\229\001\229\001\229\000\000\001\229\001\229\000\000\000\000\000\000\000\000\000\000\003n\000\000\000\000\001\229\000\000\001\229\001\229\003\014\002\190\000\000\001\229\002\138\000\000\006\238\000\000\001\229\002\246\000\000\000\000\004\254\000\000\001\229\022\242\000\000\000\000\000\000\001\210\000\000\007\014\000\000\017\178\000\000\000\000\003\018\000\000\017\202\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\150\023\166\003\030\000\000\000\000\0116\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\229\003\250\000\000\004\002\000\000\011F\005v\000\000\004\157\000\000\000\000\000\000\000\000\000\000\000\000\004\029\000\000\024\154\005z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\000\000\011N\005\149\005\149\000\000\000\000\000\000\005\149\000\000\000\000\005\149\000\000\000\000\000\000\000\000\n\229\000\000\000\000\n\229\n\229\005\149\005\138\005\149\000\000\005\149\n\229\005\149\004r\000\000\n\229\004\029\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005\149\002\194\000\000\000\000\000\000\000\000\005\149\005\149\000\000\000\000\000\000\028\222\005\149\000\000\000\000\005\149\000\000\003n\005\149\000\000\000\000\000\000\000\000\005\149\005\149\005\149\000\000\000\000\000\000\003z\000\000\000\000\000\000\000\000\000\000\017N\000\000\000\000\000\000\005\149\005\149\000\000\000\000\005\149\025\026\000\000\001\006\017\178\000\000\000\000\000\000\000\000\017\202\005\149\005\149\005\149\000\000\005\149\005\149\000\000\000\000\000\000\001\n\007\246\000\000\000\000\002\150\000\000\017\210\000\000\005\149\000\000\028\142\005\149\005\149\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017\230\018\"\000\000\005\149\004\173\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\022Z\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\003e\003e\001R\000\000\000\000\003e\001V\000\000\003e\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\003e\003e\000\000\003e\001^\003e\000\000\003e\003e\000\000\000\000\000\000\000\000\000\000\001\154\027\162\000\000\000\000\003e\003e\003e\001\158\003e\001\162\003e\003e\003e\001\166\000\000\001\170\001\174\005\029\000\000\000\000\003e\000\000\003e\003e\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\000\000\000\000\005!\000\000\000\000\003e\000\000\000\000\003e\000\000\000\000\000\000\003e\003e\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\003e\003e\003e\000\000\003e\000\000\000\000\005\029\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\003e\000\000\003e\003e\005\137\005\137\000\000\000\000\005!\005\137\000\000\000\000\005\137\003e\000\000\003e\003e\000\000\000\000\003e\000\000\000\000\005\137\000\000\005\137\000\000\005\137\000\000\005\137\000\000\003e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\137\000\000\000\000\000\000\000\000\000\000\005\137\005\137\000\000\000\000\000\000\000\000\b>\000\000\000\000\005\137\000\000\000\000\005\137\000\000\000\000\000\000\000\000\005\137\005\137\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\137\005\137\000\000\000\000\005\137\000\000\t\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\137\005\137\005\137\000\000\005\137\005\137\000\000\000\000\nR\000\000\000\000\012z\t\029\000\000\t\029\t\029\000\000\005\137\000\000\000\000\005\137\005\137\n\138\n\162\n\170\n\146\n\178\000\000\000\000\001\202\002\134\000\000\005\137\002\138\000\000\000\000\n\186\n\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\202\000\000\000\000\001\210\001\250\001\230\002\142\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\nZ\n\154\n\210\n\218\n\234\000\000\000\000\000\000\000\000\002\146\002\154\000\000\n\242\001\n\002\166\000\000\002\178\004\030\004*\000\000\000\000\n\250\000\000\021\178\000\000\021\182\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\011\026\000\000\011\"\n\226\001&\004:\001.\0012\t\029\011\002\000\000\000\000\0016\000\000\005\134\001:\000\000\011\n\011\018\000\000\000\000\000\000\000\000\000\000\021\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\b\153\b\153\001R\021\198\000\000\b\153\001V\000\000\b\153\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\b\153\000\000\b\153\001^\b\153\000\000\b\153\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027\190\000\000\000\000\000\000\b\153\000\000\001\158\000\000\001\162\000\000\b\153\b\153\001\166\000\000\001\170\001\174\000\000\000\000\000\000\b\153\000\000\000\000\b\153\000\000\000\000\000\000\000\000\b\153\b\153\b\153\000\000\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\153\000\000\000\000\000\000\b\153\ru\ru\000\000\000\000\000\000\ru\000\000\000\000\ru\b\153\b\153\b\153\000\000\b\153\b\153\000\000\000\000\000\000\ru\000\000\ru\000\000\ru\b\153\ru\000\000\b\153\001\202\001\206\000\000\b\153\000\000\000\000\000\000\000\000\000\000\ru\000\000\000\000\004\254\000\000\b\153\ru\ru\ry\ry\001\210\001\250\004B\ry\000\000\ru\ry\000\000\ru\000\000\000\000\000\000\000\000\ru\ru\ru\ry\000\000\ry\000\000\ry\000\000\ry\001\246\002\162\000\000\000\000\000\000\002\166\ru\002\178\004\030\004*\ru\ry\000\000\000\000\0046\000\000\015\218\ry\ry\000\000\ru\ru\ru\004B\ru\ru\ry\000\000\000\000\ry\004R\004:\000\000\000\000\ry\ry\ry\ru\000\000\000\000\000\000\ru\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ry\000\000\ru\000\000\ry\001\213\000\000\000\000\000\000\000\000\001\213\000\000\001\206\001\213\ry\ry\ry\000\000\ry\ry\000\000\b\249\000\000\001\213\004R\000\000\000\000\001\213\004q\001\213\000\000\ry\000\000\004q\000\000\ry\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\ry\001\213\001\213\000\000\000\000\000\000\004q\000\000\002\162\000\000\001\213\000\000\000\000\001\213\000\000\000\000\000\000\000\000\001\213\001\213\001\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004q\000\000\000\000\000\000\000\000\000\000\001\213\001\213\004q\000\000\004\154\003I\000\000\004q\002\226\000\000\003I\000\000\001\206\003I\001\213\001\213\004q\004q\001\213\001\213\000\000\b\245\000\000\003I\000\000\000\000\000\000\003I\001\213\003I\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\001\213\003I\004q\000\000\000\000\000\000\001\213\003I\001\209\000\000\000\000\004q\000\000\000\000\002\162\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\003I\000\000\000\000\004\154\003E\000\000\000\000\000\000\000\000\003E\000\000\001\206\003E\003I\003I\000\000\000\000\003I\003I\000\000\b\245\000\000\003E\000\000\000\000\000\000\003E\003I\003E\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\000\000\000\000\003I\003E\000\000\000\000\000\000\000\000\003I\003E\001\209\000\000\000\189\000\000\000\000\000\000\002\162\000\189\003E\000\000\000\189\003E\000\000\000\000\000\000\000\000\003E\003E\003E\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\000\000\000\000\000\000\000\003E\003E\000\000\000\000\004\154\000\000\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003E\003E\000\189\000\000\003E\003E\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\000\003E\000\189\000\189\000\238\000\000\000\000\000\000\003E\000\000\000\000\000\189\000\189\003E\000\000\000\000\000\000\000\000\000\189\003E\000\000\001\001\000\189\000\000\000\000\000\000\001\001\000\000\000\000\001\001\000\000\000\000\000\189\000\189\000\000\000\000\000\189\000\189\000\000\001\001\000\000\001\001\000\000\001\001\000\000\001\001\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\189\000\000\000\000\000\000\001\001\000\000\000\000\000\000\000\000\000\189\001\001\000\189\000\000\000\000\001\001\000\000\000\000\000\000\000\000\001\001\000\000\000\000\001\001\000\000\000\000\000\000\000\000\001\001\001\001\000\238\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\000\000\000\000\000\000\000\000\000\000\001\001\000\000\000\000\000\197\001\001\000\000\000\000\000\000\000\197\000\000\000\000\000\197\000\000\000\000\001\001\001\001\000\000\000\000\001\001\001\001\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\001\000\000\000\000\000\000\000\000\000\000\001\001\001\001\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\001\001\000\197\001\001\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\197\000\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\193\000\197\000\000\000\000\000\000\000\193\000\000\000\000\000\193\000\000\000\000\000\197\000\197\000\000\000\000\000\197\000\197\000\000\000\193\000\000\000\193\000\000\000\193\000\000\000\193\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\197\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\197\000\193\000\197\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\193\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\193\000\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\193\000\193\000\000\000\000\000\000\000\000\000\000\000\193\000\000\000\000\001\177\000\193\000\000\000\000\000\000\001\177\000\000\000\000\001\177\000\000\000\000\000\193\000\193\000\000\000\000\000\193\000\193\000\000\001\177\000\000\000\000\000\000\001\177\000\000\001\177\000\193\000\000\000\000\000\000\000\000\000\000\000\193\000\193\000\000\000\000\000\000\001\177\001\177\000\000\000\000\000\000\000\193\001\177\000\193\000\000\000\000\000\000\000\000\005\029\000\000\000\000\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\000\000\001\202\001\206\001\177\rq\rq\000\000\000\000\000\000\rq\000\000\000\000\rq\001\177\001\177\000\000\000\000\001\177\001\177\000\000\001\210\001\214\rq\005\029\rq\000\000\rq\001\177\rq\000\000\000\000\000\000\000\000\001\177\001\177\000\000\000\000\000\000\000\000\001\177\rq\000\000\000\000\001\246\002\162\001\177\rq\rq\002\166\000\000\002\178\004\030\004*\000\000\000\000\rq\000\000\0046\rq\015\218\000\000\000\000\000\000\rq\rq\rq\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\rq\000\000\000\000\000\000\rq\rm\rm\000\000\000\000\000\000\rm\000\000\000\000\rm\rq\rq\rq\000\000\rq\rq\000\000\000\000\000\000\rm\000\000\rm\000\000\rm\000\000\rm\000\000\rq\000\000\000\000\000\000\rq\000\000\000\000\000\000\000\000\000\000\rm\000\000\000\000\004\254\000\000\rq\rm\rm\000\000\000\000\000\000\000\000\000\000\000\000\004y\rm\000\000\000\000\rm\000\246\000\000\000\000\002\026\rm\rm\rm\000\000\000\000\000\000\000\000\000\000\000\000\018b\000\000\000\000\000\000\004y\000\000\003n\rm\000\000\b\157\b\157\rm\000\000\000\000\b\157\000\000\000\000\b\157\018f\000\000\000\000\rm\rm\rm\018\142\rm\rm\b\157\000\000\b\157\000\000\b\157\000\000\b\157\000\000\007\146\017\178\000\000\rm\000\000\000\000\017\202\rm\000\000\000\000\b\157\000\000\000\000\000\000\000\000\000\000\b\157\b\157\rm\000\000\000\000\000\000\019&\000\000\000\000\b\157\000\000\000\000\b\157\000\000\000\000\000\000\000\000\b\157\b\157\000\238\017\230\019:\000\000\000\000\004y\004y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\157\000\000\000\000\000\000\b\157\000\000\007\r\000\000\019J\000\000\000\000\000\000\000\000\000\000\b\157\b\157\b\157\000\000\b\157\b\157\000\000\000\000\nR\000\000\000\000\007\r\000\000\000\000\b\157\007\r\000\000\b\157\000\000\000\000\000\000\b\157\n\138\n\162\n\170\n\146\n\178\000\000\000\000\000\000\000\000\000\000\b\157\001\209\000\000\000\000\n\186\n\194\001\209\000\000\001\206\001\209\000\000\000\000\000\000\n\202\000\000\000\000\000\000\b\245\000\000\001\209\000\000\000\238\000\000\001\209\000\000\001\209\000\000\000\000\000\000\000\000\nZ\n\154\n\210\n\218\n\234\000\000\000\000\001\209\000\000\000\000\000\000\007\r\n\242\001\209\000\000\000\000\000\000\000\000\000\000\000\000\002\162\n\250\001\209\000\000\000\000\001\209\000\000\000\000\000\000\000\000\001\209\001\209\001\209\000\000\000\000\011\026\000\000\011\"\n\226\000\000\000\000\000\000\000\000\000\000\011\002\000\000\001\209\001\209\000\000\000\000\004\154\000\000\011\n\011\018\000\000\000\000\000\000\017\002\000\000\000\000\001\209\001\209\000\000\000\000\001\209\001\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nR\001\209\000\000\000\000\017\006\000\000\000\000\000\000\001\209\000\000\000\000\000\000\000\000\001\209\n\138\n\162\n\170\n\146\n\178\001\209\000\000\000\000\000\000\000\000\000\000\006V\000\000\000\000\n\186\n\194\000\246\001\202\001\206\002\026\000\000\000\000\000\000\n\202\000\000\000\000\000\000\000\000\000\000\018b\000\000\000\238\000\000\004y\000\000\003n\001\210\001\250\001\230\000\000\nZ\n\154\n\210\n\218\n\234\000\000\001\242\018f\000\000\000\000\000\000\000\000\n\242\018\142\000\000\000\000\000\000\000\000\000\000\001\246\002\154\n\250\000\000\000\000\002\166\017\178\002\178\004\030\004*\000\000\017\202\000\000\000\000\0046\000\000\011\026\017\n\011\"\n\226\017\026\000\000\000\000\000\000\000\000\011\002\000\000\019&\000\000\000\000\000\000\004:\000\000\011\n\011\018\005\193\005\193\000\000\000\000\000\000\005\193\017\230\019:\005\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\193\000\000\005\193\000\000\005\193\000\000\005\193\000\000\000\000\019J\000\000\000\000\000\000\000\000\004n\000\000\004r\000\000\005\193\000\000\000\000\000\000\000\000\000\000\005\193\005\193\005\189\007f\000\000\000\000\b>\005\189\000\000\005\193\005\189\000\000\005\193\000\000\000\000\000\000\000\000\005\193\005\193\000\238\005\189\000\000\005\189\000\000\005\189\000\000\005\189\000\000\000\000\000\000\000\000\000\000\000\000\005\193\000\000\000\000\000\000\005\193\005\189\000\000\000\000\000\000\000\000\000\000\005\189\007\226\000\000\005\193\005\193\005\193\000\000\005\193\005\193\005\189\000\000\000\000\005\189\000\000\000\000\000\000\000\000\005\189\005\189\000\238\005\193\000\000\000\000\000\000\005\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\189\000\000\005\193\000\000\005\189\r}\r}\000\000\000\000\000\000\r}\000\000\000\000\r}\005\189\005\189\005\189\000\000\005\189\005\189\000\000\000\000\000\000\r}\000\000\r}\t\218\r}\000\000\r}\000\000\005\189\001\202\001\206\011z\005\189\000\000\000\000\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\005\189\r}\r}\r\129\r\129\001\210\001\214\001\230\r\129\000\000\r}\r\129\000\000\r}\000\000\001\242\000\000\000\000\r}\r}\000\238\r\129\000\000\r\129\000\000\r\129\000\000\r\129\001\246\002\154\000\000\000\000\000\000\002\166\r}\002\178\004\030\004*\r}\r\129\000\000\000\000\0046\000\000\000\000\r\129\007\226\000\000\r}\r}\r}\000\000\r}\r}\r\129\000\000\000\000\r\129\000\000\004:\000\000\000\000\r\129\r\129\000\238\r}\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\000\000\r}\000\000\r\129\005\213\007f\000\000\000\000\000\000\005\213\000\000\000\000\005\213\r\129\r\129\r\129\000\000\r\129\r\129\000\000\000\000\000\000\005\213\000\000\005\213\000\000\005\213\000\000\005\213\000\000\r\129\006\229\006\229\000\000\r\129\000\000\000\000\000\000\000\000\000\000\005\213\000\000\000\000\000\000\000\000\r\129\005\213\007\226\005\217\005\217\006\229\006\229\006\229\005\217\000\000\005\213\005\217\000\000\005\213\000\000\006\229\000\000\000\000\005\213\005\213\000\238\005\217\000\000\005\217\000\000\005\217\000\000\005\217\006\229\006\229\000\000\000\000\000\000\006\229\005\213\006\229\006\229\006\229\005\213\005\217\000\000\000\000\006\229\000\000\000\000\005\217\005\217\000\000\005\213\005\213\005\213\000\000\005\213\005\213\005\217\000\000\000\000\005\217\000\000\006\229\000\000\000\000\005\217\005\217\005\217\005\213\000\000\000\000\000\000\005\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\217\000\000\005\213\000\000\005\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\217\005\217\005\217\000\000\005\217\005\217\000\246\003\014\002\190\002\194\004\230\002\138\000\000\006\238\000\000\000\000\002\246\005\217\000\000\004\165\000\000\005\217\000\000\000\000\000\000\003n\001\210\000\000\007\014\000\000\000\000\000\000\b\n\003\018\000\000\000\000\tB\003z\000\000\000\000\000\000\000\000\000\000\017N\000\000\000\000\003\030\000\000\000\000\0116\001\190\000\000\025\026\000\000\000\000\017\178\002\178\000\000\000\000\003\246\017\202\000\000\000\000\003\250\000\000\004\002\000\000\011F\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\210\003A\000\000\000\000\005z\000\000\003A\000\000\001\206\003A\000\000\000\000\005\130\005\134\017\230\018\"\011N\000\000\000\000\003A\000\000\000\000\000\000\003A\000\000\003A\000\000\000\000\000\000\000\000\000\000\t\202\000\000\000\000\t\214\022Z\005\138\003A\000\000\000\000\000\000\000\000\004r\003A\000\000\000\000\000\000\000\000\000\000\000\000\002\162\000\000\003A\000\000\000\000\003A\000\000\000\000\000\000\000\000\003A\003A\003A\000\000\003=\000\000\000\000\000\000\000\000\003=\000\000\001\206\003=\000\000\000\000\000\000\003A\003A\000\000\000\000\004\154\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\003A\003A\000\000\000\000\003A\003A\000\000\000\000\000\000\000\000\003=\000\000\000\000\000\000\003A\000\000\003=\000\000\000\000\001U\000\000\003A\000\000\002\162\001U\003=\003A\001U\003=\000\000\000\000\000\000\003A\003=\003=\003=\000\000\001U\000\000\001U\000\000\001U\000\000\001U\000\000\000\000\000\000\000\000\000\000\003=\003=\000\000\000\000\004\154\000\000\001U\000\000\000\000\000\000\000\000\000\000\001U\000\000\003=\003=\001U\000\000\003=\003=\000\000\001U\000\000\000\000\001U\000\000\000\000\000\000\003=\001U\001U\000\238\000\000\001Q\000\000\003=\000\000\000\000\001Q\001U\003=\001Q\000\000\000\000\000\000\001U\003=\000\000\000\000\001U\000\000\001Q\000\000\001Q\000\000\001Q\000\000\001Q\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\000\000\000\000\000\001Q\000\000\000\000\000\000\001U\000\000\001Q\000\000\000\000\000\000\001Q\001U\000\000\000\000\000\000\001Q\000\000\000\000\001Q\000\000\000\000\000\000\001U\001Q\001Q\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001Q\000\000\000\000\000\000\000\000\000\000\001Q\000\000\000\000\000\000\001Q\001\141\000\000\000\000\000\000\000\000\001\141\000\000\012\205\001\141\001Q\001Q\001Q\000\000\001Q\001Q\000\000\012\205\000\000\001\141\000\000\001\141\000\000\001\141\001Q\001\141\000\000\000\000\000\000\000\000\000\000\001Q\000\000\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\001Q\001\141\012\205\000\000\000\000\000\000\000\000\000\000\012\205\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\001\141\001\141\001\141\000\000\000\000\001A\000\000\000\000\000\000\000\000\001A\000\000\000\165\001A\000\000\000\000\001\141\000\000\000\000\000\000\012\205\000\165\000\000\001A\000\000\001A\000\000\001A\000\000\001A\001\141\001\141\001\141\000\000\001\141\001\141\000\000\000\000\000\000\000\000\000\000\001A\000\000\000\000\000\000\000\000\000\000\001A\000\165\000\000\000\000\001\141\000\000\000\000\000\165\000\000\000\000\000\000\000\000\001A\000\000\000\000\001\141\000\000\001A\001A\001A\000\000\001\221\000\000\000\000\000\000\000\000\001\221\000\000\015\190\001\221\000\000\002\138\000\000\001A\000\000\000\000\000\000\000\165\000\000\001\221\000\000\000\000\000\000\001\221\000\000\001\221\000\000\001A\001A\001A\000\000\001A\001A\000\000\000\000\000\000\000\000\001\221\000\000\000\000\000\000\000\000\000\000\001\221\000\000\000\000\000\000\000\000\001A\015\194\000\000\000\000\001\221\000\000\000\000\001\221\000\000\000\000\000\000\001A\001\221\001\221\000\000\015\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\001\221\003\014\002\190\000\000\001\221\002\138\000\000\006\238\000\000\000\000\002\246\000\000\000\000\005\134\001\221\001\221\000\000\000\000\001\221\001\221\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003\018\001\221\000\000\tB\000\000\000\000\000\000\004q\001\221\000\000\000\000\t~\004q\003\030\000\000\004q\r\226\001\190\000\000\001\221\000\000\000\000\000\000\002\178\000\000\004q\003\246\000\000\000\000\004q\003\250\004q\004\002\000\000\011F\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004q\000\000\000\000\000\000\005z\000\000\004q\000\000\000\000\000\000\004q\000\000\005\130\005\134\000\000\004q\000\000\000\000\004q\000\000\000\000\000\000\000\000\004q\002\226\000\238\000\000\000\000\000\000\000\000\000\000\000\000\004q\004q\r\242\000\000\005\138\000\000\000\000\004q\004q\b)\004r\004q\000\000\000\000\b)\000\000\000\000\b)\000\000\000\000\000\000\004q\004q\000\000\000\000\004q\004q\b)\000\000\000\000\000\000\b)\000\000\b)\000\000\004q\000\000\000\000\000\000\000\000\000\000\000\000\004q\000\000\000\000\b)\000\000\025\242\000\000\000\000\000\000\b)\000\000\004q\000\000\b)\000\000\000\000\000\000\000\000\b)\000\000\000\000\b)\000\000\000\000\000\000\000\000\b)\b)\000\238\b%\000\000\000\000\000\000\000\000\b%\b)\b)\b%\000\000\000\000\000\000\000\000\b)\000\000\000\000\000\000\b)\b%\000\000\000\000\000\000\b%\000\000\b%\000\000\000\000\b)\b)\b)\000\000\b)\b)\000\000\000\000\000\000\b%\000\000\000\000\000\000\000\000\b)\b%\000\000\000\000\000\000\b%\000\000\b)\000\000\000\000\b%\000\000\000\000\b%\000\000\000\000\000\000\000\000\b%\b%\000\238\0035\000\000\000\000\000\000\000\000\0035\b%\b%\0035\000\000\000\000\000\000\000\000\b%\000\000\000\000\000\000\b%\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\000\000\b%\b%\b%\000\000\b%\b%\000\000\000\000\000\000\0035\015\214\000\000\000\000\000\000\b%\0035\000\000\000\000\000\000\000\000\000\000\b%\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003\014\002\190\000\000\000\000\002\138\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003\018\0035\0035\tB\000\000\0035\0035\000\000\000\000\000\000\000\000\024\002\000\000\003\030\000\000\0035\003*\001\190\000\000\000\000\000\000\0166\0035\002\178\000\000\000\000\003\246\0035\000\000\000\000\003\250\000\000\004\002\0035\011F\005v\000\000\000\000\000\000\003\014\002\190\000\000\000\000\002\138\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\022r\007\014\000\000\000\000\000\000\000\000\003\018\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\206\003\030\005\138\000\000\0116\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\011F\005v\000\000\000\000\000\000\003\014\002\190\000\000\000\000\002\138\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\011N\007\014\000\000\000\000\000\000\000\000\003\018\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\n\003\030\005\138\000\000\0116\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005\194\011F\005v\000\000\000\000\000\000\003\014\002\190\000\000\000\000\002\138\000\000\000\000\000\000\005z\002\246\000\000\000\000\000\000\000\000\005\198\000\000\005\130\005\134\000\000\001\210\011N\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023j\003\030\005\138\000\000\003*\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\t9\000\000\000\000\000\000\000\000\000\000\003\014\002\190\000\000\005z\002\138\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\t9\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\000\000\000\000\000\000\006\134\000\000\000\000\005\138\004Y\004Y\000\000\003\030\004Y\004r\003*\001\190\000\000\004Y\000\000\000\000\000\000\002\178\000\000\004Y\003\246\000\000\000\000\004Y\003\250\000\000\004\002\005j\000\000\005v\004Y\023\186\000\000\000\000\023\210\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\004Y\000\000\000\000\004Y\004Y\000\000\005\130\005\134\000\000\005\202\004Y\000\000\000\000\004Y\000\000\000\000\000\238\004Y\000\000\004Y\004Y\000\000\004Y\0035\000\000\000\000\000\000\000\000\0035\000\000\005\138\0035\t9\0035\004Y\000\000\004r\000\000\0035\000\000\000\000\0035\004Y\004Y\000\000\0035\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\0035\015\214\000\000\000\000\000\000\000\000\0035\004Y\000\000\000\000\0035\015\214\000\000\004Y\000\000\0035\0035\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\0035\025\250\000\000\0035\0035\000\000\000\000\000\000\000\000\0035\0035\026*\000\000\0035\0035\000\000\012\197\000\000\000\000\0166\0035\012\197\000\000\000\000\012\197\0035\000\000\000\000\000\000\0166\0035\000\000\000\000\000\000\012\197\0035\000\000\000\000\012\197\000\000\012\197\000\000\000\000\000\000\000\000\000\000\005\021\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\012\197\000\000\000\000\000\000\000\000\012\197\012\197\000\000\000\000\000\000\000\000\000\000\000\000\006e\000\000\000\000\000\000\000\000\000\000\000\000\002\190\012\197\000\000\002\138\000\000\012\197\000\000\000\000\002\246\000\000\000\000\000\000\000\000\006e\000\000\012\197\012\197\002\130\001\210\012\197\012\197\000\000\002\250\000\000\000\000\000\000\000\000\000\000\000\000\012\197\000\000\002\254\000\000\003\150\000\000\000\000\012\197\000\000\000\000\000\000\000\000\003\222\001\190\000\000\000\000\000\000\000\000\012\197\002\178\000\000\000\000\003\230\000\000\000\000\000\000\bz\b~\b\138\000\000\000\000\005v\000\000\000\000\000\000\003\014\002\190\000\000\000\000\002\138\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003\018\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\030\005\138\b\146\tn\001\190\000\000\b\170\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\006\141\003\250\000\000\004\002\000\000\011F\005v\002\190\000\000\000\000\002\138\000\000\000\000\000\000\000\000\002\246\000\000\000\000\005z\000\000\006\141\000\000\000\000\000\000\000\000\001\210\005\130\005\134\000\000\002\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\254\000\000\003\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\222\001\190\005\138\000\000\000\000\000\000\000\000\002\178\004r\000\000\003\230\000\000\000\000\000\000\bz\b~\b\138\000\000\000\000\005v\000\000\000\000\000\000\005m\000\000\000\000\000\000\000\000\005m\000\000\000\000\005m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\005m\000\000\000\000\000\000\005m\000\000\005m\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\000\000\000\000\005\138\b\146\005m\000\000\005q\b\170\004r\000\000\b>\005q\000\000\005m\005q\000\000\005m\000\000\000\000\000\000\000\000\005m\005m\000\238\005q\000\000\000\000\000\000\005q\000\000\005q\000\000\000\000\000\000\000\000\000\000\000\000\005m\005m\000\000\000\000\005m\005q\000\000\000\000\000\000\000\000\000\000\005q\000\000\000\000\005m\005m\000\000\b>\005m\005m\005q\000\000\000\000\005q\000\000\000\000\000\000\000\000\005q\005q\000\238\000\000\0035\000\000\000\000\005m\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\005q\005q\005m\000\000\005q\000\000\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\005q\005q\000\000\000\000\005q\005q\000\000\000\000\000\000\000\000\0035\015\214\000\000\000\000\000\000\000\000\0035\000\000\006\029\000\000\000\000\005q\000\000\006\029\000\000\0035\006\029\000\000\0035\000\000\000\000\000\000\005q\0035\0035\0035\006\029\000\000\000\000\000\000\006\029\000\000\006\029\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\006\029\000\000\000\000\000\000\000\000\000\000\006\029\000\000\000\000\0035\0035\0182\000\000\0035\0035\006\029\000\000\000\000\006\029\000\000\000\000\000\000\000\000\006\029\006\029\000\238\000\000\000\000\000\000\0166\0035\025\210\000\000\000\000\000\000\000\000\000\000\003\014\002\190\006\029\000\000\002\138\000\000\006\029\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\006\029\006\029\021\254\001\210\006\029\006\029\000\000\000\000\000\000\000\000\003\018\000\000\000\000\000\000\006\029\000\000\000\000\012\197\000\000\000\000\000\000\006\029\012\197\003\030\000\000\012\197\003*\001\190\000\000\000\000\000\000\000\000\006\029\002\178\000\000\012\197\003\246\000\000\000\000\012\197\003\250\012\197\004\002\005j\000\000\005v\000\000\005\021\000\000\000\000\000\000\000\000\000\000\012\197\000\000\000\000\000\000\005z\000\000\012\197\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\000\000\000\000\012\197\000\000\000\000\000\000\000\000\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\005\138\000\000\006\218\012\197\t*\005\238\004r\000\000\000\000\000\000\000\000\003\014\002\190\000\000\000\000\002\138\000\000\012\197\012\197\002\130\002\246\012\197\012\197\000\000\000\000\000\000\000\000\003\254\000\000\000\000\001\210\012\197\000\000\000\000\000\000\026\234\000\000\003\018\012\197\000\000\000\000\006J\000\000\000\000\000\000\000\000\000\000\003\014\002\190\012\197\003\030\002\138\000\000\003*\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003\030\000\000\000\000\003*\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\006j\000\000\000\000\000\000\000\000\005\138\003\014\002\190\000\000\005z\002\138\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\006\158\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\000\000\006i\000\000\000\000\000\000\000\000\005\138\003\014\002\190\000\000\003\030\002\138\004r\003*\001\190\000\000\002\246\000\000\000\000\000\000\002\178\006i\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003\030\000\000\000\000\003*\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\011\226\000\000\000\000\000\000\000\000\005\138\003\014\002\190\000\000\005z\002\138\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\000\000\011\238\000\000\000\000\000\000\000\000\005\138\003\014\002\190\000\000\003\030\002\138\004r\003*\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003\030\000\000\000\000\003*\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\011\250\000\000\000\000\000\000\000\000\005\138\003\014\002\190\000\000\005z\002\138\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\018\000\000\000\000\007\021\007f\000\000\000\000\000\000\007\021\005\138\000\000\007\021\000\000\003\030\000\000\004r\003*\001\190\000\000\000\000\000\000\007\021\000\000\002\178\000\000\007\021\003\246\007\021\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\007\021\000\000\000\000\000\000\000\000\000\000\007\021\007\226\005z\000\000\000\000\000\000\000\000\000\000\000\000\007\021\005\130\005\134\007\021\005\202\000\000\000\000\000\000\007\021\007\021\000\238\001\189\000\000\000\000\000\000\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\000\000\007\021\005\138\000\000\000\000\007\021\001\189\000\000\004r\000\000\001\189\000\000\001\189\000\000\000\000\007\021\007\021\000\000\000\000\007\021\007\021\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\000\000\001\189\000\000\001\225\000\000\000\000\000\000\007\021\001\225\000\000\001\189\001\225\000\000\001\189\000\000\000\000\000\000\000\000\001\189\001\189\001\189\001\225\000\000\000\000\000\000\001\225\000\000\001\225\000\000\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\000\000\001\189\001\225\000\000\000\000\000\000\000\000\000\000\001\225\000\000\000\000\001\189\001\189\000\000\000\000\001\189\001\189\001\225\000\000\000\000\001\225\018>\000\000\000\000\000\000\001\225\001\225\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\001\189\000\000\000\000\000\000\001\225\000\000\006!\000\000\001\225\000\000\000\000\006!\000\000\000\000\006!\000\000\000\000\000\000\001\225\001\225\000\000\000\000\001\225\001\225\006!\000\000\000\000\000\000\006!\000\000\006!\000\000\001\225\000\000\000\000\000\000\000\000\000\000\000\000\001\225\000\000\000\000\006!\000\000\021\218\000\000\000\000\000\000\006!\000\000\001\225\000\000\000\000\000\000\000\000\000\000\000\000\006!\000\000\000\000\006!\000\000\000\000\000\000\000\000\006!\006!\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006!\000\000\012\197\000\000\006!\000\000\000\000\012\197\000\000\000\000\012\197\000\000\000\000\000\000\006!\006!\000\000\000\000\006!\006!\012\197\000\000\000\000\000\000\012\197\000\000\012\197\000\000\006!\000\000\000\000\000\000\005\021\000\000\000\000\006!\000\000\000\000\012\197\000\000\000\000\000\000\000\000\000\000\012\197\000\000\006!\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\000\000\012\197\012\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012}\000\000\002\190\012}\000\000\028\150\000\000\012\197\000\000\000\000\028\154\000\000\000\000\012}\000\000\000\000\000\000\000\000\000\000\012}\000\000\012\197\012\197\002\130\000\000\012\197\012\197\000\000\000\000\000\000\000\000\012}\000\000\004q\007f\012\197\000\000\012}\004q\027\"\000\000\004q\012\197\001\002\001\190\000\000\012}\000\000\000\000\012}\000\000\004q\000\000\012\197\012}\004q\000\000\004q\000\000\000\000\004q\000\000\028\158\004q\000\000\000\000\000\000\000\000\000\000\004q\012}\000\000\000\000\004q\012}\004q\007\226\004q\000\000\004q\000\000\000\000\000\000\028\162\012}\012}\000\000\004q\012}\000\000\000\000\004q\004q\002\226\000\238\000\000\000\000\004q\bY\bY\000\000\000\000\bY\b>\000\000\012}\004q\bY\004q\004q\000\000\000\000\000\000\016~\004q\002\226\000\238\bY\000\000\000\000\000\000\000\000\004q\004q\bY\000\000\004q\004q\007f\000\000\004q\000\000\004q\000\000\004q\004q\000\000\bY\000\000\000\000\bY\bY\000\000\004q\004q\004q\000\000\bY\004q\004q\bY\004q\000\000\000\000\bY\000\000\bY\bY\007\146\bY\000\000\000\000\000\000\004q\000\000\004q\000\000\000\000\000\000\004q\007\226\bY\000\000\000\000\000\000\000\000\004q\000\000\000\000\bY\bY\004q\000\000\000\000\000\000\000\000\004q\002\226\000\238\000\000\001y\000\000\000\000\000\000\000\000\001y\000\000\000\000\001y\000\000\000\000\000\000\004q\bY\000\000\000\000\000\000\000\000\001y\bY\001y\000\000\001y\000\000\001y\000\000\004q\004q\000\000\000\000\004q\004q\000\000\000\000\000\000\000\000\001y\000\000\000\000\000\000\000\000\000\000\001y\000\000\000\245\000\000\000\000\004q\000\000\000\245\000\000\000\000\000\245\000\000\001y\000\000\000\000\000\000\004q\001y\001y\000\238\000\245\000\000\000\000\000\000\000\245\000\000\000\245\000\000\000\000\000\000\000\000\000\000\000\000\001y\000\000\000\000\000\000\000\000\000\245\000\000\000\000\000\000\000\000\000\000\000\245\000\000\000\000\001y\001y\001y\000\000\001y\001y\000\245\000\000\000\000\000\245\000\000\000\000\000\000\000\000\000\245\000\245\000\238\000\000\000\249\000\000\000\000\001y\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\000\000\245\000\000\001y\000\000\000\245\000\000\000\249\000\000\000\000\000\000\000\249\000\000\000\249\000\000\000\245\000\245\000\000\000\000\000\245\000\245\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\000\007\017\000\000\000\000\000\245\000\000\007\017\000\000\000\249\007\017\000\000\000\249\000\000\000\000\000\000\000\245\000\249\000\249\000\238\007\017\000\000\000\000\000\000\007\017\000\000\007\017\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\249\007\017\000\000\000\000\000\000\000\000\000\000\007\017\000\000\000\000\000\249\000\249\000\000\000\000\000\249\000\249\007\017\000\000\000\000\007\017\000\000\000\000\000\000\000\000\007\017\007\017\000\000\000\000\006\021\000\000\000\000\000\249\000\000\006\021\000\000\000\000\006\021\000\000\000\000\000\000\007\017\000\000\000\249\018\014\007\017\000\000\006\021\000\000\000\000\000\000\006\021\000\000\006\021\000\000\007\017\007\017\017b\000\000\007\017\007\017\000\000\000\000\000\000\000\000\006\021\000\000\000\000\000\000\000\000\000\000\006\021\000\000\005y\007f\000\000\007\017\000\000\005y\000\000\006\021\005y\000\000\006\021\000\000\000\000\000\000\000\000\006\021\006\021\000\000\005y\000\000\000\000\000\000\005y\000\000\005y\000\000\000\000\000\000\000\000\012-\000\000\006\021\000\000\000\000\012-\006\021\005y\012-\000\000\000\000\000\000\000\000\005y\007\226\000\000\006\021\006\021\012-\000\000\006\021\006\021\012-\000\000\012-\005y\000\000\000\000\000\000\000\000\005y\005y\000\238\000\000\000\000\000\000\012-\006\021\000\000\000\000\000\000\000\000\012-\000\000\000\000\000\000\005y\000\000\000\000\001\202\002\134\012-\000\000\002\138\012-\000\000\000\000\000\000\000\000\012-\005y\005y\000\000\000\000\005y\005y\000\000\000\000\001\210\001\250\001\230\000\000\000\000\000\000\000\000\012-\nF\000\000\001\242\012-\000\000\005y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012-\012-\002\146\002\154\012-\012-\000\000\002\166\000\000\002\178\004\030\004*\004I\000\000\000\000\000\000\021\178\004I\026\206\004A\004I\012-\000\000\000\000\004A\000\000\000\000\004A\000\000\000\000\004I\000\000\011*\004:\004I\000\000\004I\004A\000\000\000\000\000\000\004A\005\134\004A\000\000\000\000\000\000\000\000\004I\000\000\000\000\000\000\026\218\000\000\004I\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\004I\000\000\000\000\004I\000\000\000\000\021\198\004A\004I\000\000\004A\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004I\000\000\000\000\000\000\004I\004a\000\000\004A\000\000\000\000\004a\004A\0041\004a\004I\004I\000\000\0041\004I\004I\0041\004A\004A\004a\000\000\004A\004A\004a\000\000\004a\0041\000\000\000\000\000\000\0041\004I\0041\000\000\000\000\000\000\000\000\004a\004A\000\000\000\000\000\000\017\138\004a\0041\000\000\004q\000\000\000\000\020\146\0041\004q\004a\000\000\004q\004a\000\000\000\000\000\000\0041\004a\000\000\0041\000\000\004q\000\000\000\000\0041\004q\000\000\004q\000\000\000\000\000\000\000\000\000\000\004a\000\000\000\000\000\000\004a\000\000\004q\0041\000\000\000\000\000\000\0041\004q\000\000\004a\004a\000\000\000\000\004a\004a\000\000\0041\0041\000\000\004q\0041\0041\000\000\000\000\004q\002\226\000\000\000\000\000\000\000\000\004a\001\202\001\206\000\000\000\000\000\000\000\000\0041\000\000\000\000\004q\021v\000\000\000\000\000\000\002\150\000\000\000\000\024\238\000\000\001\210\001\250\001\230\000\000\004q\004q\000\000\000\000\004q\004q\001\242\000\000\000\000\000\000\007\246\000\000\000\000\002\002\000\000\006\233\006\233\000\000\000\000\001\246\002\154\004q\000\000\000\000\002\166\000\000\002\178\004\030\004*\000\000\000\000\004.\000\000\0046\006\233\006\233\006\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\233\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\000\000\006\233\006\233\000\000\000\000\000\000\006\233\000\000\006\233\006\233\006\233\000\000\004Q\000\000\000\000\006\233\000\000\004Q\000\000\0049\004Q\000\000\000\000\015\198\0049\000\000\000\000\0049\000\000\000\000\004Q\000\000\006\233\000\000\004Q\000\000\004Q\0049\000\000\000\000\000\000\0049\000\000\0049\000\000\000\000\000\000\000\000\004Q\000\000\000\000\000\000\000\000\000\000\004Q\0049\000\000\004i\000\000\000\000\000\000\0049\004i\000\000\000\000\004i\004Q\000\000\004\"\000\000\006\233\004Q\000\000\0049\000\000\004i\000\000\000\000\0049\004i\000\000\004i\000\000\000\000\000\000\000\000\000\000\004Q\000\000\000\000\000\000\000\000\000\000\004i\0049\000\000\000\000\000\000\000\000\004i\000\000\004Q\004Q\000\000\000\000\004Q\004Q\000\000\0049\0049\000\000\004i\0049\0049\000\000\000\000\004i\t\206\000\000\000\000\000\000\000\000\004Q\001\202\001\206\000\000\000\000\000\000\000\000\0049\000\000\000\000\004i\018\222\000\000\000\000\000\000\000\000\000\000\003\254\021\030\000\000\001\210\001\250\001\230\000\000\004i\004i\000\000\000\000\004i\004i\001\242\004\133\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\001\246\002\154\004i\000\000\000\000\002\166\003j\002\178\004\030\004*\004\133\000\000\003n\021\158\0046\007\165\000\000\000\000\007\165\000\000\000\000\000\000\000\000\000\000\003z\000\000\000\000\000\000\000\000\000\000\017N\004:\000\000\000\000\007\165\007\165\000\000\007\165\007\165\025\026\000\000\000\000\017\178\000\000\000\000\000\000\000\000\017\202\000\000\000\000\000\000\007\185\000\000\000\000\007\185\000\000\000\000\000\000\007\165\000\000\000\000\000\000\000\000\017\210\000\000\000\000\000\000\004n\000\000\004r\007\185\007\185\000\000\007\185\007\185\000\000\007\165\017\230\018\"\000\000\000\000\004\133\004\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\185\000\000\007\145\000\000\022Z\007\145\000\000\000\000\000\000\000\000\000\000\000\000\007\165\000\000\007\165\000\000\000\000\000\000\000\238\000\000\000\000\007\145\007\145\000\000\007\145\007\145\005\226\000\000\000\000\007\165\007\165\000\000\000\000\000\000\007\165\007\189\007\165\000\000\007\189\000\000\007\165\000\000\000\000\000\000\000\000\007\145\000\000\000\000\007\185\000\000\007\185\000\000\000\000\000\000\007\189\007\189\000\000\007\189\007\189\000\000\000\000\000\000\007\185\007\145\000\000\005\234\007\185\000\000\000\000\000\000\007\185\000\000\007\185\000\000\000\000\000\000\007\185\000\000\007\189\000\000\007\173\000\000\000\000\007\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\145\000\000\007\145\000\238\000\000\000\000\007\173\007\173\000\000\007\173\007\173\000\000\000\000\000\000\007\145\000\000\000\000\005\234\007\145\000\000\r\133\r\133\007\145\000\000\007\145\000\000\000\000\000\000\007\145\000\000\007\173\000\000\000\000\007\189\000\000\007\189\000\000\000\000\000\000\r\133\r\133\r\133\007z\000\000\000\000\000\000\000\000\007\189\000\238\r\133\005\234\007\189\000\000\000\000\000\000\007\189\000\000\007\189\000\000\t\218\000\000\007\189\r\133\r\133\000\000\001\202\001\206\r\133\000\000\r\133\r\133\r\133\000\000\000\000\000\000\000\000\r\133\000\000\007\173\000\000\007\173\000\000\000\000\000\000\001\210\001\250\001\230\000\000\000\000\000\000\000\000\000\000\006F\r\133\001\242\005\234\007\173\000\000\000\000\000\000\007\173\000\000\007\173\001\202\001\206\023\014\007\173\001\246\002\154\000\000\000\000\000\000\002\166\000\000\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\001\210\001\214\001\230\000\000\000\000\000\000\001\202\001\206\023n\000\000\001\242\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\001\202\001\206\001\246\002\154\001\210\001\214\001\230\002\166\000\000\002\178\004\030\004*\000\000\000\000\001\242\000\000\0046\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\154\000\000\000\000\000\000\002\166\004:\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\001\246\002\170\001\202\001\206\000\000\002\166\000\000\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\000\000\004:\000\000\000\000\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\004\229\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\170\000\000\000\000\000\000\002\166\026v\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\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\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\000\000\000\000\000\000\026v"))
and lhs =
- (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\218\218\217\217\216\215\215\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\213\213\212\211\211\211\211\211\211\211\211\210\210\210\210\210\210\210\210\209\209\209\208\208\207\206\206\206\205\205\204\204\204\204\204\204\203\203\203\203\203\203\203\203\202\202\202\202\202\202\202\202\201\201\201\201\200\199\198\198\198\198\197\197\197\197\196\196\196\195\195\195\195\194\193\193\193\192\192\191\191\190\190\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\188\188\187\187\186\185\184\183\183\182\182\181\181\181\181\180\180\180\180\179\179\178\178\178\178\177\176\175\175\174\174\173\173\172\171\171\170\169\169\168\167\166\166\166\165\165\164\163\163\163\163\163\162\162\162\162\162\162\162\162\161\161\160\160\160\160\160\160\159\159\158\158\158\157\157\156\156\156\156\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\145\144\144\144\144\143\143\142\142\141\141\140\140\140\140\140\139\139\139\139\138\138\138\137\137\137\137\137\137\137\136\136\136\136\136\136\136\135\135\134\134\133\133\133\133\133\133\132\132\131\131\130\130\129\129\128\128\128\127~~~}}|||||||||{{zzyyyyyyyyyyyxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::9988776655544433322211110/...................-----,,,,,,,+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++**))))))))))))))))))))))(((((((((((((((((((((((((((((((((((((((((((((((((((''&&&%%$$$$$$$$$$$$$$$$##\"\"!!!!!!! \031\031\030\030\030\030\030\029\029\028\027\026\026\026\025\025\024\024\024\024\024\024\024\024\024\024\023\023\022\022\022\022\021\021\020\019\019\019\019\019\018\017\017\016\016\016\015\015\015\014\014\014\014\014\014\r\r")
+ (8, "\014\r\012\011\n\t\b\007\006\005\004\003\002\001\000\222\222\221\221\220\219\219\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\218\217\217\216\215\215\215\215\215\215\215\215\214\214\214\214\214\214\214\214\213\213\213\212\212\211\210\210\210\209\209\208\208\208\208\208\208\207\207\207\207\207\207\207\207\206\206\206\206\206\206\206\206\205\205\205\205\204\203\202\202\202\202\201\201\201\201\200\200\200\199\199\199\199\198\197\197\197\196\196\195\195\194\194\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\193\192\192\191\191\190\189\188\187\187\186\186\185\185\185\185\184\184\184\184\183\183\182\182\182\182\182\182\181\180\179\179\178\178\177\177\176\175\175\174\173\173\172\171\170\170\170\169\169\168\167\167\167\167\167\167\166\166\166\166\166\166\166\166\165\165\164\164\164\164\164\164\163\163\162\162\162\161\161\160\160\160\160\159\159\158\158\157\157\156\156\155\155\154\154\153\153\152\152\151\151\150\150\149\149\149\148\148\148\148\147\147\146\146\145\145\144\144\144\144\144\143\143\143\143\142\142\142\141\141\141\141\141\141\141\140\140\140\140\140\140\140\139\139\138\138\137\137\137\137\137\137\136\136\135\135\134\134\133\133\132\132\132\131\130\130\130\129\129\128\128\128\128\128\128\128\128\128\127\127~~}}}}}}}}}}}|{zyyxxxxxwvvuuttttttttttttttssrrqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqppoonnmmllkkjjiihhggffeeeeeeeeeeedcba`_^]\\[ZYYYYYYYYYYXXXWWWVVVVVUUUUUUUUUTTSSSSSRRQQPONNMMMMMLLKKJJJIIIIIIHHHGGFFEEDDCCBBBAA@@??>>==<<;;::99887776665554443333210000000000000000000/////.......-----------------------------------------------------------------,,++++++++++++++++++++++***************************************************))(((''&&&&&&&&&&&&&&&&%%$$#######\"\"\"\"!! \031\031\030\029\028\028\028\027\027\026\026\026\026\026\026\026\026\026\026\025\025\024\024\024\024\023\023\022\021\021\021\021\021\020\019\019\018\018\018\017\017\017\016\016\016\016\016\016\015\015")
and goto =
- ((16, "\000%\001k\000O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\245\000\208\000&\001K\000\241\000!\000\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\195\000\000\000\000\000\000\000\000\000\000\000\187\000\000\000\000\000\000\000\155\000\000\000\000\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\000\000\000\000\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000;(\0001\000&\000\217\000\000\000\234\002\132\000 \000\250\000\025\000\000\000\000\000\000\000|\000\000\000\000\002\132\000\000\000\000\000\000\000\000\001\234\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000H\000\000\002\234\002$\b\"\000\000\000\000\n\226;(\000\000\000\000\000)\000\000\002P\000\000\031V\001\014\000\000\000\250\001~\000\000\000\000\000\254\001B\002\188\003\158\004\200\002$\002\000\000\139\002\188\001\200\001L\002p\011\160\000\000>(\001\222\003\234\000\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\132\000\000\t\022>(\011\208\000\000\000\000\002 \004\252\002\0141\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000#h\000\000\002F\005\012\002\210\000\000\000\000\000\000\000\000\0068\000\000\000\000\005\016\000#\005@\006d\b\006\000\000\002\144\003\000\005\146\001\128\002\224\005\226\001H\000\000\000\000\003$\006f\012\006\000\000\002\234\012\144#\242$&\000\000\000u\000\000\000\000\000\000\000\000\003\226>$\004J\000\000\007\020\004f\000\000!>7\016\000\129\000\000\000\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001R\004\014\000\000\000\000\000\000\011\028\000\000\000\234\000\000\000\000\004\218\002(\000\000\000\000\007\158\000\000\015\224\000\000\004\218\000\254\004\218\000\000\000\000\000\000\000\000\000\0007$\000\000\006\188\0050\000\000\0216\007.\027V\000\000\000\000\000\000\004\218\000\000\000\000\000\000\000\000\004\158\000\000\000\000\000\000\000\000\000\0001\206\000\000\000\000\000\000\000\000\000\000\000\000\000@\005v\000\000\000\000\000\000\004\158\005\1542*\005\028\0074;\138\000\000\005T\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\000\000\000\000\006\1362<\000\000\000\000\005\142\007\2302J\000\000\000\000\000\0003\000\005~32\000\000\005~\000\0003<\005~\000\0003\162#h\006j\006\178\000\000\000\000;\196\000\000\000\000\000\000\000\000\000\000\000\000\005~\000\000\000\0003\234\000\000\005~>\\\000\000\004\158\000\000\000\0004\160\000\000\005~\000>\000\000\000\000\005~\005~\000\000\000\000\005~\000\000\000\000$&\000\000\000\000\000\000\000\000\005~$\176\000\000\000\000\005~\000\000\001P\006\244\000\000\000\000\000\000\000\000\000\000\000\000\000\0007v\000\000\006\136\000\000>\134\004\158\000\000\000\000\000\000\000\000\006\200\007^\012\132\006\190\006\218\006\222\b\218\004\246\b\230\000\015\007\186\000\000\000\000\t \tl\tZ\000&\007R\n\198\000\000\004\200\004\174\003\254\000\222\b\198\000\000\000\000.\204\000\000DL\b\142\000\000>\192\004\158>\216\004\158\000\000\000\188\003>\000\000\012f\004\200\000\000\000\000\007\198\000\000\000\000\000\000\000\000\000\000\014\246\004\200\016^\004\200\000\000\002\230\000\000\000\000\003\148\000\000\000\000\000\000\t\024\000\000\000\000\000\000\004\200\000\000\000\000\004\200\000\000\007R\0060\000\000\000>\002\224\000\000\000>\000\000\000\000\0174\004\200\000\000\000\000\000\000\000\000\000\000\000\000\000>\012\206\rx\t\022\b\206\004\1404\170\000\000\b>\n\000\r\194\bz\n\002?\024?N\000\000\000\000\000\000\000\000\000\000\004\014\t\192\000\000\000\000\000\000\b\166\nD\006\198\000>\017\198\000\000\004\200\000\000\000\000\000\000\012\144\000\000?\170\004\158\r\204\b\190\np\014\022\b\228\nv\014<$l\005~\0154\t:\n\200:\024\n:\000\000$\144\005~?\180\004\158\n>\000\000\000\000\000\000\000\000#h\n&\000\0007\172\015<\t\186\n\2024\224\005~\015~\t\208\n\212?V\000\000?~\000\000\000\000\015\164\006.\007F\000\000\000\000\000\000\000\000@>\000\000\000\000\000\000\000\252\015\254\000\000\000\000\000\000\000\000%\n@\146\000\000\000\000\000\000\000\000\000\000\t\166\016n\000\000\t\208%`\t\208%\180\t\208\000\000@\208\000\000%\190\t\208\017\012\004T\017h\000\000\000\000&\"\t\208&~\t\208&\162\t\208'D\t\208'd\t\208'\150\t\208(0\t\208(b\t\208(\130\t\208(\252\t\208),\t\208)N\t\208)\248\t\208*\026\t\208*:\t\208*\220\t\208*\228\t\208+&\t\208+\200\t\208+\208\t\208\n\218\017t5j#h\n\176\000\000,\148;\246\000\000\018\006\000\000@\012\000\000\004\158<H\000\000\004\158@\214\004\158\000\000\018*\000\000\000\000\000\000,\184\000\000\000\000<H\n\180\000\000@\246\004\158\018t\000\000\000\000\nD\000\000A\022\004\158\019\n\000\000\000\000\019r\000\000\000\000\000\000A4\004\158\019\162\000\000\n\026\019\236\000\0005*\000\000\005~5v\000\000\005~6\030\000\000\005~\004T\000\000\000\000\000\000\000\000\000\0006f\005~\000\000\004,\005\254\000\000\000\000\000\000\t\208\020\012\000\000\000\000\000\000\020<\000\000\000\000\000\000\000\000\000\000\021\026\000\000\000\000\000\000\t\208\021d\000\000\021\132\000\000\000\000\000\000\021\182\000\000\000\000\000\000\000\000A\130\000\000\000\000\022T\000\000\000\000\000\000,\238\t\208\022\254\000\000\000\000\000\000,\246\t\208\023\030\000\000\000\000\000\000-J\t\208\002\252\023N\000\000\000\000-\184\t\208\023\200\000\000\000\000.(\t\208\023\232\000\000\000\000.|\t\208\000\000\000\000\023~\000\000\000\000.\132\t\208\024\184\000\000\000\000.\198\t\208\024\198\000\000\000\000.\234\t\208\000\000/F\t\208\000\000<\146\000\000\000\000\t\208\000\000\000\000\025 \000\000\000\000\025z\000\000\000\000\n^\000\000\000\000\025\228\000\000\026.\000\000\000\000\000\000#h\011>\000\0007\246\002\160\004\218\026^\000\0008\000\000\000\000\000\000\0008D\000\000\000\000\026\244\000\000\027P\000\000\000\000\000\000\000\0000.\000\000\000\000\000\000/\170\t\2080n\t\208\000\000\n\026\027Z\000\000\000\000\027\180\000\0000\158\000\000\000\000?N\000\000\000\000\000\000\028\026\000\000\000\000\000\000\000\000\028J\000\000\000\000\000\000\000\000\011\204\000\000\000\000\000\0006\178\000\000\001\216\000\000\004F\000\000\011\150\000\000\002(\000\000\000\000\000\000\000\000\000\000\000\000\004\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\208\000\000\012\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\224\006\250\000>\028\196\000\000\011\024\n\228\011\194\004\180\007\182\000>\017\208\004\200\007\214\000>\000\000\029\026\000\000\006~\000\000\011\142\n\240\006\184\000\000\000\000\000\000\000\000\000\000\011\188\000\025\001\178\000\000\000\000\000\000<\154\000\000D\174\000\000\011$\000\000\011(\000\000\000\000\000\000\000\000\006\014\000\000\000\000\000\000\004\150\004\218\000\000\004\218\000\016\000\000\006j\004\218\004\218\011J\000\000\029\132\000\000\000\000\011T\012\142\000\000\029\180\b,\000\000\000\000\000\000\000\000\000\000\000\000\t\208\000\000\030\028\000\000\t\208\000\000\000\000\018L\000\000\004\200\000\000\018~\000\000\004\200\000\000\019>\004\200\000\000\001\b\000\000\011V\bp\001\244\000\000\011\208\011\216\011p\012\n\012\164\019\214\004\200\b\158\000\000\011\128\012\132\012\148\007\012\b\178\012l\011\152\012\176\007r\b\202\012\128\000\000\000\000\007\146\b\248\000\000\004\252\003 6\224\005~\030\128\000\000\006\000\003j\012:\011\154\t\n\003\184\000\000\012D\011\182\b\152\000\000A\206\004\158\012\244\012\248\000\000\t$\000\000\012h\011\196\bn\012\198\006\248\000\000\000\000\000\000\000\000\011\214\tn\000\000\011\244\t\146\000\000\bH3>\012\206\012\236\012\b\004\248\t\178\000\000\012\"\005\238\t\206\000\000\012\242\r\b\0126\r2\012\164\022\144\004\200\000\000\012>\r\164\000\000\b\006\000\000\nX\000\000\r\186\000\000\022\192\005\026\r\142\012J\r\200\000\000\0248\005Z\r\156\000\000\000\000\004\\\003^\n\138\000\000\024d\004\200\n\156\000\000\005\208\000\000\rZ\012~\024\140\005\168\000\000\r\\\012\142\b\194\012\198\r^\rh\012\170\014\196\000\000\r\160\003N\000\000\000\000\000\000\000\000\007\136\012\174\rxA\226\004\158\000\000\000i\012\186\014<\000\000\000\000\000\000\000\000\000\000\000\000A\242\006\026\000\000\012\198\014\144\000\000\000\000\000\000\000\000\000\000\000\000\022\b\000\000B2\004\158\n\160\000\000\004\158\012\214\b\196\000\000\012\246\012\254\t\248\000\000\n\150\026~\000\000\006\n\000\000B\166\004\158\004\158\000\000\000\000\006@\000\000\n \000\000\n\208\006@\006@\000\000\r$\":\004\158B\204\004\158\011x\000\000\000\000\000\000\000\000\011\154\000\000\000\000\0072\000\000\b\190\014\004\r6\015\028\r\214\000\000\000\000\011\166\t\002\014<\000\000\000\000\rH\015Z\014\024\000\000\000\000\012\158\000\000\b\188\000\000\015\2065|\004\158\000\000*\246\n\000\000\0002\226\000\000\000\000\000\000\006@\000\000\000\000\011\156\014~\r^\015\150\014h\000\000\000\0004l\011\180\014\216\000\000\000\000\000\0009\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\222\000\000\014\244\r`\005\014\000\000\015\230\015\162\011\238\015\012\000\000\000\000\015 \rn\005\236\000\000\000\000\tp7\016\006\182\000\000\000\000\000\000\tb\014\238\rv\000\000\015\004\tb\000\000\015\222\012*\015N\000\000\000\000\000\000\004\158\000O\000\208\t\020\000\000\000\000\000\000\000\000\015\018\rx\000\000\tl\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\158\015\000\r\128\016\\\015\022\000\0008\180\000\165\r\130\014\234\003\214\0000\r\138\015\162\000\000\016R\030\178\000\000\000\000\031\026\000\000\012T\000\000\004\246\000\000\000\000\000\000\000\000\000\000\000\000B\230\004\158\000\000\016X\031J\000\000\000\000\031\178\000\000\000\248\r\194\016\004\000\000\000\0009\002:\234\015\186\000\000B\246\004\158 \026\000\000\000\000 L\000\000\000\000\012t\000\000\002\162\000\000\000\000\000\000\000\000\000\000\000\000:\252\000\000\000\0009j;\006\015\188\000\000C\n\004\158 \176\000\000\000\000 \228\000\000\000\000\r\204!\024\012\146\000\000\r\208\r\230\003\136\003\210\r\242\b\154\014\006\016\024!\218\012\250\000\000\0140\014D\n*\000\000\005*<\196\000\000\007\234\000\000\014T9N9\182\005t\015\000\005\224\000\000;Z<\146\000\000\002\154\000\000\000\000\002\154\000\000\000\000\002\154\nZ\000\000\011\002\002\154\0166\"^\r(\000\000\002\154\000\000\000\000C\030\000\000\000\000\000\000\002\154\000\000\000\000\r\180\000\000\012\254\005\184\r\212\000\000\014j<\192\r\232\000\000\000\000\000\000\000\000\014\018\000\000\000\000\006*\000\000\002\154C\178\000\000\014\184\002\1549\194\000\000\014&\015\152\014n\016\178\015h\000\000:\006\014>\015\164\000\000\000\000\000\000\014\148\006\190\000\000\000\000\000\000\000\000\000\000\000\000\t\166\014\212\000\000\015\190\000\000\000\000\000\000\000\000\014\236=D\000\000\000\000\000\000\000\000\t\166\000\000\000\000\015\030=j\000\000\000\000\000\000\000\000\000\000\000>\004\200\000\000\000\000\005~\000\000C\200\004\158\000\000\007\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015r\014\176\t\220\000>\000\000\024\240\000\000\004\200\000\000\016\186\000\000\000\000\000\000\000\000\000\000\"\130\000\000\000\000\000\000\000\000\000\000\000\000\016b\004\020\n4\014\238\007v\014\178\000\000\003\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\018\t\170\014\180\000\000\b\014\016\196\016|\015$\000\000\000\000\016t\004Z\004\\\000\000\000\000\000\000\014\186\000\000\014\200\002z\000\000\000\000\004\218\003\014\000\000\000\000\000\000\000\000\000\000\019\174\000\000\000\000\bd\bR\000\000\000\000D\000\004\158\004\158\000\000D\024\004\158\t\242\000\000\000\000\000\000\004\158\000\000\000\000\n\004\016\132\015d\000\000\000\000\016x\004\"\000R\000\000\000\000\000\000\000\000\011H\016\196\n\b\016\136\015l\000\000\000\000\016|\bR\003\b\000\000\000\000\000\000\000\000\004\200\000\000\n\178\000\000\000\000\000\000\"\252\000\000#,\000\000\000\000\000\000\000\000\000\000\000\226\000\000\000\000\000\000\007\016\000\151\000\000\000\000\000\000\000\000\000\000\000\020\000\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t&\000\000\000\000\000\000=\164\000\000\004\158\000\000\n^\000\000\000\000\000\000\002\016\000\000\000\000\000\000\003T\000\000\000\000\000\000\000C\000\000\000\000\000\0000\184\005~\000\000\000\000\000|\000\000\000\000\000\000\000\000\004\014\004\194\015\188\004\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'6\000\000\015\148\000\000\000\000\000\000\000\000\005\012\006\174\000\170\002L\000\000\000\000\015\174\003\238\000\000\000\000\000\000\015\206\005\144\000\000\000\000\000\000\000\000"), (16, "\006(\0007\002,\002-\001e\000q\001e\000;\001\031\003\007\001\216\006\156\000\147\006\203\006\189\001\233\001\031\002n\006)\006\214\001\240\006+\001\019\000?\001\244\002o\001\023\006\209\001\023\000@\006,\0069\006\232\005Y\000m\001\"\001\031\006(\002}\002,\002-\001e\0007\005\142\001k\000\196\004\005\000\196\000\200\000\201\000\200\000\201\001\159\001e\002n\006)\0068\007\004\006+\006-\000\147\002\012\002o\000\156\001\016\001\245\004\005\006,\0069\000\196\001\023\001\026\000\200\001\002\000\\\002}\005\229\006o\000`\001\246\002\014\001\003\007\012\002-\001e\007\005\000\147\001\214\000\157\001\233\000\203\004\254\000\203\006.\000d\001\240\006-\002\127\001T\001\244\006\207\001\023\006/\006(\000y\005\231\001\006\006I\001\016\0020\002\027\002\129\000\200\000\200\001\023\001$\001\016\005\001\007'\003\007\005\232\007(\001\023\001$\006+\005\234\006>\000\202\002\025\006\022\006.\0055\005\003\006,\002\127\001\027\001\016\005`\005a\006/\001\245\006?\001\023\001$\0007\001\031\0020\001W\002\129\000\200\007\014\0062\005\004\005q\006\216\001\031\0064\005j\004\019\0056\006\218\0057\006-\006>\000\128\0007\0066\001%\000\129\002\130\002\028\002\136\002\006\005\144\000:\001%\005Y\002\142\006?\001\139\002\132\004\b\0067\006\233\002,\002-\001e\006\185\0062\007\015\0058\002\129\000\200\0064\001.\001%\006.\001l\002\006\002n\002\144\004\011\004\t\0066\000\134\006/\002\130\002o\002\136\006(\003\007\002,\002-\001e\002\142\0009\001\139\002\132\006\186\0067\002}\001\251\004\014\0059\000\200\007*\002n\006)\0068\002\025\006+\000\203\005:\005;\002o\005<\000\203\002\144\000\196\006,\0069\000\200\001\002\002\026\0061\001\016\006(\002}\002,\002-\001e\001\023\001$\003\020\0062\001\016\000\200\001\002\005x\0064\005\177\001\023\001$\002n\006)\0068\000\132\006+\006-\0066\000\151\002o\006\142\005\179\000\135\001\221\006,\0069\0042\002\127\005`\005a\005>\006\220\002}\0067\003\178\005@\005J\002\014\003%\0020\000\150\002\129\000\200\000\196\005i\005t\000\200\001\002\005j\004\019\006.\000\183\001%\006-\002\127\001\182\000\172\006m\000\179\006/\006(\005u\001%\000\178\0041\000=\0020\002\027\002\129\000\200\000\200\002\133\001\031\000\184\003\184\007'\003\007\000\203\007(\001&\001\006\006+\003\245\006>\000\203\000\203\000\174\006.\0055\0010\006,\002\127\002\026\001\031\000\147\002\025\006/\000\152\006?\002\130\005\184\004#\000\188\0020\006\252\002\129\000\200\002\142\0062\001\139\002\132\000\196\001\031\0064\000\200\001\002\0056\006\200\0057\006-\006>\000\203\000\147\0066\006\132\001\233\002\130\002\028\002\136\000\153\002\144\004\000\004\002\004\004\002\142\006?\001\139\002\132\0007\0067\006\253\002,\002-\001e\0046\0062\001\023\0058\003\179\006\181\0064\000\196\001\016\006.\000\200\001\002\002n\002\144\001\023\001\026\0066\005\188\006/\002\130\002o\002\136\006(\001\031\002,\002-\001e\002\142\001\016\001\139\002\132\000\193\0067\002}\001\023\001$\0059\006\154\007)\002n\006)\0068\006\004\006+\003\179\005:\005;\002o\005<\001\016\002\144\000\147\006,\0069\000\152\001\023\001$\0061\006\149\006(\002}\002,\002-\001e\000\211\000\189\002\026\0062\001\016\002\014\003\007\005x\0064\006R\001\023\001$\002n\006)\0068\001(\006+\006-\0066\000\224\002o\006@\004\185\001%\000\228\006,\0069\000\147\002\127\000\181\001\233\005>\002\018\002}\0067\002\027\005@\005J\000\200\001\253\0020\001\016\002\129\000\200\001%\001\023\005t\001\023\001$\003K\006\150\006.\000\200\001\002\006-\002\127\0043\007\000\006<\001\016\006/\006(\005u\001%\000\203\001\023\001$\0020\006\152\002\129\000\200\006\150\002\133\001\236\006\199\000\147\007'\001\220\001\233\007(\003\192\001e\006+\001\240\006>\005\236\003\\\001\244\006.\001\023\003z\006,\002\127\007\001\003\007\002\028\000\200\006/\004\161\006?\002\130\000\200\004\031\000\186\0020\006\186\002\129\000\200\002\142\0062\001\139\002\132\000\241\002\025\0064\002\255\001e\003\180\001%\000\196\006-\006>\000\200\000\201\0066\003\007\002\000\002\130\001\245\002\136\000\249\002\144\001\023\006x\0007\002\142\006?\001\139\002\132\006\184\0067\001Y\002,\002-\001e\006\150\0062\007\024\002-\001e\005\229\0064\003\007\002\001\006.\001\031\000\196\002n\002\144\000\200\000\201\0066\004\\\006/\002\130\002o\002\136\006(\006\140\002,\002-\001e\002\142\006\014\001\139\002\132\003\007\0067\002}\005\231\006p\007\027\007\028\007-\002n\007\030\003\181\005\229\006+\001)\000\194\005\149\002o\006y\005\232\002\144\001\n\006,\007 \005\234\006\017\002\002\0061\006\001\006(\002}\002,\002-\001e\007/\001\r\000\147\0062\005C\001\233\006\019\005\231\0064\0007\007'\003\t\002n\007(\004\165\006z\006+\006-\0066\002\026\002o\003\007\005\232\001\030\006{\006,\0070\005\234\002\127\006|\006}\005\250\006\020\002}\0067\006\141\006\187\006\188\006~\006\127\0020\001`\002\129\000\200\000\203\007\025\001\016\002\129\000\200\006\128\004\019\006.\001\023\001$\006-\002\127\005j\004\019\000\204\003\228\006/\006(\003\007\002\014\006|\006}\006z\0020\004\167\002\129\000\200\001\016\002\133\006~\006\127\006{\007'\001\023\001$\007(\001\016\007#\006+\005\153\006\128\004\019\001\023\001$\006.\004\138\002\029\006,\002\127\002\027\003\007\004}\000\200\006/\002\148\006?\002\130\001\023\003\201\001;\0020\001%\002\129\000\200\002\142\0062\001\139\002\132\003\231\000\147\0064\005M\001\233\0074\000\212\000\196\006-\000\203\000\200\000\201\0066\001B\000\225\002\130\000\234\002\136\004\150\002\144\004\007\003\007\001G\002\142\006?\001\139\002\132\0007\0067\001\016\002,\002-\001e\001V\0062\001\023\001$\001\177\005\229\0064\000\236\002\028\006.\001\239\000\196\002n\002\144\000\200\000\201\0066\004\156\006/\002\130\002o\002\136\006(\006\b\002,\002-\001e\002\142\001\\\001\139\002\132\003\007\0067\002}\005\231\001\031\000\203\004Q\0072\002n\006)\006F\005\229\006+\000\203\003\007\000\203\002o\000\242\005\232\002\144\001\239\006,\0069\005\234\004\168\004\173\0061\005\241\006(\002}\002,\002-\001e\003\007\000\196\001\175\0062\000\200\000\201\000\203\005\231\0064\004\129\007'\002\014\002n\007(\003\245\001\023\006+\006-\0066\001\239\002o\001t\005\232\001\016\000\245\006,\007+\005\234\002\127\001\023\001\026\005\238\005\229\002}\0067\003\b\001\216\001~\002\015\006J\0020\002\027\002\129\000\200\000\200\004\167\001\240\000\203\006\225\004\206\001\244\006.\001\023\006\021\006-\002\127\001\031\001\135\001\239\001 \006/\005\231\0012\004\003\004\002\004\004\005\236\0020\004\246\002\129\000\200\001\016\002\133\002,\002-\001e\005\232\001\023\001$\003\232\006\017\005\234\0013\001\"\006>\005\235\002\014\000\203\006.\001Q\000\250\001\245\002\127\001\134\004\233\006\019\003_\006/\003\245\006?\002\130\002\028\003c\004W\0020\001\246\002\129\000\200\002\142\0062\001\139\002\132\002\014\0029\0064\001G\002\027\007.\001\181\000\200\003`\006\020\006\226\001\193\0066\001\031\001*\002\130\001+\002\136\001%\002\144\003\231\001E\004\240\002\142\006?\001\139\002\132\003\215\0067\004n\002\027\0018\000\200\000\200\0062\005R\004\002\004\004\004D\0064\001\"\000\203\006\227\001\198\001\016\004\r\002\144\006\234\001\023\0066\001\023\001$\002\130\004\027\002\136\006(\002/\002,\002-\001e\002\142\004\020\001\139\002\132\002\028\0067\003\241\004\019\0020\006\137\002\129\000\200\002n\006)\005\005\003\213\006+\001\203\001C\001\031\002o\001]\001 \002\144\000\203\006,\006B\006\235\0055\004I\002\028\003\231\004n\002}\002\014\000\200\001>\004q\001\031\001\139\005\001\001 \001\016\001%\003b\004N\001\"\001F\001\023\001\026\002\014\006\236\006\163\001\016\006-\005\003\0056\005w\0057\001\023\001$\003\223\001\209\005Y\002\027\001\"\002\005\000\200\002\130\006\237\001.\004`\001e\001H\003\007\005\004\002\131\003\227\001\139\002\132\002\027\000\203\003\231\000\200\000\203\006\198\001\226\0058\006.\001*\000\196\0007\002\127\000\200\000\201\006S\001\031\006/\003\231\005\026\006v\004\237\001\139\006\176\0020\004\144\002\129\000\200\001*\001\016\001u\001\023\001%\004\238\001\228\001\023\001$\005\006\001\243\001\016\0059\006E\006\017\001\"\002\028\001\023\001$\002\014\002\004\005:\005;\003\007\005<\002,\002-\001e\006?\006\019\001\016\001.\002\028\003\007\004\025\001\016\001\023\001$\0062\003\007\002n\001\023\001\026\0064\001\016\003\007\0045\005x\002o\002\027\001\023\001$\000\200\0066\006d\006\020\002\130\003\206\002\136\005`\005a\002}\005\224\001>\002\142\000\203\001\139\002\132\003\007\0067\001%\005>\003\202\003\007\005b\005r\005@\005J\001\031\005j\004\019\001 \001>\006\187\006\188\002&\005t\002\144\001\016\001%\003\007\004?\001\016\005y\001\023\001$\002\014\001.\001\023\001\026\001H\004E\005u\005j\004\019\001\"\006\162\005\007\006\240\002\028\002,\002-\001e\004J\000m\002)\001.\004k\004\019\001H\002\127\003\245\005Y\004[\001\204\002n\002\027\003\007\001\216\000\200\001\206\002\n\0020\002o\002\129\000\200\004O\0027\001\240\003\158\004n\005\015\001\244\000\200\001\023\003\007\002}\001%\001*\002F\001\031\004\237\001\031\005!\001\031\001 \005\211\001 \004g\004\177\004\019\003\007\005\\\004\238\002\133\003\245\001\216\004\245\002I\002\007\005f\004\002\004\004\004\240\001.\003\007\001\240\001\"\001\016\001\"\001\244\001\"\001\023\001\245\001\023\001$\002\028\000\203\001\213\002,\002-\001e\002\130\000\203\002\136\004s\005Y\001\246\005Y\000m\002\142\002\014\001\139\002\132\002n\002\127\004n\004\240\006\241\000\200\001\139\002O\002o\004v\005n\004\002\004\004\0020\006\248\002\129\000\200\001\245\001*\002\144\001*\002}\005`\005a\006^\004~\001>\002\027\003\245\002[\000\200\001\246\006\178\001%\006\192\005V\004\019\005b\005r\004\130\003\007\004\228\005j\004\019\000\200\002\133\001\016\000\203\001\016\002X\001\016\002^\001\023\001$\001\023\001$\001\023\001$\006\250\001\031\001.\004\242\001 \001H\000\200\003\007\005\219\002'\002*\000\200\006\130\002b\001\139\002\130\003\007\002\136\003\007\006\171\004\002\004\004\002\127\002\142\002g\001\139\002\132\003\007\001\"\002\028\001\031\003\n\005\243\001 \0020\000\200\002\129\000\200\005`\005a\005`\005a\001>\0028\001>\005Y\002\144\001%\002\141\001%\004\145\001%\006\195\005b\005r\005b\005r\001\"\005j\004\019\005j\004\019\002\196\001\016\002\220\002G\002\133\002\227\002J\001\023\001\026\001*\000\203\000\203\001.\004\162\001.\001\216\001.\001H\001\217\001H\006t\004\019\004\166\003\000\004\220\001\240\002,\002-\001e\001\244\001\016\001\023\002\130\006\206\002\136\003o\001\023\001\026\001*\001\016\002\142\002n\001\139\002\132\000\203\001\023\001$\002P\002c\002o\002,\002-\001e\002h\000\196\006i\002\192\000\200\000\201\003\214\004\237\003\220\002}\002\144\003\007\002n\000\203\003\235\001\016\000\203\001\245\003w\004\238\002o\001\023\001$\004\239\002,\002-\001e\003\172\003\007\003\007\006W\001\246\005\229\002}\005`\005a\004\237\001\016\001>\002n\003\252\003\007\003\254\001\023\001$\001%\001G\002o\004\238\006\174\006\175\003\182\004\244\004 \005j\004\019\003\204\000\203\000\203\004\016\002}\005\231\003\007\000\203\004\021\0044\000\203\0011\002\127\000\203\003\007\000\203\001.\003\219\001%\001H\005\232\000\203\004:\004\253\0020\005\234\002\129\000\200\001\016\005\245\004A\002,\002-\001e\001\023\001\026\002\127\003\221\001\187\001e\005\002\005*\004G\004Z\003\007\001.\002n\000\203\0020\000\203\002\129\000\200\001\031\0052\002o\005\030\002\133\004_\001f\002A\004\026\001h\001i\002\127\004j\003\007\000\203\002}\002,\002-\001e\000\203\000\203\004r\005?\0020\003\234\002\129\000\200\001\"\002\133\003\007\005G\002n\002\130\000\203\002\136\004\237\004u\004\015\004\023\002o\002\142\000\203\001\139\002\132\003\007\003\212\004|\004\238\003\148\003\001\003\002\005\014\002}\000\203\000\203\002\133\002\130\004@\003\026\004\128\005^\0049\001\216\002\144\002\142\001\238\001\139\002\132\000\203\004\134\005 \004;\001\240\004\140\002\127\000\203\001\244\004>\001\023\004\152\001\127\005\143\004M\002\130\000\203\002\136\0020\002\144\002\129\000\200\004C\002\142\001n\001\139\002\132\000\200\003\007\005\178\004L\000\203\001\016\002,\002-\001e\004H\004\171\001\023\005#\004K\000\203\004Y\002\127\005\204\004\176\002\144\004^\002n\001\245\002\133\003\007\003\151\003\156\000\203\0020\002o\002\129\000\200\004\181\004f\004\191\004e\001\246\000\203\004i\003\209\004\197\000\203\002}\002,\002-\001e\004\208\000\203\002,\002-\001e\002\130\000\196\002\136\004\223\000\200\000\201\001\129\002n\002\142\002\133\001\139\002\132\002n\005$\001\130\002o\001\139\001l\005\215\004\241\002o\003\195\000\203\004\227\004t\004\238\003\147\005)\002}\005&\000\203\002\144\005\229\002}\002,\002-\001e\002\130\004\127\002\136\001.\005\249\004\248\003\007\000\203\002\142\000\203\001\139\002\132\002n\002\127\005\t\000\203\004{\001d\001e\004\139\002o\000\203\003\007\005\019\005\231\0020\003\142\002\129\000\200\000\203\004\133\002\144\003\007\002}\005,\005B\004\135\001f\001v\005\232\001h\001i\005L\004\159\005\234\000\203\005X\005l\006\007\000\203\002\127\005|\005\130\003\007\004\147\002\127\005\134\002\133\006(\004\158\003\138\004\153\0020\003\007\002\129\000\200\004\157\0020\000\203\002\129\000\200\004\170\004\175\005\018\006\005\003\007\006)\000\203\004\180\006+\001w\004\183\001x\002L\005\162\002\130\000\203\003\026\006,\005\202\006\t\006\006\002\127\002\142\002\133\001\139\002\132\000\203\000\203\002\133\006\r\004\187\005\207\004\195\0020\000\203\002\129\000\200\005\246\000\203\000\203\001\127\004\202\004\213\000\203\000\203\002\144\006-\005\212\000\203\005\017\006\018\002\130\001n\002\136\005\n\000\200\002\130\005\011\002\136\002\142\006\030\001\139\002\132\003\141\002\142\002\133\001\139\002\132\005\242\002,\002-\001e\006%\002,\002-\001e\000\203\005\016\005\218\003\007\006.\000\203\002\144\000\203\002n\005\020\005\226\002\144\002n\006/\005\021\003\007\002o\002\130\000\203\002\136\002o\006\011\003\131\006 \000\203\002\142\003t\001\139\002\132\002}\002,\002-\001e\002}\000\203\0054\001\129\0060\000\196\005-\003\007\000\200\000\201\003\007\001\130\002n\001\139\001l\002\144\002,\002-\001e\0061\002o\005.\000\203\006]\006w\006\131\003l\001\216\006\145\0062\001\248\002n\000\203\002}\0064\006\147\005\229\001\240\0063\002o\000\203\001\244\003\007\001\023\0066\001\031\003\007\0053\005\030\003d\006:\000\203\002}\000\203\001\031\002\127\005I\001 \005E\002\127\0067\002,\002-\001e\005F\005\231\003\007\0020\005H\002\129\000\200\0020\001\"\002\129\000\200\006C\002n\005s\006\136\003\007\005\232\001\"\001\245\005W\002o\005\234\000\203\000\203\000\203\006\026\002z\000\203\002\127\005[\005]\003\007\001\246\002}\000\203\002\133\005_\005k\005{\002\133\0020\005}\002\129\000\200\005~\005\131\006\180\002\127\005\135\005\139\006\194\005 \005\157\002,\002-\001e\005\164\005\168\005\192\0020\001*\002\129\000\200\002\130\005\213\002\136\005\237\002\130\002n\002\136\007!\002\142\002\133\001\139\002\132\002\142\002o\001\139\002\132\005\247\006'\001\016\002\135\007,\006!\006\"\006&\001\023\005#\002}\001\016\002\133\002\127\0065\002\144\006\\\001\023\001$\002\144\0071\002\130\006g\002\136\006r\0020\006\134\002\129\000\200\002\142\006\135\001\139\002\132\006\139\006\179\006\183\006\193\006\197\007\019\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002\144\002,\002-\001e\000\000\002\133\000\000\000\000\000\000\005$\000\000\001-\001\216\000\000\000\000\001\250\002n\002\127\001%\002\144\000\000\004\238\001\240\005(\002o\005&\001\244\000\000\001\023\0020\002\150\002\129\000\200\002\130\000\000\002\136\001.\002}\000\000\000\000\000\000\002\142\000\000\001\139\002\132\001.\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\002\193\001e\000\000\000\000\000\000\000\000\000\000\002\133\002n\000\000\002\144\000\000\000\000\001\245\000\000\000\000\002o\000\000\000\000\000\000\002\236\001v\002\149\001h\001i\000\000\000\000\001\246\000\000\002}\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\136\000\000\000\000\000\000\000\000\002\127\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\241\003\001\003\002\001\216\002\144\000\000\002\022\000\000\000\000\000\000\002,\002-\001e\001\240\000\000\000\000\000\000\001\244\000\000\001\023\000\000\000\000\000\000\000\000\002\133\002n\002\127\000\000\002,\002-\001e\000\000\001\127\002o\000\000\000\000\000\000\000\000\0020\002\201\002\129\000\200\000\000\002n\001n\000\000\002}\000\200\000\000\000\000\000\000\002o\002\130\000\000\002\136\000\000\000\000\002\212\001\245\000\000\002\142\000\000\001\139\002\132\002}\002,\002-\001e\000\000\000\000\002\133\000\000\001\246\000\000\000\000\000\000\001\216\003\005\003\006\002<\002n\001\216\000\000\002\144\003\225\000\000\001\240\000\000\002o\000\000\001\244\001\240\001\023\000\000\002\224\001\244\000\000\001\023\002\130\000\000\002\136\002}\000\000\000\000\001\129\002\127\002\142\000\000\001\139\002\132\000\000\000\000\001\130\000\000\001\139\001l\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\127\000\000\000\000\000\000\000\000\000\000\002\144\000\000\001\245\000\000\000\000\000\000\0020\001\245\002\129\000\200\000\000\002,\002-\001e\001\216\000\000\001\246\004(\000\000\000\000\002\133\001\246\000\000\000\000\001\240\000\000\002n\000\000\001\244\000\000\001\023\002\127\000\000\000\000\002o\000\000\000\000\000\000\002\133\001\216\002\231\000\000\004,\0020\000\000\002\129\000\200\002}\002\130\001\240\002\136\000\000\000\000\001\244\000\000\001\023\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002,\002-\001e\002\130\000\000\002\136\001\245\000\000\000\000\000\000\000\000\002\142\002\133\001\139\002\132\002n\002\144\000\000\000\000\000\000\001\246\000\000\000\000\002o\002,\002-\001e\000\000\000\000\002\234\000\000\001\245\000\000\000\000\002\144\000\000\002}\000\000\001\031\002n\002\130\001 \002\136\002\127\000\000\001\246\000\000\002o\002\142\000\000\001\139\002\132\000\000\002\240\000\000\0020\000\000\002\129\000\200\000\000\002}\002,\002-\001e\000\000\001\"\000\000\000\000\000\000\000\000\000\000\002\144\001\216\000\000\000\000\004/\002n\002,\002-\001e\000\000\000\000\001\240\000\000\002o\000\000\001\244\002\133\001\023\000\000\002\243\000\000\002n\000\000\000\000\002\127\000\000\002}\000\000\000\000\002o\002,\002-\001e\000\000\000\000\003\r\0020\001*\002\129\000\200\000\000\000\000\002}\000\000\002\130\002n\002\136\000\000\002\127\000\000\000\000\000\000\002\142\002o\001\139\002\132\001\245\000\000\000\000\003\017\0020\000\000\002\129\000\200\000\000\000\000\002}\001\016\002\133\000\000\001\246\000\000\000\000\001\023\001$\002\144\000\000\001\216\000\000\000\000\004=\000\000\000\000\000\000\000\000\002\127\000\000\001\240\000\000\000\000\000\000\001\244\002\133\001\023\000\000\000\000\002\130\0020\002\136\002\129\000\200\002\127\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\006\158\002\130\000\000\002\136\000\000\000\000\002\127\001%\002\144\002\142\002\133\001\139\002\132\001\245\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002,\002-\001e\000\000\002\133\001\246\000\000\000\000\000\000\000\000\002\144\000\000\001.\000\000\000\000\002n\002\130\000\000\002\136\000\000\000\000\000\000\001\031\002o\002\142\001 \001\139\002\132\002\133\000\000\000\000\000\000\002\130\003\023\002\136\000\000\002}\002,\002-\001e\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002\144\000\000\001\"\000\000\000\000\002n\002,\002-\001e\002\130\001<\002\136\000\000\002o\000\000\000\000\002\144\002\142\000\000\001\139\002\132\002n\000\000\003\028\000\000\000\000\002}\000\000\000\000\002o\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\003\030\002\144\000\000\002}\000\000\000\000\001*\002n\000\000\002\127\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\003\"\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\002\127\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\002,\002-\001e\0020\000\000\002\129\000\200\004\216\000\000\000\000\002\130\000\000\003\026\000\000\000\000\002n\002\127\001>\002\142\002\133\001\139\002\132\004\219\002o\001%\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\003*\000\000\002\133\002}\000\000\000\000\000\000\001*\002\144\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\026\000\000\001.\000\000\000\000\001D\002\142\000\000\001\139\002\132\000\000\002\133\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\001\016\002\142\000\000\001\139\002\132\000\000\001\023\001$\002\144\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\002\130\000\000\003\026\000\000\000\000\000\000\002\144\002\127\002\142\000\000\001\139\002\132\002n\002,\002-\001e\000\000\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\002n\000\000\0030\002\144\000\000\002}\001>\000\000\002o\002,\002-\001e\001\216\001%\000\000\004\137\000\000\004\221\0036\000\000\000\000\002}\001\240\002\133\002n\000\000\001\244\000\000\001\023\000\000\000\000\000\000\002o\002,\002-\001e\001\216\000\000\003=\004\149\001.\000\000\000\000\001H\000\000\002}\001\240\000\000\002n\000\000\001\244\002\130\001\023\003\026\000\000\000\000\002o\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\003N\001\245\000\000\002}\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\001\246\002\144\000\000\000\000\002n\002,\002-\001e\000\000\000\000\001\245\0020\002o\002\129\000\200\000\000\000\000\000\000\003B\000\000\002n\000\000\000\000\002\127\001\246\002}\000\000\002\133\002o\000\000\000\000\000\000\000\000\000\000\003G\0020\000\000\002\129\000\200\000\000\000\000\002}\000\000\002\133\000\000\000\000\000\000\002\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\026\000\000\0020\000\000\002\129\000\200\002\142\000\000\001\139\002\132\002\133\000\000\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002\130\0020\002\136\002\129\000\200\002\127\000\000\002\144\002\142\000\000\001\139\002\132\000\000\000\000\002,\002-\001e\0020\000\000\002\129\000\200\002,\002-\001e\002\130\000\000\003\026\000\000\000\000\002n\000\000\002\144\002\142\002\133\001\139\002\132\002n\002o\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\003S\001\216\002\133\002}\004\155\000\000\000\000\003X\002\144\000\000\002}\001\240\000\000\000\000\002\130\001\244\002\136\001\023\000\000\002,\002-\001e\002\142\001\216\001\139\002\132\004\164\000\000\000\000\000\000\002\130\000\000\002\136\001\240\002n\000\000\000\000\001\244\002\142\001\023\001\139\002\132\002o\001\216\000\000\002\144\004\172\000\000\000\000\000\000\000\000\000\000\003g\001\240\000\000\002}\001\245\001\244\000\000\001\023\000\000\002\144\002\127\000\000\002,\002-\001e\000\000\000\000\002\127\001\246\000\000\000\000\000\000\0020\000\000\002\129\000\200\001\245\002n\000\000\0020\000\000\002\129\000\200\000\000\000\000\002o\000\000\000\000\000\000\000\000\001\246\001\216\000\000\000\000\006b\003j\001\245\000\000\002}\000\000\000\000\001\240\000\000\000\000\002\133\001\244\000\000\001\023\000\000\000\000\001\246\002\133\002\127\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002n\000\000\002\130\000\000\003\026\000\000\000\000\000\000\002o\002\130\002\142\003\026\001\139\002\132\003p\000\000\001\245\002\142\000\000\001\139\002\132\002}\002,\002-\001e\000\000\002\133\002\127\000\000\000\000\001\246\000\000\000\000\002\144\000\000\000\000\000\000\002n\000\000\0020\002\144\002\129\000\200\000\000\000\000\002o\002,\002-\001e\000\000\000\000\003r\000\000\000\000\002\130\000\000\003\026\000\000\002}\000\000\000\000\002n\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002o\001\031\002\133\000\000\001 \000\000\003|\000\000\000\000\000\000\000\000\002\127\000\000\002}\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\001\"\000\000\002\130\000\000\003\026\004\231\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\002\127\000\000\000\000\000\000\002,\002-\001e\002\133\000\000\000\000\000\000\000\000\0020\002\144\002\129\000\200\000\000\000\000\000\000\002n\000\000\000\000\000\000\001*\002\127\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\003\133\000\000\002\130\0020\002\136\002\129\000\200\002}\000\000\000\000\002\142\002\133\001\139\002\132\000\000\000\000\000\000\002,\002-\001e\001\016\000\000\002,\002-\001e\000\000\001\023\001$\001\031\000\000\000\000\001 \002n\002\144\000\000\002\133\000\000\002n\000\000\002\130\002o\002\136\000\000\000\000\000\000\002o\003\136\002\142\000\000\001\139\002\132\003\150\000\000\002}\000\000\001\"\000\000\000\000\002}\000\000\000\000\000\000\000\000\002\130\000\000\002\136\002\127\002,\002-\001e\002\144\002\142\001>\001\139\002\132\000\000\000\000\000\000\0020\001%\002\129\000\200\002n\004\236\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\144\000\000\003\153\000\000\001*\000\000\000\000\000\000\000\000\002}\000\000\000\000\001.\000\000\000\000\001H\002\133\000\000\002\127\000\000\000\000\000\000\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\001\016\0020\000\000\002\129\000\200\002n\001\023\001$\000\000\000\000\002\130\000\000\002\136\002o\002,\002-\001e\000\000\002\142\000\000\001\139\002\132\000\000\003\163\000\000\000\000\002}\000\000\002\133\002n\000\000\000\000\000\000\002\133\002\127\000\000\000\000\002o\000\000\000\000\000\000\002\144\000\000\000\000\000\000\000\000\0020\003\168\002\129\000\200\002}\000\000\001>\000\000\000\000\000\000\002\130\000\000\002\136\001%\000\000\002\130\000\000\002\136\002\142\000\000\001\139\002\132\000\000\002\142\000\000\001\139\002\132\000\000\000\000\002,\002-\001e\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\127\001.\002\144\000\000\001?\002n\000\000\002\144\000\000\000\000\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\003\217\000\000\002\130\000\000\002\136\002\127\000\000\002}\000\000\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\144\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\003\230\000\000\000\000\000\000\000\000\000\000\002\133\002}\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\0020\003\026\002\129\000\200\002n\000\000\002\144\002\142\000\000\001\139\002\132\000\000\002o\000\000\002\193\001e\000\000\000\000\004\018\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\002\144\002\127\002\133\000\000\002\236\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\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\000\000\002\136\000\000\000\000\000\000\001d\001e\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002\133\002\241\003\001\003\002\000\000\000\000\000\000\000\000\000\000\002\127\000\000\001f\001v\000\000\001h\001i\002\144\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\002\130\000\000\002\136\000\000\000\000\001\127\004\"\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\002\133\001w\002n\001x\002L\000\000\002\144\000\000\000\000\000\000\002o\000\000\002,\002-\001e\000\000\004U\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\003\005\004\024\002n\002\130\000\000\002\136\000\000\001\127\000\000\000\000\002o\002\142\000\000\001\139\002\132\000\000\005\138\000\000\000\000\001n\000\000\000\000\000\200\002}\000\000\000\000\000\000\001\129\000\000\000\000\003\141\000\000\000\000\000\000\002\144\001\130\000\000\001\139\001l\002,\002-\001e\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\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002o\002,\002-\001e\000\000\000\000\005\141\0020\000\000\002\129\000\200\000\000\000\000\002}\000\000\001\031\002n\001\129\001 \000\000\002\127\000\000\000\000\000\000\002o\001\130\000\000\001\139\001l\000\000\005\156\000\000\0020\000\000\002\129\000\200\000\000\002}\000\000\002\133\000\000\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\248\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\006\144\002\130\002n\002\136\000\000\000\000\002\127\000\000\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\005\159\000\000\0020\001*\002\129\000\200\000\000\002}\000\000\000\000\002\130\000\000\002\136\000\000\002\127\000\000\002\144\000\000\002\142\000\000\001\139\002\132\000\000\002,\002-\001e\0020\000\000\002\129\000\200\000\000\000\000\000\000\001\016\002\133\000\000\000\000\000\000\002n\001\023\001$\002\144\000\000\000\000\000\000\000\000\002o\000\000\002,\002-\001e\000\000\005\172\000\000\000\000\000\000\000\000\000\000\002\133\002}\000\000\000\000\002\130\002n\002\136\000\000\002\127\000\000\000\000\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\005\175\0020\000\000\002\129\000\200\000\000\000\000\002}\001>\002\130\000\000\002\136\000\000\000\000\000\000\001%\002\144\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\002n\000\000\000\000\000\000\002\144\002\127\001.\000\000\002o\003\255\000\000\002,\002-\001e\005\196\000\000\000\000\0020\000\000\002\129\000\200\002}\000\000\000\000\000\000\002\130\002n\002\136\000\000\000\000\002\127\000\000\000\000\002\142\002o\001\139\002\132\002,\002-\001e\005\199\000\000\0020\000\000\002\129\000\200\000\000\002}\000\000\002\133\000\000\000\000\002n\000\000\000\000\000\000\002\144\000\000\000\000\000\000\002o\000\000\000\000\000\000\001\031\000\000\005\203\001 \000\000\000\000\0012\000\000\000\000\002}\002\133\000\000\000\000\002\130\000\000\002\136\002\127\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\0013\001\"\0020\000\000\002\129\000\200\000\000\001O\000\000\000\000\000\000\000\000\002\130\000\000\002\136\000\000\002\127\000\000\002\144\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\127\002\144\001*\002\193\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\133\0018\002\130\000\000\002\136\002\236\001v\000\000\001h\001i\002\142\000\000\001\139\002\132\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\002\133\000\000\002\130\000\000\002\136\000\000\000\000\002\144\000\000\000\000\002\142\000\000\001\139\002\132\001\031\000\000\000\000\001 \000\000\000\000\000\000\002\241\003\001\003\002\000\000\002\193\001e\000\000\002\130\000\000\002\136\000\000\000\000\002\144\000\000\000\000\002\142\000\000\001\139\002\132\001>\001\"\000\000\001d\001e\002\236\001v\001%\001h\001i\000\000\001F\000\000\001\127\000\000\000\000\000\000\000\000\000\000\002\144\000\000\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\006l\002\241\003\001\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\005\005\214\000\000\000\000\000\000\002,\002-\001e\001w\000\000\001x\002L\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\002n\001\127\001\023\001$\000\000\000\000\000\000\001\129\002o\002,\002-\001e\000\000\001n\006\210\001\130\000\200\001\139\001l\001\127\000\000\002}\000\000\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\001n\002o\000\000\000\200\000\000\000\000\000\000\006\212\000\000\001d\001e\003\141\000\000\000\000\002}\003\005\005\248\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\004\249\001f\001v\004\252\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002\127\001\130\001.\001\139\001l\001H\000\000\000\000\000\000\000\000\000\000\001\129\0020\000\000\002\129\000\200\000\000\000\000\000\000\001\130\000\000\001\139\001l\001w\002\127\001x\001\143\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000m\001f\001v\000\000\001h\001i\001\127\001d\001e\000\000\000\000\001\184\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\002\133\000\200\000\000\000\000\002\130\000\000\002\136\001f\001v\000\000\001h\001i\002\142\000\000\001\139\002\132\000\000\001\169\000\000\000\000\000\000\000\000\001d\001e\001w\000\000\001x\001\172\002\130\000\000\002\136\000\000\000\000\000\000\000\000\002\144\002\142\000\000\001\139\002\132\001d\001e\001f\001v\000\000\001h\001i\000\000\000\000\000\000\001w\000\000\001x\001\172\000\000\001\127\001d\001e\001\129\002\144\001f\001v\000\000\001h\001i\000\000\001\130\001n\001\139\001l\000\200\000\000\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\001\127\000\000\000\000\000\000\001w\001\174\001x\002L\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\002,\002-\001e\001w\000\000\001x\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\001\127\000\000\000\000\001w\000\000\001x\001\172\002o\000\000\000\000\000\000\001\129\001n\000\000\000\000\000\200\000\000\000\000\001\127\001\130\002}\001\139\001l\003\137\000\000\000\000\000\000\002,\002-\001e\001n\000\000\000\000\000\200\001\127\000\000\000\000\001\129\000\000\000\000\000\000\000\000\002n\000\000\000\000\001\130\001n\001\139\001l\000\200\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002W\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\001\129\000\000\002,\002-\001e\000\000\000\000\002\127\001\130\000\000\001\139\001l\002n\000\000\000\000\000\000\000\000\002n\001\129\0020\002o\002\129\000\200\000\000\000\000\002o\001\130\000\000\001\139\001l\000\000\000\000\000\000\002}\001\129\000\000\000\000\000\000\002}\000\000\000\000\000\000\001\130\000\000\001\139\001l\000\000\000\000\000\000\000\000\002\127\002\133\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\130\000\000\003\011\000\000\000\000\000\000\000\000\000\000\002\142\002}\001\139\002\132\000\000\002\127\000\000\002\133\000\000\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\0020\002\144\002\129\000\200\002n\000\000\000\000\002,\002-\001e\000\000\000\000\002o\002\130\000\000\002\138\000\000\000\000\000\000\000\000\000\000\002\142\002n\001\139\002\132\002}\000\000\002\133\000\000\000\000\002o\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002}\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\130\000\000\002\140\000\000\000\000\002\130\000\000\002\145\002\142\000\000\001\139\002\132\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006(\000\000\000\000\002\133\000\000\002\127\000\000\002\144\000\000\002,\002-\001e\002\144\000\000\000\000\000\000\000\000\0020\007\030\002\129\000\200\006+\000\000\002\127\002n\002,\002-\001e\000\000\000\000\006,\002\130\002o\002\152\000\000\0020\000\000\002\129\000\200\002\142\002n\001\139\002\132\000\000\000\000\002}\000\000\000\000\002o\002\133\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\006-\000\000\002}\002\144\000\000\000\000\002n\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\130\000\000\002\154\000\000\000\000\000\000\000\000\000\000\002\142\002}\001\139\002\132\000\000\000\000\000\000\000\000\006.\000\000\002\130\000\000\002\156\000\000\000\000\000\000\000\000\006/\002\142\002\127\001\139\002\132\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\000\000\007\031\000\000\000\000\002\144\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\000\000\0061\002n\000\000\000\000\002\127\000\000\000\000\002\133\000\000\002o\0062\002,\002-\001e\000\000\0064\0020\000\000\002\129\000\200\000\000\000\000\002}\002\133\000\000\0066\002n\002,\002-\001e\000\000\000\000\000\000\000\000\002o\002\130\000\000\002\158\000\000\000\000\000\000\0067\002n\002\142\000\000\001\139\002\132\002}\002\133\000\000\002o\002\130\000\000\002\160\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002}\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\162\000\000\000\000\002\127\002\144\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\002\127\002\144\000\000\000\000\000\000\002o\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\002}\002\133\000\000\002n\000\000\002,\002-\001e\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002}\000\000\002\133\000\000\002o\002\130\000\000\002\164\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002}\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\166\000\000\000\000\002\127\002\144\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\002\130\0020\002\168\002\129\000\200\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\127\002\144\000\000\002\133\000\000\002n\000\000\002,\002-\001e\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\002,\002-\001e\002}\002\133\000\000\000\000\002o\002\130\000\000\002\170\000\000\000\000\000\000\000\000\002n\002\142\000\000\001\139\002\132\002}\002\133\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\172\000\000\002}\000\000\000\000\002\144\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\174\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\127\002\144\002,\002-\001e\000\000\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\002n\000\000\000\000\000\000\002n\000\000\001\031\000\000\002o\005\030\002\133\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002}\002,\002-\001e\002}\000\000\002\133\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\002n\002\130\000\000\002\176\000\000\000\000\002\133\000\000\002o\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\178\002}\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\002\144\000\000\002\130\000\000\002\180\000\000\000\000\005 \000\000\000\000\002\142\002\127\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\000\000\000\000\002\144\002,\002-\001e\001\016\002,\002-\001e\000\000\000\000\001\023\005#\000\000\000\000\000\000\002\127\002n\000\000\000\000\000\000\002n\000\000\002\133\000\000\002o\000\000\002\133\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\182\000\000\002\130\000\000\002\184\000\000\002\142\002\133\001\139\002\132\002\142\005$\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\238\000\000\005'\000\000\005&\000\000\002\144\000\000\000\000\000\000\002\144\000\000\002\130\000\000\002\186\001.\000\000\000\000\000\000\000\000\002\142\002\127\001\139\002\132\000\000\002\127\000\000\000\000\000\000\001d\001e\000\000\000\000\0020\000\000\002\129\000\200\0020\002\210\002\129\000\200\000\000\000\000\002\144\000\000\000\000\002\213\001d\001e\001f\002\214\000\000\001h\001i\000\000\000\000\002\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\133\000\000\001f\002\214\002\133\001h\001i\000\000\002,\002-\001e\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002n\002\130\000\000\002\188\002o\002\130\000\000\002\190\002o\002\142\000\000\001\139\002\132\002\142\000\000\001\139\002\132\002}\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\001m\002\144\000\000\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\002n\001n\000\000\000\000\000\200\000\000\000\000\001m\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\002}\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\127\000\000\002\215\000\000\002\127\000\000\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\002\215\002n\002\217\000\000\000\000\000\000\000\000\001\129\000\000\002o\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\002\216\000\000\002}\000\000\002\133\001\129\002\127\000\000\002\133\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\0020\000\000\002\129\000\200\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003.\000\000\002\130\002n\0034\000\000\002\142\000\000\001\139\002\132\002\142\002o\001\139\002\132\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\002\127\000\000\002\144\002,\002-\001e\002\144\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\130\002n\003:\000\000\000\000\002n\000\000\000\000\002\142\002o\001\139\002\132\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\002,\002-\001e\002}\002\133\000\000\000\000\000\000\002\144\000\000\000\000\001\031\000\000\000\000\001 \002n\002\127\000\000\002,\002-\001e\000\000\000\000\002o\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\130\002n\003@\000\000\002}\000\000\001\"\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\002\127\000\000\002\133\000\000\002\127\002\144\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\000\000\002n\000\000\001*\000\000\000\000\000\000\000\000\000\000\002o\002\130\000\000\003E\000\000\000\000\000\000\000\000\002\127\002\142\000\000\001\139\002\132\002}\000\000\002\133\000\000\000\000\000\000\002\133\0020\000\000\002\129\000\200\001\016\000\000\002\127\002,\002-\001e\001\023\001$\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002n\002\130\000\000\003J\000\000\002\130\000\000\003Q\002o\002\142\002\133\001\139\002\132\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\002\127\000\000\002\144\000\000\001>\000\000\002\144\000\000\002\130\000\000\003V\001%\0020\000\000\002\129\000\200\002\142\000\000\001\139\002\132\000\000\000\000\001d\001e\000\000\000\000\002\130\000\000\003[\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\001.\002\144\000\000\001\225\001f\001v\002\133\001h\001i\000\000\000\000\000\000\002\127\000\000\000\000\002,\002-\001e\000\000\002\144\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002n\000\000\000\000\000\000\002\130\000\000\003^\000\000\002o\000\000\001\187\001e\002\142\000\000\001\139\002\132\000\000\001w\000\000\001x\002L\002}\000\000\001d\001e\000\000\002\133\000\000\000\000\000\000\001f\002A\000\000\001h\001i\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\001\127\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\144\000\000\000\000\000\000\001n\000\000\002\142\000\200\001\139\002\132\000\000\000\000\000\000\000\000\000\000\003\140\003\148\003\001\003\002\000\000\001d\001e\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002\144\001w\000\000\001x\007\b\000\000\007\n\0020\000\000\002\129\000\200\001f\001v\000\000\001h\001i\000\000\000\000\000\000\001\127\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\0012\000\000\000\000\001n\001\127\000\000\000\200\001\129\000\000\000\000\000\000\002\133\000\000\000\000\000\000\001\130\001n\001\139\001l\000\200\0013\001\"\000\000\000\000\000\000\000\000\001w\0014\001x\006M\000\000\000\000\003\155\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\146\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\001\031\001\127\000\000\001 \000\000\000\000\0012\001\129\001*\000\000\000\000\000\000\000\000\001n\002\144\001\130\000\200\001\139\001l\000\000\001\129\000\000\000\000\000\000\000\000\0018\0013\001\"\001\130\000\000\001\139\001l\000\000\001M\000\000\000\000\000\000\000\000\001\016\001d\001e\000\000\000\000\000\000\001\023\001$\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\001f\001v\001*\001h\001i\001\129\000\000\001f\001v\000\000\001h\001i\000\000\001\130\000\000\001\139\001l\000\000\000\000\0018\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\016\001F\001w\000\000\001x\001\176\001\023\001$\000\000\000\000\000\000\001w\000\000\001x\001\164\000\000\000\000\000\000\001w\000\000\001x\001\161\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001\031\000\000\000\000\005\030\001\127\000\000\000\000\001n\001d\001e\000\200\001\127\000\000\000\000\001>\000\000\001n\000\000\000\000\000\200\000\000\001%\000\000\001n\000\000\001F\000\200\001\"\001f\001v\000\000\001h\001i\001d\001e\000\000\0055\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\001f\001v\000\000\001h\001i\001f\001v\000\000\001h\001i\000\000\0056\000\000\0057\001\129\000\000\000\000\005 \001w\000\000\001x\001z\001\130\001\129\001\139\001l\000\000\000\000\000\000\000\000\001\129\001\130\000\000\001\139\001l\000\000\001d\001e\001\130\000\000\001\139\001l\0058\001w\000\000\001x\001}\001\016\001w\001\127\001x\001\128\000\000\001\023\005#\000\000\001f\001v\000\000\001h\001i\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\001\127\0059\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\005:\005;\001n\005<\000\000\000\200\000\000\001n\001f\001v\000\200\001h\001i\000\000\000\000\001w\000\000\001x\001\160\000\000\000\000\000\000\005$\000\000\000\000\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\238\000\000\005%\001\129\005&\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001\127\001\139\001l\001.\005>\001w\000\000\001x\001\148\005@\005J\000\000\001n\000\000\001\031\000\200\001\129\005\030\000\000\005t\000\000\001\129\000\000\000\000\001\130\000\000\001\139\001l\000\000\001\130\000\000\001\139\001l\001d\001e\005u\001\127\002,\002-\001e\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001f\001v\000\000\001h\001i\000\000\000\000\003\176\000\000\000\000\000\000\000\000\001d\001e\003\185\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\005 \001f\001v\000\000\001h\001i\003\198\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\156\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001\016\000\000\001\130\000\000\001\139\001l\001\023\005#\001f\001v\000\000\001h\001i\001\127\001w\000\000\001x\002d\002/\000\000\001d\001e\000\000\000\000\000\000\001n\001d\001e\000\200\002\232\003\189\000\000\002\129\000\200\001\002\000\000\001\031\002\235\000\000\001 \001f\002\214\001I\001h\001i\001\127\001f\001v\000\000\001h\001i\001w\000\000\001x\002\246\000\000\000\000\001n\000\000\005$\000\200\000\000\001K\001\"\000\000\000\000\000\000\003\179\004\231\000\000\000\000\004\238\000\000\0051\000\000\005&\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\001\129\001.\000\000\000\000\001w\002\130\001x\002\249\001\130\001n\001\139\001l\000\200\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\001d\001e\000\000\000\000\001m\000\000\000\000\001\129\000\000\000\000\001\127\000\000\000\000\0018\000\000\001\130\001n\001\139\001l\000\200\001f\001v\001n\001h\001i\000\200\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002\215\001\130\000\000\001\139\001l\001f\001v\000\000\001h\001i\000\000\000\000\001w\000\000\001x\002\252\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\001\129\000\000\001>\000\000\000\000\000\000\001\129\000\000\001\138\001%\001\139\001l\000\000\005\029\001\130\000\000\001\139\001l\001\127\000\000\003\176\001d\001e\001w\000\000\001x\003\004\003\185\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\001.\000\000\000\000\001H\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\003\186\000\000\001\031\000\000\001\127\001 \000\000\000\000\001I\000\000\000\000\000\000\001\031\000\000\000\000\001 \001n\000\000\0012\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001K\001\"\000\000\000\000\000\000\000\000\001w\000\000\001x\004S\0017\001\"\001\129\000\000\002/\000\000\000\000\000\000\001d\001e\001\130\000\000\001\139\001l\000\000\000\000\003\189\000\000\002\129\000\200\001\002\000\000\000\000\000\000\000\000\004\030\000\000\001\127\001f\002\214\000\000\001h\001i\000\000\001*\001d\001e\000\000\001\129\001n\000\000\000\000\000\200\000\000\001*\000\000\001\130\000\000\001\139\001l\000\000\0018\000\000\003\179\000\000\001f\002\214\000\000\001h\001i\000\000\0018\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001d\001e\001\016\000\000\002\130\001d\001e\000\000\001\023\001$\000\000\000\000\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\001f\002\214\000\000\001h\001i\001f\002\214\001\129\001h\001i\001m\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\001d\001e\000\000\001n\000\000\001>\000\200\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\001>\001F\000\000\001m\000\000\001f\002\214\001%\001h\001i\000\000\001F\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\002\215\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001m\001d\001e\000\000\000\000\001m\000\000\000\000\001\129\000\000\003}\000\000\001n\000\000\000\000\000\200\001\138\001n\001\139\001l\000\200\001f\002\214\000\000\001h\001i\000\000\000\000\000\000\003\128\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001m\001d\001e\000\000\001\138\000\000\001\139\001l\003}\000\000\000\000\000\000\001n\003}\000\000\000\200\000\000\000\000\005\176\000\000\000\000\001f\002\214\000\000\001h\001i\000\000\003\127\000\000\000\000\000\000\000\000\003~\001\129\000\000\000\000\000\000\000\000\001\129\001d\001e\001\138\000\000\001\139\001l\000\000\001\138\003}\001\139\001l\000\000\000\000\000\000\001d\001e\000\000\001m\000\000\000\000\001f\002\214\000\000\001h\001i\000\000\000\000\003\130\000\000\001n\000\000\005\200\000\200\001\129\001f\002\214\000\000\001h\001i\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\0055\001m\000\000\001d\001e\000\000\000\000\000\000\000\000\006\027\000\000\000\000\000\000\001n\000\000\000\000\000\200\001f\002\214\000\000\001h\001i\000\000\001f\002\214\000\000\001h\001i\0056\000\000\0057\000\000\000\000\000\000\001\129\000\000\000\000\001d\001e\001m\000\000\000\000\001\138\000\000\001\139\001l\001d\001e\002\215\000\000\000\000\001n\000\000\001m\000\200\000\000\006\029\001f\002\214\0058\001h\001i\000\000\000\000\000\000\001n\001f\002\214\000\200\001h\001i\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\005\227\000\000\000\000\000\000\000\000\001m\0059\000\000\000\000\000\000\000\000\001m\000\000\000\000\002\215\005:\005;\001n\005<\000\000\000\200\000\000\000\000\001n\000\000\001\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\001\129\000\000\005=\000\000\000\000\000\000\001m\005\240\001\138\000\000\001\139\001l\000\000\005\227\000\000\001m\000\000\000\000\001n\006\027\000\000\000\200\000\000\000\000\000\000\000\000\005>\001n\000\000\000\000\000\200\005@\005J\001\031\000\000\000\000\001 \000\000\001\129\000\000\000\000\005t\001\031\000\000\001\129\001 \001\138\001\031\001\139\001l\001 \000\000\001\138\006\027\001\139\001l\000\000\005u\000\000\005\239\001\"\000\000\003\129\000\000\001\031\000\000\006\028\001 \000\000\001\"\004\216\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\129\004\216\000\000\002,\002-\001e\004\216\005\173\001\138\001\129\001\139\001l\000\000\001\"\000\000\006\159\005\187\001\138\000\000\001\139\001l\005\197\006$\000\000\000\000\001*\003_\000\000\001d\001e\000\000\000\000\000\000\000\000\001*\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\001f\001g\005\233\001h\001i\000\000\000\000\001\016\001*\001d\001e\000\000\000\000\001\023\001$\000\000\001\016\000\000\000\000\000\000\000\000\001\016\001\023\001$\000\000\000\000\000\000\001\023\001$\001f\001\137\000\000\001h\001i\001d\001e\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\002/\000\000\000\000\000\000\001f\002\199\000\000\001h\001i\001>\000\000\000\000\0020\000\000\002\129\000\200\001%\000\000\001>\000\000\004\221\000\000\000\000\001>\001m\001%\000\000\000\000\000\000\004\221\001%\000\000\001\031\000\000\004\221\001 \001n\000\000\000\000\000\200\001>\000\000\000\000\001.\000\000\000\000\001H\001%\003b\000\000\000\000\006\166\001.\001m\000\000\001H\000\000\001.\000\000\001\"\001H\002,\002-\001e\000\000\001n\000\000\000\000\000\200\002\225\000\000\000\000\002\130\001\031\001.\000\000\001 \001H\001m\000\000\002\131\000\000\001\139\002\132\003_\000\000\000\000\000\000\000\000\000\000\001n\000\000\001\031\000\200\001\031\001 \001\129\001 \000\000\000\000\001\"\000\000\001*\000\000\001\138\000\000\001\139\001l\000\000\000\000\003\248\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\001\"\000\000\000\000\003\251\001\129\005\222\000\000\000\000\000\000\000\000\000\000\001\016\001\138\000\000\001\139\001l\000\000\001\023\001$\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\006(\000\000\001\129\000\000\000\000\000\000\000\000\000\000\002/\000\000\001\138\000\000\001\139\001l\001*\000\000\001*\000\000\006)\006(\0020\006+\002\129\000\200\000\000\001\016\000\000\000\000\000\000\000\000\006,\001\023\001$\000\000\000\000\000\000\001>\006)\000\000\000\000\006+\000\000\000\000\001%\001\016\000\000\001\016\002\207\000\000\006,\001\023\001$\001\023\001$\000\000\000\000\003a\000\000\001\031\006-\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\001\031\001H\000\000\001 \000\000\001>\006-\000\000\002\130\000\000\000\000\000\000\001%\001\"\000\000\000\000\002\131\000\000\001\139\002\132\000\000\006.\000\000\000\000\001>\000\000\001>\001\"\000\000\000\000\006/\001%\000\000\001%\000\000\004\249\000\000\004\236\006\012\001.\006.\000\000\003\255\000\000\002,\002-\001e\000\000\000\000\006/\001\031\000\000\006\244\001 \006;\000\000\001*\000\000\001.\000\000\001.\001H\000\000\001H\000\000\000\000\000\000\006Z\000\000\0061\001*\000\000\000\000\006D\000\000\000\000\000\000\001\"\001\031\0062\000\000\001 \000\000\000\000\0064\000\000\001\016\000\000\0061\000\000\000\000\000\000\001\023\001$\0066\000\000\000\000\000\000\0062\001\031\001\016\000\000\001 \0064\000\000\001\"\001\023\001$\000\000\000\000\0067\000\000\000\000\0066\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\001\"\000\000\001\031\0067\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\001>\002/\001\031\000\000\000\000\001 \000\000\001%\000\000\000\000\001*\006\245\001\016\0020\001>\002\129\000\200\001\"\001\023\001$\000\000\001%\000\000\000\000\000\000\006\205\002,\002-\001e\001\"\000\000\001*\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001.\003\193\000\000\001H\000\000\002,\002-\001e\000\000\002,\002-\001e\001*\001\016\000\000\000\000\001>\000\000\000\000\001\023\001$\000\000\000\000\001%\001*\002\130\000\000\001X\002.\002,\002-\001e\002i\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\001\016\000\000\001>\000\000\000\000\000\000\001\023\001$\001.\001%\002k\001H\001\016\001\151\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\001\031\001>\000\000\001 \000\000\000\000\000\000\000\000\001%\002/\000\000\000\000\001\192\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\0020\001\"\002\129\000\200\000\000\000\000\001\"\000\000\000\000\001>\000\000\000\000\000\000\000\000\001.\002/\001%\001H\000\000\002/\001\230\001>\000\000\001\031\000\000\000\000\001 \0020\001%\002\129\000\200\0020\001\232\002\129\000\200\000\000\000\000\000\000\000\000\002/\002,\002-\001e\001.\001*\000\000\001H\000\000\000\000\001*\001\"\0020\000\000\002\129\000\200\001.\000\000\000\000\001H\000\000\002\130\000\000\000\000\002u\000\000\000\000\000\000\000\000\002\131\000\000\001\139\002\132\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001\016\001\023\001$\002,\002-\001e\001\023\001$\002\130\000\000\000\000\000\000\002\130\000\000\001*\000\000\002\131\000\000\001\139\002\132\002\131\000\000\001\139\002\132\000\000\000\000\002\128\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002,\002-\001e\000\000\000\000\000\000\002\131\000\000\001\139\002\132\001\016\001\031\000\000\001>\001 \000\000\001\023\001$\001>\000\000\001%\000\000\002/\002\143\002C\001%\000\000\001\031\000\000\002V\001 \000\000\000\000\000\000\0020\000\000\002\129\000\200\001\"\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \001.\000\000\000\000\001H\000\000\001.\000\000\001\"\001H\000\000\000\000\001\031\000\000\000\000\001 \001>\000\000\002/\000\000\000\000\000\000\000\000\001%\001\"\000\000\000\000\002\204\000\000\000\000\0020\000\000\002\129\000\200\000\000\001*\000\000\000\000\000\000\001\"\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\002\130\002/\001.\001*\000\000\001H\000\000\000\000\002\131\000\000\001\139\002\132\000\000\0020\000\000\002\129\000\200\001\016\003'\001*\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\001*\000\000\000\000\000\000\000\000\001\023\001$\001\031\002\130\000\000\001 \000\000\000\000\000\000\000\000\001\016\002\131\001\031\001\139\002\132\001 \001\023\001$\000\000\000\000\001\031\000\000\000\000\001 \000\000\001\016\000\000\000\000\000\000\001\"\001>\001\023\001$\000\000\002\130\000\000\000\000\001%\000\000\001\"\000\000\002\209\002\131\000\000\001\139\002\132\001>\001\"\000\000\000\000\000\000\002/\001\031\001%\000\000\001 \000\000\002\222\000\000\000\000\000\000\000\000\001>\0020\001.\002\129\000\200\001H\000\000\001%\000\000\000\000\001*\002\229\000\000\000\000\000\000\001>\000\000\001\"\001.\000\000\001*\001H\001%\000\000\000\000\000\000\002\238\000\000\001*\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001\031\001.\001\016\001 \001H\000\000\000\000\000\000\001\023\001$\001\016\000\000\001*\002\130\000\000\000\000\001\023\001$\000\000\001\031\000\000\002\131\001 \001\139\002\132\000\000\000\000\001\"\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\031\000\000\001\016\001 \001>\000\000\001\"\000\000\001\023\001$\001\031\001%\000\000\001 \001>\004b\000\000\000\000\000\000\001\"\001\031\001%\001>\005\030\000\000\004\193\000\000\001\"\000\000\001%\001*\000\000\000\000\004\205\000\000\000\000\000\000\001\"\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\001\"\001.\001*\000\000\001H\000\000\000\000\001>\000\000\001.\000\000\000\000\001H\001\016\001%\001*\000\000\000\000\004\218\001\023\001$\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\001*\000\000\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\005 \001H\001\016\000\000\001\031\000\000\000\000\005\030\001\023\001$\001\016\000\000\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\001\016\000\000\001>\000\000\000\000\000\000\001\023\001$\000\000\001%\001\016\001\"\000\000\004\235\000\000\000\000\001\023\005#\000\000\000\000\000\000\001>\001\"\001\031\000\000\000\000\001 \000\000\001%\000\000\000\000\000\000\004\251\000\000\001>\001\031\001.\000\000\001 \001H\000\000\001%\001>\000\000\000\000\005\152\000\000\000\000\000\000\001%\001\"\000\000\001>\005\170\005 \001.\000\000\000\000\001H\001%\000\000\001\031\001\"\005\194\001 \001*\000\000\000\000\001.\005$\000\000\001H\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\004\238\000\000\005\254\001\016\005&\001.\000\000\001\"\001H\001\023\005#\000\000\001*\000\000\001\016\001.\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\001*\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \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\001\023\001$\001*\000\000\000\000\000\000\001\016\000\000\001\"\000\000\000\000\000\000\001\023\001$\005$\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\004\238\000\000\006\024\006P\005&\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\001*\001.\001%\000\000\001H\000\000\006\165\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\006\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\001\016\000\000\001H\001>\000\000\000\000\001\023\001$\000\000\000\000\001%\001.\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\000\000\000\000\000\001.\000\000\000\000\001\227\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%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\250"))
+ ((16, "\000)\001A\000S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000v\000\000\000\000\000\203\000\134\000\"\000\024\000\165\000\164\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000T\000\000\000\000\000\000\000\000\000\000\000\136\000\000\000\000\000\000\000\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000;n\000\000\000\000\000\000\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007 \000\250\000\000\001\022\000\141\000\225\000\000\000\214\023R\001r\001\158\000 \000\000\000\000\000\000\001\138\000\000\000\000\000v\000\000\000\000\000\000\000\000\003\012\000\000\002*\000\000\000\000\000\000\000\000\000\000\000~\000\000\000z\003R\b2\000\000\000\000\011:\007 \000\000\000\000\000-\000\000\001D\000\000%\156\001\026\001~\000\000\000\000\002\020\0028\003\178\007\026\005\216\003R\0038\000\023\002\002\001\200\002`\002p\011\200\000\000>\018\002r\002\214\002z2n\000\000\000\000\000\000\000\000\000\000\000\000\000\000#\224\000\000\002\168\003\014\003.\000\000\000\000\000\000\000\000\tZ\000\000\000\000\003\030\000Y\003h\006p\b\022\000\000\000\000\000\000\002\238\003\014\003v\001:\003<\003\158\001H\003T\003\168\001\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\196\000\000\000\000\000\000\003h\005D\011\236\t\180>\018\012F\000\000\002\238\012\142#\250$\152\000\000\000\143\000\000\000\000\000\000\000\000\004F>p\004\\\000\0002\152\004~\000\0002\1828d\000\221\000\000\001\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0003\006\004\020\000\000\000\000\000\000\022\182\000\000\006$\000\000\000\000\006\136\000\230\000\000\000\000\007\174\000\0002\210\000\000\006\136\b\196\006\136\000\000\000\000\000\000\000\000\000\0008\234\000\000\005\130\004\160\000\000>\232\005\170\027p\000\000\000\000\000\000\0044\000\000\000\000\000\000\000\000\004\012\000\000\000\000\000\000\000\000\000\0003\024\000\000\000\000\000\000\000\000\000\000\000\000\000\015\004\224\000\000\000\000\000\000\004\012\005\0163\226\004\152\006\n\016\020\000\000\007\002\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\000\000\005\1924\002\000\000\000\000\004\172\006.4J\000\000\000\000\000\0004l\004\1644\246\000\000\004\164\000\0005X\004\164\000\0005\138#\224\005\134\005\148\000\000\000\000,\022\000\000\000\000\000\000\000\000\000\000\000\000\004\164\000\000\000\0005\190\000\000\004\164>\154\000\000\004\012\000\000\000\0005\242\000\000\004\164\0014\000\000\000\000\004\164\004\164\000\000\000\000\004\164\000\000\000\000$\152\000\000\000\000\000\000\000\000\004\164$\250\000\000\000\000\004\164\000\000\001\148\005\178\000\000\000\000\000\000\000\000\000\000\000\000\000\00098\000\000\005\134\000\000?\026\004\012\000\000\000\000\000\000\000\000\005\192\006F\012\176\005\242\006\b\006\012\006\194\003X\006\200\000\144\006\168\000\000\000\000\n\138\011*\007\024\000\158\006F\011\134\000\000\004\128\000\023\007v\003T\007\160\000\000\000\000&\196\000\0009@\0074\000\000?\\\004\012?\150\004\012\000\000\003~\004\\\000\000\011\158\004\128\000\000\000\000\006p\000\000\000\000\000\000\000\000\000\000\012\018\004\128\012\182\004\128\000\000\006d\000\000\000\000\007\006\000\000\000\000\000\000\007\220\000\000\000\000\000\000\004\128\000\000\000\000\004\128\000\000\006F\007\006\000\000\000?\003<\000\000\000?\000\000\000\000\rb\004\128\000\000\000\000\000\000\000\000\000\000\000\000\000?\rv\r\204\007\176\007T\004\1486&\000\000\006\186\007n\014\030\006\254\007x?\238@\020\000\000\000\000\000\000\000\000\000\000\001\164\t\212\000\000\000\000\000\000\007\002\007\214\007\140\000?\r\234\000\000\004\128\000\000\000\000\000\000\012\142\000\000?\234\004\012\014h\007\006\b\130\014\156\007z\b\132\014\230%\004\004\164\015P\007\170\b\184<B\b\152\000\000%:\004\164@>\004\012\b\194\000\000\000\000\000\000\000\000#\224\b\218\000\000\021N\015\154\bJ\b\2506\004\004\164\016\b\b\162\t>@\144\000\000@\252\000\000\000\000\016R\006:\t\198\000\000\000\000\t\252@\204\000\000\004\012)\128\000\000\004\012A\"\004\012\000\000\000\000\000\000\000\000\000\000A\006\000\000\000\000\000\000\004\168\016\188\000\000\000\000\000\000\000\000%\238AZ\000\000\000\000\000\000\000\000\000\000\b\180\017\006\000\000\b\206& \b\206&@\b\206\000\000A\236\000\000&\144\b\206\017:\002\012\017\132\000\000\000\000&\244\b\206'\\\b\206'\186\b\206'\220\b\206(\016\b\206(~\b\206(\220\b\206(\228\b\206)6\b\206)\134\b\206*\006\b\206*v\b\206*\204\b\206+0\b\206+z\b\206+\156\b\206+\206\b\206,l\b\206,\198\b\206-\026\b\206\tV\017\1687\b#\224\t\186\000\000-@=\180\000\000\018v\000\000\000\000\018\170\000\000\000\000\000\000-~\000\000\000\000)\128\t\218\000\000A\142\004\012\018\222\000\000\000\000\t\134\000\000A\162\004\012\019F\000\000\000\000\019z\000\000\000\000\000\000B\026\004\012\019\224\000\000\t<\020J\000\0007\022\000\000\004\1647x\000\000\004\1647\130\000\000\004\164\002\026\000\000\000\000\000\000\000\000\000\0007\194\004\164\000\000\001\222\005*\000\000\000\000\000\000\b\206\020|\000\000\000\000\000\000\020\176\000\000\000\000\000\000\000\000\000\000\020\228\000\000\000\000\000\000\b\206\021\022\000\000\021\184\000\000\000\000\000\000\022\026\000\000\000\000\000\000\000\000BD\000\000\000\000\022\128\000\000\000\000\000\000-\154\b\206\022\212\000\000\000\000\000\000.6\b\206\022\226\000\000\000\000\000\000.D\b\206\004\218\023\182\000\000\000\000.f\b\206\023\216\000\000\000\000/,\b\206\024X\000\000\000\000/6\b\206\000\000\000\000\024z\000\000\000\000/\144\b\206\024\172\000\000\000\000/\224\b\206\025N\000\000\000\0000\000\b\206\000\0000\208\b\206\000\000%T\000\000\000\000\b\206\000\000\000\000\025t\000\000\000\000\025\164\000\000\000\000\tz\000\000\000\000\026\"\000\000\026t\000\000\000\000\000\000#\224\n\022\000\0009t\t\016\006\136\027\016\000\0009\172\000\000\000\000\000\0009\228\000\000\000\000\027D\000\000\027d\000\000\000\000\000\000\000\00002\000\000\000\000\000\0001\006\b\2061&\b\206\000\000\t<\027\254\000\000\000\000\028j\000\0001r\000\000\000\000@\020\000\000\000\000\000\000\028\206\000\000\000\000\000\000\000\000\029\004\000\000\000\000\000\000\000\000\n\176\000\000\000\000\000\00080\000\000\004\250\000\000\000\019\000\000\nb\000\000\005\252\000\000\000\000\000\000\000\000\000\000\000\000\001\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\206\000\000\n\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t^\007\204\000?\029$\000\000\n0\tb\n\196\002\204\b\006\000?\0158\004\128\t\172\000?\000\000\029\244\000\000\004$\000\000\nV\t~\001\232\000\000\000\000\000\000\000\000\000\000\n\150\000\198\003X\000\000\000\000\000\000=\128\000\000E|\000\000\t\190\000\000\t\210\000\000\000\000\000\000\000\000\004\156\000\000\000\000\000\000\012.\006\136\000\000\006\136\000\012\000\000\002P\000\000\rr\006\136\006\136\000\000\016x\006\136\006\136\t\218\000\000\030\020\000\000\000\000\t\228\011\144\000\000\026\238\007\004\000\000\000\000\000\000\000\000\000\000\000\000\b\206\000\000\000\000\000\000\000\000\000\000\n\220\t\236\n\228\000?\000\000\015\196\000\000\004\128\000\000\012&\000\000\000\000\000\000\000\000\000\000\030\232\000\000\b\206\000\000\000\000\018:\000\000\004\128\000\000\019\012\000\000\004\128\000\000\019\158\004\128\000\000\000?\000\000\t\246\012`\001x\000\000\011\030\011,\n\002\011f\011\252\021 \004\128\b\254\000\000\n\n\011\242\012\"\004\206\t.\011\250\n\024\012@\004\216\t4\012\n\000\000\000\000\006\024\tH\000\000\003\132\003$8\012\004\164\030F\000\000\006\162\003n\011\200\n*\012\232\001\244\000\000\011\240\n2\006\016\000\000<$\000\000Bp\004\012\000\000\012\140\012\142\000\000\t\158\000\000\004\012\0124\nB\007Z\012V\000\251\000\000\000\000\000\000\000\000\nT\n4\000\000\n\166\n`\000\000\bX1\132\012l\012\136\n\174\bJ\n\144\000\000\n\188\bx\011\004\000\000\012\138\012\188\n\200\012\228\011\252\021\192\004\128\000\000\n\204\rR\000\000\b\242\000\000\011\\\000\000\rV\000\000\023\132\005N\r$\n\206\rb\000\000\024\020\006\170\r<\000\000\000\000\000\012\003\146\011\170\000\000\024H\004\128\011\172\000\000\000\022\000\000\r\n\n\228\025|\007\130\000\000\r*\0112\007\200\012V\r0\r>\011R\014\154\000\000\rl\001\246\000\000\000\000\000\000\000\000\000\211\011X\rFB\136\004\012\000\000\004$\011~\014*\000\000\000\000\000\000\000\000\000\000\000\000B\146\007\132\000\000\011\222\014\130\000\000\000\000\000\000\000\000\000\000\000\000<v\011\208\000\000\011\226\001\030\000\000\012\"\012&\b\154\000\000\003\246=\226\000\000\000\250\000\000B\232\004\012\004\012\000\000\000\000\007\204\000\000\011\b\000\000\007P\007\204\007\204\000\000\0120\030\152\004\012C@\004\012\011\230\000\000\000\000\000\000\000\000\011\252\000\000\000\000\005\202\000\000\b>\r\234\0126\015\020\r\210\000\000\000\000\n\162\b\240\014\028\000\000\000\000\012P\015J\014\000\000\000\000\000)\210\000\000\t\244\000\0000\1448\006\004\012\000\000Ch\012\220\000\000C\160\000\000\000\000\000\000\007\204\000\000\000\000\012^\014H\012T\015h\014\030\000\000\000\000C\200\012\140\014j\000\000\000\000\000\000<\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\210\000\000\014\132\012V\t\220\000\000\015|\015.\012\248\014\142\000\000\000\000\014\148\012d\n\012\000\000\000\000\b\2448d\006\140\000\000\000\000\000\000\b\250\014b\012j\000\000\014f\b\250\000\000\015J\r\000\014\176\000\000\000\000\000\000\004\012\0005\002\024\007\192\000\000\000\000\000\000\000\000\014\130\012\220\000\000\tF\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\012\014p\012\222\015\216\014\146\000\000:\b\000\169\012\236\014f\007d\007\252\012\246\015\026\000\000\015\208\031\146\000\000\000\000\031\178\000\000\rr\000\000\003D\000\000\000\000\000\000\000\000\000\000\000\000D\002\004\012\000\000\015\212\031\226\000\000\000\000 \018\000\000\001\252\012\248\015z\000\000\000\000:x<\144\015,\000\000D\030\004\012 |\000\000\000\000 \216\000\000\000\000\r\168\000\000\002\152\000\000\000\000\000\000\000\000\000\000\000\000=Z\000\000\000\000:\180=|\0154\000\000Dd\004\012!\128\000\000\000\000!\194\000\000\000\000\012\254!\232\r\190\000\000\r\004\r\006\000m\000:\r \n\130\r<\015\138\"L\r\194\000\000\rL\rh\011b\000\000\001\224>8\000\000\005\192\000\000\rn:\208:\236\0020\014n\003\134\000\000\030&%T\000\000\003\152\000\000\000\000\003\152\000\000\000\000\003\152\012X\000\000\003\214\003\152\015\144\"\134\r\212\000\000\003\152\000\000\000\000DF\000\000\000\000\000\000\003\152\000\000\000\000\014\002\000\000\005,\t\030\014\004\000\000\r\1344\012\014\012\000\000\000\000\000\000\000\000\014&\000\000\000\000\007\204\000\000\003\152D\158\000\000\005|\003\152;\184\000\000\014:\014\254\r\212\016\022\014\208\000\000;\244\014\140\015\014\000\000\000\000\000\000 d\005\242\000\000\000\000\000\000\000\000\000\000\000\000\b\180\014\148\000\000\015\030\000\000\000\000\000\000\000\000\014\160#\134\000\000\000\000\000\000\000\000\b\180\000\000\000\000\014\166-\208\000\000\000\000\000\000\000\000\000\000\000?\004\128\000\000\000\000\004\164\000\000D\210\004\012\000\000\007\222\000\000\000\000\000\000\000\000#B\000\000\000\000\000\000\000\000\000\000\000\000\015\180\002\134\0114\014b\001l\r\220\000\000\004&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\130\002$\r\238\000\000\007H\016\022\015\208\014\176\000\000\000\000\015\196\002\148\005\204\000\000\000\000\000\000\014&\000\000\0140\004\144\000\000\000\000\006\136\005\156\000\000\000\000\000\000\000\000\000\000E\176\000\000\000\000\b`\007\206\000\000\000\000EN\004\012\004\012\000\000EX\004\012\t\142\000\000\000\000\000\000\004\012\000\000\000\000\n\016\015\216\014\188\000\000\000\000\015\204\001\024\003\200\000\000\000\000\000\000\000\000\tB\016\022\nV\015\232\014\204\000\000\000\000\015\232\001v\005\250\000\000\000\000\000\000\000\000\004\128\000\000\014\216\000\000\000\000\000\000\"\244\000\000#\146\000\000\000\000\000\000\000\000\000\000\018\002\000\000\000\000\000\000\007\224\000\186\000\000\000\000\000\000\000\000\000\000\004F\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\192\000\000\000\000\000\000>\\\000\000\004\012\000\000\n\198\000\000\000\000\000\000\000D\000\000\000\000\000\000\000\177\000\000\000\000\000\000\004\254\000\000\000?\000\000\006z\000\000\004\128\000\000\003>\000\000\000\000\000\0001\164\004\164\000\000\000\000\000\017\000\000\000\000\000\000\000\000\001\164\004\202\015$\011 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007H\000\000\014\218\000\000\000\000\000\000\000\000\005\020\006\186\000\166\002L\000\000\000\000\014\230\003\242\000\000\000\000\000\000\014\240\005\152\000\000\000\000\000\000\000\000"), (16, "\006E\0007\002,\002-\001e\002\001\004\143\007\n\001\031\000\238\001\216\006\166\001k\006\213\007\030\002-\001e\002n\006F\006\224\001\240\006H\001\016\003\184\001\244\002o\001\023\001\016\001\023\001\026\006I\006V\000;\001\023\001\026\001\"\001\031\006E\002\137\002,\002-\001e\000\149\007\011\006\199\001\233\000\238\000\234\005v\003\011\000\238\000\239\006\219\002\002\002n\006F\006U\002\014\006H\006J\000\234\001T\002o\000\238\001\002\001\245\004\t\006I\006V\003\011\002\025\000@\001\003\004\015\004\146\002\137\001\139\000\234\006\002\001\246\000\238\000\239\007 \000\131\006f\000\149\005\n\002\027\000\154\000\149\000\238\006\191\000\158\001\027\003\185\006K\006J\001\006\005\011\002\139\006\217\0007\005#\006E\006L\000q\001e\006\004\006\002\0007\001\016\0020\001W\002\141\000\238\000\241\001\023\001$\0079\004O\000\155\007:\006\005\007!\006H\002\141\000\238\006\007\006[\001\031\007\006\0063\006K\006I\000\241\004\198\002\139\006\004\001\016\006y\004\201\006L\002\012\006\\\001\023\001$\000\241\002\028\0020\001\214\002\141\000\238\006\005\006O\005}\005~\006\226\006\007\006Q\004\t\000\234\006\030\006J\000\238\000\239\006[\007\007\001l\006S\001%\005\142\002\142\001\023\002\148\005\135\004\029\000:\001\159\001e\002\154\006\\\001\139\002\144\0007\006T\002\026\002,\002-\001e\004\200\006O\006\002\001\031\001\016\004\200\006Q\001.\001%\006K\001\023\001$\002n\002\156\004\021\000?\006S\000m\006L\002\142\002o\002\148\006E\006\194\002,\002-\001e\002\154\000\\\001\139\002\144\006\004\006T\002\137\000\149\004\024\000\159\001\233\007<\002n\006F\006U\001\016\006H\003\196\001e\006\005\002o\001\023\001$\002\156\006\007\006I\006V\000`\006\023\000d\006N\001\016\006E\002\137\002,\002-\001e\001\023\001\026\002\006\006O\001\016\002\014\006\208\000\134\006Q\002\006\001\023\001\026\002n\006F\006U\003\011\006H\006J\006S\000y\002o\006\152\001\016\0009\000\149\006I\006V\000\154\001\023\001\026\002\139\000=\004N\002\137\006T\002\027\002\025\001%\000\238\003\003\001e\001\016\0020\004\012\002\141\000\238\0007\001\023\001$\000\128\006\164\0007\000\234\006K\006J\000\238\000\239\002\139\006w\004\218\004\143\006E\006L\000\238\004\r\001(\003\011\006\197\006\198\0020\000\241\002\141\000\238\001\031\002\145\005\006\0079\003\011\000\130\007:\000\234\005\n\006H\000\238\001\002\004S\006[\005\135\004\029\005v\006K\006I\001\182\005\011\002\139\002\028\005\213\005\018\002\025\006L\001%\006\\\002\142\004\t\004@\000\174\0020\000\137\002\141\000\238\002\154\006O\001\139\002\144\006\197\006\198\006Q\001\006\000\234\001\019\006J\000\238\000\239\006[\000\136\001\023\006S\006\160\006\128\002\142\001\139\002\148\000\240\002\156\005\135\004\029\003\r\002\154\006\\\001\139\002\144\005\206\006T\006\130\002,\002-\001e\004y\006O\006\002\006\150\002\026\004\143\006Q\005\208\000\238\006K\005\217\000\234\002n\002\156\000\238\000\239\006S\000\153\006L\002\142\002o\002\148\006E\000\241\002,\002-\001e\002\154\001\016\001\139\002\144\006\004\006T\002\137\001\023\001$\005\178\000\179\007;\002n\006F\006U\006\002\006H\003\245\004\029\006\005\002o\005}\005~\002\156\006\007\006I\006V\000\152\006\014\000\183\006N\000\178\006E\002\137\002,\002-\001e\005\134\000\189\002\026\006O\005\135\004\029\000\241\006\004\006Q\006\140\000\186\001\139\002n\006F\006U\002\160\006H\006J\006S\000\184\002o\006]\006\005\001%\003\232\006I\006V\006\007\0007\004\017\002\139\006\011\000\188\002\137\006T\000\149\000\241\006\142\001\233\006\134\006\135\000\193\0020\007\022\002\141\000\238\006\134\006\135\006\136\006\137\004\020\002\014\000\194\006K\006J\006\136\006\137\002\139\006Y\006\138\004\029\006E\006L\006o\000\241\002\014\006\138\004\029\000\206\0020\000\210\002\141\000\238\007\023\002\145\005\182\0079\003\235\002\018\007:\000\207\002\027\006H\001\240\000\238\003\249\006[\001\244\000\216\001\023\006K\006I\002\029\000\234\002\139\002\027\000\238\001\002\000\238\006L\003\011\006\\\002\142\004P\004)\006!\0020\006\242\002\141\000\238\002\154\006O\001\139\002\144\001\251\000\241\006Q\000\238\000\234\000\225\006J\000\238\000\239\006[\004\194\000\218\006S\000\238\001\245\002\142\001\221\002\148\000\226\002\156\004\004\004\006\004\b\002\154\006\\\001\139\002\144\002\028\006T\000\241\002,\002-\001e\003\011\006O\006\002\001\031\000\241\000\229\006Q\000\231\002\028\006K\000\232\000\234\002n\002\156\000\238\000\239\006S\000\246\006L\002\142\002o\002\148\006E\006\195\002,\002-\001e\002\154\001\016\001\139\002\144\006\004\006T\002\137\001\023\001\026\007-\007.\007?\002n\0070\000\241\006\002\006H\001Y\003\011\006\005\002o\000\241\003\236\002\156\006\007\006I\0072\006\196\006\b\004n\006N\001\n\006E\002\137\002,\002-\001e\007A\006\t\005\027\006O\000\241\001\236\006\131\006\004\006Q\000\241\0079\001\r\002n\007:\003\182\001\240\006H\006J\006S\001\244\002o\001\023\006\005\005\n\001\030\006I\007B\006\007\005\030\001;\002\139\006\018\006\250\002\137\006T\005\011\003\249\006\132\003\235\005\012\001B\001\016\0020\005 \002\141\000\238\006\133\001\023\001$\006\243\006\159\004\171\003\024\006K\006J\000\238\001\002\002\139\007\014\001G\001\245\006E\006L\005!\004\143\002\014\003\011\000\238\001V\0020\004a\002\141\000\238\001\031\002\145\004f\0079\003O\001\177\007:\000\238\001\002\006H\0075\003\011\004\007\004\006\004\b\000\242\003)\006K\006I\007\015\000\234\002\139\002\027\000\238\001\002\000\238\006L\001%\006\\\002\142\006z\003\205\001\\\0020\001\175\002\141\000\238\002\154\006O\001\139\002\144\003`\001t\006Q\001\239\000\234\007F\006J\000\238\000\239\003\235\004}\001e\006S\006\160\003\235\002\142\003\183\002\148\006\251\002\156\001\139\001~\003\012\002\154\006\\\001\139\002\144\001\031\006T\003\188\002,\002-\001e\003\011\006O\006\002\001\135\000\241\000\247\006Q\004\183\002\028\006K\001\134\000\234\002n\002\156\000\238\000\239\006S\001\181\006L\002\142\002o\002\148\006E\003\011\002,\002-\001e\002\154\001\016\001\139\002\144\006\004\006T\002\137\001\023\001$\001E\006\162\007D\002n\006F\006c\006\002\006H\001)\000\234\006\005\002o\000\238\000\239\002\156\006\007\006I\006V\001\193\006$\001C\006N\001\016\006E\002\137\002,\002-\001e\001\023\001$\005\"\006O\000\241\0007\006\151\006\004\006Q\001\239\0079\000\234\002n\007:\000\238\001\002\006H\006J\006S\001\198\002o\004%\006\005\001%\004k\006I\007=\006\007\005\030\006\209\002\139\0067\001\016\002\137\006T\000\241\007\018\006\132\001\023\001$\001]\001`\0020\005 \002\141\000\238\006\133\003\011\003\183\000\149\006\160\000\181\001\233\006K\006J\000\241\001\031\002\139\001u\001 \006\196\005\253\006L\005!\001\253\001\216\006E\004\030\007\019\0020\001\023\002\141\000\238\003\249\002\145\001\240\006\147\003\235\003\217\001\244\001\203\001\023\001\016\001\"\0070\006\169\006[\006H\001\023\001$\006K\001%\003\011\001\209\002\139\000\149\006I\001\220\001\233\006L\002\005\006\\\002\142\000\241\003g\001\226\0020\001\228\002\141\000\238\002\154\006O\001\139\002\144\002\014\001\243\006Q\004\189\001&\007@\001\245\000\241\005o\004\006\004\b\006J\006S\001\031\001*\002\142\001+\002\148\001\204\002\156\001\246\001\206\002\004\002\154\006\\\001\139\002\144\002\015\006T\001\016\002\027\002\000\006\235\000\238\006O\001\023\001$\001\023\003\210\006Q\001\"\003\011\003\011\005\171\001\016\003\206\002\156\006K\004#\006S\001\023\001$\002\142\002&\002\148\006E\006L\002,\002-\001e\002\154\001\213\001\139\002\144\001\016\006T\004t\002\014\001\016\001\239\001\023\001$\002n\006F\001\023\001\026\006H\0071\003\011\001\031\002o\000\241\001 \002\156\000\241\006I\006_\002)\005R\0027\002\028\002F\006+\002\137\0029\006N\001>\002\027\001\031\002\014\000\238\001 \006\173\001%\002'\006O\001\"\006\176\006\236\002*\006Q\004\206\004\239\003\249\006J\001\016\005S\005\148\005T\006.\006S\001\023\001$\005v\000\241\001\"\003\219\005\n\002\014\002\027\001.\001\016\000\238\001H\0060\003\011\006T\001\023\001\026\005\011\006\237\004\140\004\029\005\017\0062\006\244\001\023\005U\005\019\002I\006K\001*\001\031\006p\002\139\003\227\0028\002\028\002\027\006L\0061\000\238\005\131\004\006\004\b\006\186\0020\000\241\002\141\000\238\001*\006.\000\241\002O\001%\005\173\001\031\001\239\001G\001 \006.\001\016\005V\006b\002[\006\245\0060\001\023\001$\002\028\001\031\005W\005X\004\158\005Y\0060\004\210\004\029\006\\\001\023\001\016\001.\006\172\001\"\001\016\005$\001\023\001$\006O\006\246\001\023\001$\0061\006Q\005\r\006\205\004\162\005\149\002\028\000\241\005v\0061\001\023\006S\003\011\002X\002\142\006\247\002\148\005}\005~\003\011\005\001\001>\002\154\000\238\001\139\002\144\000\241\006T\001%\005[\002G\002J\005\127\005\143\005]\005g\001*\005\135\004\029\002^\001>\002b\001\016\003\011\005\145\002\156\003\011\001%\001\023\001$\005y\005\150\002,\002-\001e\001.\003\011\002P\001H\005\r\005\146\002,\002-\001e\006%\004\177\001\016\002n\002,\002-\001e\001\023\001\023\001$\001.\002o\000\149\001H\005`\001\233\001\016\0048\005,\002n\003c\002g\001\023\001$\002\137\004\\\002c\002o\001\031\000\241\000\241\0057\003\249\003\162\002{\003\011\000\149\001%\005j\001\233\002\137\001\016\001\031\001\216\003d\001 \006g\001\023\001$\004b\005}\005~\004g\001\240\001>\001\"\000\241\001\244\003\014\001\023\002h\001%\004l\002\014\0010\005\127\005\143\002\153\003\249\001\"\005\135\004\029\002\204\005s\004\029\001%\003\218\001\031\003\224\000m\001 \005\139\004\006\004\b\005\r\002\139\005v\002\208\001.\000\241\003\231\001H\003\239\002\027\002/\000m\000\238\0020\001\245\002\141\000\238\002\139\003~\002\224\001\"\004\135\0020\006\t\002\141\000\238\003\011\0007\001\246\0020\001*\002\141\000\238\006\181\004\006\004\b\002\231\005v\003\004\000\241\004\000\002,\002-\001e\006\188\002\145\001\016\003s\003\011\003{\004\002\000\241\001\023\001$\004\026\000\241\002n\000\241\003f\004\031\001\016\002\145\003\176\0041\002o\001*\001\023\001$\004Q\002\028\007\002\000\241\003\011\002\142\004W\002\148\003\186\002\137\004^\006\202\003\208\002\154\002\142\001\139\002\144\004d\007*\002-\001e\002\142\002\143\002\148\001\139\002\144\004w\001\016\004\148\002\154\004|\001\139\002\144\001\023\001$\000\241\002\156\001%\004\139\001\031\005}\005~\001 \001\216\001>\000\241\002\n\004\147\007\004\000\241\004\151\001%\002\156\001\240\000\241\005\127\005\143\001\244\000\241\001\023\005\135\004\029\003\011\000\241\001.\001\016\001\"\002\014\003\223\000\241\002\139\001\023\001\026\000\241\004\159\005}\005~\003\225\001.\001>\000\241\001H\0020\005v\002\141\000\238\001%\003\238\004\150\000\241\005\127\005\143\004\157\000\241\0042\005\135\004\029\002\027\001\245\004\161\000\238\000\241\002,\002-\001e\004\167\003\011\004\173\004\185\004\025\000\241\001*\001\246\001.\002\145\005\015\001H\002n\000\238\004\204\002,\002-\001e\001\216\005\n\002o\002\007\007+\004!\002\141\000\238\006s\004\163\001\240\005\240\002n\005\011\001\244\002\137\001\023\005+\001\016\002\142\002o\002\148\003\011\003\011\001\023\001$\004=\002\154\000\241\001\139\002\144\0040\000\241\002\137\002\028\004\209\004;\005\248\001\031\000\241\000\238\003\011\002,\002-\001e\000\241\001\216\000\241\000\241\001\217\002\156\004\214\003\011\004\178\004\224\001\245\001\240\002n\001\216\000\241\001\244\001\238\001\023\003\011\004]\002o\005}\005~\001\240\001\246\001>\004V\001\244\004\230\001\023\004+\002\139\001%\002\137\001\187\001e\006\184\006\185\006~\004\029\004X\005\135\004\029\0020\004[\002\141\000\238\004\195\004\199\002\139\002,\002-\001e\000\241\001f\002A\001\245\001h\001i\001.\004j\0020\001H\002\141\000\238\002n\004\250\003\011\001\245\000\241\001\246\001\216\000\241\002o\001\248\002\145\004\241\005\026\004\252\004$\001\031\001\240\001\246\005>\004`\001\244\002\137\001\023\005\031\002\014\003\011\000\241\004i\002\145\002\139\001\016\003\152\003\005\003\006\004e\004h\001\023\001$\002\142\004v\002\148\0020\001\"\002\141\000\238\005\014\002\154\005\000\001\139\002\144\006\016\004R\005\021\000\238\002\027\005&\002\142\000\238\002\148\004{\003\011\001\245\004\134\004\133\002\154\001\127\001\139\002\144\0050\002\156\005I\005_\005G\002\145\000\241\001\246\000\241\001n\005i\003\011\000\238\005u\002\139\003\011\002,\002-\001e\002\156\001\216\001%\001\031\001\250\002\014\004\138\0020\005O\002\141\000\238\001\240\002n\004\149\002\142\001\244\003\030\001\023\003\155\003\160\002o\000\241\002\154\000\241\001\139\002\144\003\216\002\028\000\241\004\011\001\016\000\241\004x\002\137\004\160\002\027\001\023\001$\000\238\002\145\002,\002-\001e\005\\\000\241\002\156\000\241\000\241\004\156\004\172\001\129\005\137\005\153\003\011\000\241\002n\001\245\000\241\001\130\005\159\001\139\001l\005d\002o\005\163\005\191\005{\002\142\005\231\002\148\001\246\006#\005\236\003\213\004\166\002\154\002\137\001\139\002\144\004\168\003\011\002,\002-\001e\004\192\006\019\004\180\001\216\004\191\001%\002\022\003\011\004\186\003\011\002\139\002\028\002n\001\240\002\156\005\241\004\190\001\244\003\011\001\023\002o\001\016\0020\006\015\002\141\000\238\003\199\001\023\001$\004\203\000\241\000\241\001.\002\137\002,\002-\001e\005\247\000\241\005\172\005\255\003\011\003\011\000\241\000\241\004\208\003\011\000\241\005/\002n\000\241\000\241\006(\002\139\002\145\004\213\004\216\002o\001\245\003\011\002,\002-\001e\003\151\000\241\0020\005\207\002\141\000\238\003\011\002\137\001\216\001\246\004\220\002<\002n\004\228\005\233\000\241\005\244\001%\001\240\002\142\002o\002\148\001\244\000\241\001\023\006\022\003\146\002\154\006=\001\139\002\144\002\139\006\129\002\137\002\145\001d\001e\000\241\004\235\004\246\000\241\006\141\005.\0020\004\019\002\141\000\238\003\011\006\"\006&\002\156\003\011\000\241\006*\005'\001f\001v\003\011\001h\001i\003\011\005(\002\142\001\245\003\030\003\011\006/\005-\002\139\006\155\002\154\003\011\001\139\002\144\006\157\002\145\006;\001\246\003\142\003\011\0020\0051\002\141\000\238\0052\003\011\003\011\002,\002-\001e\005Q\000\241\003\011\002\156\002\139\000\241\005J\003\011\001w\005K\001x\002L\002n\002\142\000\241\002\148\0020\005P\002\141\000\238\002o\002\154\002\145\001\139\002\144\005f\003\135\006B\005b\005c\005e\006P\005\144\002\137\002,\002-\001e\006W\005t\005x\006`\001\127\000\241\005z\002\156\006\146\005|\000\241\002\145\002n\002\142\006\190\002\148\001n\005\136\005\152\000\238\002o\002\154\006\204\001\139\002\144\005\154\003x\003\145\006\216\0073\005\155\005\160\005\164\002\137\005\168\007>\005\186\005\193\005\197\002\142\007C\002\148\005\221\005\242\002\156\006\n\006\020\002\154\001\216\001\139\002\144\003\229\002,\002-\001e\006D\006>\002\139\001\240\001d\001e\006?\001\244\006C\001\023\006R\006|\002n\006\144\0020\002\156\002\141\000\238\006\145\006\149\002o\001\129\006\189\006\193\001f\001g\003p\001h\001i\001\130\006\203\001\139\001l\002\137\002,\002-\001e\006\207\007%\002\139\000\000\000\000\000\000\000\000\000\000\000\000\002\145\000\000\001\245\002n\000\000\0020\000\000\002\141\000\238\000\000\000\000\002o\000\000\000\000\000\000\001\031\001\246\001\216\000\000\000\000\0046\003h\000\000\000\000\002\137\000\000\000\000\001\240\002\142\000\000\002\148\001\244\000\000\001\023\000\000\000\000\002\154\002\145\001\139\002\144\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\002\139\000\000\000\000\000\000\000\000\000\000\001m\000\000\002n\000\000\000\000\002\156\0020\000\000\002\141\000\238\002o\002\142\001n\002\148\000\000\000\238\002\134\000\000\001\245\002\154\000\000\001\139\002\144\002\137\002,\002-\001e\000\000\000\000\000\000\000\000\002\139\001\246\000\000\000\000\000\000\000\000\000\000\002\145\002n\000\000\000\000\002\156\0020\000\000\002\141\000\238\002o\000\000\000\000\002,\002-\001e\002\147\000\000\000\000\000\000\000\000\000\000\000\000\002\137\000\000\000\000\001\016\000\000\002n\002\142\000\000\002\148\001\023\001$\000\000\001\129\002o\002\154\002\145\001\139\002\144\000\000\002\162\001\138\000\000\001\139\001l\002\139\000\000\002\137\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\0020\002\156\002\141\000\238\000\000\000\000\002n\002\142\000\000\003\030\002\205\001e\000\000\000\000\002o\002\154\000\000\001\139\002\144\000\000\002\161\000\000\000\000\000\000\000\000\002\139\001%\002\137\000\000\000\000\002\240\001v\002\145\001h\001i\000\000\000\000\0020\002\156\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\139\005R\004\023\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\002\148\0020\000\000\002\141\000\238\000\000\002\154\002\145\001\139\002\144\002\245\003\005\003\006\000\000\000\000\000\000\000\000\000\000\005S\006\228\005T\000\000\000\000\000\000\000\000\000\000\002\139\000\000\000\000\002\156\000\000\000\000\000\000\002\145\000\000\002\142\000\000\002\148\0020\000\000\002\141\000\238\000\000\002\154\001\127\001\139\002\144\000\000\000\000\005U\002,\002-\001e\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\002\142\000\000\002\148\000\000\002n\002\156\000\000\000\000\002\154\002\145\001\139\002\144\002o\000\000\000\000\002,\002-\001e\002\213\000\000\000\000\000\000\000\000\005V\000\000\002\137\000\000\000\000\003\t\003\n\002n\002\156\005W\005X\000\000\005Y\000\000\002\142\002o\002\148\000\000\002,\002-\001e\002\216\002\154\000\000\001\139\002\144\000\000\000\000\002\137\000\000\000\000\000\000\001\129\002n\000\000\005\149\001\216\000\000\000\000\004E\001\130\002o\001\139\001l\000\000\002\156\001\240\002\228\000\000\000\000\001\244\000\000\001\023\000\000\002\137\000\000\000\000\000\000\000\000\005[\006\230\000\000\000\000\002\139\005]\005g\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\005\145\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\139\005\146\001\245\000\000\002o\000\000\000\000\002,\002-\001e\002\235\000\000\0020\000\000\002\141\000\238\001\246\002\137\002\145\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\139\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\002\238\000\000\0020\000\000\002\141\000\238\000\000\002\137\002\145\000\000\002\142\000\000\002\148\000\000\000\000\000\000\001\216\000\000\002\154\004I\001\139\002\144\002,\002-\001e\000\000\001\240\000\000\000\000\000\000\001\244\000\000\001\023\000\000\002\145\000\000\002\142\002n\002\148\000\000\000\000\002\156\002\139\000\000\002\154\002o\001\139\002\144\000\000\000\000\000\000\002\244\000\000\000\000\0020\000\000\002\141\000\238\002\137\000\000\000\000\000\000\002\142\000\000\002\148\000\000\000\000\002\156\002\139\000\000\002\154\001\245\001\139\002\144\000\000\002,\002-\001e\000\000\000\000\0020\000\000\002\141\000\238\000\000\001\246\002\145\000\000\000\000\001\216\002n\000\000\004L\002\156\000\000\000\000\000\000\000\000\002o\001\240\002,\002-\001e\001\244\002\247\001\023\000\000\000\000\000\000\000\000\000\000\002\137\002\145\000\000\002\142\002n\002\148\000\000\000\000\002\139\000\000\000\000\002\154\002o\001\139\002\144\002,\002-\001e\003\017\000\000\0020\000\000\002\141\000\238\000\000\002\137\000\000\000\000\000\000\002\142\002n\002\148\000\000\001\245\002\156\000\000\000\000\002\154\002o\001\139\002\144\002,\002-\001e\003\021\000\000\000\000\001\246\000\000\000\000\000\000\002\137\002\145\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\156\002\139\000\000\000\000\002o\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\0020\003\027\002\141\000\238\002\137\000\000\000\000\002\142\002n\002\148\000\000\000\000\000\000\002\139\000\000\002\154\002o\001\139\002\144\000\000\000\000\000\000\001d\001e\000\000\0020\003 \002\141\000\238\002\137\000\000\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\156\002\139\000\000\000\000\001f\002\218\000\000\001h\001i\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\002\145\000\000\000\000\002\142\000\000\002\148\000\000\000\000\002\139\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002,\002-\001e\0020\000\000\002\141\000\238\000\000\000\000\002\145\000\000\002\142\000\000\002\148\000\000\002n\002\139\002\156\000\000\002\154\000\000\001\139\002\144\002o\001\216\000\000\000\000\004Z\0020\000\000\002\141\000\238\000\000\003\"\001\240\002\145\002\137\002\142\001\244\002\148\001\023\000\000\002\156\000\000\001m\002\154\000\000\001\139\002\144\002,\002-\001e\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\002\145\000\000\000\000\002\142\002n\003\030\000\000\000\000\002\156\000\000\000\000\002\154\002o\001\139\002\144\000\000\000\000\000\000\000\000\001\245\000\000\000\000\003&\000\000\000\000\002\137\000\000\000\000\002\142\000\000\003\030\003\129\000\000\001\246\002\156\000\000\002\154\002\139\001\139\002\144\002,\002-\001e\000\000\001\216\000\000\000\000\004\170\000\000\0020\003\132\002\141\000\238\000\000\001\240\002n\001\129\000\000\001\244\002\156\001\023\000\000\000\000\002o\001\138\000\000\001\139\001l\000\000\000\000\000\000\000\000\000\000\003.\000\000\001\031\002\137\000\000\001 \000\000\000\000\002\145\002,\002-\001e\000\000\002\139\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\002n\0020\001\245\002\141\000\238\001\"\000\000\002n\002o\000\000\000\000\000\000\002\142\000\000\003\030\002o\001\246\000\000\0034\000\000\002\154\002\137\001\139\002\144\000\000\003:\000\000\000\000\002\137\000\000\000\000\000\000\000\000\002\145\000\000\000\000\000\000\000\000\000\000\000\000\002\139\000\000\000\000\002\156\000\000\000\000\005R\000\000\000\000\000\000\001*\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\002\142\000\000\003\030\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\005S\006\210\005T\000\000\000\000\000\000\001\016\000\000\002\139\000\000\002\145\000\000\001\023\001$\000\000\002\139\000\000\000\000\002\156\000\000\0020\000\000\002\141\000\238\002,\002-\001e\0020\000\000\002\141\000\238\005U\000\000\000\000\000\000\000\000\000\000\000\000\002\142\002n\003\030\002,\002-\001e\000\000\000\000\002\154\002o\001\139\002\144\000\000\000\000\002\145\003A\000\000\000\000\002n\000\000\0011\002\145\002\137\000\000\000\000\000\000\002o\001%\005V\000\000\000\000\002\156\003F\000\000\000\000\000\000\000\000\005W\005X\002\137\005Y\000\000\002\142\000\000\003\030\000\000\000\000\000\000\000\000\002\142\002\154\003\030\001\139\002\144\001.\000\000\000\000\002\154\000\000\001\139\002\144\001\216\000\000\005\149\004\182\000\000\000\000\002,\002-\001e\000\000\001\240\000\000\002\156\000\000\001\244\000\000\001\023\000\000\000\000\002\156\000\000\002n\002\139\002,\002-\001e\005[\000\000\000\000\002o\000\000\005]\005g\000\000\0020\003K\002\141\000\238\002n\002\139\000\000\005\145\002\137\000\000\000\000\000\000\002o\000\000\002,\002-\001e\0020\000\000\002\141\000\238\001\245\003R\005\146\000\000\002\137\000\000\000\000\000\000\002n\000\000\000\000\002\145\000\000\000\000\001\246\000\000\002o\001\216\000\000\000\000\004\188\000\000\000\000\000\000\000\000\000\000\003W\001\240\002\145\002\137\000\000\001\244\000\000\001\023\000\000\000\000\000\000\000\000\000\000\002\142\000\000\002\148\000\000\001\216\000\000\000\000\004\197\002\154\002\139\001\139\002\144\000\000\000\000\001\240\000\000\000\000\002\142\001\244\002\148\001\023\0020\000\000\002\141\000\238\002\154\002\139\001\139\002\144\000\000\000\000\002\156\000\000\001\245\000\000\002,\002-\001e\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\001\246\002\156\000\000\002n\002\139\000\000\002\145\002,\002-\001e\000\000\002o\001\245\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\003\\\002n\002\145\002\137\000\000\001\246\000\000\000\000\000\000\002o\002,\002-\001e\002\142\000\000\002\148\000\000\000\000\000\000\003k\000\000\002\154\002\137\001\139\002\144\002n\000\000\002\145\000\000\000\000\002\142\000\000\003\030\002o\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\003n\002\156\000\000\002\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\003\030\000\000\000\000\000\000\002\156\000\000\002\154\002\139\001\139\002\144\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\0020\000\000\002\141\000\238\000\000\000\000\000\000\002\139\000\000\000\000\002\156\000\000\002n\000\000\001\216\000\000\000\000\004\205\000\000\0020\002o\002\141\000\238\000\000\001\240\000\000\003t\000\000\001\244\000\000\001\023\002\139\002\145\002\137\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\002\145\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\002\142\002o\003\030\000\000\000\000\000\000\000\000\003v\002\154\001\245\001\139\002\144\000\000\000\000\002\137\002\145\000\000\000\000\000\000\002\142\000\000\003\030\000\000\001\246\000\000\000\000\000\000\002\154\000\000\001\139\002\144\002\156\000\000\000\000\002\139\000\000\000\000\000\000\000\000\000\000\002\205\001e\000\000\002\142\000\000\003\030\0020\000\000\002\141\000\238\002\156\002\154\000\000\001\139\002\144\000\000\002,\002-\001e\000\000\002\240\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\002\156\002\139\000\000\000\000\002\145\002o\000\000\000\000\002,\002-\001e\003\128\000\000\0020\000\000\002\141\000\238\000\000\002\137\000\000\000\000\000\000\000\000\002n\002,\002-\001e\000\000\002\245\003\005\003\006\002o\002\142\000\000\002\148\000\000\000\000\003\137\001\031\002n\002\154\001 \001\139\002\144\002\137\002\145\000\000\002o\000\000\000\000\000\000\000\000\000\000\003\140\000\000\000\000\000\000\000\000\000\000\000\000\002\137\000\000\001\127\002\156\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\142\001n\002\148\000\000\000\238\000\000\002\139\000\000\002\154\000\000\001\139\002\144\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\002\156\002\139\000\000\003\t\004\"\000\000\001*\000\000\000\000\000\000\000\000\000\000\002n\0020\000\000\002\141\000\238\002\139\000\000\002\145\002o\000\000\000\000\000\000\000\000\000\000\003\154\000\000\000\000\0020\001\129\002\141\000\238\002\137\000\000\000\000\001\016\000\000\001\130\000\000\001\139\001l\001\023\001$\000\000\002\145\000\000\002\142\000\000\002\148\000\000\002,\002-\001e\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002\145\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\002\142\002o\002\148\000\000\000\000\002\156\000\000\003\157\002\154\000\000\001\139\002\144\000\000\000\000\002\137\001>\002\142\000\000\002\148\000\000\000\000\002\139\001%\000\000\002\154\000\000\001\139\002\144\002,\002-\001e\002\156\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\156\000\000\001.\000\000\002o\001?\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\003\167\000\000\000\000\002\137\002\145\000\000\000\000\000\000\000\000\002n\002,\002-\001e\000\000\002\139\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\0020\003\172\002\141\000\238\002\137\000\000\002\142\002o\002\148\000\000\000\000\000\000\000\000\003\221\002\154\000\000\001\139\002\144\000\000\000\000\002\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\145\000\000\000\000\000\000\000\000\002\156\002\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\002\148\000\000\000\000\002\139\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\139\002\145\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\002\156\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002n\002,\002-\001e\000\000\000\000\002\145\002\142\002o\003\030\002,\002-\001e\000\000\003\234\002\154\002n\001\139\002\144\000\000\000\000\002\137\002\145\000\000\002o\000\000\002,\002-\001e\000\000\004\028\000\000\000\000\003c\002\142\000\000\003\030\002\137\002\156\000\000\000\000\002n\002\154\000\000\001\139\002\144\000\000\000\000\000\000\002o\002\142\000\000\002\148\000\000\000\000\004r\000\000\006\006\002\154\000\000\001\139\002\144\002\137\000\000\000\000\002\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\002\156\002\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\139\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\002/\001d\001e\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\139\000\000\000\000\002\145\000\000\001f\001v\000\000\001h\001i\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\002\145\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\004?\000\000\000\000\002\142\003f\002\148\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\002\145\000\000\000\000\002\142\001w\002\148\001x\002L\000\000\000\000\001\016\002\154\002\142\001\139\002\144\000\000\001\023\001$\002\156\000\000\002\143\000\000\001\139\002\144\000\000\002,\002-\001e\002\142\000\000\002\148\000\000\000\000\000\000\002\156\000\000\002\154\001\127\001\139\002\144\002n\002,\002-\001e\000\000\000\000\000\000\000\000\002o\001n\000\000\000\000\000\238\000\000\005\167\000\000\002n\000\000\000\000\002\156\003\145\002\137\001>\000\000\002o\002,\002-\001e\000\000\001%\005\170\000\000\000\000\005\022\000\000\000\000\005\025\002\137\000\000\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002o\002,\002-\001e\000\000\000\000\005\185\000\000\001.\000\000\000\000\001H\000\000\002\137\000\000\000\000\002n\000\000\000\000\000\000\000\000\001\129\000\000\000\000\002o\000\000\000\000\000\000\000\000\001\130\005\188\001\139\001l\000\000\002\139\000\000\000\000\002\137\000\000\000\000\006E\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\139\000\000\000\000\000\000\002,\002-\001e\000\000\006F\000\000\000\000\006H\0020\000\000\002\141\000\238\000\000\000\000\000\000\002n\006I\000\000\000\000\000\000\002\139\000\000\000\000\002o\002\145\000\000\000\000\000\000\000\000\005\201\000\000\000\000\0020\000\000\002\141\000\238\002\137\000\000\000\000\000\000\002\145\000\000\000\000\000\000\002\139\006J\002,\002-\001e\000\000\000\000\000\000\002\142\000\000\002\148\000\000\0020\000\000\002\141\000\238\002\154\002n\001\139\002\144\002\145\000\000\000\000\000\000\002\142\002o\002\148\000\000\000\000\000\000\000\000\005\204\002\154\000\000\001\139\002\144\000\000\006K\002\137\002\156\000\000\000\000\000\000\000\000\002\145\000\000\006L\000\000\002\142\000\000\002\148\000\000\000\000\002\139\000\000\002\156\002\154\000\000\001\139\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\006M\000\000\002\142\000\000\002\148\000\000\000\000\000\000\000\000\002\156\002\154\000\000\001\139\002\144\000\000\006N\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\006O\000\000\002\145\000\000\002\139\006Q\002n\000\000\002\156\000\000\000\000\000\000\000\000\000\000\002o\006S\0020\000\000\002\141\000\238\005\225\000\000\000\000\000\000\002,\002-\001e\002\137\000\000\000\000\002\142\006T\002\148\000\000\000\000\000\000\000\000\000\000\002\154\002n\001\139\002\144\000\000\002,\002-\001e\000\000\002o\002\145\000\000\000\000\000\000\000\000\005\228\000\000\000\000\000\000\000\000\002n\000\000\002\137\002\156\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\005\232\000\000\000\000\000\000\002\142\000\000\002\148\002\137\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\002\139\000\000\000\000\000\000\000\000\000\000\002\205\001e\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\002\156\000\000\000\000\000\000\000\000\000\000\000\000\002\240\001v\000\000\001h\001i\000\000\000\000\002\139\000\000\002\205\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\145\0020\000\000\002\141\000\238\000\000\000\000\000\000\002\139\000\000\000\000\002\240\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\245\003\005\003\006\000\000\002\142\000\000\002\148\000\000\000\000\002\145\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\002\145\002\245\003\005\003\006\000\000\000\000\001\127\002\156\002n\002\142\000\000\002\148\000\000\000\000\000\000\000\000\002o\002\154\001n\001\139\002\144\000\238\006\220\000\000\000\000\000\000\000\000\000\000\002\142\002\137\002\148\000\000\000\000\001d\001e\001\127\002\154\000\000\001\139\002\144\002\156\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\003\t\005\243\001f\001v\000\000\001h\001i\000\000\002\156\000\000\000\000\000\000\000\000\006E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\006v\000\000\001\129\000\000\003\t\006\021\006F\000\000\000\000\006H\001\130\002n\001\139\001l\002\139\000\000\000\000\000\000\006I\002o\001w\000\000\001x\002L\000\000\006\222\0020\000\000\002\141\000\238\000\000\001\129\002\137\000\000\000\000\000\000\001d\001e\000\000\001\130\000\000\001\139\001l\000\000\000\000\000\000\000\000\006J\000\000\001d\001e\000\000\000\000\001\127\000\000\000\000\001f\001v\002\145\001h\001i\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\001f\001v\000\000\001h\001i\000\000\000\000\003\145\000\000\000\000\001\184\000\000\000\000\000\000\006K\000\000\000\000\002\142\000\000\002\148\000\000\000\000\000\000\006L\002\139\002\154\000\000\001\139\002\144\000\000\001w\000\000\001x\001\143\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\001w\000\000\001x\001\172\006X\002\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000m\000\000\001d\001e\000\000\006N\001\127\001\130\000\000\001\139\001l\002\145\000\000\000\000\000\000\006O\000\000\000\000\001n\001\127\006Q\000\238\001f\001v\000\000\001h\001i\000\000\000\000\000\000\006S\001n\001\169\000\000\000\238\000\000\000\000\000\000\000\000\002\142\000\000\002\148\000\000\000\000\000\000\000\000\006T\002\154\000\000\001\139\002\144\001d\001e\000\000\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\172\000\000\002\156\001f\001v\000\000\001h\001i\001f\001v\001\129\001h\001i\001\174\000\000\001d\001e\000\000\001\130\000\000\001\139\001l\000\000\001\129\000\000\000\000\000\000\002,\002-\001e\001\127\001\130\000\000\001\139\001l\001f\001v\000\000\001h\001i\000\000\000\000\001n\000\000\000\000\000\238\001w\000\000\001x\001\172\003c\001w\000\000\001x\002L\000\000\000\000\000\000\000\000\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\031\000\000\000\000\001 \000\000\000\000\000\000\001w\001\127\001x\002T\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\001n\000\000\001\"\000\238\000\000\000\000\001\129\000\000\002,\002-\001e\003\141\003\252\000\000\001\130\001\127\001\139\001l\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\006\154\001n\002/\000\000\000\238\002o\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\137\000\000\000\000\001*\002n\002,\002-\001e\000\000\000\000\000\000\001\129\002o\002W\000\000\000\000\001\129\000\000\000\000\001\130\002n\001\139\001l\000\000\001\130\002\137\001\139\001l\002o\000\000\000\000\000\000\003e\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\002\137\000\000\001\129\000\000\002,\002-\001e\000\000\000\000\000\000\001\130\000\000\001\139\001l\000\000\002\142\000\000\000\000\000\000\002n\002\139\000\000\000\000\002\143\000\000\001\139\002\144\002o\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\001\031\000\000\002\137\001 \000\000\000\000\001>\002\139\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\002,\002-\001e\0020\000\000\002\141\000\238\002\139\000\000\000\000\002\145\001\"\000\000\000\000\000\000\002n\000\000\000\000\000\000\0020\000\000\002\141\000\238\002o\001.\000\000\000\000\004\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\137\000\000\002\142\000\000\003\015\000\000\000\000\000\000\000\000\000\000\002\154\002\139\001\139\002\144\000\000\002\145\002,\002-\001e\000\000\001*\000\000\000\000\0020\000\000\002\141\000\238\002\142\000\000\002\150\000\000\002n\000\000\002\156\000\000\002\154\000\000\001\139\002\144\002o\000\000\000\000\000\000\002\142\000\000\002\152\000\000\000\000\000\000\000\000\001\016\002\154\002\137\001\139\002\144\002\145\001\023\001$\002\156\000\000\000\000\002\139\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\002\156\002\141\000\238\000\000\002n\000\000\002,\002-\001e\002\142\000\000\002\157\002o\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\002n\000\000\000\000\000\000\002\137\000\000\000\000\001>\002o\000\000\002\145\002,\002-\001e\001%\000\000\000\000\000\000\002\139\002\156\000\000\002\137\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\0020\000\000\002\141\000\238\002o\000\000\000\000\000\000\002\142\000\000\002\164\001.\000\000\000\000\001\225\000\000\002\154\002\137\001\139\002\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\002\145\000\000\000\000\002\139\002,\002-\001e\002\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002n\002\139\000\000\000\000\000\000\000\000\000\000\000\000\002o\002\142\000\000\002\166\000\000\0020\000\000\002\141\000\238\002\154\000\000\001\139\002\144\002\137\000\000\000\000\000\000\000\000\000\000\002\139\002\145\000\000\000\000\000\000\002,\002-\001e\000\000\002,\002-\001e\0020\002\156\002\141\000\238\000\000\000\000\002\145\000\000\002n\000\000\000\000\000\000\002n\000\000\000\000\000\000\002o\002\142\000\000\002\168\002o\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\002\137\000\000\000\000\002\145\002\137\002\142\000\000\002\170\000\000\002,\002-\001e\000\000\002\154\002\139\001\139\002\144\000\000\000\000\002\156\000\000\000\000\000\000\000\000\002n\000\000\0020\000\000\002\141\000\238\000\000\002\142\002o\002\172\000\000\000\000\002\156\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002\137\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\001\031\000\000\000\000\001 \002\145\000\000\000\000\002\139\002\156\000\000\002n\002\139\000\000\000\000\000\000\000\000\000\000\000\000\002o\0020\000\000\002\141\000\238\0020\000\000\002\141\000\238\001\"\000\000\000\000\000\000\002\137\002\142\000\000\002\174\000\000\000\000\002\229\000\000\000\000\002\154\001\031\001\139\002\144\005;\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\139\000\000\000\000\002\145\000\000\000\000\000\000\002,\002-\001e\000\000\002\156\0020\000\000\002\141\000\238\001\"\000\000\000\000\000\000\001*\000\000\002n\000\000\000\000\000\000\000\000\002\142\000\000\002\176\002o\002\142\000\000\002\178\000\000\002\154\000\000\001\139\002\144\002\154\002\139\001\139\002\144\002\137\002\145\000\000\000\000\000\000\000\000\000\000\001\016\000\000\0020\000\000\002\141\000\238\001\023\001$\002\156\000\000\000\000\005=\002\156\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\002\180\000\000\000\000\000\000\002n\000\000\002\154\000\000\001\139\002\144\002\145\000\000\002o\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\005@\002\137\000\000\000\000\001>\002\156\002\139\000\000\002,\002-\001e\001%\000\000\000\000\002\142\002x\002\182\000\000\0020\000\000\002\141\000\238\002\154\002n\001\139\002\144\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\002\137\002\156\000\000\000\000\000\000\000\000\002\145\000\000\005A\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\002\139\000\000\005\011\000\000\005F\000\000\005C\000\000\000\000\000\000\000\000\002n\0020\000\000\002\141\000\238\002\142\001.\002\184\002o\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\000\000\000\000\002\137\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\139\002\145\000\000\000\000\002\156\002n\000\000\002,\002-\001e\000\000\000\000\0020\002o\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\137\000\000\000\000\002\142\002o\002\186\002,\002-\001e\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002\137\002\145\000\000\000\000\002n\000\000\000\000\002\139\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\002\156\000\000\0020\000\000\002\141\000\238\000\000\000\000\002\137\001d\001e\000\000\002\142\000\000\002\188\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\000\000\002\139\000\000\001f\001\137\000\000\001h\001i\002\145\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\002\156\002\139\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\002\142\000\000\002\190\000\000\002n\000\000\000\000\002\139\002\154\002\145\001\139\002\144\002o\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\002\137\002\145\000\000\000\000\000\000\000\000\002\156\000\000\000\000\002,\002-\001e\002\142\000\000\002\192\000\000\000\000\000\000\001m\000\000\002\154\000\000\001\139\002\144\002n\000\000\002\145\000\000\000\000\002\142\001n\002\194\002o\000\238\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002\156\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\002\142\000\000\002\196\000\000\000\000\000\000\002\156\002\139\002\154\000\000\001\139\002\144\002n\000\000\000\000\000\000\000\000\001d\001e\0020\002o\002\141\000\238\000\000\000\000\000\000\002\214\000\000\000\000\000\000\000\000\002\156\000\000\002\137\002\217\000\000\001\129\001f\002\218\000\000\001h\001i\000\000\000\000\001\138\000\000\001\139\001l\001d\001e\000\000\002\145\002\139\000\000\000\000\000\000\000\000\002\214\000\000\000\000\000\000\002,\002-\001e\0020\002\217\002\141\000\238\001f\002\218\000\000\001h\001i\000\000\000\000\000\000\002n\000\000\000\000\002\142\000\000\002\198\000\000\000\000\002o\000\000\006E\002\154\000\000\001\139\002\144\000\000\000\000\000\000\002\139\000\000\002\145\002\137\000\000\000\000\000\000\000\000\000\000\000\000\006F\000\000\0020\006H\002\141\000\238\002\156\000\000\000\000\001m\000\000\000\000\006I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\142\001n\002\200\000\000\000\238\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\000\000\002\145\002,\002-\001e\000\000\000\000\001m\006J\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\002n\002\156\001n\000\000\002\139\000\238\002\219\002n\002o\002,\002-\001e\002\142\000\000\002\202\002o\0020\000\000\002\141\000\238\002\154\002\137\001\139\002\144\002n\000\000\002\221\006K\002\137\000\000\000\000\001\129\002o\000\000\000\000\000\000\006L\002\219\000\000\001\138\000\000\001\139\001l\002\156\000\000\002\137\000\000\000\000\002\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\006a\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\006N\002\142\000\000\0032\000\000\000\000\000\000\002\139\000\000\002\154\006O\001\139\002\144\000\000\002\139\006Q\000\000\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\006S\0020\000\000\002\141\000\238\000\000\002\139\002\156\002,\002-\001e\000\000\000\000\002,\002-\001e\006T\000\000\0020\000\000\002\141\000\238\000\000\002n\000\000\000\000\002\145\000\000\002n\000\000\000\000\002o\000\000\002\145\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\137\000\000\000\000\000\000\000\000\002\137\002\145\000\000\000\000\000\000\002\142\000\000\0038\000\000\002,\002-\001e\002\142\002\154\003>\001\139\002\144\000\000\000\000\000\000\002\154\000\000\001\139\002\144\002n\000\000\000\000\000\000\000\000\002\142\000\000\003D\002o\000\000\000\000\000\000\002\156\002\154\000\000\001\139\002\144\000\000\000\000\002\156\000\000\002\137\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\002\139\000\000\000\000\000\000\002\156\002\139\000\000\000\000\002n\002,\002-\001e\0020\000\000\002\141\000\238\002o\0020\000\000\002\141\000\238\000\000\000\000\000\000\002n\000\000\000\000\000\000\000\000\002\137\000\000\000\000\002o\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\137\000\000\000\000\000\000\002\145\002\139\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\000\000\000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\003I\000\000\000\000\002\142\000\000\003N\002\154\000\000\001\139\002\144\000\000\002\154\000\000\001\139\002\144\001\031\002\139\000\000\005;\000\000\002\145\000\000\000\000\000\000\001w\000\000\001x\002L\0020\002\156\002\141\000\238\002\139\000\000\002\156\000\000\000\000\000\000\000\000\002,\002-\001e\001\"\000\000\0020\000\000\002\141\000\238\002\142\000\000\003U\000\000\000\000\000\000\002n\000\000\002\154\001\127\001\139\002\144\002\145\000\000\002o\000\000\000\000\000\000\002,\002-\001e\001n\000\000\000\000\000\238\000\000\000\000\002\137\002\145\000\000\000\000\002\156\003\144\002n\002,\002-\001e\000\000\000\000\005=\002\142\002o\003Z\000\000\000\000\000\000\000\000\000\000\002\154\002n\001\139\002\144\000\000\000\000\002\137\000\000\002\142\002o\003_\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\139\002\144\000\000\001\016\002\137\002\156\000\000\001\187\001e\001\023\005@\000\000\000\000\005R\000\000\001\129\000\000\000\000\000\000\000\000\000\000\002\156\002\139\001\130\000\000\001\139\001l\001f\002A\000\000\001h\001i\001d\001e\0020\000\000\002\141\000\238\000\000\000\000\000\000\005S\000\000\005T\000\000\000\000\000\000\000\000\000\000\002\139\000\000\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\0020\005A\002\141\000\238\002\139\002\145\000\000\000\000\003\152\003\005\003\006\005U\000\000\005\011\000\000\005E\0020\005C\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\000\000\002\145\002\142\001w\003b\001x\007\026\000\000\007\028\000\000\002\154\001\127\001\139\002\144\000\000\005V\000\000\002\145\000\000\000\000\000\000\000\000\000\000\001n\005W\005X\000\238\005Y\000\000\002\142\000\000\003\148\000\000\002\156\000\000\000\000\001\127\002\154\000\000\001\139\002\144\001d\001e\000\000\000\000\002\142\000\000\003\150\001n\000\000\005\147\000\238\003\159\002\154\000\000\001\139\002\144\000\000\000\000\000\000\002\156\001f\001v\000\000\001h\001i\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\005[\0012\002\156\000\000\000\000\005]\005g\000\000\000\000\001\129\001\031\000\000\000\000\001 \000\000\005\145\0012\001\130\000\000\001\139\001l\0013\001\"\000\000\001\031\000\000\000\000\001 \001Q\000\000\001w\005\146\001x\006j\001\129\000\000\0013\001\"\000\000\000\000\000\000\000\000\001\130\001O\001\139\001l\000\000\000\000\000\000\000\000\001\031\001\"\000\000\001 \000\000\000\000\0012\000\000\000\000\001\031\000\000\000\000\001 \001\127\000\000\0012\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\0013\001\"\000\238\000\000\000\000\000\000\001*\0014\0018\0013\001\"\000\000\000\000\000\000\000\000\000\000\001M\000\000\000\000\000\000\001*\001\016\000\000\0018\000\000\000\000\000\000\001\023\001$\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\001\023\001$\000\000\000\000\001*\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001*\001\023\001$\000\000\001\129\000\000\000\000\000\000\0018\000\000\000\000\000\000\001\130\000\000\001\139\001l\000\000\0018\001>\000\000\000\000\001\016\001d\001e\000\000\001%\000\000\001\023\001$\001F\001\016\000\000\000\000\001>\000\000\000\000\001\023\001$\001d\001e\001%\000\000\001f\001v\001F\001h\001i\001-\000\000\000\000\001\031\000\000\001.\001 \001%\001H\000\000\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001>\001d\001e\000\000\001\"\000\000\000\000\001%\001.\001>\000\000\001F\001w\000\000\001x\001\176\001%\000\000\001d\001e\001F\001f\001v\000\000\001h\001i\000\000\000\000\001w\000\000\001x\001\164\000\000\000\000\001.\000\000\000\000\001H\001f\001v\000\000\001h\001i\001.\000\000\001\127\001H\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\001\127\000\000\000\000\001w\000\000\001x\001\161\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\000\000\001\016\000\000\001w\000\000\001x\001z\001\023\001$\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001v\001n\001h\001i\000\238\000\000\001\127\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001n\001\139\001l\000\238\000\000\001>\000\000\001\129\000\000\000\000\001d\001e\001%\000\000\000\000\001\130\005\022\001\139\001l\006)\000\000\000\000\000\000\000\000\001w\000\000\001x\001}\000\000\000\000\001f\001v\000\000\001h\001i\001d\001e\000\000\000\000\001.\000\000\000\000\001H\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\001f\001v\001\127\001h\001i\001\129\001d\001e\000\000\000\000\000\000\000\000\000\000\001\130\001n\001\139\001l\000\238\001w\000\000\001x\001\128\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\001w\000\000\001x\001\160\000\000\000\000\000\000\000\000\001\127\001f\001v\000\000\001h\001i\002,\002-\001e\000\000\001f\001v\001n\001h\001i\000\238\000\000\000\000\001w\000\000\001x\001\148\000\000\001\129\000\000\001\127\000\000\000\000\000\000\003\180\000\000\001\130\000\000\001\139\001l\000\000\003\189\001n\000\000\000\000\000\238\000\000\000\000\000\000\001w\000\000\001x\001\156\000\000\000\000\000\000\001\127\000\000\001w\000\000\001x\002d\000\000\000\000\003\202\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\001\127\000\000\000\000\001\130\000\000\001\139\001l\000\000\000\000\001\127\000\000\000\000\001n\000\000\000\000\000\238\000\000\000\000\000\000\000\000\001\129\001n\000\000\000\000\000\238\000\000\002/\000\000\001\130\000\000\001\139\001l\000\000\000\000\000\000\000\000\000\000\000\000\003\193\000\000\002\141\000\238\001\002\001d\001e\000\000\001\129\000\000\000\000\000\000\001d\001e\002\236\000\000\001\130\000\000\001\139\001l\000\000\000\000\002\239\000\000\000\000\001f\002\218\000\000\001h\001i\000\000\000\000\001f\001v\001\129\001h\001i\003\183\000\000\000\000\000\000\000\000\001\130\001\129\001\139\001l\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\000\000\000\000\000\000\000\000\000\000\002\142\001d\001e\000\000\000\000\000\000\001d\001e\002\143\000\000\001\139\002\144\000\000\000\000\000\000\001w\000\000\001x\002\250\000\000\000\000\001f\001v\000\000\001h\001i\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\001m\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\001f\001v\001n\001h\001i\000\238\001w\000\000\001x\002\253\000\000\001w\000\000\001x\003\000\000\000\000\000\001d\001e\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\001I\000\000\000\000\002\219\000\000\000\000\000\000\002,\002-\001e\001f\001v\001\127\001h\001i\000\000\001w\001\127\001x\003\b\001K\001\"\000\000\000\000\001n\000\000\005\004\000\238\001\129\001n\003\180\000\000\000\238\000\000\000\000\001\129\001\138\003\189\001\139\001l\000\000\001\031\000\000\001\130\001 \001\139\001l\001I\000\000\001\127\000\000\000\000\000\000\001w\000\000\001x\004p\000\000\000\000\000\000\003\190\001n\000\000\000\000\000\238\000\000\001*\001K\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\0018\001\129\000\000\001\127\000\000\000\000\001\129\000\000\000\000\001\130\000\000\001\139\001l\001\016\001\130\001n\001\139\001l\000\238\001\023\001$\002/\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\001*\0012\000\000\003\193\000\000\002\141\000\238\001\002\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\0018\001\139\001l\000\000\0017\001\"\000\000\000\000\000\000\000\000\001d\001e\000\000\001\016\000\000\000\000\000\000\000\000\001>\001\023\001$\001\031\000\000\003\183\001 \001%\000\000\004(\001\129\005:\001f\002\218\000\000\001h\001i\000\000\001\130\000\000\001\139\001l\001d\001e\000\000\000\000\000\000\000\000\002\142\000\000\001\"\000\000\001*\000\000\001.\000\000\002\143\001H\001\139\002\144\000\000\000\000\001f\002\218\000\000\001h\001i\001>\000\000\0018\001d\001e\000\000\000\000\001%\000\000\000\000\000\000\001F\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001f\002\218\000\000\001h\001i\001*\000\000\000\000\001d\001e\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\001f\002\218\001n\001h\001i\000\238\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001>\000\000\001f\002\218\001m\001h\001i\001%\000\000\000\000\000\000\001F\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\238\000\000\002\219\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001m\000\000\001.\000\000\000\000\001H\001d\001e\000\000\000\000\000\000\001>\001n\000\000\001\129\000\238\000\000\000\000\001%\003\129\000\000\000\000\001\138\005\205\001\139\001l\001f\002\218\001m\001h\001i\000\000\000\000\000\000\000\000\000\000\001d\001e\003\131\000\000\001n\000\000\000\000\000\238\001\129\001.\001m\003\129\001\227\000\000\001d\001e\001\138\005\229\001\139\001l\001f\002\218\001n\001h\001i\000\238\000\000\000\000\001d\001e\003\130\000\000\000\000\000\000\001f\002\218\001\129\001h\001i\003\129\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\001f\002\218\000\000\001h\001i\000\000\000\000\000\000\000\000\0068\003\134\000\000\000\000\000\000\000\000\000\000\001\129\000\000\001m\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\001n\000\000\000\000\000\238\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\001m\000\000\000\000\000\000\001\031\000\000\000\000\001 \006:\000\000\000\000\000\000\001n\000\000\001m\000\238\000\000\002\219\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\001m\000\238\000\000\001\"\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\001n\004\127\001\129\000\238\000\000\000\000\000\000\002\219\000\000\000\000\001\138\000\000\001\139\001l\001f\002\218\006\215\001h\001i\000\000\000\000\006\000\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\006\000\001*\000\000\000\000\000\000\001\138\000\000\001\139\001l\001f\002\218\001\129\001h\001i\000\000\000\000\000\000\000\000\000\000\001\138\001\031\001\139\001l\001 \000\000\001\129\000\000\000\000\001d\001e\000\000\001\016\006\r\001\138\000\000\001\139\001l\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\012\001\"\001f\002\218\000\000\001h\001i\000\000\000\000\001m\000\000\004\127\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\001n\000\000\000\000\000\238\000\000\004\130\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001>\000\000\001m\000\000\000\000\001\"\000\000\001%\000\000\001*\000\000\004\136\005R\000\000\001n\004\127\000\000\000\238\001\"\0068\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\127\000\000\004\249\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\001\016\005S\001m\005T\005\202\001\129\001\023\001$\000\000\000\000\0068\001*\000\000\001\138\001n\001\139\001l\000\238\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\0069\000\000\000\000\000\000\000\000\005U\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001\016\000\000\001\138\000\000\001\139\001l\001\023\001$\003\133\000\000\000\000\001>\001\031\001\016\000\000\001 \006A\000\000\001%\001\023\001$\000\000\004\136\000\000\000\000\000\000\005V\000\000\000\000\001\031\000\000\001\031\001 \001\129\001 \005W\005X\000\000\005Y\001\"\000\000\001\138\000\000\001\139\001l\001.\000\000\000\000\001H\004\127\001d\001e\001>\000\000\000\000\000\000\001\"\000\000\001\"\001%\000\000\005Z\000\000\004\136\005\216\001>\004\127\000\000\003\252\000\000\001f\002\211\001%\001h\001i\000\000\004\136\000\000\000\000\000\000\001\031\005\226\003\255\001 \001*\005[\001.\000\000\000\000\001H\005]\005g\000\000\000\000\000\000\000\000\002,\002-\001e\001.\005\145\001*\001H\001*\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\005\004\000\000\001\016\000\000\005\146\000\000\000\000\004.\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\016\000\000\001\016\000\000\000\000\000\000\001\023\001$\001\023\001$\001\031\000\000\000\000\001 \000\000\001m\000\000\000\000\000\000\001\"\001\031\001*\000\000\001 \005\251\000\000\000\000\001n\000\000\000\000\000\238\000\000\000\000\000\000\000\000\001>\000\000\001\"\000\000\000\000\000\000\001\031\001%\000\000\001 \000\000\004\136\001\"\000\000\000\000\000\000\001\016\001>\000\000\001>\000\000\000\000\001\023\001$\001%\000\000\001%\002/\004\136\001*\000\000\000\000\000\000\001\"\001.\000\000\000\000\001H\000\000\0020\000\000\002\141\000\238\006\254\000\000\001\031\000\000\001*\001 \000\000\000\000\001.\001\129\001.\001H\000\000\004\003\001*\000\000\001\016\001\138\000\000\001\139\001l\000\000\001\023\001$\000\000\001>\000\000\001\031\000\000\001\"\001 \000\000\001%\000\000\001\016\001*\005\t\001<\000\000\000\000\001\023\001$\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\001\"\000\000\002\142\000\000\000\000\001.\001\031\000\000\001H\001 \002\143\001\016\001\139\002\144\001>\000\000\000\000\001\023\001$\000\000\001*\001%\000\000\000\000\000\000\005\t\000\000\000\000\000\000\000\000\000\000\000\000\001>\001\"\000\000\001\031\000\000\000\000\001 \001%\000\000\000\000\001>\006\255\000\000\001*\000\000\000\000\001.\001%\001\016\001H\000\000\001X\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\001\"\001>\000\000\000\000\001.\000\000\000\000\001H\001%\002,\002-\001e\001\151\001\016\001.\001\031\001*\001H\001 \001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\003\197\000\000\000\000\001.\000\000\000\000\001H\000\000\001>\000\000\001\"\000\000\000\000\001*\001\016\001%\000\000\000\000\000\000\002.\001\023\001$\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\001.\001\016\001\192\001D\000\000\000\000\000\000\001\023\001$\000\000\001\"\000\000\000\000\001*\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\001>\001.\000\000\000\000\001H\000\000\000\000\001%\002/\000\000\000\000\001\230\000\000\000\000\000\000\002i\000\000\000\000\000\000\001\016\0020\000\000\002\141\000\238\000\000\001\023\001$\002/\000\000\001>\001\031\001*\000\000\001 \001.\000\000\001%\001H\000\000\0020\001\232\002\141\000\238\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\016\000\000\001.\000\000\000\000\001H\001\023\001$\002k\000\000\001>\000\000\001\031\002\129\000\000\001 \000\000\001%\000\000\002\142\000\000\002C\000\000\000\000\000\000\000\000\000\000\002\143\002/\001\139\002\144\000\000\002,\002-\001e\000\000\000\000\000\000\002\142\001\"\0020\001*\002\141\000\238\001.\000\000\002\143\001H\001\139\002\144\000\000\000\000\001>\000\000\000\000\002\140\000\000\000\000\000\000\001%\000\000\000\000\000\000\002V\000\000\000\000\001\031\000\000\000\000\001 \000\000\001\016\000\000\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\000\000\002/\000\000\001*\000\000\001.\002/\000\000\001H\000\000\000\000\000\000\001\"\0020\000\000\002\141\000\238\000\000\0020\002\142\002\141\000\238\001\"\000\000\002,\002-\001e\002\143\000\000\001\139\002\144\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001>\000\000\000\000\000\000\000\000\002\155\002/\001%\000\000\000\000\000\000\002u\000\000\001\031\000\000\001*\001 \000\000\0020\000\000\002\141\000\238\000\000\000\000\000\000\001*\002,\002-\001e\000\000\000\000\002\142\000\000\000\000\001.\000\000\002\142\001H\000\000\002\143\001\"\001\139\002\144\001>\002\143\001\016\001\139\002\144\000\000\003+\001%\001\023\001$\000\000\002z\001\016\001\031\000\000\000\000\001 \000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\001\031\000\000\000\000\001 \001.\002\142\002/\001H\000\000\000\000\001\"\000\000\001*\002\143\000\000\001\139\002\144\000\000\0020\000\000\002\141\000\238\001\"\000\000\001>\000\000\000\000\001\"\000\000\000\000\000\000\001%\000\000\000\000\001>\002\226\000\000\000\000\000\000\000\000\000\000\001%\001\016\001\031\000\000\002\233\001 \000\000\001\023\001$\002/\000\000\000\000\000\000\000\000\001*\000\000\000\000\001.\000\000\000\000\001H\0020\000\000\002\141\000\238\000\000\001*\001.\000\000\001\"\001H\001*\000\000\000\000\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\001\016\002\143\001\031\001\139\002\144\001 \001\023\001$\000\000\001>\000\000\000\000\001\016\000\000\000\000\000\000\001%\001\016\001\023\001$\002\242\000\000\001\031\001\023\001$\005;\000\000\000\000\000\000\001\"\001*\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\001.\000\000\002\143\001H\001\139\002\144\001\"\001\031\000\000\001>\005;\000\000\000\000\000\000\000\000\000\000\001%\001\016\000\000\000\000\004\129\001>\000\000\001\023\001$\000\000\001>\001\031\001%\000\000\005;\001*\004\226\001%\001\"\000\000\000\000\004\238\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\005=\000\000\000\000\001\"\001.\001\031\000\000\001H\001 \001.\001\016\000\000\001H\000\000\000\000\000\000\001\023\001$\001>\001\031\000\000\000\000\001 \000\000\000\000\001%\000\000\000\000\005=\005\b\001\016\000\000\001\"\000\000\000\000\000\000\001\023\005@\000\000\001\031\000\000\000\000\005;\000\000\000\000\000\000\001\"\000\000\005=\000\000\000\000\000\000\001.\000\000\001\031\001H\000\000\001 \001\016\000\000\000\000\000\000\001>\000\000\001\023\005@\001\"\000\000\000\000\001%\000\000\000\000\000\000\005\024\000\000\000\000\000\000\001*\001\016\000\000\000\000\001\"\000\000\001\031\001\023\005@\005;\000\000\000\000\005A\000\000\001*\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\005\011\000\000\005D\000\000\005C\000\000\001\016\000\000\001\031\001\"\005=\001 \001\023\001$\000\000\001.\005A\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001*\001\023\001$\005\011\000\000\005B\000\000\005C\000\000\000\000\001\"\005A\000\000\000\000\000\000\001\016\000\000\000\000\001.\000\000\000\000\001\023\005@\005\011\000\000\005N\000\000\005C\000\000\005=\001\016\000\000\000\000\001>\000\000\000\000\001\023\001$\001.\000\000\001%\000\000\000\000\000\000\005\181\001\031\000\000\001>\001 \000\000\001\031\000\000\000\000\001 \001%\001*\000\000\000\000\005\199\001\016\000\000\000\000\000\000\000\000\000\000\001\023\005@\001.\001\031\000\000\001H\001 \001\"\000\000\005A\000\000\000\000\001\"\000\000\000\000\000\000\001.\001>\000\000\001H\001\016\005\011\000\000\006\027\001%\005C\001\023\001$\005\223\001\031\001\"\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\000\000\000\000\000\000\000\000\000\000\000\000\001.\001*\005A\001H\000\000\001\"\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\011\000\000\0065\000\000\005C\000\000\000\000\001>\000\000\000\000\001*\000\000\000\000\000\000\001%\001.\000\000\001\016\006m\000\000\000\000\000\000\001\016\001\023\001$\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\001\016\001.\000\000\000\000\001H\000\000\001\023\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\016\000\000\000\000\001>\000\000\000\000\001\023\001$\001>\000\000\001%\000\000\000\000\000\000\006\175\001%\000\000\000\000\000\000\006\179\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\006\168\000\000\000\000\000\000\000\000\000\000\000\000\001%\001.\000\000\000\000\003\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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."))
and semantic_action =
[|
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3745 "parsing/parser.mly"
+# 3763 "parsing/parser.mly"
( "+" )
# 1380 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3746 "parsing/parser.mly"
+# 3764 "parsing/parser.mly"
( "+." )
# 1405 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3298 "parsing/parser.mly"
+# 3316 "parsing/parser.mly"
( _1 )
# 1430 "parsing/parser.ml"
in
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3301 "parsing/parser.mly"
+# 3319 "parsing/parser.mly"
( Ptyp_alias(ty, tyvar) )
# 1477 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 1486 "parsing/parser.ml"
in
-# 3303 "parsing/parser.mly"
+# 3321 "parsing/parser.mly"
( _1 )
# 1492 "parsing/parser.ml"
in
let _v : (let_binding) = let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
# 1540 "parsing/parser.ml"
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
# 1549 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2554 "parsing/parser.mly"
+# 2567 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklb ~loc:_sloc false body attrs
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3629 "parsing/parser.mly"
+# 3647 "parsing/parser.mly"
( _1 )
# 1586 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3630 "parsing/parser.mly"
+# 3648 "parsing/parser.mly"
( Lident _1 )
# 1611 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 3359 "parsing/parser.mly"
+# 3377 "parsing/parser.mly"
( _2 )
# 1650 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
# 1727 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
# 1733 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3361 "parsing/parser.mly"
+# 3379 "parsing/parser.mly"
( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 )
# 1742 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3364 "parsing/parser.mly"
+# 3382 "parsing/parser.mly"
( Ptyp_var _2 )
# 1775 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 1784 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 1790 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3366 "parsing/parser.mly"
+# 3384 "parsing/parser.mly"
( Ptyp_any )
# 1816 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 1824 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 1830 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 1861 "parsing/parser.ml"
in
let tys =
-# 3411 "parsing/parser.mly"
+# 3429 "parsing/parser.mly"
( [] )
# 1867 "parsing/parser.ml"
in
-# 3369 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
# 1872 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 1881 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 1887 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 1925 "parsing/parser.ml"
in
let tys =
-# 3413 "parsing/parser.mly"
+# 3431 "parsing/parser.mly"
( [ty] )
# 1931 "parsing/parser.ml"
in
-# 3369 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
# 1936 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 1946 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 1952 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 2005 "parsing/parser.ml"
# 2013 "parsing/parser.ml"
in
-# 1045 "parsing/parser.mly"
+# 1049 "parsing/parser.mly"
( xs )
# 2018 "parsing/parser.ml"
in
-# 3415 "parsing/parser.mly"
+# 3433 "parsing/parser.mly"
( tys )
# 2024 "parsing/parser.ml"
in
-# 3369 "parsing/parser.mly"
+# 3387 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
# 2030 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2040 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2046 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3371 "parsing/parser.mly"
+# 3389 "parsing/parser.mly"
( let (f, c) = _2 in Ptyp_object (f, c) )
# 2086 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2095 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2101 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3373 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
( Ptyp_object ([], Closed) )
# 2134 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2143 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2149 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 2187 "parsing/parser.ml"
in
let tys =
-# 3411 "parsing/parser.mly"
+# 3429 "parsing/parser.mly"
( [] )
# 2193 "parsing/parser.ml"
in
-# 3377 "parsing/parser.mly"
+# 3395 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
# 2198 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2208 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2214 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 2259 "parsing/parser.ml"
in
let tys =
-# 3413 "parsing/parser.mly"
+# 3431 "parsing/parser.mly"
( [ty] )
# 2265 "parsing/parser.ml"
in
-# 3377 "parsing/parser.mly"
+# 3395 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
# 2270 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2280 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2286 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 2346 "parsing/parser.ml"
# 2354 "parsing/parser.ml"
in
-# 1045 "parsing/parser.mly"
+# 1049 "parsing/parser.mly"
( xs )
# 2359 "parsing/parser.ml"
in
-# 3415 "parsing/parser.mly"
+# 3433 "parsing/parser.mly"
( tys )
# 2365 "parsing/parser.ml"
in
-# 3377 "parsing/parser.mly"
+# 3395 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
# 2371 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2381 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2387 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3380 "parsing/parser.mly"
+# 3398 "parsing/parser.mly"
( Ptyp_variant([_2], Closed, None) )
# 2427 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2436 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2442 "parsing/parser.ml"
in
# 2492 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
# 2497 "parsing/parser.ml"
in
-# 3425 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( _1 )
# 2503 "parsing/parser.ml"
in
-# 3382 "parsing/parser.mly"
+# 3400 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, None) )
# 2509 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2519 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2525 "parsing/parser.ml"
in
# 2582 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
# 2587 "parsing/parser.ml"
in
-# 3425 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( _1 )
# 2593 "parsing/parser.ml"
in
-# 3384 "parsing/parser.mly"
+# 3402 "parsing/parser.mly"
( Ptyp_variant(_2 :: _4, Closed, None) )
# 2599 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2609 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2615 "parsing/parser.ml"
in
# 2665 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
# 2670 "parsing/parser.ml"
in
-# 3425 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( _1 )
# 2676 "parsing/parser.ml"
in
-# 3386 "parsing/parser.mly"
+# 3404 "parsing/parser.mly"
( Ptyp_variant(_3, Open, None) )
# 2682 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2692 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2698 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3388 "parsing/parser.mly"
+# 3406 "parsing/parser.mly"
( Ptyp_variant([], Open, None) )
# 2731 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2740 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2746 "parsing/parser.ml"
in
# 2796 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
# 2801 "parsing/parser.ml"
in
-# 3425 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( _1 )
# 2807 "parsing/parser.ml"
in
-# 3390 "parsing/parser.mly"
+# 3408 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some []) )
# 2813 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2823 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2829 "parsing/parser.ml"
in
# 2894 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 989 "parsing/parser.mly"
( xs )
# 2899 "parsing/parser.ml"
in
-# 3453 "parsing/parser.mly"
+# 3471 "parsing/parser.mly"
( _1 )
# 2905 "parsing/parser.ml"
# 2913 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
# 2918 "parsing/parser.ml"
in
-# 3425 "parsing/parser.mly"
+# 3443 "parsing/parser.mly"
( _1 )
# 2924 "parsing/parser.ml"
in
-# 3392 "parsing/parser.mly"
+# 3410 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some _5) )
# 2930 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2940 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2946 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3394 "parsing/parser.mly"
+# 3412 "parsing/parser.mly"
( Ptyp_extension _1 )
# 2972 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
# 2980 "parsing/parser.ml"
in
-# 3396 "parsing/parser.mly"
+# 3414 "parsing/parser.mly"
( _1 )
# 2986 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3812 "parsing/parser.mly"
+# 3830 "parsing/parser.mly"
( _1 )
# 3012 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 913 "parsing/parser.mly"
+# 917 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
# 3020 "parsing/parser.ml"
in
-# 3814 "parsing/parser.mly"
+# 3832 "parsing/parser.mly"
( _1 )
# 3026 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3813 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 ^ "." ^ _3.txt )
# 3066 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 913 "parsing/parser.mly"
+# 917 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
# 3075 "parsing/parser.ml"
in
-# 3814 "parsing/parser.mly"
+# 3832 "parsing/parser.mly"
( _1 )
# 3081 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3818 "parsing/parser.mly"
+# 3836 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
# 3130 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) =
-# 1858 "parsing/parser.mly"
+# 1872 "parsing/parser.mly"
( _1 )
# 3155 "parsing/parser.ml"
in
let _v : (Parsetree.class_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
# 3196 "parsing/parser.ml"
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1860 "parsing/parser.mly"
+# 1874 "parsing/parser.mly"
( wrap_class_attrs ~loc:_sloc _3 _2 )
# 3205 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1862 "parsing/parser.mly"
+# 1876 "parsing/parser.mly"
( class_of_let_bindings ~loc:_sloc _1 _3 )
# 3247 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 3312 "parsing/parser.ml"
let _4 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
# 3321 "parsing/parser.ml"
in
let _3 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
# 3327 "parsing/parser.ml"
in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1864 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
# 3409 "parsing/parser.ml"
let _4 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
# 3418 "parsing/parser.ml"
in
- let _3 =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let _3 =
+# 3756 "parsing/parser.mly"
( Override )
-# 3426 "parsing/parser.ml"
-
- in
+# 3424 "parsing/parser.ml"
+ in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1864 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 3437 "parsing/parser.ml"
+# 3434 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1868 "parsing/parser.mly"
+# 1882 "parsing/parser.mly"
( Cl.attr _1 _2 )
-# 3469 "parsing/parser.ml"
+# 3466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 3504 "parsing/parser.ml"
+# 3501 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 989 "parsing/parser.mly"
( xs )
-# 3509 "parsing/parser.ml"
+# 3506 "parsing/parser.ml"
in
-# 1871 "parsing/parser.mly"
+# 1885 "parsing/parser.mly"
( Pcl_apply(_1, _2) )
-# 3515 "parsing/parser.ml"
+# 3512 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3525 "parsing/parser.ml"
+# 3522 "parsing/parser.ml"
in
-# 1874 "parsing/parser.mly"
+# 1888 "parsing/parser.mly"
( _1 )
-# 3531 "parsing/parser.ml"
+# 3528 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1873 "parsing/parser.mly"
+# 1887 "parsing/parser.mly"
( Pcl_extension _1 )
-# 3557 "parsing/parser.ml"
+# 3554 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3565 "parsing/parser.ml"
+# 3562 "parsing/parser.ml"
in
-# 1874 "parsing/parser.mly"
+# 1888 "parsing/parser.mly"
( _1 )
-# 3571 "parsing/parser.ml"
+# 3568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3626 "parsing/parser.ml"
+# 3623 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 3635 "parsing/parser.ml"
+# 3632 "parsing/parser.ml"
in
let _2 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 3641 "parsing/parser.ml"
+# 3638 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1923 "parsing/parser.mly"
+# 1937 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3650 "parsing/parser.ml"
+# 3647 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3712 "parsing/parser.ml"
+# 3709 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _3 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 3721 "parsing/parser.ml"
+# 3718 "parsing/parser.ml"
in
- let _2 =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let _2 =
+# 3756 "parsing/parser.mly"
( Override )
-# 3729 "parsing/parser.ml"
-
- in
+# 3724 "parsing/parser.ml"
+ in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1923 "parsing/parser.mly"
+# 1937 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3739 "parsing/parser.ml"
+# 3733 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3782 "parsing/parser.ml"
+# 3776 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1926 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( let v, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3794 "parsing/parser.ml"
+# 3788 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3837 "parsing/parser.ml"
+# 3831 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1930 "parsing/parser.mly"
+# 1944 "parsing/parser.mly"
( let meth, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3849 "parsing/parser.ml"
+# 3843 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3897 "parsing/parser.ml"
+# 3891 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 3906 "parsing/parser.ml"
+# 3900 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1934 "parsing/parser.mly"
+# 1948 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3916 "parsing/parser.ml"
+# 3910 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 3964 "parsing/parser.ml"
+# 3958 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 3973 "parsing/parser.ml"
+# 3967 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1937 "parsing/parser.mly"
+# 1951 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3983 "parsing/parser.ml"
+# 3977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _2 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4017 "parsing/parser.ml"
+# 4011 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1940 "parsing/parser.mly"
+# 1954 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 4028 "parsing/parser.ml"
+# 4022 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_field) = let _1 =
let _1 =
-# 1943 "parsing/parser.mly"
+# 1957 "parsing/parser.mly"
( Pcf_attribute _1 )
-# 4054 "parsing/parser.ml"
+# 4048 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 934 "parsing/parser.mly"
+# 938 "parsing/parser.mly"
( mkcf ~loc:_sloc _1 )
-# 4062 "parsing/parser.ml"
+# 4056 "parsing/parser.ml"
in
-# 1944 "parsing/parser.mly"
+# 1958 "parsing/parser.mly"
( _1 )
-# 4068 "parsing/parser.ml"
+# 4062 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1838 "parsing/parser.mly"
+# 1852 "parsing/parser.mly"
( _2 )
-# 4100 "parsing/parser.ml"
+# 4094 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1841 "parsing/parser.mly"
+# 1855 "parsing/parser.mly"
( Pcl_constraint(_4, _2) )
-# 4147 "parsing/parser.ml"
+# 4141 "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
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4156 "parsing/parser.ml"
+# 4150 "parsing/parser.ml"
in
-# 1844 "parsing/parser.mly"
+# 1858 "parsing/parser.mly"
( _1 )
-# 4162 "parsing/parser.ml"
+# 4156 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1843 "parsing/parser.mly"
+# 1857 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 4195 "parsing/parser.ml"
+# 4189 "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
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4204 "parsing/parser.ml"
+# 4198 "parsing/parser.ml"
in
-# 1844 "parsing/parser.mly"
+# 1858 "parsing/parser.mly"
( _1 )
-# 4210 "parsing/parser.ml"
+# 4204 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1899 "parsing/parser.mly"
+# 1913 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4250 "parsing/parser.ml"
+# 4244 "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
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4259 "parsing/parser.ml"
+# 4253 "parsing/parser.ml"
in
-# 1900 "parsing/parser.mly"
+# 1914 "parsing/parser.mly"
( _1 )
-# 4265 "parsing/parser.ml"
+# 4259 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1899 "parsing/parser.mly"
+# 1913 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4298 "parsing/parser.ml"
+# 4292 "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
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4307 "parsing/parser.ml"
+# 4301 "parsing/parser.ml"
in
-# 1900 "parsing/parser.mly"
+# 1914 "parsing/parser.mly"
( _1 )
-# 4313 "parsing/parser.ml"
+# 4307 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3619 "parsing/parser.mly"
+# 3637 "parsing/parser.mly"
( _1 )
-# 4338 "parsing/parser.ml"
+# 4332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1908 "parsing/parser.mly"
+# 1922 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 4380 "parsing/parser.ml"
+# 4374 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 1910 "parsing/parser.mly"
+# 1924 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 4434 "parsing/parser.ml"
+# 4428 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 4443 "parsing/parser.ml"
+# 4437 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 1925 "parsing/parser.mly"
( _1 )
-# 4449 "parsing/parser.ml"
+# 4443 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 1913 "parsing/parser.mly"
+# 1927 "parsing/parser.mly"
( ghpat ~loc:_sloc Ppat_any )
-# 4470 "parsing/parser.ml"
+# 4464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 2038 "parsing/parser.mly"
+# 2052 "parsing/parser.mly"
( _2 )
-# 4509 "parsing/parser.ml"
+# 4503 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _startpos in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2039 "parsing/parser.mly"
+# 2053 "parsing/parser.mly"
( Ptyp_any )
-# 4528 "parsing/parser.ml"
+# 4522 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__0_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 4537 "parsing/parser.ml"
+# 4531 "parsing/parser.ml"
in
-# 2040 "parsing/parser.mly"
+# 2054 "parsing/parser.mly"
( _1 )
-# 4543 "parsing/parser.ml"
+# 4537 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4591 "parsing/parser.ml"
+# 4585 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 4600 "parsing/parser.ml"
+# 4594 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2048 "parsing/parser.mly"
+# 2062 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 4610 "parsing/parser.ml"
+# 4604 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 4670 "parsing/parser.ml"
+# 4664 "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
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4683 "parsing/parser.ml"
+# 4677 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined3_ in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let label =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 4693 "parsing/parser.ml"
+# 4687 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4701 "parsing/parser.ml"
+# 4695 "parsing/parser.ml"
in
-# 2073 "parsing/parser.mly"
+# 2087 "parsing/parser.mly"
(
let mut, virt = flags in
label, mut, virt, ty
)
-# 4710 "parsing/parser.ml"
+# 4704 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 4718 "parsing/parser.ml"
+# 4712 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2051 "parsing/parser.mly"
+# 2065 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4728 "parsing/parser.ml"
+# 4722 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 4788 "parsing/parser.ml"
+# 4782 "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
let _v : (Parsetree.class_type_field) = let _7 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4801 "parsing/parser.ml"
+# 4795 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _6 =
let _1 = _1_inlined3 in
-# 3264 "parsing/parser.mly"
+# 3282 "parsing/parser.mly"
( _1 )
-# 4810 "parsing/parser.ml"
+# 4804 "parsing/parser.ml"
in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 4818 "parsing/parser.ml"
+# 4812 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4826 "parsing/parser.ml"
+# 4820 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 4834 "parsing/parser.ml"
+# 4828 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2055 "parsing/parser.mly"
+# 2069 "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 )
-# 4845 "parsing/parser.ml"
+# 4839 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4893 "parsing/parser.ml"
+# 4887 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 4902 "parsing/parser.ml"
+# 4896 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2059 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4912 "parsing/parser.ml"
+# 4906 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _2 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 4946 "parsing/parser.ml"
+# 4940 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2062 "parsing/parser.mly"
+# 2076 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4957 "parsing/parser.ml"
+# 4951 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type_field) = let _1 =
let _1 =
-# 2065 "parsing/parser.mly"
+# 2079 "parsing/parser.mly"
( Pctf_attribute _1 )
-# 4983 "parsing/parser.ml"
+# 4977 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 932 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkctf ~loc:_sloc _1 )
-# 4991 "parsing/parser.ml"
+# 4985 "parsing/parser.ml"
in
-# 2066 "parsing/parser.mly"
+# 2080 "parsing/parser.mly"
( _1 )
-# 4997 "parsing/parser.ml"
+# 4991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5028 "parsing/parser.ml"
+# 5022 "parsing/parser.ml"
in
let tys =
let tys =
-# 2024 "parsing/parser.mly"
+# 2038 "parsing/parser.mly"
( [] )
-# 5035 "parsing/parser.ml"
+# 5029 "parsing/parser.ml"
in
-# 2030 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( tys )
-# 5040 "parsing/parser.ml"
+# 5034 "parsing/parser.ml"
in
-# 2007 "parsing/parser.mly"
+# 2021 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5046 "parsing/parser.ml"
+# 5040 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5055 "parsing/parser.ml"
+# 5049 "parsing/parser.ml"
in
-# 2010 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( _1 )
-# 5061 "parsing/parser.ml"
+# 5055 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5114 "parsing/parser.ml"
+# 5108 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5123 "parsing/parser.ml"
+# 5117 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 5128 "parsing/parser.ml"
+# 5122 "parsing/parser.ml"
in
-# 2026 "parsing/parser.mly"
+# 2040 "parsing/parser.mly"
( params )
-# 5134 "parsing/parser.ml"
+# 5128 "parsing/parser.ml"
in
-# 2030 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( tys )
-# 5140 "parsing/parser.ml"
+# 5134 "parsing/parser.ml"
in
-# 2007 "parsing/parser.mly"
+# 2021 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5146 "parsing/parser.ml"
+# 5140 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5156 "parsing/parser.ml"
+# 5150 "parsing/parser.ml"
in
-# 2010 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( _1 )
-# 5162 "parsing/parser.ml"
+# 5156 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
-# 2009 "parsing/parser.mly"
+# 2023 "parsing/parser.mly"
( Pcty_extension _1 )
-# 5188 "parsing/parser.ml"
+# 5182 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5196 "parsing/parser.ml"
+# 5190 "parsing/parser.ml"
in
-# 2010 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( _1 )
-# 5202 "parsing/parser.ml"
+# 5196 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5259 "parsing/parser.ml"
+# 5253 "parsing/parser.ml"
in
-# 2044 "parsing/parser.mly"
+# 2058 "parsing/parser.mly"
( _1 )
-# 5264 "parsing/parser.ml"
+# 5258 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 878 "parsing/parser.mly"
+# 882 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5273 "parsing/parser.ml"
+# 5267 "parsing/parser.ml"
in
-# 2034 "parsing/parser.mly"
+# 2048 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5279 "parsing/parser.ml"
+# 5273 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 5287 "parsing/parser.ml"
+# 5281 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2012 "parsing/parser.mly"
+# 2026 "parsing/parser.mly"
( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 5296 "parsing/parser.ml"
+# 5290 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5353 "parsing/parser.ml"
+# 5347 "parsing/parser.ml"
in
-# 2044 "parsing/parser.mly"
+# 2058 "parsing/parser.mly"
( _1 )
-# 5358 "parsing/parser.ml"
+# 5352 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 878 "parsing/parser.mly"
+# 882 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5367 "parsing/parser.ml"
+# 5361 "parsing/parser.ml"
in
-# 2034 "parsing/parser.mly"
+# 2048 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5373 "parsing/parser.ml"
+# 5367 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 5381 "parsing/parser.ml"
+# 5375 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2014 "parsing/parser.mly"
+# 2028 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5389 "parsing/parser.ml"
+# 5383 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_type) =
-# 2016 "parsing/parser.mly"
+# 2030 "parsing/parser.mly"
( Cty.attr _1 _2 )
-# 5421 "parsing/parser.ml"
+# 5415 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5486 "parsing/parser.ml"
+# 5480 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 5495 "parsing/parser.ml"
+# 5489 "parsing/parser.ml"
in
let _3 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 5501 "parsing/parser.ml"
+# 5495 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2018 "parsing/parser.mly"
+# 2032 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5511 "parsing/parser.ml"
+# 5505 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5583 "parsing/parser.ml"
+# 5577 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 5592 "parsing/parser.ml"
+# 5586 "parsing/parser.ml"
in
- let _3 =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let _3 =
+# 3756 "parsing/parser.mly"
( Override )
-# 5600 "parsing/parser.ml"
-
- in
+# 5592 "parsing/parser.ml"
+ in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2018 "parsing/parser.mly"
+# 2032 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5611 "parsing/parser.ml"
+# 5602 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.class_expr) =
-# 1878 "parsing/parser.mly"
+# 1892 "parsing/parser.mly"
( _2 )
-# 5650 "parsing/parser.ml"
+# 5641 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1880 "parsing/parser.mly"
+# 1894 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 5691 "parsing/parser.ml"
+# 5682 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5722 "parsing/parser.ml"
+# 5713 "parsing/parser.ml"
in
let tys =
let tys =
-# 2024 "parsing/parser.mly"
+# 2038 "parsing/parser.mly"
( [] )
-# 5729 "parsing/parser.ml"
+# 5720 "parsing/parser.ml"
in
-# 2030 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( tys )
-# 5734 "parsing/parser.ml"
+# 5725 "parsing/parser.ml"
in
-# 1883 "parsing/parser.mly"
+# 1897 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5740 "parsing/parser.ml"
+# 5731 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5749 "parsing/parser.ml"
+# 5740 "parsing/parser.ml"
in
-# 1890 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( _1 )
-# 5755 "parsing/parser.ml"
+# 5746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5808 "parsing/parser.ml"
+# 5799 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5817 "parsing/parser.ml"
+# 5808 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 5822 "parsing/parser.ml"
+# 5813 "parsing/parser.ml"
in
-# 2026 "parsing/parser.mly"
+# 2040 "parsing/parser.mly"
( params )
-# 5828 "parsing/parser.ml"
+# 5819 "parsing/parser.ml"
in
-# 2030 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( tys )
-# 5834 "parsing/parser.ml"
+# 5825 "parsing/parser.ml"
in
-# 1883 "parsing/parser.mly"
+# 1897 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5840 "parsing/parser.ml"
+# 5831 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5850 "parsing/parser.ml"
+# 5841 "parsing/parser.ml"
in
-# 1890 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( _1 )
-# 5856 "parsing/parser.ml"
+# 5847 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5915 "parsing/parser.ml"
+# 5906 "parsing/parser.ml"
in
-# 1917 "parsing/parser.mly"
+# 1931 "parsing/parser.mly"
( _1 )
-# 5920 "parsing/parser.ml"
+# 5911 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 877 "parsing/parser.mly"
+# 881 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 5929 "parsing/parser.ml"
+# 5920 "parsing/parser.ml"
in
-# 1904 "parsing/parser.mly"
+# 1918 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 5935 "parsing/parser.ml"
+# 5926 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 5943 "parsing/parser.ml"
+# 5934 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1885 "parsing/parser.mly"
+# 1899 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5951 "parsing/parser.ml"
+# 5942 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5961 "parsing/parser.ml"
+# 5952 "parsing/parser.ml"
in
-# 1890 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( _1 )
-# 5967 "parsing/parser.ml"
+# 5958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1887 "parsing/parser.mly"
+# 1901 "parsing/parser.mly"
( Pcl_constraint(_2, _4) )
-# 6021 "parsing/parser.ml"
+# 6012 "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
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 6030 "parsing/parser.ml"
+# 6021 "parsing/parser.ml"
in
-# 1890 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( _1 )
-# 6036 "parsing/parser.ml"
+# 6027 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1889 "parsing/parser.mly"
+# 1903 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 6093 "parsing/parser.ml"
+# 6084 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 936 "parsing/parser.mly"
+# 940 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 6103 "parsing/parser.ml"
+# 6094 "parsing/parser.ml"
in
-# 1890 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( _1 )
-# 6109 "parsing/parser.ml"
+# 6100 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 6166 "parsing/parser.ml"
+# 6157 "parsing/parser.ml"
in
-# 1917 "parsing/parser.mly"
+# 1931 "parsing/parser.mly"
( _1 )
-# 6171 "parsing/parser.ml"
+# 6162 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 877 "parsing/parser.mly"
+# 881 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 6180 "parsing/parser.ml"
+# 6171 "parsing/parser.ml"
in
-# 1904 "parsing/parser.mly"
+# 1918 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 6186 "parsing/parser.ml"
+# 6177 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 6194 "parsing/parser.ml"
+# 6185 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1892 "parsing/parser.mly"
+# 1906 "parsing/parser.mly"
( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 6203 "parsing/parser.ml"
+# 6194 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) =
-# 1995 "parsing/parser.mly"
+# 2009 "parsing/parser.mly"
( _1 )
-# 6228 "parsing/parser.ml"
+# 6219 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3327 "parsing/parser.mly"
+# 3345 "parsing/parser.mly"
( Optional label )
-# 6276 "parsing/parser.ml"
+# 6267 "parsing/parser.ml"
in
-# 2001 "parsing/parser.mly"
+# 2015 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6281 "parsing/parser.ml"
+# 6272 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6291 "parsing/parser.ml"
+# 6282 "parsing/parser.ml"
in
-# 2002 "parsing/parser.mly"
+# 2016 "parsing/parser.mly"
( _1 )
-# 6297 "parsing/parser.ml"
+# 6288 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let label : (
# 705 "parsing/parser.mly"
(string)
-# 6346 "parsing/parser.ml"
+# 6337 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3329 "parsing/parser.mly"
+# 3347 "parsing/parser.mly"
( Labelled label )
-# 6356 "parsing/parser.ml"
+# 6347 "parsing/parser.ml"
in
-# 2001 "parsing/parser.mly"
+# 2015 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6361 "parsing/parser.ml"
+# 6352 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6371 "parsing/parser.ml"
+# 6362 "parsing/parser.ml"
in
-# 2002 "parsing/parser.mly"
+# 2016 "parsing/parser.mly"
( _1 )
-# 6377 "parsing/parser.ml"
+# 6368 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3331 "parsing/parser.mly"
+# 3349 "parsing/parser.mly"
( Nolabel )
-# 6418 "parsing/parser.ml"
+# 6409 "parsing/parser.ml"
in
-# 2001 "parsing/parser.mly"
+# 2015 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6423 "parsing/parser.ml"
+# 6414 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 930 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6433 "parsing/parser.ml"
+# 6424 "parsing/parser.ml"
in
-# 2002 "parsing/parser.mly"
+# 2016 "parsing/parser.mly"
( _1 )
-# 6439 "parsing/parser.ml"
+# 6430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 6524 "parsing/parser.ml"
+# 6515 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 6542 "parsing/parser.ml"
+# 6533 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 6554 "parsing/parser.ml"
+# 6545 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 6562 "parsing/parser.ml"
+# 6553 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2140 "parsing/parser.mly"
+# 2154 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
)
-# 6577 "parsing/parser.ml"
+# 6568 "parsing/parser.ml"
in
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 6583 "parsing/parser.ml"
+# 6574 "parsing/parser.ml"
in
-# 2128 "parsing/parser.mly"
+# 2142 "parsing/parser.mly"
( _1 )
-# 6589 "parsing/parser.ml"
+# 6580 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3616 "parsing/parser.mly"
+# 3634 "parsing/parser.mly"
( _1 )
-# 6614 "parsing/parser.ml"
+# 6605 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 691 "parsing/parser.mly"
(string * char option)
-# 6635 "parsing/parser.ml"
+# 6626 "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) =
-# 3499 "parsing/parser.mly"
+# 3517 "parsing/parser.mly"
( let (n, m) = _1 in Pconst_integer (n, m) )
-# 6643 "parsing/parser.ml"
+# 6634 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 650 "parsing/parser.mly"
(char)
-# 6664 "parsing/parser.ml"
+# 6655 "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) =
-# 3500 "parsing/parser.mly"
+# 3518 "parsing/parser.mly"
( Pconst_char _1 )
-# 6672 "parsing/parser.ml"
+# 6663 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 6693 "parsing/parser.ml"
+# 6684 "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) =
-# 3501 "parsing/parser.mly"
+# 3519 "parsing/parser.mly"
( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
-# 6701 "parsing/parser.ml"
+# 6692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 670 "parsing/parser.mly"
(string * char option)
-# 6722 "parsing/parser.ml"
+# 6713 "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) =
-# 3502 "parsing/parser.mly"
+# 3520 "parsing/parser.mly"
( let (f, m) = _1 in Pconst_float (f, m) )
-# 6730 "parsing/parser.ml"
+# 6721 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3573 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( "[]" )
-# 6762 "parsing/parser.ml"
+# 6753 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3574 "parsing/parser.mly"
+# 3592 "parsing/parser.mly"
( "()" )
-# 6794 "parsing/parser.ml"
+# 6785 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3575 "parsing/parser.mly"
+# 3593 "parsing/parser.mly"
( "false" )
-# 6819 "parsing/parser.ml"
+# 6810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3576 "parsing/parser.mly"
+# 3594 "parsing/parser.mly"
( "true" )
-# 6844 "parsing/parser.ml"
+# 6835 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 756 "parsing/parser.mly"
(string)
-# 6865 "parsing/parser.ml"
+# 6856 "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) =
-# 3579 "parsing/parser.mly"
+# 3597 "parsing/parser.mly"
( _1 )
-# 6873 "parsing/parser.ml"
+# 6864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) = let _1 =
-# 3570 "parsing/parser.mly"
+# 3588 "parsing/parser.mly"
( "::" )
-# 6912 "parsing/parser.ml"
+# 6903 "parsing/parser.ml"
in
-# 3580 "parsing/parser.mly"
+# 3598 "parsing/parser.mly"
( _1 )
-# 6917 "parsing/parser.ml"
+# 6908 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3581 "parsing/parser.mly"
+# 3599 "parsing/parser.mly"
( _1 )
-# 6942 "parsing/parser.ml"
+# 6933 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3584 "parsing/parser.mly"
+# 3602 "parsing/parser.mly"
( _1 )
-# 6967 "parsing/parser.ml"
+# 6958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
- let _v : (Longident.t) = let _3 =
- let (_2, _1) = (_2_inlined1, _1_inlined1) in
-
-# 3570 "parsing/parser.mly"
+ let _v : (Longident.t) = let _3 =
+# 3588 "parsing/parser.mly"
( "::" )
-# 7022 "parsing/parser.ml"
-
- in
+# 7011 "parsing/parser.ml"
+ in
-# 3585 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 7028 "parsing/parser.ml"
+# 7016 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
-# 3570 "parsing/parser.mly"
+# 3588 "parsing/parser.mly"
( "::" )
-# 7067 "parsing/parser.ml"
+# 7055 "parsing/parser.ml"
in
-# 3586 "parsing/parser.mly"
+# 3604 "parsing/parser.mly"
( Lident _1 )
-# 7072 "parsing/parser.ml"
+# 7060 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3587 "parsing/parser.mly"
+# 3605 "parsing/parser.mly"
( Lident _1 )
-# 7097 "parsing/parser.ml"
+# 7085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type * Parsetree.core_type) =
-# 2084 "parsing/parser.mly"
+# 2098 "parsing/parser.mly"
( _1, _3 )
-# 7136 "parsing/parser.ml"
+# 7124 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 7163 "parsing/parser.ml"
+# 7151 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7168 "parsing/parser.ml"
+# 7156 "parsing/parser.ml"
in
-# 1021 "parsing/parser.mly"
+# 1025 "parsing/parser.mly"
( xs )
-# 7174 "parsing/parser.ml"
+# 7162 "parsing/parser.ml"
in
-# 3130 "parsing/parser.mly"
+# 3148 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7180 "parsing/parser.ml"
+# 7168 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 7221 "parsing/parser.ml"
+# 7209 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7226 "parsing/parser.ml"
+# 7214 "parsing/parser.ml"
in
-# 1021 "parsing/parser.mly"
+# 1025 "parsing/parser.mly"
( xs )
-# 7232 "parsing/parser.ml"
+# 7220 "parsing/parser.ml"
in
-# 3130 "parsing/parser.mly"
+# 3148 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7238 "parsing/parser.ml"
+# 7226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.constructor_arguments) =
-# 3132 "parsing/parser.mly"
+# 3150 "parsing/parser.mly"
( Pcstr_record _2 )
-# 7277 "parsing/parser.ml"
+# 7265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constructor_declaration list) =
-# 3051 "parsing/parser.mly"
+# 3064 "parsing/parser.mly"
( [] )
-# 7302 "parsing/parser.ml"
+# 7290 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.constructor_declaration list) = let cs =
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( List.rev xs )
-# 7327 "parsing/parser.ml"
+# 7315 "parsing/parser.ml"
in
-# 3053 "parsing/parser.mly"
+# 3066 "parsing/parser.mly"
( cs )
-# 7332 "parsing/parser.ml"
+# 7320 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 7357 "parsing/parser.ml"
+# 7345 "parsing/parser.ml"
in
-# 3279 "parsing/parser.mly"
+# 3297 "parsing/parser.mly"
( _1 )
-# 7362 "parsing/parser.ml"
+# 7350 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 3281 "parsing/parser.mly"
+# 3299 "parsing/parser.mly"
( Typ.attr _1 _2 )
-# 7394 "parsing/parser.ml"
+# 7382 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3682 "parsing/parser.mly"
+# 3700 "parsing/parser.mly"
( Upto )
-# 7419 "parsing/parser.ml"
+# 7407 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3683 "parsing/parser.mly"
+# 3701 "parsing/parser.mly"
( Downto )
-# 7444 "parsing/parser.ml"
+# 7432 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2251 "parsing/parser.mly"
+# 2265 "parsing/parser.mly"
( _1 )
-# 7469 "parsing/parser.ml"
+# 7457 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7549 "parsing/parser.ml"
+# 7537 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 7559 "parsing/parser.ml"
+# 7547 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 7565 "parsing/parser.ml"
+# 7553 "parsing/parser.ml"
in
-# 2284 "parsing/parser.mly"
+# 2298 "parsing/parser.mly"
( Pexp_letmodule(_4, _5, _7), _3 )
-# 7571 "parsing/parser.ml"
+# 7559 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7582 "parsing/parser.ml"
+# 7570 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
- let _2_inlined1 : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic _2_inlined1 in
+ let _2_inlined1 : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = Obj.magic _2_inlined1 in
let _1_inlined3 : (Asttypes.label) = 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 _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 7668 "parsing/parser.ml"
+# 7657 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7679 "parsing/parser.ml"
+# 7668 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3115 "parsing/parser.mly"
- ( let args, res = _2 in
- Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 7689 "parsing/parser.ml"
+# 3128 "parsing/parser.mly"
+ ( let vars, args, res = _2 in
+ Te.decl _1 ~vars ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
+# 7678 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 7699 "parsing/parser.ml"
+# 7688 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 7705 "parsing/parser.ml"
+# 7694 "parsing/parser.ml"
in
-# 2286 "parsing/parser.mly"
+# 2300 "parsing/parser.mly"
( Pexp_letexception(_4, _6), _3 )
-# 7711 "parsing/parser.ml"
+# 7700 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7722 "parsing/parser.ml"
+# 7711 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 7794 "parsing/parser.ml"
+# 7783 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 7800 "parsing/parser.ml"
+# 7789 "parsing/parser.ml"
in
let _3 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 7806 "parsing/parser.ml"
+# 7795 "parsing/parser.ml"
in
-# 2288 "parsing/parser.mly"
+# 2302 "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 )
-# 7813 "parsing/parser.ml"
+# 7802 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7824 "parsing/parser.ml"
+# 7813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 7903 "parsing/parser.ml"
+# 7892 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 7909 "parsing/parser.ml"
+# 7898 "parsing/parser.ml"
in
- let _3 =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let _3 =
+# 3756 "parsing/parser.mly"
( Override )
-# 7917 "parsing/parser.ml"
-
- in
+# 7904 "parsing/parser.ml"
+ in
-# 2288 "parsing/parser.mly"
+# 2302 "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 )
-# 7925 "parsing/parser.ml"
+# 7911 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7936 "parsing/parser.ml"
+# 7922 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7985 "parsing/parser.ml"
+# 7971 "parsing/parser.ml"
in
-# 1078 "parsing/parser.mly"
+# 1082 "parsing/parser.mly"
( xs )
-# 7990 "parsing/parser.ml"
+# 7976 "parsing/parser.ml"
in
-# 2598 "parsing/parser.mly"
+# 2611 "parsing/parser.mly"
( xs )
-# 7996 "parsing/parser.ml"
+# 7982 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8006 "parsing/parser.ml"
+# 7992 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8012 "parsing/parser.ml"
+# 7998 "parsing/parser.ml"
in
-# 2292 "parsing/parser.mly"
+# 2306 "parsing/parser.mly"
( Pexp_function _3, _2 )
-# 8018 "parsing/parser.ml"
+# 8004 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8029 "parsing/parser.ml"
+# 8015 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8087 "parsing/parser.ml"
+# 8073 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8093 "parsing/parser.ml"
+# 8079 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2308 "parsing/parser.mly"
( let (l,o,p) = _3 in
Pexp_fun(l, o, p, _4), _2 )
-# 8100 "parsing/parser.ml"
+# 8086 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8111 "parsing/parser.ml"
+# 8097 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _1 =
let _5 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 8186 "parsing/parser.ml"
+# 8172 "parsing/parser.ml"
in
let _2 =
let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8195 "parsing/parser.ml"
+# 8181 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8201 "parsing/parser.ml"
+# 8187 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2297 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 )
-# 8210 "parsing/parser.ml"
+# 8196 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8221 "parsing/parser.ml"
+# 8207 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8284 "parsing/parser.ml"
+# 8270 "parsing/parser.ml"
in
-# 1078 "parsing/parser.mly"
+# 1082 "parsing/parser.mly"
( xs )
-# 8289 "parsing/parser.ml"
+# 8275 "parsing/parser.ml"
in
-# 2598 "parsing/parser.mly"
+# 2611 "parsing/parser.mly"
( xs )
-# 8295 "parsing/parser.ml"
+# 8281 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8305 "parsing/parser.ml"
+# 8291 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8311 "parsing/parser.ml"
+# 8297 "parsing/parser.ml"
in
-# 2299 "parsing/parser.mly"
+# 2313 "parsing/parser.mly"
( Pexp_match(_3, _5), _2 )
-# 8317 "parsing/parser.ml"
+# 8303 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8328 "parsing/parser.ml"
+# 8314 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8391 "parsing/parser.ml"
+# 8377 "parsing/parser.ml"
in
-# 1078 "parsing/parser.mly"
+# 1082 "parsing/parser.mly"
( xs )
-# 8396 "parsing/parser.ml"
+# 8382 "parsing/parser.ml"
in
-# 2598 "parsing/parser.mly"
+# 2611 "parsing/parser.mly"
( xs )
-# 8402 "parsing/parser.ml"
+# 8388 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8412 "parsing/parser.ml"
+# 8398 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8418 "parsing/parser.ml"
+# 8404 "parsing/parser.ml"
in
-# 2301 "parsing/parser.mly"
+# 2315 "parsing/parser.mly"
( Pexp_try(_3, _5), _2 )
-# 8424 "parsing/parser.ml"
+# 8410 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8435 "parsing/parser.ml"
+# 8421 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8500 "parsing/parser.ml"
+# 8486 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8506 "parsing/parser.ml"
+# 8492 "parsing/parser.ml"
in
-# 2303 "parsing/parser.mly"
+# 2317 "parsing/parser.mly"
( syntax_error() )
-# 8512 "parsing/parser.ml"
+# 8498 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8523 "parsing/parser.ml"
+# 8509 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8602 "parsing/parser.ml"
+# 8588 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8608 "parsing/parser.ml"
+# 8594 "parsing/parser.ml"
in
-# 2305 "parsing/parser.mly"
+# 2319 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 8614 "parsing/parser.ml"
+# 8600 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8625 "parsing/parser.ml"
+# 8611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8690 "parsing/parser.ml"
+# 8676 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8696 "parsing/parser.ml"
+# 8682 "parsing/parser.ml"
in
-# 2307 "parsing/parser.mly"
+# 2321 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, None), _2 )
-# 8702 "parsing/parser.ml"
+# 8688 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8713 "parsing/parser.ml"
+# 8699 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8785 "parsing/parser.ml"
+# 8771 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8791 "parsing/parser.ml"
+# 8777 "parsing/parser.ml"
in
-# 2309 "parsing/parser.mly"
+# 2323 "parsing/parser.mly"
( Pexp_while(_3, _5), _2 )
-# 8797 "parsing/parser.ml"
+# 8783 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8808 "parsing/parser.ml"
+# 8794 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8908 "parsing/parser.ml"
+# 8894 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8914 "parsing/parser.ml"
+# 8900 "parsing/parser.ml"
in
-# 2312 "parsing/parser.mly"
+# 2326 "parsing/parser.mly"
( Pexp_for(_3, _5, _7, _6, _9), _2 )
-# 8920 "parsing/parser.ml"
+# 8906 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__10_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8931 "parsing/parser.ml"
+# 8917 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 8982 "parsing/parser.ml"
+# 8968 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 8988 "parsing/parser.ml"
+# 8974 "parsing/parser.ml"
in
-# 2314 "parsing/parser.mly"
+# 2328 "parsing/parser.mly"
( Pexp_assert _3, _2 )
-# 8994 "parsing/parser.ml"
+# 8980 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9005 "parsing/parser.ml"
+# 8991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 9056 "parsing/parser.ml"
+# 9042 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 9062 "parsing/parser.ml"
+# 9048 "parsing/parser.ml"
in
-# 2316 "parsing/parser.mly"
+# 2330 "parsing/parser.mly"
( Pexp_lazy _3, _2 )
-# 9068 "parsing/parser.ml"
+# 9054 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2253 "parsing/parser.mly"
+# 2267 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9079 "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 = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = xss;
- MenhirLib.EngineTypes.startp = _startpos_xss_;
- MenhirLib.EngineTypes.endp = _endpos_xss_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined3;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined2;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined1;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- };
- } = _menhir_stack in
- let _4 : unit = Obj.magic _4 in
- let xss : (Parsetree.class_field list list) = Obj.magic xss in
- let _1_inlined3 : (Parsetree.pattern) = 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 _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__4_ in
- let _v : (Parsetree.expression) = let _1 =
- let _3 =
- let _1 = _1_inlined3 in
- let _2 =
- let _1 =
- let _1 =
-# 260 "<standard.mly>"
- ( List.flatten xss )
-# 9144 "parsing/parser.ml"
- in
-
-# 1917 "parsing/parser.mly"
- ( _1 )
-# 9149 "parsing/parser.ml"
-
- in
- let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
- let _endpos = _endpos__1_ in
- let _startpos = _startpos__1_ in
-
-# 877 "parsing/parser.mly"
- ( extra_cstr _startpos _endpos _1 )
-# 9158 "parsing/parser.ml"
-
- in
-
-# 1904 "parsing/parser.mly"
- ( Cstr.mk _1 _2 )
-# 9164 "parsing/parser.ml"
-
- in
- let _2 =
- let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
- let _2 =
- let _1 = _1_inlined1 in
-
-# 3835 "parsing/parser.mly"
- ( _1 )
-# 9174 "parsing/parser.ml"
-
- in
-
-# 3848 "parsing/parser.mly"
- ( _1, _2 )
-# 9180 "parsing/parser.ml"
-
- in
-
-# 2318 "parsing/parser.mly"
- ( Pexp_object _3, _2 )
-# 9186 "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
-
-# 2253 "parsing/parser.mly"
- ( let desc, attrs = _1 in
- mkexp_attrs ~loc:_sloc desc attrs )
-# 9197 "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 = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = xss;
- MenhirLib.EngineTypes.startp = _startpos_xss_;
- MenhirLib.EngineTypes.endp = _endpos_xss_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined3;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined2;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _1_inlined1;
- MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
- MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- };
- } = _menhir_stack in
- let _4 : unit = Obj.magic _4 in
- let xss : (Parsetree.class_field list list) = Obj.magic xss in
- let _1_inlined3 : (Parsetree.pattern) = 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 _1 : unit = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__4_ in
- let _v : (Parsetree.expression) = let _1 =
- let _3 =
- let _1 = _1_inlined3 in
- let _2 =
- let _1 =
- let _1 =
-# 260 "<standard.mly>"
- ( List.flatten xss )
-# 9262 "parsing/parser.ml"
- in
-
-# 1917 "parsing/parser.mly"
- ( _1 )
-# 9267 "parsing/parser.ml"
-
- in
- let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
- let _endpos = _endpos__1_ in
- let _startpos = _startpos__1_ in
-
-# 877 "parsing/parser.mly"
- ( extra_cstr _startpos _endpos _1 )
-# 9276 "parsing/parser.ml"
-
- in
-
-# 1904 "parsing/parser.mly"
- ( Cstr.mk _1 _2 )
-# 9282 "parsing/parser.ml"
-
- in
- let _2 =
- let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
- let _2 =
- let _1 = _1_inlined1 in
-
-# 3835 "parsing/parser.mly"
- ( _1 )
-# 9292 "parsing/parser.ml"
-
- in
-
-# 3848 "parsing/parser.mly"
- ( _1, _2 )
-# 9298 "parsing/parser.ml"
-
- in
- let _loc__4_ = (_startpos__4_, _endpos__4_) in
- let _loc__1_ = (_startpos__1_, _endpos__1_) in
-
-# 2320 "parsing/parser.mly"
- ( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 9306 "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
-
-# 2253 "parsing/parser.mly"
- ( let desc, attrs = _1 in
- mkexp_attrs ~loc:_sloc desc attrs )
-# 9317 "parsing/parser.ml"
+# 9065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9352 "parsing/parser.ml"
+# 9100 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 989 "parsing/parser.mly"
( xs )
-# 9357 "parsing/parser.ml"
+# 9105 "parsing/parser.ml"
in
-# 2324 "parsing/parser.mly"
+# 2334 "parsing/parser.mly"
( Pexp_apply(_1, _2) )
-# 9363 "parsing/parser.ml"
+# 9111 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9373 "parsing/parser.ml"
+# 9121 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9379 "parsing/parser.ml"
+# 9127 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9408 "parsing/parser.ml"
+# 9156 "parsing/parser.ml"
in
-# 1045 "parsing/parser.mly"
+# 1049 "parsing/parser.mly"
( xs )
-# 9413 "parsing/parser.ml"
+# 9161 "parsing/parser.ml"
in
-# 2625 "parsing/parser.mly"
+# 2638 "parsing/parser.mly"
( es )
-# 9419 "parsing/parser.ml"
+# 9167 "parsing/parser.ml"
in
-# 2326 "parsing/parser.mly"
+# 2336 "parsing/parser.mly"
( Pexp_tuple(_1) )
-# 9425 "parsing/parser.ml"
+# 9173 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9435 "parsing/parser.ml"
+# 9183 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9441 "parsing/parser.ml"
+# 9189 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 9479 "parsing/parser.ml"
+# 9227 "parsing/parser.ml"
in
-# 2328 "parsing/parser.mly"
+# 2338 "parsing/parser.mly"
( Pexp_construct(_1, Some _2) )
-# 9485 "parsing/parser.ml"
+# 9233 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9495 "parsing/parser.ml"
+# 9243 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9501 "parsing/parser.ml"
+# 9249 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2330 "parsing/parser.mly"
+# 2340 "parsing/parser.mly"
( Pexp_variant(_1, Some _2) )
-# 9534 "parsing/parser.ml"
+# 9282 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9543 "parsing/parser.ml"
+# 9291 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9549 "parsing/parser.ml"
+# 9297 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 681 "parsing/parser.mly"
(string)
-# 9583 "parsing/parser.ml"
+# 9331 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3543 "parsing/parser.mly"
+# 3561 "parsing/parser.mly"
( op )
-# 9595 "parsing/parser.ml"
+# 9343 "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
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9604 "parsing/parser.ml"
+# 9352 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9610 "parsing/parser.ml"
+# 9358 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9620 "parsing/parser.ml"
+# 9368 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9626 "parsing/parser.ml"
+# 9374 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 682 "parsing/parser.mly"
(string)
-# 9660 "parsing/parser.ml"
+# 9408 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3544 "parsing/parser.mly"
+# 3562 "parsing/parser.mly"
( op )
-# 9672 "parsing/parser.ml"
+# 9420 "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
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9681 "parsing/parser.ml"
+# 9429 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9687 "parsing/parser.ml"
+# 9435 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9697 "parsing/parser.ml"
+# 9445 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9703 "parsing/parser.ml"
+# 9451 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 683 "parsing/parser.mly"
(string)
-# 9737 "parsing/parser.ml"
+# 9485 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3545 "parsing/parser.mly"
+# 3563 "parsing/parser.mly"
( op )
-# 9749 "parsing/parser.ml"
+# 9497 "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
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9758 "parsing/parser.ml"
+# 9506 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9764 "parsing/parser.ml"
+# 9512 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9774 "parsing/parser.ml"
+# 9522 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9780 "parsing/parser.ml"
+# 9528 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 684 "parsing/parser.mly"
(string)
-# 9814 "parsing/parser.ml"
+# 9562 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3546 "parsing/parser.mly"
+# 3564 "parsing/parser.mly"
( op )
-# 9826 "parsing/parser.ml"
+# 9574 "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
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9835 "parsing/parser.ml"
+# 9583 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9841 "parsing/parser.ml"
+# 9589 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9851 "parsing/parser.ml"
+# 9599 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9857 "parsing/parser.ml"
+# 9605 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 685 "parsing/parser.mly"
(string)
-# 9891 "parsing/parser.ml"
+# 9639 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3547 "parsing/parser.mly"
+# 3565 "parsing/parser.mly"
( op )
-# 9903 "parsing/parser.ml"
+# 9651 "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
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9912 "parsing/parser.ml"
+# 9660 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9918 "parsing/parser.ml"
+# 9666 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9928 "parsing/parser.ml"
+# 9676 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 9934 "parsing/parser.ml"
+# 9682 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3548 "parsing/parser.mly"
+# 3566 "parsing/parser.mly"
("+")
-# 9976 "parsing/parser.ml"
+# 9724 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9984 "parsing/parser.ml"
+# 9732 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9990 "parsing/parser.ml"
+# 9738 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10000 "parsing/parser.ml"
+# 9748 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10006 "parsing/parser.ml"
+# 9754 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3549 "parsing/parser.mly"
+# 3567 "parsing/parser.mly"
("+.")
-# 10048 "parsing/parser.ml"
+# 9796 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10056 "parsing/parser.ml"
+# 9804 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10062 "parsing/parser.ml"
+# 9810 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10072 "parsing/parser.ml"
+# 9820 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10078 "parsing/parser.ml"
+# 9826 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3550 "parsing/parser.mly"
+# 3568 "parsing/parser.mly"
("+=")
-# 10120 "parsing/parser.ml"
+# 9868 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10128 "parsing/parser.ml"
+# 9876 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10134 "parsing/parser.ml"
+# 9882 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10144 "parsing/parser.ml"
+# 9892 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10150 "parsing/parser.ml"
+# 9898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3551 "parsing/parser.mly"
+# 3569 "parsing/parser.mly"
("-")
-# 10192 "parsing/parser.ml"
+# 9940 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10200 "parsing/parser.ml"
+# 9948 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10206 "parsing/parser.ml"
+# 9954 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10216 "parsing/parser.ml"
+# 9964 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10222 "parsing/parser.ml"
+# 9970 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3552 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
("-.")
-# 10264 "parsing/parser.ml"
+# 10012 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10272 "parsing/parser.ml"
+# 10020 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10278 "parsing/parser.ml"
+# 10026 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10288 "parsing/parser.ml"
+# 10036 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10294 "parsing/parser.ml"
+# 10042 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3553 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
("*")
-# 10336 "parsing/parser.ml"
+# 10084 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10344 "parsing/parser.ml"
+# 10092 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10350 "parsing/parser.ml"
+# 10098 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10360 "parsing/parser.ml"
+# 10108 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10366 "parsing/parser.ml"
+# 10114 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3554 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
("%")
-# 10408 "parsing/parser.ml"
+# 10156 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10416 "parsing/parser.ml"
+# 10164 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10422 "parsing/parser.ml"
+# 10170 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10432 "parsing/parser.ml"
+# 10180 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10438 "parsing/parser.ml"
+# 10186 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3555 "parsing/parser.mly"
+# 3573 "parsing/parser.mly"
("=")
-# 10480 "parsing/parser.ml"
+# 10228 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10488 "parsing/parser.ml"
+# 10236 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10494 "parsing/parser.ml"
+# 10242 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10504 "parsing/parser.ml"
+# 10252 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10510 "parsing/parser.ml"
+# 10258 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3556 "parsing/parser.mly"
+# 3574 "parsing/parser.mly"
("<")
-# 10552 "parsing/parser.ml"
+# 10300 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10560 "parsing/parser.ml"
+# 10308 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10566 "parsing/parser.ml"
+# 10314 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10576 "parsing/parser.ml"
+# 10324 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10582 "parsing/parser.ml"
+# 10330 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3557 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
(">")
-# 10624 "parsing/parser.ml"
+# 10372 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10632 "parsing/parser.ml"
+# 10380 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10638 "parsing/parser.ml"
+# 10386 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10648 "parsing/parser.ml"
+# 10396 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10654 "parsing/parser.ml"
+# 10402 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3558 "parsing/parser.mly"
+# 3576 "parsing/parser.mly"
("or")
-# 10696 "parsing/parser.ml"
+# 10444 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10704 "parsing/parser.ml"
+# 10452 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10710 "parsing/parser.ml"
+# 10458 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10720 "parsing/parser.ml"
+# 10468 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10726 "parsing/parser.ml"
+# 10474 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3559 "parsing/parser.mly"
+# 3577 "parsing/parser.mly"
("||")
-# 10768 "parsing/parser.ml"
+# 10516 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10776 "parsing/parser.ml"
+# 10524 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10782 "parsing/parser.ml"
+# 10530 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10792 "parsing/parser.ml"
+# 10540 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10798 "parsing/parser.ml"
+# 10546 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3560 "parsing/parser.mly"
+# 3578 "parsing/parser.mly"
("&")
-# 10840 "parsing/parser.ml"
+# 10588 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10848 "parsing/parser.ml"
+# 10596 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10854 "parsing/parser.ml"
+# 10602 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10864 "parsing/parser.ml"
+# 10612 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10870 "parsing/parser.ml"
+# 10618 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3561 "parsing/parser.mly"
+# 3579 "parsing/parser.mly"
("&&")
-# 10912 "parsing/parser.ml"
+# 10660 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10920 "parsing/parser.ml"
+# 10668 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10926 "parsing/parser.ml"
+# 10674 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10936 "parsing/parser.ml"
+# 10684 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 10942 "parsing/parser.ml"
+# 10690 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3562 "parsing/parser.mly"
+# 3580 "parsing/parser.mly"
(":=")
-# 10984 "parsing/parser.ml"
+# 10732 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10992 "parsing/parser.ml"
+# 10740 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2342 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10998 "parsing/parser.ml"
+# 10746 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11008 "parsing/parser.ml"
+# 10756 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 11014 "parsing/parser.ml"
+# 10762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2334 "parsing/parser.mly"
+# 2344 "parsing/parser.mly"
( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 11049 "parsing/parser.ml"
+# 10797 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11059 "parsing/parser.ml"
+# 10807 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 11065 "parsing/parser.ml"
+# 10813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2336 "parsing/parser.mly"
+# 2346 "parsing/parser.mly"
( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 11100 "parsing/parser.ml"
+# 10848 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11110 "parsing/parser.ml"
+# 10858 "parsing/parser.ml"
in
-# 2256 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( _1 )
-# 11116 "parsing/parser.ml"
+# 10864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2258 "parsing/parser.mly"
+# 2272 "parsing/parser.mly"
( expr_of_let_bindings ~loc:_sloc _1 _3 )
-# 11158 "parsing/parser.ml"
+# 10906 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 687 "parsing/parser.mly"
(string)
-# 11200 "parsing/parser.ml"
+# 10948 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11212 "parsing/parser.ml"
+# 10960 "parsing/parser.ml"
in
let _startpos_pbop_op_ = _startpos__1_ in
let _symbolstartpos = _startpos_pbop_op_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2260 "parsing/parser.mly"
+# 2274 "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}) )
-# 11226 "parsing/parser.ml"
+# 10974 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2266 "parsing/parser.mly"
+# 2280 "parsing/parser.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 11269 "parsing/parser.ml"
+# 11017 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 11304 "parsing/parser.ml"
+# 11052 "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 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 11313 "parsing/parser.ml"
+# 11061 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11321 "parsing/parser.ml"
+# 11069 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2268 "parsing/parser.mly"
+# 2282 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 11330 "parsing/parser.ml"
+# 11078 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11388 "parsing/parser.ml"
+# 11136 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2270 "parsing/parser.mly"
+# 2284 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 11397 "parsing/parser.ml"
+# 11145 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2271 "parsing/parser.mly"
+# 2285 "parsing/parser.mly"
(Some v)
-# 11465 "parsing/parser.ml"
+# 11213 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 11470 "parsing/parser.ml"
+# 11218 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2272 "parsing/parser.mly"
+# 2286 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 11480 "parsing/parser.ml"
+# 11228 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2271 "parsing/parser.mly"
+# 2285 "parsing/parser.mly"
(Some v)
-# 11548 "parsing/parser.ml"
+# 11296 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 11553 "parsing/parser.ml"
+# 11301 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2272 "parsing/parser.mly"
+# 2286 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 11563 "parsing/parser.ml"
+# 11311 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2271 "parsing/parser.mly"
+# 2285 "parsing/parser.mly"
(Some v)
-# 11631 "parsing/parser.ml"
+# 11379 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 11636 "parsing/parser.ml"
+# 11384 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2272 "parsing/parser.mly"
+# 2286 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 11646 "parsing/parser.ml"
+# 11394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 11708 "parsing/parser.ml"
+# 11456 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2273 "parsing/parser.mly"
+# 2287 "parsing/parser.mly"
(Some v)
-# 11718 "parsing/parser.ml"
+# 11466 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 11723 "parsing/parser.ml"
+# 11471 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 11729 "parsing/parser.ml"
+# 11477 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 11734 "parsing/parser.ml"
+# 11482 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 11740 "parsing/parser.ml"
+# 11488 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 11750 "parsing/parser.ml"
+# 11498 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 11824 "parsing/parser.ml"
+# 11572 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _startpos = _startpos_array_ in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
- let r =
- let _1 = _1_inlined1 in
-
-# 2273 "parsing/parser.mly"
+ let r =
+# 2287 "parsing/parser.mly"
(Some v)
-# 11838 "parsing/parser.ml"
-
- in
+# 11584 "parsing/parser.ml"
+ in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 11844 "parsing/parser.ml"
+# 11589 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 11852 "parsing/parser.ml"
+# 11597 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 11857 "parsing/parser.ml"
+# 11602 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 11863 "parsing/parser.ml"
+# 11608 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 11869 "parsing/parser.ml"
+# 11614 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 11879 "parsing/parser.ml"
+# 11624 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 11941 "parsing/parser.ml"
+# 11686 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2273 "parsing/parser.mly"
+# 2287 "parsing/parser.mly"
(Some v)
-# 11951 "parsing/parser.ml"
+# 11696 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 11956 "parsing/parser.ml"
+# 11701 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 11962 "parsing/parser.ml"
+# 11707 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 11967 "parsing/parser.ml"
+# 11712 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 11973 "parsing/parser.ml"
+# 11718 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 11983 "parsing/parser.ml"
+# 11728 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 12057 "parsing/parser.ml"
+# 11802 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _startpos = _startpos_array_ in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
- let r =
- let _1 = _1_inlined1 in
-
-# 2273 "parsing/parser.mly"
+ let r =
+# 2287 "parsing/parser.mly"
(Some v)
-# 12071 "parsing/parser.ml"
-
- in
+# 11814 "parsing/parser.ml"
+ in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 12077 "parsing/parser.ml"
+# 11819 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 12085 "parsing/parser.ml"
+# 11827 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 12090 "parsing/parser.ml"
+# 11832 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 12096 "parsing/parser.ml"
+# 11838 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 12102 "parsing/parser.ml"
+# 11844 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 12112 "parsing/parser.ml"
+# 11854 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 12174 "parsing/parser.ml"
+# 11916 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2273 "parsing/parser.mly"
+# 2287 "parsing/parser.mly"
(Some v)
-# 12184 "parsing/parser.ml"
+# 11926 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 12189 "parsing/parser.ml"
+# 11931 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 12195 "parsing/parser.ml"
+# 11937 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 12200 "parsing/parser.ml"
+# 11942 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 12206 "parsing/parser.ml"
+# 11948 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 12216 "parsing/parser.ml"
+# 11958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 12290 "parsing/parser.ml"
+# 12032 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _startpos = _startpos_array_ in
let _endpos = _endpos_v_ in
let _v : (Parsetree.expression) = let _1 =
- let r =
- let _1 = _1_inlined1 in
-
-# 2273 "parsing/parser.mly"
+ let r =
+# 2287 "parsing/parser.mly"
(Some v)
-# 12304 "parsing/parser.ml"
-
- in
+# 12044 "parsing/parser.ml"
+ in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 12310 "parsing/parser.ml"
+# 12049 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 12318 "parsing/parser.ml"
+# 12057 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 12323 "parsing/parser.ml"
+# 12062 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 12329 "parsing/parser.ml"
+# 12068 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 12335 "parsing/parser.ml"
+# 12074 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2274 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 12345 "parsing/parser.ml"
+# 12084 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2276 "parsing/parser.mly"
+# 2290 "parsing/parser.mly"
( Exp.attr _1 _2 )
-# 12377 "parsing/parser.ml"
+# 12116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2279 "parsing/parser.mly"
+# 2293 "parsing/parser.mly"
( not_expecting _loc__1_ "wildcard \"_\"" )
-# 12403 "parsing/parser.ml"
+# 12142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string Asttypes.loc option) =
-# 3838 "parsing/parser.mly"
+# 3856 "parsing/parser.mly"
( None )
-# 12421 "parsing/parser.ml"
+# 12160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string Asttypes.loc option) =
-# 3839 "parsing/parser.mly"
+# 3857 "parsing/parser.mly"
( Some _2 )
-# 12453 "parsing/parser.ml"
+# 12192 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3851 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
( (_2, _3) )
-# 12499 "parsing/parser.ml"
+# 12238 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 745 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
-# 12520 "parsing/parser.ml"
+# 12259 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3853 "parsing/parser.mly"
+# 3871 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 12531 "parsing/parser.ml"
+# 12270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 12586 "parsing/parser.ml"
+# 12325 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12598 "parsing/parser.ml"
+# 12337 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12609 "parsing/parser.ml"
+# 12348 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3199 "parsing/parser.mly"
+# 3217 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12619 "parsing/parser.ml"
+# 12358 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 12667 "parsing/parser.ml"
+# 12406 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12679 "parsing/parser.ml"
+# 12418 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12689 "parsing/parser.ml"
+# 12428 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3656 "parsing/parser.mly"
+# 3674 "parsing/parser.mly"
( () )
-# 12696 "parsing/parser.ml"
+# 12435 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3199 "parsing/parser.mly"
+# 3217 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12705 "parsing/parser.ml"
+# 12444 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3826 "parsing/parser.mly"
+# 3844 "parsing/parser.mly"
( mark_symbol_docs _sloc;
Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 12755 "parsing/parser.ml"
+# 12494 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
-# 2024 "parsing/parser.mly"
+# 2038 "parsing/parser.mly"
( [] )
-# 12773 "parsing/parser.ml"
+# 12512 "parsing/parser.ml"
in
-# 1849 "parsing/parser.mly"
+# 1863 "parsing/parser.mly"
( params )
-# 12778 "parsing/parser.ml"
+# 12517 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12819 "parsing/parser.ml"
+# 12558 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 12824 "parsing/parser.ml"
+# 12563 "parsing/parser.ml"
in
-# 2026 "parsing/parser.mly"
+# 2040 "parsing/parser.mly"
( params )
-# 12830 "parsing/parser.ml"
+# 12569 "parsing/parser.ml"
in
-# 1849 "parsing/parser.mly"
+# 1863 "parsing/parser.mly"
( params )
-# 12836 "parsing/parser.ml"
+# 12575 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2584 "parsing/parser.mly"
+# 2597 "parsing/parser.mly"
( _1 )
-# 12861 "parsing/parser.ml"
+# 12600 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2586 "parsing/parser.mly"
+# 2599 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _3 _1 )
-# 12903 "parsing/parser.ml"
+# 12642 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2610 "parsing/parser.mly"
+# 2623 "parsing/parser.mly"
( _2 )
-# 12935 "parsing/parser.ml"
+# 12674 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2612 "parsing/parser.mly"
+# 2625 "parsing/parser.mly"
( Pexp_constraint (_4, _2) )
-# 12982 "parsing/parser.ml"
+# 12721 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 12991 "parsing/parser.ml"
+# 12730 "parsing/parser.ml"
in
-# 2613 "parsing/parser.mly"
+# 2626 "parsing/parser.mly"
( _1 )
-# 12997 "parsing/parser.ml"
+# 12736 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2616 "parsing/parser.mly"
+# 2629 "parsing/parser.mly"
(
let (l,o,p) = _1 in
ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2))
)
-# 13035 "parsing/parser.ml"
+# 12774 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 13088 "parsing/parser.ml"
+# 12827 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2621 "parsing/parser.mly"
+# 2634 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 13096 "parsing/parser.ml"
+# 12835 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3315 "parsing/parser.mly"
+# 3333 "parsing/parser.mly"
( ty )
-# 13121 "parsing/parser.ml"
+# 12860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 881 "parsing/parser.mly"
+# 885 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13169 "parsing/parser.ml"
+# 12908 "parsing/parser.ml"
in
let label =
-# 3327 "parsing/parser.mly"
+# 3345 "parsing/parser.mly"
( Optional label )
-# 13174 "parsing/parser.ml"
+# 12913 "parsing/parser.ml"
in
-# 3321 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13179 "parsing/parser.ml"
+# 12918 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13189 "parsing/parser.ml"
+# 12928 "parsing/parser.ml"
in
-# 3323 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 13195 "parsing/parser.ml"
+# 12934 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let label : (
# 705 "parsing/parser.mly"
(string)
-# 13244 "parsing/parser.ml"
+# 12983 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 881 "parsing/parser.mly"
+# 885 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13254 "parsing/parser.ml"
+# 12993 "parsing/parser.ml"
in
let label =
-# 3329 "parsing/parser.mly"
+# 3347 "parsing/parser.mly"
( Labelled label )
-# 13259 "parsing/parser.ml"
+# 12998 "parsing/parser.ml"
in
-# 3321 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13264 "parsing/parser.ml"
+# 13003 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13274 "parsing/parser.ml"
+# 13013 "parsing/parser.ml"
in
-# 3323 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 13280 "parsing/parser.ml"
+# 13019 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 881 "parsing/parser.mly"
+# 885 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13321 "parsing/parser.ml"
+# 13060 "parsing/parser.ml"
in
let label =
-# 3331 "parsing/parser.mly"
+# 3349 "parsing/parser.mly"
( Nolabel )
-# 13326 "parsing/parser.ml"
+# 13065 "parsing/parser.ml"
in
-# 3321 "parsing/parser.mly"
+# 3339 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13331 "parsing/parser.ml"
+# 13070 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_codomain_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13341 "parsing/parser.ml"
+# 13080 "parsing/parser.ml"
in
-# 3323 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( _1 )
-# 13347 "parsing/parser.ml"
+# 13086 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Lexing.position * Parsetree.functor_parameter) = let _startpos = _startpos__1_ in
-# 1261 "parsing/parser.mly"
+# 1275 "parsing/parser.mly"
( _startpos, Unit )
-# 13380 "parsing/parser.ml"
+# 13119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13438 "parsing/parser.ml"
+# 13177 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 1264 "parsing/parser.mly"
+# 1278 "parsing/parser.mly"
( _startpos, Named (x, mty) )
-# 13445 "parsing/parser.ml"
+# 13184 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
- let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3119 "parsing/parser.mly"
- ( (Pcstr_tuple [],None) )
-# 13463 "parsing/parser.ml"
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) =
+# 3132 "parsing/parser.mly"
+ ( ([],Pcstr_tuple [],None) )
+# 13203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3120 "parsing/parser.mly"
- ( (_2,None) )
-# 13495 "parsing/parser.ml"
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) =
+# 3133 "parsing/parser.mly"
+ ( ([],_2,None) )
+# 13236 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
- let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3122 "parsing/parser.mly"
- ( (_2,Some _4) )
-# 13541 "parsing/parser.ml"
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) =
+# 3135 "parsing/parser.mly"
+ ( ([],_2,Some _4) )
+# 13283 "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 = _6;
+ MenhirLib.EngineTypes.startp = _startpos__6_;
+ MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.next = {
+ 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 = xs;
+ MenhirLib.EngineTypes.startp = _startpos_xs_;
+ MenhirLib.EngineTypes.endp = _endpos_xs_;
+ 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 _6 : (Parsetree.core_type) = Obj.magic _6 in
+ let _5 : unit = Obj.magic _5 in
+ let _4 : (Parsetree.constructor_arguments) = Obj.magic _4 in
+ let _3 : unit = Obj.magic _3 in
+ let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs 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__6_ in
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = let _2 =
+ let _1 =
+ let xs =
+# 253 "<standard.mly>"
+ ( List.rev xs )
+# 13346 "parsing/parser.ml"
+ in
+
+# 989 "parsing/parser.mly"
+ ( xs )
+# 13351 "parsing/parser.ml"
+
+ in
+
+# 3268 "parsing/parser.mly"
+ ( _1 )
+# 13357 "parsing/parser.ml"
+
+ in
+
+# 3138 "parsing/parser.mly"
+ ( (_2,_4,Some _6) )
+# 13363 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3124 "parsing/parser.mly"
- ( (Pcstr_tuple [],Some _2) )
-# 13573 "parsing/parser.ml"
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) =
+# 3140 "parsing/parser.mly"
+ ( ([],Pcstr_tuple [],Some _2) )
+# 13396 "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 = _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 = xs;
+ MenhirLib.EngineTypes.startp = _startpos_xs_;
+ MenhirLib.EngineTypes.endp = _endpos_xs_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _4 : (Parsetree.core_type) = Obj.magic _4 in
+ let _3 : unit = Obj.magic _3 in
+ let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__4_ in
+ let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = let _2 =
+ let _1 =
+ let xs =
+# 253 "<standard.mly>"
+ ( List.rev xs )
+# 13445 "parsing/parser.ml"
+ in
+
+# 989 "parsing/parser.mly"
+ ( xs )
+# 13450 "parsing/parser.ml"
+
+ in
+
+# 3268 "parsing/parser.mly"
+ ( _1 )
+# 13456 "parsing/parser.ml"
+
+ in
+
+# 3142 "parsing/parser.mly"
+ ( (_2,Pcstr_tuple [],Some _4) )
+# 13462 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = args_res;
- MenhirLib.EngineTypes.startp = _startpos_args_res_;
- MenhirLib.EngineTypes.endp = _endpos_args_res_;
+ MenhirLib.EngineTypes.semv = vars_args_res;
+ MenhirLib.EngineTypes.startp = _startpos_vars_args_res_;
+ MenhirLib.EngineTypes.endp = _endpos_vars_args_res_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _1_inlined1;
};
} = _menhir_stack in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
- let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res in
+ let vars_args_res : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = Obj.magic vars_args_res in
let _1_inlined1 : (Asttypes.label) = 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__1_inlined2_ in
- let _v : (Ast_helper.str * Parsetree.constructor_arguments *
+ let _v : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = let attrs =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 13623 "parsing/parser.ml"
+# 13513 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13635 "parsing/parser.ml"
+# 13525 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3067 "parsing/parser.mly"
+# 3080 "parsing/parser.mly"
(
- let args, res = args_res in
+ let vars, args, res = vars_args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
- cid, args, res, attrs, loc, info
+ cid, vars, args, res, attrs, loc, info
)
-# 13649 "parsing/parser.ml"
+# 13539 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = args_res;
- MenhirLib.EngineTypes.startp = _startpos_args_res_;
- MenhirLib.EngineTypes.endp = _endpos_args_res_;
+ MenhirLib.EngineTypes.semv = vars_args_res;
+ MenhirLib.EngineTypes.startp = _startpos_vars_args_res_;
+ MenhirLib.EngineTypes.endp = _endpos_vars_args_res_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.semv = _1;
};
} = _menhir_stack in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
- let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res in
+ let vars_args_res : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = Obj.magic vars_args_res in
let _1 : (Asttypes.label) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_inlined1_ in
- let _v : (Ast_helper.str * Parsetree.constructor_arguments *
+ let _v : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 13692 "parsing/parser.ml"
+# 13583 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13703 "parsing/parser.ml"
+# 13594 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3656 "parsing/parser.mly"
+# 3674 "parsing/parser.mly"
( () )
-# 13710 "parsing/parser.ml"
+# 13601 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3067 "parsing/parser.mly"
+# 3080 "parsing/parser.mly"
(
- let args, res = args_res in
+ let vars, args, res = vars_args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
- cid, args, res, attrs, loc, info
+ cid, vars, args, res, attrs, loc, info
)
-# 13723 "parsing/parser.ml"
+# 13614 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 13796 "parsing/parser.ml"
+# 13687 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 13811 "parsing/parser.ml"
+# 13702 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13820 "parsing/parser.ml"
+# 13711 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 13825 "parsing/parser.ml"
+# 13716 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 13831 "parsing/parser.ml"
+# 13722 "parsing/parser.ml"
in
- let kind_priv_manifest =
- let _1 = _1_inlined3 in
-
-# 3007 "parsing/parser.mly"
+ let kind_priv_manifest =
+# 3020 "parsing/parser.mly"
( _2 )
-# 13839 "parsing/parser.ml"
-
- in
+# 13728 "parsing/parser.ml"
+ in
let id =
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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13850 "parsing/parser.ml"
+# 13738 "parsing/parser.ml"
in
let flag =
-# 3676 "parsing/parser.mly"
+# 3694 "parsing/parser.mly"
( Recursive )
-# 13856 "parsing/parser.ml"
+# 13744 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 13863 "parsing/parser.ml"
+# 13751 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2944 "parsing/parser.mly"
+# 2957 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13879 "parsing/parser.ml"
+# 13767 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (
# 705 "parsing/parser.mly"
(string)
-# 13958 "parsing/parser.ml"
+# 13846 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined5 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 13974 "parsing/parser.ml"
+# 13862 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined5_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13983 "parsing/parser.ml"
+# 13871 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 13988 "parsing/parser.ml"
+# 13876 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 13994 "parsing/parser.ml"
+# 13882 "parsing/parser.ml"
in
- let kind_priv_manifest =
- let _1 = _1_inlined4 in
-
-# 3007 "parsing/parser.mly"
+ let kind_priv_manifest =
+# 3020 "parsing/parser.mly"
( _2 )
-# 14002 "parsing/parser.ml"
-
- in
+# 13888 "parsing/parser.ml"
+ in
let id =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14013 "parsing/parser.ml"
+# 13898 "parsing/parser.ml"
in
let flag =
- let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3678 "parsing/parser.mly"
+# 3696 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 14024 "parsing/parser.ml"
+# 13909 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14032 "parsing/parser.ml"
+# 13917 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2944 "parsing/parser.mly"
+# 2957 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 14048 "parsing/parser.ml"
+# 13933 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 14114 "parsing/parser.ml"
+# 13999 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 14129 "parsing/parser.ml"
+# 14014 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14138 "parsing/parser.ml"
+# 14023 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 14143 "parsing/parser.ml"
+# 14028 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 14149 "parsing/parser.ml"
+# 14034 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14160 "parsing/parser.ml"
+# 14045 "parsing/parser.ml"
in
let flag =
-# 3672 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Recursive )
-# 14166 "parsing/parser.ml"
+# 14051 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14173 "parsing/parser.ml"
+# 14058 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2944 "parsing/parser.mly"
+# 2957 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 14189 "parsing/parser.ml"
+# 14074 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (
# 705 "parsing/parser.mly"
(string)
-# 14261 "parsing/parser.ml"
+# 14146 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 14277 "parsing/parser.ml"
+# 14162 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14286 "parsing/parser.ml"
+# 14171 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 14291 "parsing/parser.ml"
+# 14176 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 14297 "parsing/parser.ml"
+# 14182 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14308 "parsing/parser.ml"
+# 14193 "parsing/parser.ml"
in
- let flag =
- let _1 = _1_inlined2 in
-
-# 3673 "parsing/parser.mly"
+ let flag =
+# 3691 "parsing/parser.mly"
( Nonrecursive )
-# 14316 "parsing/parser.ml"
-
- in
+# 14199 "parsing/parser.ml"
+ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14324 "parsing/parser.ml"
+# 14206 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2944 "parsing/parser.mly"
+# 2957 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 14340 "parsing/parser.ml"
+# 14222 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 756 "parsing/parser.mly"
(string)
-# 14361 "parsing/parser.ml"
+# 14243 "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) =
-# 3515 "parsing/parser.mly"
+# 3533 "parsing/parser.mly"
( _1 )
-# 14369 "parsing/parser.ml"
+# 14251 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 14390 "parsing/parser.ml"
+# 14272 "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) =
-# 3516 "parsing/parser.mly"
+# 3534 "parsing/parser.mly"
( _1 )
-# 14398 "parsing/parser.ml"
+# 14280 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.structure) =
-# 1138 "parsing/parser.mly"
+# 1142 "parsing/parser.mly"
( _1 )
-# 14430 "parsing/parser.ml"
+# 14312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string) =
-# 3565 "parsing/parser.mly"
+# 3583 "parsing/parser.mly"
( "" )
-# 14448 "parsing/parser.ml"
+# 14330 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3566 "parsing/parser.mly"
+# 3584 "parsing/parser.mly"
( ";.." )
-# 14480 "parsing/parser.ml"
+# 14362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.signature) =
-# 1145 "parsing/parser.mly"
+# 1149 "parsing/parser.mly"
( _1 )
-# 14512 "parsing/parser.ml"
+# 14394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3856 "parsing/parser.mly"
+# 3874 "parsing/parser.mly"
( (_2, _3) )
-# 14558 "parsing/parser.ml"
+# 14440 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 747 "parsing/parser.mly"
(string * Location.t * string * Location.t * string option)
-# 14579 "parsing/parser.ml"
+# 14461 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3858 "parsing/parser.mly"
+# 3876 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 14590 "parsing/parser.ml"
+# 14472 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 14638 "parsing/parser.ml"
+# 14520 "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
let _v : (Parsetree.label_declaration) = let _5 =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14649 "parsing/parser.ml"
+# 14531 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3268 "parsing/parser.mly"
+# 3286 "parsing/parser.mly"
( _1 )
-# 14658 "parsing/parser.ml"
+# 14540 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 14666 "parsing/parser.ml"
+# 14548 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14674 "parsing/parser.ml"
+# 14556 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3141 "parsing/parser.mly"
+# 3159 "parsing/parser.mly"
( let info = symbol_info _endpos in
Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 14688 "parsing/parser.ml"
+# 14570 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 14750 "parsing/parser.ml"
+# 14632 "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
let _v : (Parsetree.label_declaration) = let _7 =
let _1 = _1_inlined4 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14761 "parsing/parser.ml"
+# 14643 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _5 =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 14770 "parsing/parser.ml"
+# 14652 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3268 "parsing/parser.mly"
+# 3286 "parsing/parser.mly"
( _1 )
-# 14779 "parsing/parser.ml"
+# 14661 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 14787 "parsing/parser.ml"
+# 14669 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14795 "parsing/parser.ml"
+# 14677 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3146 "parsing/parser.mly"
+# 3164 "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 )
-# 14813 "parsing/parser.ml"
+# 14695 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3135 "parsing/parser.mly"
+# 3153 "parsing/parser.mly"
( [_1] )
-# 14838 "parsing/parser.ml"
+# 14720 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3136 "parsing/parser.mly"
+# 3154 "parsing/parser.mly"
( [_1] )
-# 14863 "parsing/parser.ml"
+# 14745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.label_declaration list) =
-# 3137 "parsing/parser.mly"
+# 3155 "parsing/parser.mly"
( _1 :: _2 )
-# 14895 "parsing/parser.ml"
+# 14777 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 14916 "parsing/parser.ml"
+# 14798 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14929 "parsing/parser.ml"
+# 14811 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2219 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14938 "parsing/parser.ml"
+# 14820 "parsing/parser.ml"
in
-# 2211 "parsing/parser.mly"
+# 2225 "parsing/parser.mly"
( x )
-# 14944 "parsing/parser.ml"
+# 14826 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 14979 "parsing/parser.ml"
+# 14861 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14992 "parsing/parser.ml"
+# 14874 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2219 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15001 "parsing/parser.ml"
+# 14883 "parsing/parser.ml"
in
let _startpos_x_ = _startpos__1_ in
let _symbolstartpos = _startpos_x_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2213 "parsing/parser.mly"
+# 2227 "parsing/parser.mly"
( let lab, pat = x in
lab,
mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 15013 "parsing/parser.ml"
+# 14895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3597 "parsing/parser.mly"
+# 3615 "parsing/parser.mly"
( _1 )
-# 15038 "parsing/parser.ml"
+# 14920 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2464 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( (Nolabel, _1) )
-# 15063 "parsing/parser.ml"
+# 14945 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 692 "parsing/parser.mly"
(string)
-# 15091 "parsing/parser.ml"
+# 14973 "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) =
-# 2466 "parsing/parser.mly"
+# 2480 "parsing/parser.mly"
( (Labelled _1, _2) )
-# 15099 "parsing/parser.ml"
+# 14981 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let label : (
# 705 "parsing/parser.mly"
(string)
-# 15126 "parsing/parser.ml"
+# 15008 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2468 "parsing/parser.mly"
+# 2482 "parsing/parser.mly"
( let loc = _loc_label_ in
(Labelled label, mkexpvar ~loc label) )
-# 15137 "parsing/parser.ml"
+# 15019 "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 = ty;
+ MenhirLib.EngineTypes.startp = _startpos_ty_;
+ MenhirLib.EngineTypes.endp = _endpos_ty_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = label;
+ MenhirLib.EngineTypes.startp = _startpos_label_;
+ MenhirLib.EngineTypes.endp = _endpos_label_;
+ 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 ty : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic ty in
+ let label : (
+# 705 "parsing/parser.mly"
+ (string)
+# 15066 "parsing/parser.ml"
+ ) = Obj.magic label 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__5_ in
+ let _v : (Asttypes.arg_label * Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _loc_label_ = (_startpos_label_, _endpos_label_) in
+
+# 2485 "parsing/parser.mly"
+ ( (Labelled label, mkexp_constraint ~loc:(_startpos__2_, _endpos)
+ (mkexpvar ~loc:_loc_label_ label) ty) )
+# 15079 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let label : (
# 705 "parsing/parser.mly"
(string)
-# 15164 "parsing/parser.ml"
+# 15106 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2471 "parsing/parser.mly"
+# 2488 "parsing/parser.mly"
( let loc = _loc_label_ in
(Optional label, mkexpvar ~loc label) )
-# 15175 "parsing/parser.ml"
+# 15117 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 722 "parsing/parser.mly"
(string)
-# 15203 "parsing/parser.ml"
+# 15145 "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) =
-# 2474 "parsing/parser.mly"
+# 2491 "parsing/parser.mly"
( (Optional _1, _2) )
-# 15211 "parsing/parser.ml"
+# 15153 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2207 "parsing/parser.mly"
+# 2221 "parsing/parser.mly"
( _1 )
-# 15266 "parsing/parser.ml"
+# 15208 "parsing/parser.ml"
in
-# 2181 "parsing/parser.mly"
+# 2195 "parsing/parser.mly"
( (Optional (fst _3), _4, snd _3) )
-# 15272 "parsing/parser.ml"
+# 15214 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 15299 "parsing/parser.ml"
+# 15241 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15314 "parsing/parser.ml"
+# 15256 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2219 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15323 "parsing/parser.ml"
+# 15265 "parsing/parser.ml"
in
-# 2183 "parsing/parser.mly"
+# 2197 "parsing/parser.mly"
( (Optional (fst _2), None, snd _2) )
-# 15329 "parsing/parser.ml"
+# 15271 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 722 "parsing/parser.mly"
(string)
-# 15378 "parsing/parser.ml"
+# 15320 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2207 "parsing/parser.mly"
+# 2221 "parsing/parser.mly"
( _1 )
-# 15388 "parsing/parser.ml"
+# 15330 "parsing/parser.ml"
in
-# 2185 "parsing/parser.mly"
+# 2199 "parsing/parser.mly"
( (Optional _1, _4, _3) )
-# 15394 "parsing/parser.ml"
+# 15336 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 722 "parsing/parser.mly"
(string)
-# 15422 "parsing/parser.ml"
+# 15364 "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) =
-# 2187 "parsing/parser.mly"
+# 2201 "parsing/parser.mly"
( (Optional _1, None, _2) )
-# 15430 "parsing/parser.ml"
+# 15372 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2189 "parsing/parser.mly"
+# 2203 "parsing/parser.mly"
( (Labelled (fst _3), None, snd _3) )
-# 15476 "parsing/parser.ml"
+# 15418 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 15503 "parsing/parser.ml"
+# 15445 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15518 "parsing/parser.ml"
+# 15460 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2219 "parsing/parser.mly"
+# 2233 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15527 "parsing/parser.ml"
+# 15469 "parsing/parser.ml"
in
-# 2191 "parsing/parser.mly"
+# 2205 "parsing/parser.mly"
( (Labelled (fst _2), None, snd _2) )
-# 15533 "parsing/parser.ml"
+# 15475 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 692 "parsing/parser.mly"
(string)
-# 15561 "parsing/parser.ml"
+# 15503 "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) =
-# 2193 "parsing/parser.mly"
+# 2207 "parsing/parser.mly"
( (Labelled _1, None, _2) )
-# 15569 "parsing/parser.ml"
+# 15511 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2195 "parsing/parser.mly"
+# 2209 "parsing/parser.mly"
( (Nolabel, None, _1) )
-# 15594 "parsing/parser.ml"
+# 15536 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern * Parsetree.expression * bool) =
-# 2521 "parsing/parser.mly"
+# 2534 "parsing/parser.mly"
( let p,e = _1 in (p,e,false) )
-# 15619 "parsing/parser.ml"
+# 15561 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 2524 "parsing/parser.mly"
+# 2537 "parsing/parser.mly"
( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1, true) )
-# 15647 "parsing/parser.ml"
+# 15589 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2481 "parsing/parser.mly"
+# 2498 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15683 "parsing/parser.ml"
+# 15625 "parsing/parser.ml"
in
-# 2485 "parsing/parser.mly"
+# 2502 "parsing/parser.mly"
( (_1, _2) )
-# 15689 "parsing/parser.ml"
+# 15631 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2481 "parsing/parser.mly"
+# 2498 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15739 "parsing/parser.ml"
+# 15681 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2487 "parsing/parser.mly"
+# 2504 "parsing/parser.mly"
( let v = _1 in (* PR#7344 *)
let t =
match _2 with
let patloc = (_startpos__1_, _endpos__2_) in
(ghpat ~loc:patloc (Ppat_constraint(v, typ)),
mkexp_constraint ~loc:_sloc _4 _2) )
-# 15759 "parsing/parser.ml"
+# 15701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = xs;
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
- let _5 : (Parsetree.core_type) = Obj.magic _5 in
+ let _5 : (Parsetree.expression) = Obj.magic _5 in
let _4 : unit = Obj.magic _4 in
+ let _3 : (Parsetree.core_type) = Obj.magic _3 in
+ let _2_inlined1 : unit = Obj.magic _2_inlined1 in
let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs in
let _2 : unit = Obj.magic _2 in
let _1 : (Asttypes.label) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
+ let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern * Parsetree.expression) = let _3 =
let _1 =
- let xs =
+ let _1 =
+ let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15828 "parsing/parser.ml"
- in
-
-# 985 "parsing/parser.mly"
+# 15771 "parsing/parser.ml"
+ in
+
+# 989 "parsing/parser.mly"
( xs )
-# 15833 "parsing/parser.ml"
+# 15776 "parsing/parser.ml"
+
+ in
+
+# 3268 "parsing/parser.mly"
+ ( _1 )
+# 15782 "parsing/parser.ml"
in
-# 3250 "parsing/parser.mly"
- ( _1 )
-# 15839 "parsing/parser.ml"
+# 3272 "parsing/parser.mly"
+ ( Ptyp_poly(_1, _3) )
+# 15788 "parsing/parser.ml"
in
let _startpos__3_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2481 "parsing/parser.mly"
+# 2498 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15850 "parsing/parser.ml"
+# 15799 "parsing/parser.ml"
in
+ let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2503 "parsing/parser.mly"
- ( let typloc = (_startpos__3_, _endpos__5_) in
- let patloc = (_startpos__1_, _endpos__5_) in
+# 2517 "parsing/parser.mly"
+ ( let patloc = (_startpos__1_, _endpos__3_) in
(ghpat ~loc:patloc
- (Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))),
- _7) )
-# 15860 "parsing/parser.ml"
+ (Ppat_constraint(_1, ghtyp ~loc:(_loc__3_) _3)),
+ _5) )
+# 15809 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__8_ in
let _v : (Parsetree.pattern * Parsetree.expression) = let _4 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 15934 "parsing/parser.ml"
+# 15883 "parsing/parser.ml"
in
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2481 "parsing/parser.mly"
+# 2498 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15943 "parsing/parser.ml"
+# 15892 "parsing/parser.ml"
in
let _endpos = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2509 "parsing/parser.mly"
+# 2522 "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) )
-# 15955 "parsing/parser.ml"
+# 15904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2514 "parsing/parser.mly"
+# 2527 "parsing/parser.mly"
( (_1, _3) )
-# 15994 "parsing/parser.ml"
+# 15943 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2516 "parsing/parser.mly"
+# 2529 "parsing/parser.mly"
( let loc = (_startpos__1_, _endpos__3_) in
(ghpat ~loc (Ppat_constraint(_1, _3)), _5) )
-# 16048 "parsing/parser.ml"
+# 15997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 16111 "parsing/parser.ml"
+# 16060 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 16120 "parsing/parser.ml"
+# 16069 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2544 "parsing/parser.mly"
+# 2557 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16132 "parsing/parser.ml"
+# 16081 "parsing/parser.ml"
in
-# 2534 "parsing/parser.mly"
+# 2547 "parsing/parser.mly"
( _1 )
-# 16138 "parsing/parser.ml"
+# 16087 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2535 "parsing/parser.mly"
+# 2548 "parsing/parser.mly"
( addlb _1 _2 )
-# 16170 "parsing/parser.ml"
+# 16119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 16226 "parsing/parser.ml"
+# 16175 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 16235 "parsing/parser.ml"
+# 16184 "parsing/parser.ml"
in
let ext =
-# 3842 "parsing/parser.mly"
+# 3860 "parsing/parser.mly"
( None )
-# 16241 "parsing/parser.ml"
+# 16190 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2544 "parsing/parser.mly"
+# 2557 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16252 "parsing/parser.ml"
+# 16201 "parsing/parser.ml"
in
-# 2534 "parsing/parser.mly"
+# 2547 "parsing/parser.mly"
( _1 )
-# 16258 "parsing/parser.ml"
+# 16207 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 16328 "parsing/parser.ml"
+# 16277 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 16337 "parsing/parser.ml"
+# 16286 "parsing/parser.ml"
in
let ext =
- let (_startpos__1_, _1) = (_startpos__1_inlined1_, _1_inlined1) in
+ let _startpos__1_ = _startpos__1_inlined1_ in
let _endpos = _endpos__2_ in
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3844 "parsing/parser.mly"
+# 3862 "parsing/parser.mly"
( not_expecting _loc "extension" )
-# 16348 "parsing/parser.ml"
+# 16297 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2544 "parsing/parser.mly"
+# 2557 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16360 "parsing/parser.ml"
+# 16309 "parsing/parser.ml"
in
-# 2534 "parsing/parser.mly"
+# 2547 "parsing/parser.mly"
( _1 )
-# 16366 "parsing/parser.ml"
+# 16315 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2535 "parsing/parser.mly"
+# 2548 "parsing/parser.mly"
( addlb _1 _2 )
-# 16398 "parsing/parser.ml"
+# 16347 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2223 "parsing/parser.mly"
+# 2237 "parsing/parser.mly"
( _1 )
-# 16423 "parsing/parser.ml"
+# 16372 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2225 "parsing/parser.mly"
+# 2239 "parsing/parser.mly"
( Ppat_constraint(_1, _3) )
-# 16463 "parsing/parser.ml"
+# 16412 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 16472 "parsing/parser.ml"
+# 16421 "parsing/parser.ml"
in
-# 2226 "parsing/parser.mly"
+# 2240 "parsing/parser.mly"
( _1 )
-# 16478 "parsing/parser.ml"
+# 16427 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2481 "parsing/parser.mly"
+# 2498 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 16514 "parsing/parser.ml"
+# 16463 "parsing/parser.ml"
in
-# 2561 "parsing/parser.mly"
+# 2574 "parsing/parser.mly"
( (pat, exp) )
-# 16520 "parsing/parser.ml"
+# 16469 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 2564 "parsing/parser.mly"
+# 2577 "parsing/parser.mly"
( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1) )
-# 16548 "parsing/parser.ml"
+# 16497 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2566 "parsing/parser.mly"
+# 2579 "parsing/parser.mly"
( let loc = (_startpos_pat_, _endpos_typ_) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 16602 "parsing/parser.ml"
+# 16551 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2569 "parsing/parser.mly"
+# 2582 "parsing/parser.mly"
( (pat, exp) )
-# 16641 "parsing/parser.ml"
+# 16590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_body_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) =
-# 2573 "parsing/parser.mly"
+# 2586 "parsing/parser.mly"
( let let_pat, let_exp = body in
let_pat, let_exp, [] )
-# 16667 "parsing/parser.ml"
+# 16616 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 688 "parsing/parser.mly"
(string)
-# 16701 "parsing/parser.ml"
+# 16650 "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
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16714 "parsing/parser.ml"
+# 16663 "parsing/parser.ml"
in
let _endpos = _endpos_body_ in
let _symbolstartpos = _startpos_bindings_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2576 "parsing/parser.mly"
+# 2589 "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 )
-# 16727 "parsing/parser.ml"
+# 16676 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16745 "parsing/parser.ml"
+# 16694 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 16811 "parsing/parser.ml"
+# 16760 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 16826 "parsing/parser.ml"
+# 16775 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16838 "parsing/parser.ml"
+# 16787 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 16846 "parsing/parser.ml"
+# 16795 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1827 "parsing/parser.mly"
+# 1841 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16861 "parsing/parser.ml"
+# 16810 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16867 "parsing/parser.ml"
+# 16816 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_description list) =
# 211 "<standard.mly>"
( [] )
-# 16885 "parsing/parser.ml"
+# 16834 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 16958 "parsing/parser.ml"
+# 16907 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 16973 "parsing/parser.ml"
+# 16922 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16985 "parsing/parser.ml"
+# 16934 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 16993 "parsing/parser.ml"
+# 16942 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2118 "parsing/parser.mly"
+# 2132 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
)
-# 17008 "parsing/parser.ml"
+# 16957 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17014 "parsing/parser.ml"
+# 16963 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17032 "parsing/parser.ml"
+# 16981 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 17105 "parsing/parser.ml"
+# 17054 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 17120 "parsing/parser.ml"
+# 17069 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17132 "parsing/parser.ml"
+# 17081 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 17140 "parsing/parser.ml"
+# 17089 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2157 "parsing/parser.mly"
+# 2171 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
)
-# 17155 "parsing/parser.ml"
+# 17104 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17161 "parsing/parser.ml"
+# 17110 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_binding list) =
# 211 "<standard.mly>"
( [] )
-# 17179 "parsing/parser.ml"
+# 17128 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 17242 "parsing/parser.ml"
+# 17191 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17254 "parsing/parser.ml"
+# 17203 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 17262 "parsing/parser.ml"
+# 17211 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1489 "parsing/parser.mly"
+# 1503 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let text = symbol_text _symbolstartpos in
Mb.mk name body ~attrs ~loc ~text ~docs
)
-# 17277 "parsing/parser.ml"
+# 17226 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17283 "parsing/parser.ml"
+# 17232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17301 "parsing/parser.ml"
+# 17250 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 17371 "parsing/parser.ml"
+# 17320 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17383 "parsing/parser.ml"
+# 17332 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 17391 "parsing/parser.ml"
+# 17340 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1768 "parsing/parser.mly"
+# 1782 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Md.mk name mty ~attrs ~loc ~text ~docs
)
-# 17406 "parsing/parser.ml"
+# 17355 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17412 "parsing/parser.ml"
+# 17361 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17430 "parsing/parser.ml"
+# 17379 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17462 "parsing/parser.ml"
+# 17411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17480 "parsing/parser.ml"
+# 17429 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 17547 "parsing/parser.ml"
+# 17496 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 17562 "parsing/parser.ml"
+# 17511 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17571 "parsing/parser.ml"
+# 17520 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 17576 "parsing/parser.ml"
+# 17525 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 17582 "parsing/parser.ml"
+# 17531 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17593 "parsing/parser.ml"
+# 17542 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 17601 "parsing/parser.ml"
+# 17550 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2961 "parsing/parser.mly"
+# 2974 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17617 "parsing/parser.ml"
+# 17566 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17623 "parsing/parser.ml"
+# 17572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17641 "parsing/parser.ml"
+# 17590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 17715 "parsing/parser.ml"
+# 17664 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 17730 "parsing/parser.ml"
+# 17679 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17739 "parsing/parser.ml"
+# 17688 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 17744 "parsing/parser.ml"
+# 17693 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 17750 "parsing/parser.ml"
+# 17699 "parsing/parser.ml"
in
- let kind_priv_manifest =
- let _1 = _1_inlined3 in
-
-# 3007 "parsing/parser.mly"
+ let kind_priv_manifest =
+# 3020 "parsing/parser.mly"
( _2 )
-# 17758 "parsing/parser.ml"
-
- in
+# 17705 "parsing/parser.ml"
+ in
let id =
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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17769 "parsing/parser.ml"
+# 17715 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 17777 "parsing/parser.ml"
+# 17723 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2961 "parsing/parser.mly"
+# 2974 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17793 "parsing/parser.ml"
+# 17739 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17799 "parsing/parser.ml"
+# 17745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17817 "parsing/parser.ml"
+# 17763 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17849 "parsing/parser.ml"
+# 17795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17867 "parsing/parser.ml"
+# 17813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 893 "parsing/parser.mly"
+# 897 "parsing/parser.mly"
( text_sig _startpos )
-# 17902 "parsing/parser.ml"
+# 17848 "parsing/parser.ml"
in
-# 1627 "parsing/parser.mly"
+# 1641 "parsing/parser.mly"
( _1 )
-# 17908 "parsing/parser.ml"
+# 17854 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17914 "parsing/parser.ml"
+# 17860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 891 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( text_sig _startpos @ [_1] )
-# 17949 "parsing/parser.ml"
+# 17895 "parsing/parser.ml"
in
-# 1627 "parsing/parser.mly"
+# 1641 "parsing/parser.mly"
( _1 )
-# 17955 "parsing/parser.ml"
+# 17901 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17961 "parsing/parser.ml"
+# 17907 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17979 "parsing/parser.ml"
+# 17925 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let ys =
let items =
-# 953 "parsing/parser.mly"
+# 957 "parsing/parser.mly"
( [] )
-# 18014 "parsing/parser.ml"
+# 17960 "parsing/parser.ml"
in
-# 1372 "parsing/parser.mly"
+# 1386 "parsing/parser.mly"
( items )
-# 18019 "parsing/parser.ml"
+# 17965 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 889 "parsing/parser.mly"
+# 893 "parsing/parser.mly"
( text_str _startpos )
-# 18027 "parsing/parser.ml"
+# 17973 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 18033 "parsing/parser.ml"
+# 17979 "parsing/parser.ml"
in
-# 1388 "parsing/parser.mly"
+# 1402 "parsing/parser.mly"
( _1 )
-# 18039 "parsing/parser.ml"
+# 17985 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18045 "parsing/parser.ml"
+# 17991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 18099 "parsing/parser.ml"
+# 18045 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1393 "parsing/parser.mly"
( mkstrexp e attrs )
-# 18104 "parsing/parser.ml"
+# 18050 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 887 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18112 "parsing/parser.ml"
+# 18058 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 906 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 18122 "parsing/parser.ml"
+# 18068 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 959 "parsing/parser.mly"
( x )
-# 18128 "parsing/parser.ml"
+# 18074 "parsing/parser.ml"
in
-# 1372 "parsing/parser.mly"
+# 1386 "parsing/parser.mly"
( items )
-# 18134 "parsing/parser.ml"
+# 18080 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 889 "parsing/parser.mly"
+# 893 "parsing/parser.mly"
( text_str _startpos )
-# 18142 "parsing/parser.ml"
+# 18088 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 18148 "parsing/parser.ml"
+# 18094 "parsing/parser.ml"
in
-# 1388 "parsing/parser.mly"
+# 1402 "parsing/parser.mly"
( _1 )
-# 18154 "parsing/parser.ml"
+# 18100 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18160 "parsing/parser.ml"
+# 18106 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 887 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18195 "parsing/parser.ml"
+# 18141 "parsing/parser.ml"
in
-# 1388 "parsing/parser.mly"
+# 1402 "parsing/parser.mly"
( _1 )
-# 18201 "parsing/parser.ml"
+# 18147 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18207 "parsing/parser.ml"
+# 18153 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) =
# 211 "<standard.mly>"
( [] )
-# 18225 "parsing/parser.ml"
+# 18171 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) = let x =
let _startpos = _startpos__1_ in
-# 901 "parsing/parser.mly"
+# 905 "parsing/parser.mly"
( text_csig _startpos @ [_1] )
-# 18259 "parsing/parser.ml"
+# 18205 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18265 "parsing/parser.ml"
+# 18211 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) =
# 211 "<standard.mly>"
( [] )
-# 18283 "parsing/parser.ml"
+# 18229 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) = let x =
let _startpos = _startpos__1_ in
-# 899 "parsing/parser.mly"
+# 903 "parsing/parser.mly"
( text_cstr _startpos @ [_1] )
-# 18317 "parsing/parser.ml"
+# 18263 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18323 "parsing/parser.ml"
+# 18269 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 18341 "parsing/parser.ml"
+# 18287 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) = let x =
let _startpos = _startpos__1_ in
-# 887 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18375 "parsing/parser.ml"
+# 18321 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18381 "parsing/parser.ml"
+# 18327 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) =
# 211 "<standard.mly>"
( [] )
-# 18399 "parsing/parser.ml"
+# 18345 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let x =
let _1 =
-# 953 "parsing/parser.mly"
+# 957 "parsing/parser.mly"
( [] )
-# 18434 "parsing/parser.ml"
+# 18380 "parsing/parser.ml"
in
-# 1185 "parsing/parser.mly"
+# 1189 "parsing/parser.mly"
( _1 )
-# 18439 "parsing/parser.ml"
+# 18385 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18445 "parsing/parser.ml"
+# 18391 "parsing/parser.ml"
in
-# 1197 "parsing/parser.mly"
+# 1201 "parsing/parser.mly"
( _1 )
-# 18451 "parsing/parser.ml"
+# 18397 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18457 "parsing/parser.ml"
+# 18403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 18511 "parsing/parser.ml"
+# 18457 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1393 "parsing/parser.mly"
( mkstrexp e attrs )
-# 18516 "parsing/parser.ml"
+# 18462 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18522 "parsing/parser.ml"
+# 18468 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 895 "parsing/parser.mly"
+# 899 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18530 "parsing/parser.ml"
+# 18476 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 959 "parsing/parser.mly"
( x )
-# 18536 "parsing/parser.ml"
+# 18482 "parsing/parser.ml"
in
-# 1185 "parsing/parser.mly"
+# 1189 "parsing/parser.mly"
( _1 )
-# 18542 "parsing/parser.ml"
+# 18488 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18548 "parsing/parser.ml"
+# 18494 "parsing/parser.ml"
in
-# 1197 "parsing/parser.mly"
+# 1201 "parsing/parser.mly"
( _1 )
-# 18554 "parsing/parser.ml"
+# 18500 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18560 "parsing/parser.ml"
+# 18506 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) = let x =
let _1 =
let _1 =
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18594 "parsing/parser.ml"
+# 18540 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 895 "parsing/parser.mly"
+# 899 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18600 "parsing/parser.ml"
+# 18546 "parsing/parser.ml"
in
-# 1197 "parsing/parser.mly"
+# 1201 "parsing/parser.mly"
( _1 )
-# 18606 "parsing/parser.ml"
+# 18552 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18612 "parsing/parser.ml"
+# 18558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 906 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 18650 "parsing/parser.ml"
+# 18596 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 895 "parsing/parser.mly"
+# 899 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18657 "parsing/parser.ml"
+# 18603 "parsing/parser.ml"
in
-# 1197 "parsing/parser.mly"
+# 1201 "parsing/parser.mly"
( _1 )
-# 18663 "parsing/parser.ml"
+# 18609 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18669 "parsing/parser.ml"
+# 18615 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 124 "<standard.mly>"
( None )
-# 18708 "parsing/parser.ml"
+# 18654 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18718 "parsing/parser.ml"
+# 18664 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2847 "parsing/parser.mly"
- ( let label, pat =
+# 2860 "parsing/parser.mly"
+ ( let constraint_loc, label, pat =
match opat with
| None ->
(* No pattern; this is a pun. Desugar it.
But that the pattern was there and the label reconstructed (which
piece of AST is marked as ghost is important for warning
emission). *)
- make_ghost label, pat_of_label label
+ _sloc, make_ghost label, pat_of_label label
| Some pat ->
- label, pat
+ (_startpos_octy_, _endpos), label, pat
in
- label, mkpat_opt_constraint ~loc:_sloc pat octy
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 18740 "parsing/parser.ml"
+# 18686 "parsing/parser.ml"
in
-# 1122 "parsing/parser.mly"
+# 1126 "parsing/parser.mly"
( [x], None )
-# 18746 "parsing/parser.ml"
+# 18692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 18792 "parsing/parser.ml"
+# 18738 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18802 "parsing/parser.ml"
+# 18748 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2847 "parsing/parser.mly"
- ( let label, pat =
+# 2860 "parsing/parser.mly"
+ ( let constraint_loc, label, pat =
match opat with
| None ->
(* No pattern; this is a pun. Desugar it.
But that the pattern was there and the label reconstructed (which
piece of AST is marked as ghost is important for warning
emission). *)
- make_ghost label, pat_of_label label
+ _sloc, make_ghost label, pat_of_label label
| Some pat ->
- label, pat
+ (_startpos_octy_, _endpos), label, pat
in
- label, mkpat_opt_constraint ~loc:_sloc pat octy
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 18824 "parsing/parser.ml"
+# 18770 "parsing/parser.ml"
in
-# 1122 "parsing/parser.mly"
+# 1126 "parsing/parser.mly"
( [x], None )
-# 18830 "parsing/parser.ml"
+# 18776 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18895 "parsing/parser.ml"
+# 18841 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2847 "parsing/parser.mly"
- ( let label, pat =
+# 2860 "parsing/parser.mly"
+ ( let constraint_loc, label, pat =
match opat with
| None ->
(* No pattern; this is a pun. Desugar it.
But that the pattern was there and the label reconstructed (which
piece of AST is marked as ghost is important for warning
emission). *)
- make_ghost label, pat_of_label label
+ _sloc, make_ghost label, pat_of_label label
| Some pat ->
- label, pat
+ (_startpos_octy_, _endpos), label, pat
in
- label, mkpat_opt_constraint ~loc:_sloc pat octy
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 18917 "parsing/parser.ml"
+# 18863 "parsing/parser.ml"
in
-# 1124 "parsing/parser.mly"
+# 1128 "parsing/parser.mly"
( [x], Some y )
-# 18923 "parsing/parser.ml"
+# 18869 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18981 "parsing/parser.ml"
+# 18927 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2847 "parsing/parser.mly"
- ( let label, pat =
+# 2860 "parsing/parser.mly"
+ ( let constraint_loc, label, pat =
match opat with
| None ->
(* No pattern; this is a pun. Desugar it.
But that the pattern was there and the label reconstructed (which
piece of AST is marked as ghost is important for warning
emission). *)
- make_ghost label, pat_of_label label
+ _sloc, make_ghost label, pat_of_label label
| Some pat ->
- label, pat
+ (_startpos_octy_, _endpos), label, pat
in
- label, mkpat_opt_constraint ~loc:_sloc pat octy
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
)
-# 19003 "parsing/parser.ml"
+# 18949 "parsing/parser.ml"
in
-# 1128 "parsing/parser.mly"
+# 1132 "parsing/parser.mly"
( let xs, y = tail in
x :: xs, y )
-# 19010 "parsing/parser.ml"
+# 18956 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) =
-# 2602 "parsing/parser.mly"
+# 2615 "parsing/parser.mly"
( Exp.case _1 _3 )
-# 19049 "parsing/parser.ml"
+# 18995 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.case) =
-# 2604 "parsing/parser.mly"
+# 2617 "parsing/parser.mly"
( Exp.case _1 ~guard:_3 _5 )
-# 19102 "parsing/parser.ml"
+# 19048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2606 "parsing/parser.mly"
+# 2619 "parsing/parser.mly"
( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
-# 19142 "parsing/parser.ml"
+# 19088 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 19205 "parsing/parser.ml"
+# 19151 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19216 "parsing/parser.ml"
+# 19162 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19225 "parsing/parser.ml"
+# 19171 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3268 "parsing/parser.mly"
+# 3286 "parsing/parser.mly"
( _1 )
-# 19234 "parsing/parser.ml"
+# 19180 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19241 "parsing/parser.ml"
+# 19187 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19249 "parsing/parser.ml"
+# 19195 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3478 "parsing/parser.mly"
+# 3496 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19264 "parsing/parser.ml"
+# 19210 "parsing/parser.ml"
in
-# 3459 "parsing/parser.mly"
+# 3477 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 19270 "parsing/parser.ml"
+# 19216 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3489 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19313 "parsing/parser.ml"
+# 19259 "parsing/parser.ml"
in
-# 3459 "parsing/parser.mly"
+# 3477 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 19319 "parsing/parser.ml"
+# 19265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 19375 "parsing/parser.ml"
+# 19321 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19386 "parsing/parser.ml"
+# 19332 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19395 "parsing/parser.ml"
+# 19341 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3268 "parsing/parser.mly"
+# 3286 "parsing/parser.mly"
( _1 )
-# 19404 "parsing/parser.ml"
+# 19350 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19411 "parsing/parser.ml"
+# 19357 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19419 "parsing/parser.ml"
+# 19365 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3478 "parsing/parser.mly"
+# 3496 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19434 "parsing/parser.ml"
+# 19380 "parsing/parser.ml"
in
-# 3462 "parsing/parser.mly"
+# 3480 "parsing/parser.mly"
( [head], Closed )
-# 19440 "parsing/parser.ml"
+# 19386 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3489 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19476 "parsing/parser.ml"
+# 19422 "parsing/parser.ml"
in
-# 3462 "parsing/parser.mly"
+# 3480 "parsing/parser.mly"
( [head], Closed )
-# 19482 "parsing/parser.ml"
+# 19428 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 19524 "parsing/parser.ml"
+# 19470 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _4 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19535 "parsing/parser.ml"
+# 19481 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3268 "parsing/parser.mly"
+# 3286 "parsing/parser.mly"
( _1 )
-# 19544 "parsing/parser.ml"
+# 19490 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19551 "parsing/parser.ml"
+# 19497 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19559 "parsing/parser.ml"
+# 19505 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3471 "parsing/parser.mly"
+# 3489 "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 )
-# 19570 "parsing/parser.ml"
+# 19516 "parsing/parser.ml"
in
-# 3465 "parsing/parser.mly"
+# 3483 "parsing/parser.mly"
( [head], Closed )
-# 19576 "parsing/parser.ml"
+# 19522 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3489 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19605 "parsing/parser.ml"
+# 19551 "parsing/parser.ml"
in
-# 3465 "parsing/parser.mly"
+# 3483 "parsing/parser.mly"
( [head], Closed )
-# 19611 "parsing/parser.ml"
+# 19557 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.object_field list * Asttypes.closed_flag) =
-# 3467 "parsing/parser.mly"
+# 3485 "parsing/parser.mly"
( [], Open )
-# 19636 "parsing/parser.ml"
+# 19582 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 19683 "parsing/parser.ml"
+# 19629 "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
Parsetree.attributes) = let ty =
let _1 = _1_inlined2 in
-# 3264 "parsing/parser.mly"
+# 3282 "parsing/parser.mly"
( _1 )
-# 19697 "parsing/parser.ml"
+# 19643 "parsing/parser.ml"
in
let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19705 "parsing/parser.ml"
+# 19651 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19713 "parsing/parser.ml"
+# 19659 "parsing/parser.ml"
in
let attrs =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19719 "parsing/parser.ml"
+# 19665 "parsing/parser.ml"
in
let _1 =
-# 3734 "parsing/parser.mly"
+# 3752 "parsing/parser.mly"
( Fresh )
-# 19724 "parsing/parser.ml"
+# 19670 "parsing/parser.ml"
in
-# 1965 "parsing/parser.mly"
+# 1979 "parsing/parser.mly"
( (label, private_, Cfk_virtual ty), attrs )
-# 19729 "parsing/parser.ml"
+# 19675 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 19769 "parsing/parser.ml"
+# 19715 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19783 "parsing/parser.ml"
+# 19729 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19791 "parsing/parser.ml"
+# 19737 "parsing/parser.ml"
in
let _2 =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19797 "parsing/parser.ml"
+# 19743 "parsing/parser.ml"
in
let _1 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 19802 "parsing/parser.ml"
+# 19748 "parsing/parser.ml"
in
-# 1967 "parsing/parser.mly"
+# 1981 "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 )
-# 19810 "parsing/parser.ml"
+# 19756 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 19856 "parsing/parser.ml"
+# 19802 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19871 "parsing/parser.ml"
+# 19817 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19879 "parsing/parser.ml"
+# 19825 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19887 "parsing/parser.ml"
+# 19833 "parsing/parser.ml"
in
let _1 =
-# 3738 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( Override )
-# 19893 "parsing/parser.ml"
+# 19839 "parsing/parser.ml"
in
-# 1967 "parsing/parser.mly"
+# 1981 "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 )
-# 19901 "parsing/parser.ml"
+# 19847 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 19962 "parsing/parser.ml"
+# 19908 "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
Parsetree.attributes) = let _6 =
let _1 = _1_inlined2 in
-# 3264 "parsing/parser.mly"
+# 3282 "parsing/parser.mly"
( _1 )
-# 19976 "parsing/parser.ml"
+# 19922 "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 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 19985 "parsing/parser.ml"
+# 19931 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19993 "parsing/parser.ml"
+# 19939 "parsing/parser.ml"
in
let _2 =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 19999 "parsing/parser.ml"
+# 19945 "parsing/parser.ml"
in
let _1 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 20004 "parsing/parser.ml"
+# 19950 "parsing/parser.ml"
in
-# 1973 "parsing/parser.mly"
+# 1987 "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 )
-# 20012 "parsing/parser.ml"
+# 19958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 20079 "parsing/parser.ml"
+# 20025 "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
Parsetree.attributes) = let _6 =
let _1 = _1_inlined3 in
-# 3264 "parsing/parser.mly"
+# 3282 "parsing/parser.mly"
( _1 )
-# 20094 "parsing/parser.ml"
+# 20040 "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 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 20103 "parsing/parser.ml"
+# 20049 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20111 "parsing/parser.ml"
+# 20057 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 20119 "parsing/parser.ml"
+# 20065 "parsing/parser.ml"
in
let _1 =
-# 3738 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( Override )
-# 20125 "parsing/parser.ml"
+# 20071 "parsing/parser.ml"
in
-# 1973 "parsing/parser.mly"
+# 1987 "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 )
-# 20133 "parsing/parser.ml"
+# 20079 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 20215 "parsing/parser.ml"
+# 20161 "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
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 20227 "parsing/parser.ml"
+# 20173 "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 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 20235 "parsing/parser.ml"
+# 20181 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20243 "parsing/parser.ml"
+# 20189 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 20250 "parsing/parser.ml"
+# 20196 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 20256 "parsing/parser.ml"
+# 20202 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__11_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1979 "parsing/parser.mly"
+# 1993 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 20283 "parsing/parser.ml"
+# 20229 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 20371 "parsing/parser.ml"
+# 20317 "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
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 20384 "parsing/parser.ml"
+# 20330 "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 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 20392 "parsing/parser.ml"
+# 20338 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20400 "parsing/parser.ml"
+# 20346 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 20409 "parsing/parser.ml"
+# 20355 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3738 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( Override )
-# 20416 "parsing/parser.ml"
+# 20362 "parsing/parser.ml"
in
let _endpos = _endpos__11_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1979 "parsing/parser.mly"
+# 1993 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 20442 "parsing/parser.ml"
+# 20388 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 20463 "parsing/parser.ml"
+# 20409 "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) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20471 "parsing/parser.ml"
+# 20417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (
# 705 "parsing/parser.mly"
(string)
-# 20504 "parsing/parser.ml"
+# 20450 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20514 "parsing/parser.ml"
+# 20460 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 756 "parsing/parser.mly"
(string)
-# 20535 "parsing/parser.ml"
+# 20481 "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) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20543 "parsing/parser.ml"
+# 20489 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (
# 756 "parsing/parser.mly"
(string)
-# 20576 "parsing/parser.ml"
+# 20522 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20586 "parsing/parser.ml"
+# 20532 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20611 "parsing/parser.ml"
+# 20557 "parsing/parser.ml"
in
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20616 "parsing/parser.ml"
+# 20562 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
let _1 =
-# 3570 "parsing/parser.mly"
+# 3588 "parsing/parser.mly"
( "::" )
-# 20656 "parsing/parser.ml"
+# 20602 "parsing/parser.ml"
in
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20661 "parsing/parser.ml"
+# 20607 "parsing/parser.ml"
in
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20667 "parsing/parser.ml"
+# 20613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20692 "parsing/parser.ml"
+# 20638 "parsing/parser.ml"
in
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20697 "parsing/parser.ml"
+# 20643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20738 "parsing/parser.ml"
+# 20684 "parsing/parser.ml"
in
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20744 "parsing/parser.ml"
+# 20690 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _3 =
- let (_2, _1) = (_2_inlined1, _1_inlined1) in
let _1 =
-# 3570 "parsing/parser.mly"
+# 3588 "parsing/parser.mly"
( "::" )
-# 20799 "parsing/parser.ml"
+# 20744 "parsing/parser.ml"
in
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20804 "parsing/parser.ml"
+# 20749 "parsing/parser.ml"
in
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20810 "parsing/parser.ml"
+# 20755 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3628 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( _1 )
-# 20851 "parsing/parser.ml"
+# 20796 "parsing/parser.ml"
in
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20857 "parsing/parser.ml"
+# 20802 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20882 "parsing/parser.ml"
+# 20827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20921 "parsing/parser.ml"
+# 20866 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 20942 "parsing/parser.ml"
+# 20887 "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) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 20950 "parsing/parser.ml"
+# 20895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (
# 705 "parsing/parser.mly"
(string)
-# 20983 "parsing/parser.ml"
+# 20928 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20993 "parsing/parser.ml"
+# 20938 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 756 "parsing/parser.mly"
(string)
-# 21014 "parsing/parser.ml"
+# 20959 "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) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 21022 "parsing/parser.ml"
+# 20967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (
# 756 "parsing/parser.mly"
(string)
-# 21055 "parsing/parser.ml"
+# 21000 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 21065 "parsing/parser.ml"
+# 21010 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3590 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( Lident _1 )
-# 21090 "parsing/parser.ml"
+# 21035 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3591 "parsing/parser.mly"
+# 3609 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 21129 "parsing/parser.ml"
+# 21074 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3606 "parsing/parser.mly"
+# 3624 "parsing/parser.mly"
( _1 )
-# 21154 "parsing/parser.ml"
+# 21099 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3608 "parsing/parser.mly"
+# 3626 "parsing/parser.mly"
( lapply ~loc:_sloc _1 _3 )
-# 21203 "parsing/parser.ml"
+# 21148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3610 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( expecting _loc__3_ "module path" )
-# 21243 "parsing/parser.ml"
+# 21188 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3603 "parsing/parser.mly"
+# 3621 "parsing/parser.mly"
( _1 )
-# 21268 "parsing/parser.ml"
+# 21213 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1448 "parsing/parser.mly"
+# 1462 "parsing/parser.mly"
( me )
-# 21300 "parsing/parser.ml"
+# 21245 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1451 "parsing/parser.mly"
+# 1465 "parsing/parser.mly"
( Pmod_constraint(me, mty) )
-# 21347 "parsing/parser.ml"
+# 21292 "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
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21356 "parsing/parser.ml"
+# 21301 "parsing/parser.ml"
in
-# 1455 "parsing/parser.mly"
+# 1469 "parsing/parser.mly"
( _1 )
-# 21362 "parsing/parser.ml"
+# 21307 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1453 "parsing/parser.mly"
+# 1467 "parsing/parser.mly"
( let (_, arg) = arg_and_pos in
Pmod_functor(arg, body) )
-# 21396 "parsing/parser.ml"
+# 21341 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21405 "parsing/parser.ml"
+# 21350 "parsing/parser.ml"
in
-# 1455 "parsing/parser.mly"
+# 1469 "parsing/parser.mly"
( _1 )
-# 21411 "parsing/parser.ml"
+# 21356 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_mty_ in
let _v : (Parsetree.module_type) =
-# 1694 "parsing/parser.mly"
+# 1708 "parsing/parser.mly"
( mty )
-# 21443 "parsing/parser.ml"
+# 21388 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1697 "parsing/parser.mly"
+# 1711 "parsing/parser.mly"
( let (_, arg) = arg_and_pos in
Pmty_functor(arg, body) )
-# 21477 "parsing/parser.ml"
+# 21422 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 928 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21486 "parsing/parser.ml"
+# 21431 "parsing/parser.ml"
in
-# 1700 "parsing/parser.mly"
+# 1714 "parsing/parser.mly"
( _1 )
-# 21492 "parsing/parser.ml"
+# 21437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 21540 "parsing/parser.ml"
+# 21485 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1287 "parsing/parser.mly"
+# 1301 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 21549 "parsing/parser.ml"
+# 21494 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 21597 "parsing/parser.ml"
+# 21542 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1289 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( unclosed "struct" _loc__1_ "end" _loc__4_ )
-# 21605 "parsing/parser.ml"
+# 21550 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let args =
let _1 = _1_inlined2 in
-# 1253 "parsing/parser.mly"
+# 1267 "parsing/parser.mly"
( _1 )
-# 21660 "parsing/parser.ml"
+# 21605 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 21668 "parsing/parser.ml"
+# 21613 "parsing/parser.ml"
in
let _endpos = _endpos_me_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1291 "parsing/parser.mly"
+# 1305 "parsing/parser.mly"
( wrap_mod_attrs ~loc:_sloc attrs (
List.fold_left (fun acc (startpos, arg) ->
mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc))
) me args
) )
-# 21681 "parsing/parser.ml"
+# 21626 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1297 "parsing/parser.mly"
+# 1311 "parsing/parser.mly"
( me )
-# 21706 "parsing/parser.ml"
+# 21651 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_attr_ in
let _v : (Parsetree.module_expr) =
-# 1299 "parsing/parser.mly"
+# 1313 "parsing/parser.mly"
( Mod.attr me attr )
-# 21738 "parsing/parser.ml"
+# 21683 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21769 "parsing/parser.ml"
+# 21714 "parsing/parser.ml"
in
-# 1303 "parsing/parser.mly"
+# 1317 "parsing/parser.mly"
( Pmod_ident x )
-# 21775 "parsing/parser.ml"
+# 21720 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21784 "parsing/parser.ml"
+# 21729 "parsing/parser.ml"
in
-# 1315 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 21790 "parsing/parser.ml"
+# 21735 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me2_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1306 "parsing/parser.mly"
+# 1320 "parsing/parser.mly"
( Pmod_apply(me1, me2) )
-# 21823 "parsing/parser.ml"
+# 21768 "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
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21832 "parsing/parser.ml"
+# 21777 "parsing/parser.ml"
in
-# 1315 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 21838 "parsing/parser.ml"
+# 21783 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_me1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1309 "parsing/parser.mly"
+# 1323 "parsing/parser.mly"
( (* TODO review mkmod location *)
Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) )
-# 21883 "parsing/parser.ml"
+# 21828 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21893 "parsing/parser.ml"
+# 21838 "parsing/parser.ml"
in
-# 1315 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 21899 "parsing/parser.ml"
+# 21844 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_ex_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1313 "parsing/parser.mly"
+# 1327 "parsing/parser.mly"
( Pmod_extension ex )
-# 21925 "parsing/parser.ml"
+# 21870 "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
-# 926 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21934 "parsing/parser.ml"
+# 21879 "parsing/parser.ml"
in
-# 1315 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( _1 )
-# 21940 "parsing/parser.ml"
+# 21885 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x : (
# 756 "parsing/parser.mly"
(string)
-# 21961 "parsing/parser.ml"
+# 21906 "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) =
-# 1270 "parsing/parser.mly"
+# 1284 "parsing/parser.mly"
( Some x )
-# 21969 "parsing/parser.ml"
+# 21914 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string option) =
-# 1273 "parsing/parser.mly"
+# 1287 "parsing/parser.mly"
( None )
-# 21994 "parsing/parser.ml"
+# 21939 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 756 "parsing/parser.mly"
(string)
-# 22054 "parsing/parser.ml"
+# 21999 "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
let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 22067 "parsing/parser.ml"
+# 22012 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22079 "parsing/parser.ml"
+# 22024 "parsing/parser.ml"
in
let uid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22090 "parsing/parser.ml"
+# 22035 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22098 "parsing/parser.ml"
+# 22043 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1730 "parsing/parser.mly"
+# 1744 "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
)
-# 22112 "parsing/parser.ml"
+# 22057 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 756 "parsing/parser.mly"
(string)
-# 22165 "parsing/parser.ml"
+# 22110 "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
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22181 "parsing/parser.ml"
+# 22126 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22189 "parsing/parser.ml"
+# 22134 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
-# 1737 "parsing/parser.mly"
+# 1751 "parsing/parser.mly"
( expecting _loc__6_ "module path" )
-# 22196 "parsing/parser.ml"
+# 22141 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22244 "parsing/parser.ml"
+# 22189 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1580 "parsing/parser.mly"
+# 1594 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 22253 "parsing/parser.ml"
+# 22198 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22301 "parsing/parser.ml"
+# 22246 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1582 "parsing/parser.mly"
+# 1596 "parsing/parser.mly"
( unclosed "sig" _loc__1_ "end" _loc__4_ )
-# 22309 "parsing/parser.ml"
+# 22254 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let args =
let _1 = _1_inlined2 in
-# 1253 "parsing/parser.mly"
+# 1267 "parsing/parser.mly"
( _1 )
-# 22364 "parsing/parser.ml"
+# 22309 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22372 "parsing/parser.ml"
+# 22317 "parsing/parser.ml"
in
let _endpos = _endpos_mty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1586 "parsing/parser.mly"
+# 1600 "parsing/parser.mly"
( wrap_mty_attrs ~loc:_sloc attrs (
List.fold_left (fun acc (startpos, arg) ->
mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc))
) mty args
) )
-# 22385 "parsing/parser.ml"
+# 22330 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _4 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22440 "parsing/parser.ml"
+# 22385 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1592 "parsing/parser.mly"
+# 1606 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 22449 "parsing/parser.ml"
+# 22394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) =
-# 1594 "parsing/parser.mly"
+# 1608 "parsing/parser.mly"
( _2 )
-# 22488 "parsing/parser.ml"
+# 22433 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1596 "parsing/parser.mly"
+# 1610 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 22529 "parsing/parser.ml"
+# 22474 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1598 "parsing/parser.mly"
+# 1612 "parsing/parser.mly"
( Mty.attr _1 _2 )
-# 22561 "parsing/parser.ml"
+# 22506 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22592 "parsing/parser.ml"
+# 22537 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1615 "parsing/parser.mly"
( Pmty_ident _1 )
-# 22598 "parsing/parser.ml"
+# 22543 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 928 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22607 "parsing/parser.ml"
+# 22552 "parsing/parser.ml"
in
-# 1612 "parsing/parser.mly"
+# 1626 "parsing/parser.mly"
( _1 )
-# 22613 "parsing/parser.ml"
+# 22558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1604 "parsing/parser.mly"
+# 1618 "parsing/parser.mly"
( Pmty_functor(Named (mknoloc None, _1), _3) )
-# 22653 "parsing/parser.ml"
+# 22598 "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
-# 928 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22662 "parsing/parser.ml"
+# 22607 "parsing/parser.ml"
in
-# 1612 "parsing/parser.mly"
+# 1626 "parsing/parser.mly"
( _1 )
-# 22668 "parsing/parser.ml"
+# 22613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 22710 "parsing/parser.ml"
+# 22655 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 22715 "parsing/parser.ml"
+# 22660 "parsing/parser.ml"
in
-# 1606 "parsing/parser.mly"
+# 1620 "parsing/parser.mly"
( Pmty_with(_1, _3) )
-# 22721 "parsing/parser.ml"
+# 22666 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 928 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22731 "parsing/parser.ml"
+# 22676 "parsing/parser.ml"
in
-# 1612 "parsing/parser.mly"
+# 1626 "parsing/parser.mly"
( _1 )
-# 22737 "parsing/parser.ml"
+# 22682 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1610 "parsing/parser.mly"
+# 1624 "parsing/parser.mly"
( Pmty_extension _1 )
-# 22763 "parsing/parser.ml"
+# 22708 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 928 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22771 "parsing/parser.ml"
+# 22716 "parsing/parser.ml"
in
-# 1612 "parsing/parser.mly"
+# 1626 "parsing/parser.mly"
( _1 )
-# 22777 "parsing/parser.ml"
+# 22722 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 22846 "parsing/parser.ml"
+# 22791 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22858 "parsing/parser.ml"
+# 22803 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22866 "parsing/parser.ml"
+# 22811 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1526 "parsing/parser.mly"
+# 1540 "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
)
-# 22880 "parsing/parser.ml"
+# 22825 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 22956 "parsing/parser.ml"
+# 22901 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22968 "parsing/parser.ml"
+# 22913 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 22976 "parsing/parser.ml"
+# 22921 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1786 "parsing/parser.mly"
+# 1800 "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
)
-# 22990 "parsing/parser.ml"
+# 22935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3613 "parsing/parser.mly"
+# 3631 "parsing/parser.mly"
( _1 )
-# 23015 "parsing/parser.ml"
+# 22960 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag) =
-# 3694 "parsing/parser.mly"
+# 3712 "parsing/parser.mly"
( Immutable )
-# 23033 "parsing/parser.ml"
+# 22978 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3695 "parsing/parser.mly"
+# 3713 "parsing/parser.mly"
( Mutable )
-# 23058 "parsing/parser.ml"
+# 23003 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3703 "parsing/parser.mly"
+# 3721 "parsing/parser.mly"
( Immutable, Concrete )
-# 23076 "parsing/parser.ml"
+# 23021 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3705 "parsing/parser.mly"
+# 3723 "parsing/parser.mly"
( Mutable, Concrete )
-# 23101 "parsing/parser.ml"
+# 23046 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3707 "parsing/parser.mly"
+# 3725 "parsing/parser.mly"
( Immutable, Virtual )
-# 23126 "parsing/parser.ml"
+# 23071 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3710 "parsing/parser.mly"
+# 3728 "parsing/parser.mly"
( Mutable, Virtual )
-# 23158 "parsing/parser.ml"
+# 23103 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3710 "parsing/parser.mly"
+# 3728 "parsing/parser.mly"
( Mutable, Virtual )
-# 23190 "parsing/parser.ml"
+# 23135 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3665 "parsing/parser.mly"
+# 3683 "parsing/parser.mly"
( _2 )
-# 23222 "parsing/parser.ml"
+# 23167 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 23243 "parsing/parser.ml"
+# 23188 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23255 "parsing/parser.ml"
+# 23200 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 23261 "parsing/parser.ml"
+# 23206 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 23289 "parsing/parser.ml"
+# 23234 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23301 "parsing/parser.ml"
+# 23246 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 23307 "parsing/parser.ml"
+# 23252 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let s : (
# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 23328 "parsing/parser.ml"
+# 23273 "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 =
-# 3661 "parsing/parser.mly"
+# 3679 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 23336 "parsing/parser.ml"
+# 23281 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 23341 "parsing/parser.ml"
+# 23286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let s : (
# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 23369 "parsing/parser.ml"
+# 23314 "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 =
-# 3661 "parsing/parser.mly"
+# 3679 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 23377 "parsing/parser.ml"
+# 23322 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 23382 "parsing/parser.ml"
+# 23327 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23407 "parsing/parser.ml"
+# 23352 "parsing/parser.ml"
in
-# 2981 "parsing/parser.mly"
+# 2994 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 23412 "parsing/parser.ml"
+# 23357 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23444 "parsing/parser.ml"
+# 23389 "parsing/parser.ml"
in
-# 2981 "parsing/parser.mly"
+# 2994 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 23449 "parsing/parser.ml"
+# 23394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_cs_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23474 "parsing/parser.ml"
+# 23419 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23480 "parsing/parser.ml"
+# 23425 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23485 "parsing/parser.ml"
+# 23430 "parsing/parser.ml"
in
-# 2985 "parsing/parser.mly"
+# 2998 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23491 "parsing/parser.ml"
+# 23436 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23523 "parsing/parser.ml"
+# 23468 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23529 "parsing/parser.ml"
+# 23474 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23534 "parsing/parser.ml"
+# 23479 "parsing/parser.ml"
in
-# 2985 "parsing/parser.mly"
+# 2998 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23540 "parsing/parser.ml"
+# 23485 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23579 "parsing/parser.ml"
+# 23524 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23586 "parsing/parser.ml"
+# 23531 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23591 "parsing/parser.ml"
+# 23536 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23597 "parsing/parser.ml"
+# 23542 "parsing/parser.ml"
in
-# 2985 "parsing/parser.mly"
+# 2998 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23603 "parsing/parser.ml"
+# 23548 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23649 "parsing/parser.ml"
+# 23594 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23656 "parsing/parser.ml"
+# 23601 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23661 "parsing/parser.ml"
+# 23606 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23667 "parsing/parser.ml"
+# 23612 "parsing/parser.ml"
in
-# 2985 "parsing/parser.mly"
+# 2998 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23673 "parsing/parser.ml"
+# 23618 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23698 "parsing/parser.ml"
+# 23643 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23704 "parsing/parser.ml"
+# 23649 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23709 "parsing/parser.ml"
+# 23654 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3002 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23715 "parsing/parser.ml"
+# 23660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23747 "parsing/parser.ml"
+# 23692 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23753 "parsing/parser.ml"
+# 23698 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23758 "parsing/parser.ml"
+# 23703 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3002 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23764 "parsing/parser.ml"
+# 23709 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23803 "parsing/parser.ml"
+# 23748 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23810 "parsing/parser.ml"
+# 23755 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23815 "parsing/parser.ml"
+# 23760 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23821 "parsing/parser.ml"
+# 23766 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3002 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23827 "parsing/parser.ml"
+# 23772 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23873 "parsing/parser.ml"
+# 23818 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23880 "parsing/parser.ml"
+# 23825 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23885 "parsing/parser.ml"
+# 23830 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23891 "parsing/parser.ml"
+# 23836 "parsing/parser.ml"
in
-# 2989 "parsing/parser.mly"
+# 3002 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23897 "parsing/parser.ml"
+# 23842 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 23936 "parsing/parser.ml"
+# 23881 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23942 "parsing/parser.ml"
+# 23887 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 23947 "parsing/parser.ml"
+# 23892 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3006 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23953 "parsing/parser.ml"
+# 23898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 23999 "parsing/parser.ml"
+# 23944 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 24005 "parsing/parser.ml"
+# 23950 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 24010 "parsing/parser.ml"
+# 23955 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3006 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 24016 "parsing/parser.ml"
+# 23961 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 24069 "parsing/parser.ml"
+# 24014 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 24076 "parsing/parser.ml"
+# 24021 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 24081 "parsing/parser.ml"
+# 24026 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 24087 "parsing/parser.ml"
+# 24032 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3006 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 24093 "parsing/parser.ml"
+# 24038 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 24153 "parsing/parser.ml"
+# 24098 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 24160 "parsing/parser.ml"
+# 24105 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 24165 "parsing/parser.ml"
+# 24110 "parsing/parser.ml"
in
-# 2997 "parsing/parser.mly"
+# 3010 "parsing/parser.mly"
( _1 )
-# 24171 "parsing/parser.ml"
+# 24116 "parsing/parser.ml"
in
-# 2993 "parsing/parser.mly"
+# 3006 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 24177 "parsing/parser.ml"
+# 24122 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 24232 "parsing/parser.ml"
+# 24177 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 24241 "parsing/parser.ml"
+# 24186 "parsing/parser.ml"
in
let override =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 24247 "parsing/parser.ml"
+# 24192 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1545 "parsing/parser.mly"
+# 1559 "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
)
-# 24260 "parsing/parser.ml"
+# 24205 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 24322 "parsing/parser.ml"
+# 24267 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 24331 "parsing/parser.ml"
+# 24276 "parsing/parser.ml"
in
- let override =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let override =
+# 3756 "parsing/parser.mly"
( Override )
-# 24339 "parsing/parser.ml"
-
- in
+# 24282 "parsing/parser.ml"
+ in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1545 "parsing/parser.mly"
+# 1559 "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
)
-# 24353 "parsing/parser.ml"
+# 24295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 24408 "parsing/parser.ml"
+# 24350 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 24420 "parsing/parser.ml"
+# 24362 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 24428 "parsing/parser.ml"
+# 24370 "parsing/parser.ml"
in
let override =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 24434 "parsing/parser.ml"
+# 24376 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1560 "parsing/parser.mly"
+# 1574 "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
)
-# 24447 "parsing/parser.ml"
+# 24389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 24509 "parsing/parser.ml"
+# 24451 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 24521 "parsing/parser.ml"
+# 24463 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined2 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 24529 "parsing/parser.ml"
+# 24471 "parsing/parser.ml"
in
- let override =
- let _1 = _1_inlined1 in
-
-# 3738 "parsing/parser.mly"
+ let override =
+# 3756 "parsing/parser.mly"
( Override )
-# 24537 "parsing/parser.ml"
-
- in
+# 24477 "parsing/parser.ml"
+ in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1560 "parsing/parser.mly"
+# 1574 "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
)
-# 24551 "parsing/parser.ml"
+# 24490 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 729 "parsing/parser.mly"
(string)
-# 24572 "parsing/parser.ml"
+# 24511 "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) =
-# 3529 "parsing/parser.mly"
+# 3547 "parsing/parser.mly"
( _1 )
-# 24580 "parsing/parser.ml"
+# 24519 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 687 "parsing/parser.mly"
(string)
-# 24601 "parsing/parser.ml"
+# 24540 "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) =
-# 3530 "parsing/parser.mly"
+# 3548 "parsing/parser.mly"
( _1 )
-# 24609 "parsing/parser.ml"
+# 24548 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 688 "parsing/parser.mly"
(string)
-# 24630 "parsing/parser.ml"
+# 24569 "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) =
-# 3531 "parsing/parser.mly"
+# 3549 "parsing/parser.mly"
( _1 )
-# 24638 "parsing/parser.ml"
+# 24577 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24680 "parsing/parser.ml"
+# 24619 "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 : (Asttypes.label) =
-# 3532 "parsing/parser.mly"
+# 3550 "parsing/parser.mly"
( "."^ _1 ^"(" ^ _3 ^ ")" )
-# 24688 "parsing/parser.ml"
+# 24627 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24737 "parsing/parser.ml"
+# 24676 "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 : (Asttypes.label) =
-# 3533 "parsing/parser.mly"
+# 3551 "parsing/parser.mly"
( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
-# 24745 "parsing/parser.ml"
+# 24684 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24787 "parsing/parser.ml"
+# 24726 "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 : (Asttypes.label) =
-# 3534 "parsing/parser.mly"
+# 3552 "parsing/parser.mly"
( "."^ _1 ^"[" ^ _3 ^ "]" )
-# 24795 "parsing/parser.ml"
+# 24734 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24844 "parsing/parser.ml"
+# 24783 "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 : (Asttypes.label) =
-# 3535 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
-# 24852 "parsing/parser.ml"
+# 24791 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24894 "parsing/parser.ml"
+# 24833 "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 : (Asttypes.label) =
-# 3536 "parsing/parser.mly"
+# 3554 "parsing/parser.mly"
( "."^ _1 ^"{" ^ _3 ^ "}" )
-# 24902 "parsing/parser.ml"
+# 24841 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 686 "parsing/parser.mly"
(string)
-# 24951 "parsing/parser.ml"
+# 24890 "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 : (Asttypes.label) =
-# 3537 "parsing/parser.mly"
+# 3555 "parsing/parser.mly"
( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
-# 24959 "parsing/parser.ml"
+# 24898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 740 "parsing/parser.mly"
(string)
-# 24980 "parsing/parser.ml"
+# 24919 "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) =
-# 3538 "parsing/parser.mly"
+# 3556 "parsing/parser.mly"
( _1 )
-# 24988 "parsing/parser.ml"
+# 24927 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3539 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
( "!" )
-# 25013 "parsing/parser.ml"
+# 24952 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 681 "parsing/parser.mly"
(string)
-# 25034 "parsing/parser.ml"
+# 24973 "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 : (Asttypes.label) = let _1 =
-# 3543 "parsing/parser.mly"
+# 3561 "parsing/parser.mly"
( op )
-# 25042 "parsing/parser.ml"
+# 24981 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25047 "parsing/parser.ml"
+# 24986 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 682 "parsing/parser.mly"
(string)
-# 25068 "parsing/parser.ml"
+# 25007 "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 : (Asttypes.label) = let _1 =
-# 3544 "parsing/parser.mly"
+# 3562 "parsing/parser.mly"
( op )
-# 25076 "parsing/parser.ml"
+# 25015 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25081 "parsing/parser.ml"
+# 25020 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 683 "parsing/parser.mly"
(string)
-# 25102 "parsing/parser.ml"
+# 25041 "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 : (Asttypes.label) = let _1 =
-# 3545 "parsing/parser.mly"
+# 3563 "parsing/parser.mly"
( op )
-# 25110 "parsing/parser.ml"
+# 25049 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25115 "parsing/parser.ml"
+# 25054 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 684 "parsing/parser.mly"
(string)
-# 25136 "parsing/parser.ml"
+# 25075 "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 : (Asttypes.label) = let _1 =
-# 3546 "parsing/parser.mly"
+# 3564 "parsing/parser.mly"
( op )
-# 25144 "parsing/parser.ml"
+# 25083 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25149 "parsing/parser.ml"
+# 25088 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let op : (
# 685 "parsing/parser.mly"
(string)
-# 25170 "parsing/parser.ml"
+# 25109 "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 : (Asttypes.label) = let _1 =
-# 3547 "parsing/parser.mly"
+# 3565 "parsing/parser.mly"
( op )
-# 25178 "parsing/parser.ml"
+# 25117 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25183 "parsing/parser.ml"
+# 25122 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3548 "parsing/parser.mly"
+# 3566 "parsing/parser.mly"
("+")
-# 25208 "parsing/parser.ml"
+# 25147 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25213 "parsing/parser.ml"
+# 25152 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3549 "parsing/parser.mly"
+# 3567 "parsing/parser.mly"
("+.")
-# 25238 "parsing/parser.ml"
+# 25177 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25243 "parsing/parser.ml"
+# 25182 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3550 "parsing/parser.mly"
+# 3568 "parsing/parser.mly"
("+=")
-# 25268 "parsing/parser.ml"
+# 25207 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25273 "parsing/parser.ml"
+# 25212 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3551 "parsing/parser.mly"
+# 3569 "parsing/parser.mly"
("-")
-# 25298 "parsing/parser.ml"
+# 25237 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25303 "parsing/parser.ml"
+# 25242 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3552 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
("-.")
-# 25328 "parsing/parser.ml"
+# 25267 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25333 "parsing/parser.ml"
+# 25272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3553 "parsing/parser.mly"
+# 3571 "parsing/parser.mly"
("*")
-# 25358 "parsing/parser.ml"
+# 25297 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25363 "parsing/parser.ml"
+# 25302 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3554 "parsing/parser.mly"
+# 3572 "parsing/parser.mly"
("%")
-# 25388 "parsing/parser.ml"
+# 25327 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25393 "parsing/parser.ml"
+# 25332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3555 "parsing/parser.mly"
+# 3573 "parsing/parser.mly"
("=")
-# 25418 "parsing/parser.ml"
+# 25357 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25423 "parsing/parser.ml"
+# 25362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3556 "parsing/parser.mly"
+# 3574 "parsing/parser.mly"
("<")
-# 25448 "parsing/parser.ml"
+# 25387 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25453 "parsing/parser.ml"
+# 25392 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3557 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
(">")
-# 25478 "parsing/parser.ml"
+# 25417 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25483 "parsing/parser.ml"
+# 25422 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3558 "parsing/parser.mly"
+# 3576 "parsing/parser.mly"
("or")
-# 25508 "parsing/parser.ml"
+# 25447 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25513 "parsing/parser.ml"
+# 25452 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3559 "parsing/parser.mly"
+# 3577 "parsing/parser.mly"
("||")
-# 25538 "parsing/parser.ml"
+# 25477 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25543 "parsing/parser.ml"
+# 25482 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3560 "parsing/parser.mly"
+# 3578 "parsing/parser.mly"
("&")
-# 25568 "parsing/parser.ml"
+# 25507 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25573 "parsing/parser.ml"
+# 25512 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3561 "parsing/parser.mly"
+# 3579 "parsing/parser.mly"
("&&")
-# 25598 "parsing/parser.ml"
+# 25537 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25603 "parsing/parser.ml"
+# 25542 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3562 "parsing/parser.mly"
+# 3580 "parsing/parser.mly"
(":=")
-# 25628 "parsing/parser.ml"
+# 25567 "parsing/parser.ml"
in
-# 3540 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
( _1 )
-# 25633 "parsing/parser.ml"
+# 25572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (bool) =
-# 3444 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( true )
-# 25658 "parsing/parser.ml"
+# 25597 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (bool) =
-# 3445 "parsing/parser.mly"
+# 3463 "parsing/parser.mly"
( false )
-# 25676 "parsing/parser.ml"
+# 25615 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25694 "parsing/parser.ml"
+# 25633 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25719 "parsing/parser.ml"
+# 25658 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25737 "parsing/parser.ml"
+# 25676 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25762 "parsing/parser.ml"
+# 25701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (string Asttypes.loc option) =
# 114 "<standard.mly>"
( None )
-# 25780 "parsing/parser.ml"
+# 25719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 25807 "parsing/parser.ml"
+# 25746 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 25822 "parsing/parser.ml"
+# 25761 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 25828 "parsing/parser.ml"
+# 25767 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25834 "parsing/parser.ml"
+# 25773 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) =
# 114 "<standard.mly>"
( None )
-# 25852 "parsing/parser.ml"
+# 25791 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25884 "parsing/parser.ml"
+# 25823 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25889 "parsing/parser.ml"
+# 25828 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 25907 "parsing/parser.ml"
+# 25846 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 25939 "parsing/parser.ml"
+# 25878 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25944 "parsing/parser.ml"
+# 25883 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) =
# 114 "<standard.mly>"
( None )
-# 25962 "parsing/parser.ml"
+# 25901 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25994 "parsing/parser.ml"
+# 25933 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25999 "parsing/parser.ml"
+# 25938 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) =
# 114 "<standard.mly>"
( None )
-# 26017 "parsing/parser.ml"
+# 25956 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) = let x =
# 183 "<standard.mly>"
( x )
-# 26049 "parsing/parser.ml"
+# 25988 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 26054 "parsing/parser.ml"
+# 25993 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 26072 "parsing/parser.ml"
+# 26011 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 26104 "parsing/parser.ml"
+# 26043 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 26109 "parsing/parser.ml"
+# 26048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 114 "<standard.mly>"
( None )
-# 26127 "parsing/parser.ml"
+# 26066 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 116 "<standard.mly>"
( Some x )
-# 26152 "parsing/parser.ml"
+# 26091 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 722 "parsing/parser.mly"
(string)
-# 26173 "parsing/parser.ml"
+# 26112 "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) =
-# 3749 "parsing/parser.mly"
+# 3767 "parsing/parser.mly"
( _1 )
-# 26181 "parsing/parser.ml"
+# 26120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 705 "parsing/parser.mly"
(string)
-# 26215 "parsing/parser.ml"
+# 26154 "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) =
-# 3750 "parsing/parser.mly"
+# 3768 "parsing/parser.mly"
( _2 )
-# 26224 "parsing/parser.ml"
+# 26163 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1324 "parsing/parser.mly"
+# 1338 "parsing/parser.mly"
( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 26280 "parsing/parser.ml"
+# 26219 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1326 "parsing/parser.mly"
+# 1340 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 26335 "parsing/parser.ml"
+# 26274 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) =
-# 1329 "parsing/parser.mly"
+# 1343 "parsing/parser.mly"
( me (* TODO consider reloc *) )
-# 26374 "parsing/parser.ml"
+# 26313 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1331 "parsing/parser.mly"
+# 1345 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 26415 "parsing/parser.ml"
+# 26354 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
-# 1348 "parsing/parser.mly"
+# 1362 "parsing/parser.mly"
( e )
-# 26468 "parsing/parser.ml"
+# 26407 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26475 "parsing/parser.ml"
+# 26414 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1335 "parsing/parser.mly"
+# 1349 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26484 "parsing/parser.ml"
+# 26423 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
- let (_endpos__1_, _startpos__1_, _1, _2) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2, _2_inlined1) in
+ let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let ty =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26559 "parsing/parser.ml"
+# 26498 "parsing/parser.ml"
in
let _endpos_ty_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1350 "parsing/parser.mly"
+# 1364 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 26569 "parsing/parser.ml"
+# 26508 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26577 "parsing/parser.ml"
+# 26516 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1335 "parsing/parser.mly"
+# 1349 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26586 "parsing/parser.ml"
+# 26525 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
- let (_endpos__1_inlined1_, _startpos__1_inlined1_, _endpos__1_, _startpos__1_, _1_inlined1, _1, _2) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2, _2_inlined1) in
+ let (_endpos__1_inlined1_, _startpos__1_inlined1_, _endpos__1_, _startpos__1_, _1_inlined1, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2) in
let ty2 =
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
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26676 "parsing/parser.ml"
+# 26615 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26689 "parsing/parser.ml"
+# 26628 "parsing/parser.ml"
in
let _endpos = _endpos_ty2_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1352 "parsing/parser.mly"
+# 1366 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 26698 "parsing/parser.ml"
+# 26637 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26706 "parsing/parser.ml"
+# 26645 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1335 "parsing/parser.mly"
+# 1349 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26715 "parsing/parser.ml"
+# 26654 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
- let (_endpos__1_, _startpos__1_, _1, _2) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2, _2_inlined1) in
+ let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let ty2 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26790 "parsing/parser.ml"
+# 26729 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1354 "parsing/parser.mly"
+# 1368 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 26800 "parsing/parser.ml"
+# 26739 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26808 "parsing/parser.ml"
+# 26747 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1335 "parsing/parser.mly"
+# 1349 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26817 "parsing/parser.ml"
+# 26756 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26879 "parsing/parser.ml"
+# 26818 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1337 "parsing/parser.mly"
+# 1351 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26887 "parsing/parser.ml"
+# 26826 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 26949 "parsing/parser.ml"
+# 26888 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1339 "parsing/parser.mly"
+# 1353 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26957 "parsing/parser.ml"
+# 26896 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 27012 "parsing/parser.ml"
+# 26951 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1341 "parsing/parser.mly"
+# 1355 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 27020 "parsing/parser.ml"
+# 26959 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1243 "parsing/parser.mly"
+# 1257 "parsing/parser.mly"
( _1 )
-# 27052 "parsing/parser.ml"
+# 26991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1228 "parsing/parser.mly"
+# 1242 "parsing/parser.mly"
( _1 )
-# 27084 "parsing/parser.ml"
+# 27023 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 1203 "parsing/parser.mly"
+# 1217 "parsing/parser.mly"
( _1 )
-# 27116 "parsing/parser.ml"
+# 27055 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 1208 "parsing/parser.mly"
+# 1222 "parsing/parser.mly"
( _1 )
-# 27148 "parsing/parser.ml"
+# 27087 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1233 "parsing/parser.mly"
+# 1247 "parsing/parser.mly"
( _1 )
-# 27180 "parsing/parser.ml"
+# 27119 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1238 "parsing/parser.mly"
+# 1252 "parsing/parser.mly"
+ ( _1 )
+# 27151 "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 : (Parsetree.module_expr) = 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.module_expr) =
+# 1212 "parsing/parser.mly"
+ ( _1 )
+# 27183 "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 : (Parsetree.module_type) = 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.module_type) =
+# 1207 "parsing/parser.mly"
( _1 )
-# 27212 "parsing/parser.ml"
+# 27215 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1218 "parsing/parser.mly"
+# 1232 "parsing/parser.mly"
( _1 )
-# 27244 "parsing/parser.ml"
+# 27247 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) =
-# 1213 "parsing/parser.mly"
+# 1227 "parsing/parser.mly"
( _1 )
-# 27276 "parsing/parser.ml"
+# 27279 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Longident.t) =
-# 1223 "parsing/parser.mly"
+# 1237 "parsing/parser.mly"
( _1 )
-# 27308 "parsing/parser.ml"
+# 27311 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2710 "parsing/parser.mly"
+# 2723 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 27352 "parsing/parser.ml"
+# 27355 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27358 "parsing/parser.ml"
+# 27361 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2712 "parsing/parser.mly"
+# 2725 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 27390 "parsing/parser.ml"
+# 27393 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27395 "parsing/parser.ml"
+# 27398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2714 "parsing/parser.mly"
+# 2727 "parsing/parser.mly"
( _1 )
-# 27420 "parsing/parser.ml"
+# 27423 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27425 "parsing/parser.ml"
+# 27428 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27472 "parsing/parser.ml"
+# 27475 "parsing/parser.ml"
in
-# 2717 "parsing/parser.mly"
+# 2730 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 27478 "parsing/parser.ml"
+# 27481 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27488 "parsing/parser.ml"
+# 27491 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27494 "parsing/parser.ml"
+# 27497 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27500 "parsing/parser.ml"
+# 27503 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2719 "parsing/parser.mly"
+# 2732 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 27543 "parsing/parser.ml"
+# 27546 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27553 "parsing/parser.ml"
+# 27556 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27559 "parsing/parser.ml"
+# 27562 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27565 "parsing/parser.ml"
+# 27568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2721 "parsing/parser.mly"
+# 2734 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 27592 "parsing/parser.ml"
+# 27595 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27600 "parsing/parser.ml"
+# 27603 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27606 "parsing/parser.ml"
+# 27609 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27612 "parsing/parser.ml"
+# 27615 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2723 "parsing/parser.mly"
+# 2736 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27655 "parsing/parser.ml"
+# 27658 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27665 "parsing/parser.ml"
+# 27668 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27671 "parsing/parser.ml"
+# 27674 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27677 "parsing/parser.ml"
+# 27680 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2725 "parsing/parser.mly"
+# 2738 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 27718 "parsing/parser.ml"
+# 27721 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27727 "parsing/parser.ml"
+# 27730 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27733 "parsing/parser.ml"
+# 27736 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27739 "parsing/parser.ml"
+# 27742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2727 "parsing/parser.mly"
+# 2740 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27782 "parsing/parser.ml"
+# 27785 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27792 "parsing/parser.ml"
+# 27795 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 27798 "parsing/parser.ml"
+# 27801 "parsing/parser.ml"
in
-# 2698 "parsing/parser.mly"
+# 2711 "parsing/parser.mly"
( _1 )
-# 27804 "parsing/parser.ml"
+# 27807 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 27854 "parsing/parser.ml"
+# 27857 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 27860 "parsing/parser.ml"
+# 27863 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2700 "parsing/parser.mly"
+# 2713 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 27869 "parsing/parser.ml"
+# 27872 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2827 "parsing/parser.mly"
+# 2840 "parsing/parser.mly"
( _3 :: _1 )
-# 27908 "parsing/parser.ml"
+# 27911 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2828 "parsing/parser.mly"
+# 2841 "parsing/parser.mly"
( [_3; _1] )
-# 27947 "parsing/parser.ml"
+# 27950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2829 "parsing/parser.mly"
+# 2842 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27987 "parsing/parser.ml"
+# 27990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2827 "parsing/parser.mly"
+# 2840 "parsing/parser.mly"
( _3 :: _1 )
-# 28026 "parsing/parser.ml"
+# 28029 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2828 "parsing/parser.mly"
+# 2841 "parsing/parser.mly"
( [_3; _1] )
-# 28065 "parsing/parser.ml"
+# 28068 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2829 "parsing/parser.mly"
+# 2842 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28105 "parsing/parser.ml"
+# 28108 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2733 "parsing/parser.mly"
+# 2746 "parsing/parser.mly"
( _1 )
-# 28130 "parsing/parser.ml"
+# 28133 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28168 "parsing/parser.ml"
+# 28171 "parsing/parser.ml"
in
-# 2736 "parsing/parser.mly"
+# 2749 "parsing/parser.mly"
( Ppat_construct(_1, Some ([], _2)) )
-# 28174 "parsing/parser.ml"
+# 28177 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28184 "parsing/parser.ml"
+# 28187 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2755 "parsing/parser.mly"
( _1 )
-# 28190 "parsing/parser.ml"
+# 28193 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let newtypes =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 28252 "parsing/parser.ml"
+# 28255 "parsing/parser.ml"
in
let constr =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28261 "parsing/parser.ml"
+# 28264 "parsing/parser.ml"
in
-# 2739 "parsing/parser.mly"
+# 2752 "parsing/parser.mly"
( Ppat_construct(constr, Some (newtypes, pat)) )
-# 28267 "parsing/parser.ml"
+# 28270 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_pat_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28277 "parsing/parser.ml"
+# 28280 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2755 "parsing/parser.mly"
( _1 )
-# 28283 "parsing/parser.ml"
+# 28286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2741 "parsing/parser.mly"
+# 2754 "parsing/parser.mly"
( Ppat_variant(_1, Some _2) )
-# 28316 "parsing/parser.ml"
+# 28319 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28325 "parsing/parser.ml"
+# 28328 "parsing/parser.ml"
in
-# 2742 "parsing/parser.mly"
+# 2755 "parsing/parser.mly"
( _1 )
-# 28331 "parsing/parser.ml"
+# 28334 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 28381 "parsing/parser.ml"
+# 28384 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 28387 "parsing/parser.ml"
+# 28390 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2744 "parsing/parser.mly"
+# 2757 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 28396 "parsing/parser.ml"
+# 28399 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2710 "parsing/parser.mly"
+# 2723 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 28440 "parsing/parser.ml"
+# 28443 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28446 "parsing/parser.ml"
+# 28449 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2712 "parsing/parser.mly"
+# 2725 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 28478 "parsing/parser.ml"
+# 28481 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28483 "parsing/parser.ml"
+# 28486 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2714 "parsing/parser.mly"
+# 2727 "parsing/parser.mly"
( _1 )
-# 28508 "parsing/parser.ml"
+# 28511 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28513 "parsing/parser.ml"
+# 28516 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28560 "parsing/parser.ml"
+# 28563 "parsing/parser.ml"
in
-# 2717 "parsing/parser.mly"
+# 2730 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 28566 "parsing/parser.ml"
+# 28569 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28576 "parsing/parser.ml"
+# 28579 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28582 "parsing/parser.ml"
+# 28585 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28588 "parsing/parser.ml"
+# 28591 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2719 "parsing/parser.mly"
+# 2732 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 28631 "parsing/parser.ml"
+# 28634 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28641 "parsing/parser.ml"
+# 28644 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28647 "parsing/parser.ml"
+# 28650 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28653 "parsing/parser.ml"
+# 28656 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2721 "parsing/parser.mly"
+# 2734 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 28680 "parsing/parser.ml"
+# 28683 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28688 "parsing/parser.ml"
+# 28691 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28694 "parsing/parser.ml"
+# 28697 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28700 "parsing/parser.ml"
+# 28703 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2723 "parsing/parser.mly"
+# 2736 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28743 "parsing/parser.ml"
+# 28746 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28753 "parsing/parser.ml"
+# 28756 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28759 "parsing/parser.ml"
+# 28762 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28765 "parsing/parser.ml"
+# 28768 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2725 "parsing/parser.mly"
+# 2738 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 28806 "parsing/parser.ml"
+# 28809 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28815 "parsing/parser.ml"
+# 28818 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28821 "parsing/parser.ml"
+# 28824 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28827 "parsing/parser.ml"
+# 28830 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2727 "parsing/parser.mly"
+# 2740 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28870 "parsing/parser.ml"
+# 28873 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28880 "parsing/parser.ml"
+# 28883 "parsing/parser.ml"
in
-# 2728 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( _1 )
-# 28886 "parsing/parser.ml"
+# 28889 "parsing/parser.ml"
in
-# 2705 "parsing/parser.mly"
+# 2718 "parsing/parser.mly"
( _1 )
-# 28892 "parsing/parser.ml"
+# 28895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 28913 "parsing/parser.ml"
+# 28916 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28927 "parsing/parser.ml"
+# 28930 "parsing/parser.ml"
in
-# 2200 "parsing/parser.mly"
+# 2214 "parsing/parser.mly"
( Ppat_var _1 )
-# 28933 "parsing/parser.ml"
+# 28936 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28942 "parsing/parser.ml"
+# 28945 "parsing/parser.ml"
in
-# 2202 "parsing/parser.mly"
+# 2216 "parsing/parser.mly"
( _1 )
-# 28948 "parsing/parser.ml"
+# 28951 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2201 "parsing/parser.mly"
+# 2215 "parsing/parser.mly"
( Ppat_any )
-# 28974 "parsing/parser.ml"
+# 28977 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28982 "parsing/parser.ml"
+# 28985 "parsing/parser.ml"
in
-# 2202 "parsing/parser.mly"
+# 2216 "parsing/parser.mly"
( _1 )
-# 28988 "parsing/parser.ml"
+# 28991 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 3861 "parsing/parser.mly"
+# 3879 "parsing/parser.mly"
( PStr _1 )
-# 29013 "parsing/parser.ml"
+# 29016 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3862 "parsing/parser.mly"
+# 3880 "parsing/parser.mly"
( PSig _2 )
-# 29045 "parsing/parser.ml"
+# 29048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3863 "parsing/parser.mly"
+# 3881 "parsing/parser.mly"
( PTyp _2 )
-# 29077 "parsing/parser.ml"
+# 29080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3864 "parsing/parser.mly"
+# 3882 "parsing/parser.mly"
( PPat (_2, None) )
-# 29109 "parsing/parser.ml"
+# 29112 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.payload) =
-# 3865 "parsing/parser.mly"
+# 3883 "parsing/parser.mly"
( PPat (_2, Some _4) )
-# 29155 "parsing/parser.ml"
+# 29158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3258 "parsing/parser.mly"
+# 3276 "parsing/parser.mly"
( _1 )
-# 29180 "parsing/parser.ml"
+# 29183 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 29223 "parsing/parser.ml"
+# 29226 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 989 "parsing/parser.mly"
( xs )
-# 29228 "parsing/parser.ml"
+# 29231 "parsing/parser.ml"
in
-# 3250 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 29234 "parsing/parser.ml"
+# 29237 "parsing/parser.ml"
in
-# 3254 "parsing/parser.mly"
+# 3272 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 29240 "parsing/parser.ml"
+# 29243 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 29250 "parsing/parser.ml"
+# 29253 "parsing/parser.ml"
in
-# 3260 "parsing/parser.mly"
+# 3278 "parsing/parser.mly"
( _1 )
-# 29256 "parsing/parser.ml"
+# 29259 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 29281 "parsing/parser.ml"
+# 29284 "parsing/parser.ml"
in
-# 3258 "parsing/parser.mly"
+# 3276 "parsing/parser.mly"
( _1 )
-# 29286 "parsing/parser.ml"
+# 29289 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let _3 =
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 29327 "parsing/parser.ml"
+# 29330 "parsing/parser.ml"
in
let _1 =
let _1 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 29334 "parsing/parser.ml"
+# 29337 "parsing/parser.ml"
in
-# 985 "parsing/parser.mly"
+# 989 "parsing/parser.mly"
( xs )
-# 29339 "parsing/parser.ml"
+# 29342 "parsing/parser.ml"
in
-# 3250 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 29345 "parsing/parser.ml"
+# 29348 "parsing/parser.ml"
in
-# 3254 "parsing/parser.mly"
+# 3272 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 29351 "parsing/parser.ml"
+# 29354 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 29361 "parsing/parser.ml"
+# 29364 "parsing/parser.ml"
in
-# 3260 "parsing/parser.mly"
+# 3278 "parsing/parser.mly"
( _1 )
-# 29367 "parsing/parser.ml"
+# 29370 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3822 "parsing/parser.mly"
+# 3840 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 29416 "parsing/parser.ml"
+# 29419 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 29499 "parsing/parser.ml"
+# 29502 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 29511 "parsing/parser.ml"
+# 29514 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 29519 "parsing/parser.ml"
+# 29522 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2891 "parsing/parser.mly"
+# 2904 "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 )
-# 29532 "parsing/parser.ml"
+# 29535 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag) = let _1 =
-# 3690 "parsing/parser.mly"
+# 3708 "parsing/parser.mly"
( Public )
-# 29550 "parsing/parser.ml"
+# 29553 "parsing/parser.ml"
in
-# 3687 "parsing/parser.mly"
+# 3705 "parsing/parser.mly"
( _1 )
-# 29555 "parsing/parser.ml"
+# 29558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) = let _1 =
-# 3691 "parsing/parser.mly"
+# 3709 "parsing/parser.mly"
( Private )
-# 29580 "parsing/parser.ml"
+# 29583 "parsing/parser.ml"
in
-# 3687 "parsing/parser.mly"
+# 3705 "parsing/parser.mly"
( _1 )
-# 29585 "parsing/parser.ml"
+# 29588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3713 "parsing/parser.mly"
+# 3731 "parsing/parser.mly"
( Public, Concrete )
-# 29603 "parsing/parser.ml"
+# 29606 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3714 "parsing/parser.mly"
+# 3732 "parsing/parser.mly"
( Private, Concrete )
-# 29628 "parsing/parser.ml"
+# 29631 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3715 "parsing/parser.mly"
+# 3733 "parsing/parser.mly"
( Public, Virtual )
-# 29653 "parsing/parser.ml"
+# 29656 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3716 "parsing/parser.mly"
+# 3734 "parsing/parser.mly"
( Private, Virtual )
-# 29685 "parsing/parser.ml"
+# 29688 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3717 "parsing/parser.mly"
+# 3735 "parsing/parser.mly"
( Private, Virtual )
-# 29717 "parsing/parser.ml"
+# 29720 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.rec_flag) =
-# 3668 "parsing/parser.mly"
+# 3686 "parsing/parser.mly"
( Nonrecursive )
-# 29735 "parsing/parser.ml"
+# 29738 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.rec_flag) =
-# 3669 "parsing/parser.mly"
+# 3687 "parsing/parser.mly"
( Recursive )
-# 29760 "parsing/parser.ml"
+# 29763 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
(Longident.t Asttypes.loc * Parsetree.expression) list) = let eo =
# 124 "<standard.mly>"
( None )
-# 29786 "parsing/parser.ml"
+# 29789 "parsing/parser.ml"
in
-# 2630 "parsing/parser.mly"
+# 2643 "parsing/parser.mly"
( eo, fields )
-# 29791 "parsing/parser.ml"
+# 29794 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x =
# 191 "<standard.mly>"
( x )
-# 29832 "parsing/parser.ml"
+# 29835 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 29837 "parsing/parser.ml"
+# 29840 "parsing/parser.ml"
in
-# 2630 "parsing/parser.mly"
+# 2643 "parsing/parser.mly"
( eo, fields )
-# 29843 "parsing/parser.ml"
+# 29846 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3076 "parsing/parser.mly"
+# 3089 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Type.constructor cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 29873 "parsing/parser.ml"
+# 29876 "parsing/parser.ml"
in
-# 1095 "parsing/parser.mly"
+# 1099 "parsing/parser.mly"
( [x] )
-# 29878 "parsing/parser.ml"
+# 29881 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3076 "parsing/parser.mly"
+# 3089 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Type.constructor cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 29908 "parsing/parser.ml"
+# 29911 "parsing/parser.ml"
in
-# 1098 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( [x] )
-# 29913 "parsing/parser.ml"
+# 29916 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let xs : (Parsetree.constructor_declaration list) = Obj.magic xs in
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 3076 "parsing/parser.mly"
+# 3089 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Type.constructor cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 29950 "parsing/parser.ml"
+# 29953 "parsing/parser.ml"
in
-# 1102 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( x :: xs )
-# 29955 "parsing/parser.ml"
+# 29958 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 29986 "parsing/parser.ml"
+# 29989 "parsing/parser.ml"
in
-# 3182 "parsing/parser.mly"
+# 3200 "parsing/parser.mly"
( _1 )
-# 29991 "parsing/parser.ml"
+# 29994 "parsing/parser.ml"
in
-# 1095 "parsing/parser.mly"
+# 1099 "parsing/parser.mly"
( [x] )
-# 29997 "parsing/parser.ml"
+# 30000 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3184 "parsing/parser.mly"
+# 3202 "parsing/parser.mly"
( _1 )
-# 30022 "parsing/parser.ml"
+# 30025 "parsing/parser.ml"
in
-# 1095 "parsing/parser.mly"
+# 1099 "parsing/parser.mly"
( [x] )
-# 30027 "parsing/parser.ml"
+# 30030 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 30058 "parsing/parser.ml"
+# 30061 "parsing/parser.ml"
in
-# 3182 "parsing/parser.mly"
+# 3200 "parsing/parser.mly"
( _1 )
-# 30063 "parsing/parser.ml"
+# 30066 "parsing/parser.ml"
in
-# 1098 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( [x] )
-# 30069 "parsing/parser.ml"
+# 30072 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3184 "parsing/parser.mly"
+# 3202 "parsing/parser.mly"
( _1 )
-# 30094 "parsing/parser.ml"
+# 30097 "parsing/parser.ml"
in
-# 1098 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( [x] )
-# 30099 "parsing/parser.ml"
+# 30102 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 30137 "parsing/parser.ml"
+# 30140 "parsing/parser.ml"
in
-# 3182 "parsing/parser.mly"
+# 3200 "parsing/parser.mly"
( _1 )
-# 30142 "parsing/parser.ml"
+# 30145 "parsing/parser.ml"
in
-# 1102 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( x :: xs )
-# 30148 "parsing/parser.ml"
+# 30151 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3184 "parsing/parser.mly"
+# 3202 "parsing/parser.mly"
( _1 )
-# 30180 "parsing/parser.ml"
+# 30183 "parsing/parser.ml"
in
-# 1102 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( x :: xs )
-# 30185 "parsing/parser.ml"
+# 30188 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 30215 "parsing/parser.ml"
+# 30218 "parsing/parser.ml"
in
-# 1095 "parsing/parser.mly"
+# 1099 "parsing/parser.mly"
( [x] )
-# 30220 "parsing/parser.ml"
+# 30223 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 30250 "parsing/parser.ml"
+# 30253 "parsing/parser.ml"
in
-# 1098 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( [x] )
-# 30255 "parsing/parser.ml"
+# 30258 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
};
} = _menhir_stack in
- let d : (Ast_helper.str * Parsetree.constructor_arguments *
+ let d : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
Parsetree.core_type option * Parsetree.attributes * Location.t *
Docstrings.info) = Obj.magic d in
let xs : (Parsetree.extension_constructor list) = Obj.magic xs in
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3188 "parsing/parser.mly"
+# 3206 "parsing/parser.mly"
(
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
)
-# 30292 "parsing/parser.ml"
+# 30295 "parsing/parser.ml"
in
-# 1102 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( x :: xs )
-# 30297 "parsing/parser.ml"
+# 30300 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) =
-# 961 "parsing/parser.mly"
+# 965 "parsing/parser.mly"
( [] )
-# 30315 "parsing/parser.ml"
+# 30318 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2080 "parsing/parser.mly"
+# 2094 "parsing/parser.mly"
( _1, _3, make_loc _sloc )
-# 30374 "parsing/parser.ml"
+# 30377 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 30380 "parsing/parser.ml"
+# 30383 "parsing/parser.ml"
in
-# 963 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( x :: xs )
-# 30386 "parsing/parser.ml"
+# 30389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( [ x ] )
-# 30411 "parsing/parser.ml"
+# 30414 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 977 "parsing/parser.mly"
+# 981 "parsing/parser.mly"
( x :: xs )
-# 30443 "parsing/parser.ml"
+# 30446 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( [ x ] )
-# 30468 "parsing/parser.ml"
+# 30471 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 977 "parsing/parser.mly"
+# 981 "parsing/parser.mly"
( x :: xs )
-# 30500 "parsing/parser.ml"
+# 30503 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( [ x ] )
-# 30525 "parsing/parser.ml"
+# 30528 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 977 "parsing/parser.mly"
+# 981 "parsing/parser.mly"
( x :: xs )
-# 30557 "parsing/parser.ml"
+# 30560 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30595 "parsing/parser.ml"
+# 30598 "parsing/parser.ml"
in
-# 3246 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _2 )
-# 30601 "parsing/parser.ml"
+# 30604 "parsing/parser.ml"
in
-# 975 "parsing/parser.mly"
+# 979 "parsing/parser.mly"
( [ x ] )
-# 30607 "parsing/parser.ml"
+# 30610 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30652 "parsing/parser.ml"
+# 30655 "parsing/parser.ml"
in
-# 3246 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _2 )
-# 30658 "parsing/parser.ml"
+# 30661 "parsing/parser.ml"
in
-# 977 "parsing/parser.mly"
+# 981 "parsing/parser.mly"
( x :: xs )
-# 30664 "parsing/parser.ml"
+# 30667 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.case list) = let _1 =
# 124 "<standard.mly>"
( None )
-# 30689 "parsing/parser.ml"
+# 30692 "parsing/parser.ml"
in
-# 1066 "parsing/parser.mly"
+# 1070 "parsing/parser.mly"
( [x] )
-# 30694 "parsing/parser.ml"
+# 30697 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 30728 "parsing/parser.ml"
+# 30731 "parsing/parser.ml"
in
-# 1066 "parsing/parser.mly"
+# 1070 "parsing/parser.mly"
( [x] )
-# 30734 "parsing/parser.ml"
+# 30737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.case list) =
-# 1070 "parsing/parser.mly"
+# 1074 "parsing/parser.mly"
( x :: xs )
-# 30773 "parsing/parser.ml"
+# 30776 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 30799 "parsing/parser.ml"
+# 30802 "parsing/parser.ml"
in
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 30804 "parsing/parser.ml"
+# 30807 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 30810 "parsing/parser.ml"
+# 30813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 30850 "parsing/parser.ml"
+# 30853 "parsing/parser.ml"
in
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 30855 "parsing/parser.ml"
+# 30858 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 30861 "parsing/parser.ml"
+# 30864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 30886 "parsing/parser.ml"
+# 30889 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 30891 "parsing/parser.ml"
+# 30894 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 30930 "parsing/parser.ml"
+# 30933 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 30935 "parsing/parser.ml"
+# 30938 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 30960 "parsing/parser.ml"
+# 30963 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 30965 "parsing/parser.ml"
+# 30968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 31004 "parsing/parser.ml"
+# 31007 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31009 "parsing/parser.ml"
+# 31012 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 31034 "parsing/parser.ml"
+# 31037 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31039 "parsing/parser.ml"
+# 31042 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 31078 "parsing/parser.ml"
+# 31081 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31083 "parsing/parser.ml"
+# 31086 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 31108 "parsing/parser.ml"
+# 31111 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31113 "parsing/parser.ml"
+# 31116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 31152 "parsing/parser.ml"
+# 31155 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31157 "parsing/parser.ml"
+# 31160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1001 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( [ x ] )
-# 31182 "parsing/parser.ml"
+# 31185 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31187 "parsing/parser.ml"
+# 31190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 1005 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( x :: xs )
-# 31226 "parsing/parser.ml"
+# 31229 "parsing/parser.ml"
in
-# 1009 "parsing/parser.mly"
+# 1013 "parsing/parser.mly"
( xs )
-# 31231 "parsing/parser.ml"
+# 31234 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 31270 "parsing/parser.ml"
+# 31273 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( [ x2; x1 ] )
-# 31309 "parsing/parser.ml"
+# 31312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.expression list) =
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 31348 "parsing/parser.ml"
+# 31351 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.expression list) =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( [ x2; x1 ] )
-# 31387 "parsing/parser.ml"
+# 31390 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 1032 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( x :: xs )
-# 31426 "parsing/parser.ml"
+# 31429 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 1036 "parsing/parser.mly"
+# 1040 "parsing/parser.mly"
( [ x2; x1 ] )
-# 31465 "parsing/parser.ml"
+# 31468 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.row_field) =
-# 3429 "parsing/parser.mly"
+# 3447 "parsing/parser.mly"
( _1 )
-# 31490 "parsing/parser.ml"
+# 31493 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3431 "parsing/parser.mly"
+# 3449 "parsing/parser.mly"
( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 31518 "parsing/parser.ml"
+# 31521 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31543 "parsing/parser.ml"
+# 31546 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31548 "parsing/parser.ml"
+# 31551 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31582 "parsing/parser.ml"
+# 31585 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31588 "parsing/parser.ml"
+# 31591 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.expression list) =
-# 1057 "parsing/parser.mly"
+# 1061 "parsing/parser.mly"
( x :: xs )
-# 31627 "parsing/parser.ml"
+# 31630 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 31655 "parsing/parser.ml"
+# 31658 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31663 "parsing/parser.ml"
+# 31666 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 31670 "parsing/parser.ml"
+# 31673 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31678 "parsing/parser.ml"
+# 31681 "parsing/parser.ml"
in
- let _startpos_label_ = _startpos__1_ in
- let _endpos = _endpos_oe_ in
- let _symbolstartpos = _startpos_label_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2653 "parsing/parser.mly"
- ( let e =
+# 2666 "parsing/parser.mly"
+ ( let label, e =
match oe with
| None ->
(* No expression; this is a pun. Desugar it. *)
- exp_of_label ~loc:_sloc label
+ make_ghost label, exp_of_label label
| Some e ->
- e
+ label, e
in
label, e )
-# 31696 "parsing/parser.ml"
+# 31695 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31702 "parsing/parser.ml"
+# 31701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 31737 "parsing/parser.ml"
+# 31736 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 31745 "parsing/parser.ml"
+# 31744 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 31752 "parsing/parser.ml"
+# 31751 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31760 "parsing/parser.ml"
+# 31759 "parsing/parser.ml"
in
- let _startpos_label_ = _startpos__1_ in
- let _endpos = _endpos_oe_ in
- let _symbolstartpos = _startpos_label_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2653 "parsing/parser.mly"
- ( let e =
+# 2666 "parsing/parser.mly"
+ ( let label, e =
match oe with
| None ->
(* No expression; this is a pun. Desugar it. *)
- exp_of_label ~loc:_sloc label
+ make_ghost label, exp_of_label label
| Some e ->
- e
+ label, e
in
label, e )
-# 31778 "parsing/parser.ml"
+# 31773 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31784 "parsing/parser.ml"
+# 31779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 31826 "parsing/parser.ml"
+# 31821 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x =
let label =
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 31836 "parsing/parser.ml"
+# 31831 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31844 "parsing/parser.ml"
+# 31839 "parsing/parser.ml"
in
- let _startpos_label_ = _startpos__1_ in
- let _endpos = _endpos_oe_ in
- let _symbolstartpos = _startpos_label_ in
- let _sloc = (_symbolstartpos, _endpos) in
-# 2653 "parsing/parser.mly"
- ( let e =
+# 2666 "parsing/parser.mly"
+ ( let label, e =
match oe with
| None ->
(* No expression; this is a pun. Desugar it. *)
- exp_of_label ~loc:_sloc label
+ make_ghost label, exp_of_label label
| Some e ->
- e
+ label, e
in
label, e )
-# 31862 "parsing/parser.ml"
+# 31853 "parsing/parser.ml"
in
-# 1057 "parsing/parser.mly"
+# 1061 "parsing/parser.mly"
( x :: xs )
-# 31868 "parsing/parser.ml"
+# 31859 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31893 "parsing/parser.ml"
+# 31884 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31898 "parsing/parser.ml"
+# 31889 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31932 "parsing/parser.ml"
+# 31923 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 31938 "parsing/parser.ml"
+# 31929 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.pattern list) =
-# 1057 "parsing/parser.mly"
+# 1061 "parsing/parser.mly"
( x :: xs )
-# 31977 "parsing/parser.ml"
+# 31968 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 32016 "parsing/parser.ml"
+# 32007 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32026 "parsing/parser.ml"
+# 32017 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2636 "parsing/parser.mly"
- ( let e =
+# 2649 "parsing/parser.mly"
+ ( let constraint_loc, label, e =
match eo with
| None ->
(* No pattern; this is a pun. Desugar it. *)
- exp_of_longident ~loc:_sloc label
+ _sloc, make_ghost label, exp_of_longident label
| Some e ->
- e
+ (_startpos_c_, _endpos), label, e
in
- label, mkexp_opt_constraint ~loc:_sloc e c )
-# 32044 "parsing/parser.ml"
+ label, mkexp_opt_constraint ~loc:constraint_loc e c )
+# 32035 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 32050 "parsing/parser.ml"
+# 32041 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 32096 "parsing/parser.ml"
+# 32087 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32106 "parsing/parser.ml"
+# 32097 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2636 "parsing/parser.mly"
- ( let e =
+# 2649 "parsing/parser.mly"
+ ( let constraint_loc, label, e =
match eo with
| None ->
(* No pattern; this is a pun. Desugar it. *)
- exp_of_longident ~loc:_sloc label
+ _sloc, make_ghost label, exp_of_longident label
| Some e ->
- e
+ (_startpos_c_, _endpos), label, e
in
- label, mkexp_opt_constraint ~loc:_sloc e c )
-# 32124 "parsing/parser.ml"
+ label, mkexp_opt_constraint ~loc:constraint_loc e c )
+# 32115 "parsing/parser.ml"
in
-# 1053 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( [x] )
-# 32130 "parsing/parser.ml"
+# 32121 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32188 "parsing/parser.ml"
+# 32179 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2636 "parsing/parser.mly"
- ( let e =
+# 2649 "parsing/parser.mly"
+ ( let constraint_loc, label, e =
match eo with
| None ->
(* No pattern; this is a pun. Desugar it. *)
- exp_of_longident ~loc:_sloc label
+ _sloc, make_ghost label, exp_of_longident label
| Some e ->
- e
+ (_startpos_c_, _endpos), label, e
in
- label, mkexp_opt_constraint ~loc:_sloc e c )
-# 32206 "parsing/parser.ml"
+ label, mkexp_opt_constraint ~loc:constraint_loc e c )
+# 32197 "parsing/parser.ml"
in
-# 1057 "parsing/parser.mly"
+# 1061 "parsing/parser.mly"
( x :: xs )
-# 32212 "parsing/parser.ml"
+# 32203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2169 "parsing/parser.mly"
+# 2183 "parsing/parser.mly"
( _1 )
-# 32237 "parsing/parser.ml"
+# 32228 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2170 "parsing/parser.mly"
+# 2184 "parsing/parser.mly"
( _1 )
-# 32269 "parsing/parser.ml"
+# 32260 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2172 "parsing/parser.mly"
+# 2186 "parsing/parser.mly"
( Pexp_sequence(_1, _3) )
-# 32309 "parsing/parser.ml"
+# 32300 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 32318 "parsing/parser.ml"
+# 32309 "parsing/parser.ml"
in
-# 2173 "parsing/parser.mly"
+# 2187 "parsing/parser.mly"
( _1 )
-# 32324 "parsing/parser.ml"
+# 32315 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2175 "parsing/parser.mly"
+# 2189 "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)) )
-# 32382 "parsing/parser.ml"
+# 32373 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = args_res;
- MenhirLib.EngineTypes.startp = _startpos_args_res_;
- MenhirLib.EngineTypes.endp = _endpos_args_res_;
+ MenhirLib.EngineTypes.semv = vars_args_res;
+ MenhirLib.EngineTypes.startp = _startpos_vars_args_res_;
+ MenhirLib.EngineTypes.endp = _endpos_vars_args_res_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _1_inlined2;
} = _menhir_stack in
let _1_inlined4 : (Parsetree.attributes) = Obj.magic _1_inlined4 in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
- let args_res : (Parsetree.constructor_arguments * Parsetree.core_type option) = Obj.magic args_res in
+ let vars_args_res : (Ast_helper.str list * Parsetree.constructor_arguments *
+ Parsetree.core_type option) = Obj.magic vars_args_res in
let _1_inlined2 : (Asttypes.label) = 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 _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 32451 "parsing/parser.ml"
+# 32443 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined4_ in
let attrs2 =
let _1 = _1_inlined3 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 32460 "parsing/parser.ml"
+# 32452 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32472 "parsing/parser.ml"
+# 32464 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 32480 "parsing/parser.ml"
+# 32472 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3106 "parsing/parser.mly"
- ( let args, res = args_res in
+# 3119 "parsing/parser.mly"
+ ( let vars, args, res = vars_args_res in
let loc = make_loc (_startpos, _endpos_attrs2_) in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
- (Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+ (Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 32495 "parsing/parser.ml"
+# 32487 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 32521 "parsing/parser.ml"
+# 32513 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 876 "parsing/parser.mly"
+# 880 "parsing/parser.mly"
( extra_sig _startpos _endpos _1 )
-# 32529 "parsing/parser.ml"
+# 32521 "parsing/parser.ml"
in
-# 1618 "parsing/parser.mly"
+# 1632 "parsing/parser.mly"
( _1 )
-# 32535 "parsing/parser.ml"
+# 32527 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item) = let _2 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 32569 "parsing/parser.ml"
+# 32561 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1633 "parsing/parser.mly"
+# 1647 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 32580 "parsing/parser.ml"
+# 32572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1637 "parsing/parser.mly"
+# 1651 "parsing/parser.mly"
( Psig_attribute _1 )
-# 32606 "parsing/parser.ml"
+# 32598 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 924 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mksig ~loc:_sloc _1 )
-# 32614 "parsing/parser.ml"
+# 32606 "parsing/parser.ml"
in
-# 1639 "parsing/parser.mly"
+# 1653 "parsing/parser.mly"
( _1 )
-# 32620 "parsing/parser.ml"
+# 32612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1642 "parsing/parser.mly"
+# 1656 "parsing/parser.mly"
( psig_value _1 )
-# 32646 "parsing/parser.ml"
+# 32638 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32654 "parsing/parser.ml"
+# 32646 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 32660 "parsing/parser.ml"
+# 32652 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1644 "parsing/parser.mly"
+# 1658 "parsing/parser.mly"
( psig_value _1 )
-# 32686 "parsing/parser.ml"
+# 32678 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32694 "parsing/parser.ml"
+# 32686 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 32700 "parsing/parser.ml"
+# 32692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32737 "parsing/parser.ml"
+# 32729 "parsing/parser.ml"
in
-# 2927 "parsing/parser.mly"
+# 2940 "parsing/parser.mly"
( _1 )
-# 32742 "parsing/parser.ml"
+# 32734 "parsing/parser.ml"
in
-# 2910 "parsing/parser.mly"
+# 2923 "parsing/parser.mly"
( _1 )
-# 32748 "parsing/parser.ml"
+# 32740 "parsing/parser.ml"
in
-# 1646 "parsing/parser.mly"
+# 1660 "parsing/parser.mly"
( psig_type _1 )
-# 32754 "parsing/parser.ml"
+# 32746 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32764 "parsing/parser.ml"
+# 32756 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 32770 "parsing/parser.ml"
+# 32762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32807 "parsing/parser.ml"
+# 32799 "parsing/parser.ml"
in
-# 2927 "parsing/parser.mly"
+# 2940 "parsing/parser.mly"
( _1 )
-# 32812 "parsing/parser.ml"
+# 32804 "parsing/parser.ml"
in
-# 2915 "parsing/parser.mly"
+# 2928 "parsing/parser.mly"
( _1 )
-# 32818 "parsing/parser.ml"
+# 32810 "parsing/parser.ml"
in
-# 1648 "parsing/parser.mly"
+# 1662 "parsing/parser.mly"
( psig_typesubst _1 )
-# 32824 "parsing/parser.ml"
+# 32816 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32834 "parsing/parser.ml"
+# 32826 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 32840 "parsing/parser.ml"
+# 32832 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 32927 "parsing/parser.ml"
+# 32919 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( List.rev xs )
-# 32934 "parsing/parser.ml"
+# 32926 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32944 "parsing/parser.ml"
+# 32936 "parsing/parser.ml"
in
let _4 =
-# 3676 "parsing/parser.mly"
+# 3694 "parsing/parser.mly"
( Recursive )
-# 32950 "parsing/parser.ml"
+# 32942 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 32957 "parsing/parser.ml"
+# 32949 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3175 "parsing/parser.mly"
+# 3193 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 32969 "parsing/parser.ml"
+# 32961 "parsing/parser.ml"
in
-# 3162 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 32975 "parsing/parser.ml"
+# 32967 "parsing/parser.ml"
in
-# 1650 "parsing/parser.mly"
+# 1664 "parsing/parser.mly"
( psig_typext _1 )
-# 32981 "parsing/parser.ml"
+# 32973 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32991 "parsing/parser.ml"
+# 32983 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 32997 "parsing/parser.ml"
+# 32989 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33091 "parsing/parser.ml"
+# 33083 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( List.rev xs )
-# 33098 "parsing/parser.ml"
+# 33090 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33108 "parsing/parser.ml"
+# 33100 "parsing/parser.ml"
in
let _4 =
- let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3678 "parsing/parser.mly"
+# 3696 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 33119 "parsing/parser.ml"
+# 33111 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 33127 "parsing/parser.ml"
+# 33119 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3175 "parsing/parser.mly"
+# 3193 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 33139 "parsing/parser.ml"
+# 33131 "parsing/parser.ml"
in
-# 3162 "parsing/parser.mly"
+# 3180 "parsing/parser.mly"
( _1 )
-# 33145 "parsing/parser.ml"
+# 33137 "parsing/parser.ml"
in
-# 1650 "parsing/parser.mly"
+# 1664 "parsing/parser.mly"
( psig_typext _1 )
-# 33151 "parsing/parser.ml"
+# 33143 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33161 "parsing/parser.ml"
+# 33153 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33167 "parsing/parser.ml"
+# 33159 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1652 "parsing/parser.mly"
+# 1666 "parsing/parser.mly"
( psig_exception _1 )
-# 33193 "parsing/parser.ml"
+# 33185 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33201 "parsing/parser.ml"
+# 33193 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33207 "parsing/parser.ml"
+# 33199 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33272 "parsing/parser.ml"
+# 33264 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33284 "parsing/parser.ml"
+# 33276 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 33292 "parsing/parser.ml"
+# 33284 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1683 "parsing/parser.mly"
+# 1697 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 33306 "parsing/parser.ml"
+# 33298 "parsing/parser.ml"
in
-# 1654 "parsing/parser.mly"
+# 1668 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 33312 "parsing/parser.ml"
+# 33304 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33322 "parsing/parser.ml"
+# 33314 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33328 "parsing/parser.ml"
+# 33320 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33400 "parsing/parser.ml"
+# 33392 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33413 "parsing/parser.ml"
+# 33405 "parsing/parser.ml"
in
let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
let _symbolstartpos = _startpos_id_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1720 "parsing/parser.mly"
+# 1734 "parsing/parser.mly"
( Mty.alias ~loc:(make_loc _sloc) id )
-# 33423 "parsing/parser.ml"
+# 33415 "parsing/parser.ml"
in
let name =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33434 "parsing/parser.ml"
+# 33426 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 33442 "parsing/parser.ml"
+# 33434 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1711 "parsing/parser.mly"
+# 1725 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 33456 "parsing/parser.ml"
+# 33448 "parsing/parser.ml"
in
-# 1656 "parsing/parser.mly"
+# 1670 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 33462 "parsing/parser.ml"
+# 33454 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33472 "parsing/parser.ml"
+# 33464 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33478 "parsing/parser.ml"
+# 33470 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1658 "parsing/parser.mly"
+# 1672 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 33504 "parsing/parser.ml"
+# 33496 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33512 "parsing/parser.ml"
+# 33504 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33518 "parsing/parser.ml"
+# 33510 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33606 "parsing/parser.ml"
+# 33598 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33618 "parsing/parser.ml"
+# 33610 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 33626 "parsing/parser.ml"
+# 33618 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1754 "parsing/parser.mly"
+# 1768 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
ext, Md.mk name mty ~attrs ~loc ~docs
)
-# 33640 "parsing/parser.ml"
+# 33632 "parsing/parser.ml"
in
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 33646 "parsing/parser.ml"
+# 33638 "parsing/parser.ml"
in
-# 1743 "parsing/parser.mly"
+# 1757 "parsing/parser.mly"
( _1 )
-# 33652 "parsing/parser.ml"
+# 33644 "parsing/parser.ml"
in
-# 1660 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 33658 "parsing/parser.ml"
+# 33650 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33668 "parsing/parser.ml"
+# 33660 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33674 "parsing/parser.ml"
+# 33666 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1662 "parsing/parser.mly"
+# 1676 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 33700 "parsing/parser.ml"
+# 33692 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33708 "parsing/parser.ml"
+# 33700 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33714 "parsing/parser.ml"
+# 33706 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1664 "parsing/parser.mly"
+# 1678 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modtypesubst body, ext) )
-# 33740 "parsing/parser.ml"
+# 33732 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33748 "parsing/parser.ml"
+# 33740 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33754 "parsing/parser.ml"
+# 33746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1666 "parsing/parser.mly"
+# 1680 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_open body, ext) )
-# 33780 "parsing/parser.ml"
+# 33772 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33788 "parsing/parser.ml"
+# 33780 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33794 "parsing/parser.ml"
+# 33786 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33852 "parsing/parser.ml"
+# 33844 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 33861 "parsing/parser.ml"
+# 33853 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1510 "parsing/parser.mly"
+# 1524 "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
)
-# 33875 "parsing/parser.ml"
+# 33867 "parsing/parser.ml"
in
-# 1668 "parsing/parser.mly"
+# 1682 "parsing/parser.mly"
( psig_include _1 )
-# 33881 "parsing/parser.ml"
+# 33873 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33891 "parsing/parser.ml"
+# 33883 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 33897 "parsing/parser.ml"
+# 33889 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 33976 "parsing/parser.ml"
+# 33968 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 33996 "parsing/parser.ml"
+# 33988 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 34008 "parsing/parser.ml"
+# 34000 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 34016 "parsing/parser.ml"
+# 34008 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2101 "parsing/parser.mly"
+# 2115 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
)
-# 34031 "parsing/parser.ml"
+# 34023 "parsing/parser.ml"
in
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 34037 "parsing/parser.ml"
+# 34029 "parsing/parser.ml"
in
-# 2089 "parsing/parser.mly"
+# 2103 "parsing/parser.mly"
( _1 )
-# 34043 "parsing/parser.ml"
+# 34035 "parsing/parser.ml"
in
-# 1670 "parsing/parser.mly"
+# 1684 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class l, ext) )
-# 34049 "parsing/parser.ml"
+# 34041 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 34059 "parsing/parser.ml"
+# 34051 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 34065 "parsing/parser.ml"
+# 34057 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1672 "parsing/parser.mly"
+# 1686 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 34091 "parsing/parser.ml"
+# 34083 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 941 "parsing/parser.mly"
+# 945 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 34099 "parsing/parser.ml"
+# 34091 "parsing/parser.ml"
in
-# 1674 "parsing/parser.mly"
+# 1688 "parsing/parser.mly"
( _1 )
-# 34105 "parsing/parser.ml"
+# 34097 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3505 "parsing/parser.mly"
+# 3523 "parsing/parser.mly"
( _1 )
-# 34130 "parsing/parser.ml"
+# 34122 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 691 "parsing/parser.mly"
(string * char option)
-# 34157 "parsing/parser.ml"
+# 34149 "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) =
-# 3506 "parsing/parser.mly"
+# 3524 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 34166 "parsing/parser.ml"
+# 34158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 670 "parsing/parser.mly"
(string * char option)
-# 34193 "parsing/parser.ml"
+# 34185 "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) =
-# 3507 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 34202 "parsing/parser.ml"
+# 34194 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 691 "parsing/parser.mly"
(string * char option)
-# 34229 "parsing/parser.ml"
+# 34221 "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) =
-# 3508 "parsing/parser.mly"
+# 3526 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer (n, m) )
-# 34238 "parsing/parser.ml"
+# 34230 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 670 "parsing/parser.mly"
(string * char option)
-# 34265 "parsing/parser.ml"
+# 34257 "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) =
-# 3509 "parsing/parser.mly"
+# 3527 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float(f, m) )
-# 34274 "parsing/parser.ml"
+# 34266 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2839 "parsing/parser.mly"
+# 2852 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 34319 "parsing/parser.ml"
+# 34311 "parsing/parser.ml"
in
-# 2810 "parsing/parser.mly"
+# 2823 "parsing/parser.mly"
( let (fields, closed) = _2 in
Ppat_record(fields, closed) )
-# 34326 "parsing/parser.ml"
+# 34318 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34336 "parsing/parser.ml"
+# 34328 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34342 "parsing/parser.ml"
+# 34334 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2839 "parsing/parser.mly"
+# 2852 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 34387 "parsing/parser.ml"
+# 34379 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2813 "parsing/parser.mly"
+# 2826 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 34395 "parsing/parser.ml"
+# 34387 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34405 "parsing/parser.ml"
+# 34397 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34411 "parsing/parser.ml"
+# 34403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2833 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( ps )
-# 34452 "parsing/parser.ml"
+# 34444 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2815 "parsing/parser.mly"
+# 2828 "parsing/parser.mly"
( fst (mktailpat _loc__3_ _2) )
-# 34458 "parsing/parser.ml"
+# 34450 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34468 "parsing/parser.ml"
+# 34460 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34474 "parsing/parser.ml"
+# 34466 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2833 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( ps )
-# 34515 "parsing/parser.ml"
+# 34507 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2817 "parsing/parser.mly"
+# 2830 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 34522 "parsing/parser.ml"
+# 34514 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34532 "parsing/parser.ml"
+# 34524 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34538 "parsing/parser.ml"
+# 34530 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2833 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( ps )
-# 34579 "parsing/parser.ml"
+# 34571 "parsing/parser.ml"
in
-# 2819 "parsing/parser.mly"
+# 2832 "parsing/parser.mly"
( Ppat_array _2 )
-# 34584 "parsing/parser.ml"
+# 34576 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34594 "parsing/parser.ml"
+# 34586 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34600 "parsing/parser.ml"
+# 34592 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2821 "parsing/parser.mly"
+# 2834 "parsing/parser.mly"
( Ppat_array [] )
-# 34633 "parsing/parser.ml"
+# 34625 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34642 "parsing/parser.ml"
+# 34634 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34648 "parsing/parser.ml"
+# 34640 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2833 "parsing/parser.mly"
+# 2846 "parsing/parser.mly"
( ps )
-# 34689 "parsing/parser.ml"
+# 34681 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2823 "parsing/parser.mly"
+# 2836 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 34696 "parsing/parser.ml"
+# 34688 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34706 "parsing/parser.ml"
+# 34698 "parsing/parser.ml"
in
-# 2824 "parsing/parser.mly"
+# 2837 "parsing/parser.mly"
( _1 )
-# 34712 "parsing/parser.ml"
+# 34704 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2341 "parsing/parser.mly"
+# 2351 "parsing/parser.mly"
( reloc_exp ~loc:_sloc _2 )
-# 34754 "parsing/parser.ml"
+# 34746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2343 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 34795 "parsing/parser.ml"
+# 34787 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2345 "parsing/parser.mly"
+# 2355 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _2 _3 )
-# 34844 "parsing/parser.ml"
+# 34836 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2346 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( None )
-# 34898 "parsing/parser.ml"
+# 34890 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 34903 "parsing/parser.ml"
+# 34895 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2347 "parsing/parser.mly"
+# 2357 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 34913 "parsing/parser.ml"
+# 34905 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2346 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( None )
-# 34967 "parsing/parser.ml"
+# 34959 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 34972 "parsing/parser.ml"
+# 34964 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2347 "parsing/parser.mly"
+# 2357 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 34982 "parsing/parser.ml"
+# 34974 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2346 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( None )
-# 35036 "parsing/parser.ml"
+# 35028 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 35041 "parsing/parser.ml"
+# 35033 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2347 "parsing/parser.mly"
+# 2357 "parsing/parser.mly"
( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 35051 "parsing/parser.ml"
+# 35043 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35099 "parsing/parser.ml"
+# 35091 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35109 "parsing/parser.ml"
+# 35101 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35114 "parsing/parser.ml"
+# 35106 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 35120 "parsing/parser.ml"
+# 35112 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35125 "parsing/parser.ml"
+# 35117 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 35131 "parsing/parser.ml"
+# 35123 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35141 "parsing/parser.ml"
+# 35133 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35201 "parsing/parser.ml"
+# 35193 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35213 "parsing/parser.ml"
+# 35205 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35218 "parsing/parser.ml"
+# 35210 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 35226 "parsing/parser.ml"
+# 35218 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 35231 "parsing/parser.ml"
+# 35223 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35237 "parsing/parser.ml"
+# 35229 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2245 "parsing/parser.mly"
( array, d, Paren, i, r )
-# 35243 "parsing/parser.ml"
+# 35235 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35253 "parsing/parser.ml"
+# 35245 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35301 "parsing/parser.ml"
+# 35293 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35311 "parsing/parser.ml"
+# 35303 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35316 "parsing/parser.ml"
+# 35308 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 35322 "parsing/parser.ml"
+# 35314 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35327 "parsing/parser.ml"
+# 35319 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 35333 "parsing/parser.ml"
+# 35325 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35343 "parsing/parser.ml"
+# 35335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35403 "parsing/parser.ml"
+# 35395 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35415 "parsing/parser.ml"
+# 35407 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35420 "parsing/parser.ml"
+# 35412 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 35428 "parsing/parser.ml"
+# 35420 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 35433 "parsing/parser.ml"
+# 35425 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35439 "parsing/parser.ml"
+# 35431 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2247 "parsing/parser.mly"
( array, d, Brace, i, r )
-# 35445 "parsing/parser.ml"
+# 35437 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35455 "parsing/parser.ml"
+# 35447 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35503 "parsing/parser.ml"
+# 35495 "parsing/parser.ml"
) = Obj.magic _2 in
let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35513 "parsing/parser.ml"
+# 35505 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35518 "parsing/parser.ml"
+# 35510 "parsing/parser.ml"
in
let d =
let _1 =
# 124 "<standard.mly>"
( None )
-# 35524 "parsing/parser.ml"
+# 35516 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35529 "parsing/parser.ml"
+# 35521 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 35535 "parsing/parser.ml"
+# 35527 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35545 "parsing/parser.ml"
+# 35537 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35605 "parsing/parser.ml"
+# 35597 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _1 =
let r =
-# 2348 "parsing/parser.mly"
+# 2358 "parsing/parser.mly"
( None )
-# 35617 "parsing/parser.ml"
+# 35609 "parsing/parser.ml"
in
let i =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35622 "parsing/parser.ml"
+# 35614 "parsing/parser.ml"
in
let d =
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 35630 "parsing/parser.ml"
+# 35622 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 35635 "parsing/parser.ml"
+# 35627 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35641 "parsing/parser.ml"
+# 35633 "parsing/parser.ml"
in
-# 2235 "parsing/parser.mly"
+# 2249 "parsing/parser.mly"
( array, d, Bracket, i, r )
-# 35647 "parsing/parser.ml"
+# 35639 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2349 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 35657 "parsing/parser.ml"
+# 35649 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2240 "parsing/parser.mly"
+# 2254 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
-# 35713 "parsing/parser.ml"
+# 35705 "parsing/parser.ml"
in
-# 2350 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( _1 )
-# 35719 "parsing/parser.ml"
+# 35711 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2242 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 35775 "parsing/parser.ml"
+# 35767 "parsing/parser.ml"
in
-# 2350 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( _1 )
-# 35781 "parsing/parser.ml"
+# 35773 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2244 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 35837 "parsing/parser.ml"
+# 35829 "parsing/parser.ml"
in
-# 2350 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( _1 )
-# 35843 "parsing/parser.ml"
+# 35835 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35891 "parsing/parser.ml"
+# 35883 "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 _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35901 "parsing/parser.ml"
+# 35893 "parsing/parser.ml"
in
let _2 =
let _1 =
# 124 "<standard.mly>"
( None )
-# 35907 "parsing/parser.ml"
+# 35899 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 35912 "parsing/parser.ml"
+# 35904 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2240 "parsing/parser.mly"
+# 2254 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
-# 35920 "parsing/parser.ml"
+# 35912 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 35926 "parsing/parser.ml"
+# 35918 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 35986 "parsing/parser.ml"
+# 35978 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 35998 "parsing/parser.ml"
+# 35990 "parsing/parser.ml"
in
let _2 =
- let _1 = _1_inlined1 in
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 36007 "parsing/parser.ml"
+# 35998 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 36012 "parsing/parser.ml"
+# 36003 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 36018 "parsing/parser.ml"
+# 36009 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2240 "parsing/parser.mly"
+# 2254 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
-# 36026 "parsing/parser.ml"
+# 36017 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 36032 "parsing/parser.ml"
+# 36023 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 36080 "parsing/parser.ml"
+# 36071 "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 _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 36090 "parsing/parser.ml"
+# 36081 "parsing/parser.ml"
in
let _2 =
let _1 =
# 124 "<standard.mly>"
( None )
-# 36096 "parsing/parser.ml"
+# 36087 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 36101 "parsing/parser.ml"
+# 36092 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2242 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 36109 "parsing/parser.ml"
+# 36100 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 36115 "parsing/parser.ml"
+# 36106 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 36175 "parsing/parser.ml"
+# 36166 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 36187 "parsing/parser.ml"
+# 36178 "parsing/parser.ml"
in
let _2 =
- let _1 = _1_inlined1 in
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 36196 "parsing/parser.ml"
+# 36186 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 36201 "parsing/parser.ml"
+# 36191 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 36207 "parsing/parser.ml"
+# 36197 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2242 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 36215 "parsing/parser.ml"
+# 36205 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 36221 "parsing/parser.ml"
+# 36211 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 36269 "parsing/parser.ml"
+# 36259 "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 _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 36279 "parsing/parser.ml"
+# 36269 "parsing/parser.ml"
in
let _2 =
let _1 =
# 124 "<standard.mly>"
( None )
-# 36285 "parsing/parser.ml"
+# 36275 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 36290 "parsing/parser.ml"
+# 36280 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2244 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 36298 "parsing/parser.ml"
+# 36288 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 36304 "parsing/parser.ml"
+# 36294 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (
# 686 "parsing/parser.mly"
(string)
-# 36364 "parsing/parser.ml"
+# 36354 "parsing/parser.ml"
) = Obj.magic _2 in
let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _endpos = _endpos__e_ in
let _v : (Parsetree.expression) = let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 36376 "parsing/parser.ml"
+# 36366 "parsing/parser.ml"
in
let _2 =
- let _1 = _1_inlined1 in
let _1 =
let _2 = _2_inlined1 in
let x =
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
(_2)
-# 36385 "parsing/parser.ml"
+# 36374 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 36390 "parsing/parser.ml"
+# 36379 "parsing/parser.ml"
in
-# 2247 "parsing/parser.mly"
+# 2261 "parsing/parser.mly"
( _1, _2 )
-# 36396 "parsing/parser.ml"
+# 36385 "parsing/parser.ml"
in
let _loc__p_ = (_startpos__p_, _endpos__p_) in
let _loc__e_ = (_startpos__e_, _endpos__e_) in
-# 2244 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 36404 "parsing/parser.ml"
+# 36393 "parsing/parser.ml"
in
-# 2351 "parsing/parser.mly"
+# 2361 "parsing/parser.mly"
( _1 )
-# 36410 "parsing/parser.ml"
+# 36399 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36466 "parsing/parser.ml"
+# 36455 "parsing/parser.ml"
in
-# 2360 "parsing/parser.mly"
+# 2370 "parsing/parser.mly"
( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 36472 "parsing/parser.ml"
+# 36461 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36483 "parsing/parser.ml"
+# 36472 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36534 "parsing/parser.ml"
+# 36523 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 36540 "parsing/parser.ml"
+# 36529 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2362 "parsing/parser.mly"
+# 2372 "parsing/parser.mly"
( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 36549 "parsing/parser.ml"
+# 36538 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36560 "parsing/parser.ml"
+# 36549 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36618 "parsing/parser.ml"
+# 36607 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 36624 "parsing/parser.ml"
+# 36613 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2364 "parsing/parser.mly"
+# 2374 "parsing/parser.mly"
( unclosed "begin" _loc__1_ "end" _loc__4_ )
-# 36632 "parsing/parser.ml"
+# 36621 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36643 "parsing/parser.ml"
+# 36632 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36695 "parsing/parser.ml"
+# 36684 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36705 "parsing/parser.ml"
+# 36694 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 36711 "parsing/parser.ml"
+# 36700 "parsing/parser.ml"
in
-# 2366 "parsing/parser.mly"
+# 2376 "parsing/parser.mly"
( Pexp_new(_3), _2 )
-# 36717 "parsing/parser.ml"
+# 36706 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36728 "parsing/parser.ml"
+# 36717 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36793 "parsing/parser.ml"
+# 36782 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 36799 "parsing/parser.ml"
+# 36788 "parsing/parser.ml"
in
-# 2368 "parsing/parser.mly"
+# 2378 "parsing/parser.mly"
( Pexp_pack _4, _3 )
-# 36805 "parsing/parser.ml"
+# 36794 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36816 "parsing/parser.ml"
+# 36805 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 36898 "parsing/parser.ml"
+# 36887 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 36908 "parsing/parser.ml"
+# 36897 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 36914 "parsing/parser.ml"
+# 36903 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2370 "parsing/parser.mly"
+# 2380 "parsing/parser.mly"
( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 36923 "parsing/parser.ml"
+# 36912 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36934 "parsing/parser.ml"
+# 36923 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 37006 "parsing/parser.ml"
+# 36995 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 37012 "parsing/parser.ml"
+# 37001 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2372 "parsing/parser.mly"
+# 2382 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 37020 "parsing/parser.ml"
+# 37009 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2353 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
+ ( let desc, attrs = _1 in
+ mkexp_attrs ~loc:_sloc desc attrs )
+# 37020 "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 = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = xss;
+ MenhirLib.EngineTypes.startp = _startpos_xss_;
+ MenhirLib.EngineTypes.endp = _endpos_xss_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined3;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined2;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _4 : unit = Obj.magic _4 in
+ let xss : (Parsetree.class_field list list) = Obj.magic xss in
+ let _1_inlined3 : (Parsetree.pattern) = 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 _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__4_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _3 =
+ let _1 = _1_inlined3 in
+ let _2 =
+ let _1 =
+ let _1 =
+# 260 "<standard.mly>"
+ ( List.flatten xss )
+# 37085 "parsing/parser.ml"
+ in
+
+# 1931 "parsing/parser.mly"
+ ( _1 )
+# 37090 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+ let _endpos = _endpos__1_ in
+ let _startpos = _startpos__1_ in
+
+# 881 "parsing/parser.mly"
+ ( extra_cstr _startpos _endpos _1 )
+# 37099 "parsing/parser.ml"
+
+ in
+
+# 1918 "parsing/parser.mly"
+ ( Cstr.mk _1 _2 )
+# 37105 "parsing/parser.ml"
+
+ in
+ let _2 =
+ let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+ let _2 =
+ let _1 = _1_inlined1 in
+
+# 3853 "parsing/parser.mly"
+ ( _1 )
+# 37115 "parsing/parser.ml"
+
+ in
+
+# 3866 "parsing/parser.mly"
+ ( _1, _2 )
+# 37121 "parsing/parser.ml"
+
+ in
+
+# 2384 "parsing/parser.mly"
+ ( Pexp_object _3, _2 )
+# 37127 "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
+
+# 2363 "parsing/parser.mly"
+ ( let desc, attrs = _1 in
+ mkexp_attrs ~loc:_sloc desc attrs )
+# 37138 "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 = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = xss;
+ MenhirLib.EngineTypes.startp = _startpos_xss_;
+ MenhirLib.EngineTypes.endp = _endpos_xss_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined3;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined2;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _4 : unit = Obj.magic _4 in
+ let xss : (Parsetree.class_field list list) = Obj.magic xss in
+ let _1_inlined3 : (Parsetree.pattern) = 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 _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__4_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _3 =
+ let _1 = _1_inlined3 in
+ let _2 =
+ let _1 =
+ let _1 =
+# 260 "<standard.mly>"
+ ( List.flatten xss )
+# 37203 "parsing/parser.ml"
+ in
+
+# 1931 "parsing/parser.mly"
+ ( _1 )
+# 37208 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+ let _endpos = _endpos__1_ in
+ let _startpos = _startpos__1_ in
+
+# 881 "parsing/parser.mly"
+ ( extra_cstr _startpos _endpos _1 )
+# 37217 "parsing/parser.ml"
+
+ in
+
+# 1918 "parsing/parser.mly"
+ ( Cstr.mk _1 _2 )
+# 37223 "parsing/parser.ml"
+
+ in
+ let _2 =
+ let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+ let _2 =
+ let _1 = _1_inlined1 in
+
+# 3853 "parsing/parser.mly"
+ ( _1 )
+# 37233 "parsing/parser.ml"
+
+ in
+
+# 3866 "parsing/parser.mly"
+ ( _1, _2 )
+# 37239 "parsing/parser.ml"
+
+ in
+ let _loc__4_ = (_startpos__4_, _endpos__4_) in
+ let _loc__1_ = (_startpos__1_, _endpos__1_) in
+
+# 2386 "parsing/parser.mly"
+ ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 37247 "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
+
+# 2363 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 37031 "parsing/parser.ml"
+# 37258 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37062 "parsing/parser.ml"
+# 37289 "parsing/parser.ml"
in
-# 2376 "parsing/parser.mly"
+# 2390 "parsing/parser.mly"
( Pexp_ident (_1) )
-# 37068 "parsing/parser.ml"
+# 37295 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37077 "parsing/parser.ml"
+# 37304 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37083 "parsing/parser.ml"
+# 37310 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2378 "parsing/parser.mly"
+# 2392 "parsing/parser.mly"
( Pexp_constant _1 )
-# 37109 "parsing/parser.ml"
+# 37336 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37117 "parsing/parser.ml"
+# 37344 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37123 "parsing/parser.ml"
+# 37350 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37154 "parsing/parser.ml"
+# 37381 "parsing/parser.ml"
in
-# 2380 "parsing/parser.mly"
+# 2394 "parsing/parser.mly"
( Pexp_construct(_1, None) )
-# 37160 "parsing/parser.ml"
+# 37387 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37169 "parsing/parser.ml"
+# 37396 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37175 "parsing/parser.ml"
+# 37402 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2382 "parsing/parser.mly"
+# 2396 "parsing/parser.mly"
( Pexp_variant(_1, None) )
-# 37201 "parsing/parser.ml"
+# 37428 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37209 "parsing/parser.ml"
+# 37436 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37215 "parsing/parser.ml"
+# 37442 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 729 "parsing/parser.mly"
(string)
-# 37243 "parsing/parser.ml"
+# 37470 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 37257 "parsing/parser.ml"
+# 37484 "parsing/parser.ml"
in
-# 2384 "parsing/parser.mly"
+# 2398 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 37263 "parsing/parser.ml"
+# 37490 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37273 "parsing/parser.ml"
+# 37500 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37279 "parsing/parser.ml"
+# 37506 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 2385 "parsing/parser.mly"
+# 2399 "parsing/parser.mly"
("!")
-# 37314 "parsing/parser.ml"
+# 37541 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 37322 "parsing/parser.ml"
+# 37549 "parsing/parser.ml"
in
-# 2386 "parsing/parser.mly"
+# 2400 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 37328 "parsing/parser.ml"
+# 37555 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37338 "parsing/parser.ml"
+# 37565 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37344 "parsing/parser.ml"
+# 37571 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2648 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( xs )
-# 37385 "parsing/parser.ml"
+# 37612 "parsing/parser.ml"
in
-# 2388 "parsing/parser.mly"
+# 2402 "parsing/parser.mly"
( Pexp_override _2 )
-# 37390 "parsing/parser.ml"
+# 37617 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37400 "parsing/parser.ml"
+# 37627 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37406 "parsing/parser.ml"
+# 37633 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2648 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( xs )
-# 37447 "parsing/parser.ml"
+# 37674 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2390 "parsing/parser.mly"
+# 2404 "parsing/parser.mly"
( unclosed "{<" _loc__1_ ">}" _loc__3_ )
-# 37454 "parsing/parser.ml"
+# 37681 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37464 "parsing/parser.ml"
+# 37691 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37470 "parsing/parser.ml"
+# 37697 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2392 "parsing/parser.mly"
+# 2406 "parsing/parser.mly"
( Pexp_override [] )
-# 37503 "parsing/parser.ml"
+# 37730 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37512 "parsing/parser.ml"
+# 37739 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37518 "parsing/parser.ml"
+# 37745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37564 "parsing/parser.ml"
+# 37791 "parsing/parser.ml"
in
-# 2394 "parsing/parser.mly"
+# 2408 "parsing/parser.mly"
( Pexp_field(_1, _3) )
-# 37570 "parsing/parser.ml"
+# 37797 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37580 "parsing/parser.ml"
+# 37807 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37586 "parsing/parser.ml"
+# 37813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37646 "parsing/parser.ml"
+# 37873 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37655 "parsing/parser.ml"
+# 37882 "parsing/parser.ml"
in
-# 2396 "parsing/parser.mly"
+# 2410 "parsing/parser.mly"
( Pexp_open(od, _4) )
-# 37661 "parsing/parser.ml"
+# 37888 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37671 "parsing/parser.ml"
+# 37898 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37677 "parsing/parser.ml"
+# 37904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2648 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( xs )
-# 37732 "parsing/parser.ml"
+# 37959 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37742 "parsing/parser.ml"
+# 37969 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37751 "parsing/parser.ml"
+# 37978 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2398 "parsing/parser.mly"
+# 2412 "parsing/parser.mly"
( (* TODO: review the location of Pexp_override *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 37762 "parsing/parser.ml"
+# 37989 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37772 "parsing/parser.ml"
+# 37999 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37778 "parsing/parser.ml"
+# 38005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2648 "parsing/parser.mly"
+# 2661 "parsing/parser.mly"
( xs )
-# 37833 "parsing/parser.ml"
+# 38060 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2401 "parsing/parser.mly"
+# 2415 "parsing/parser.mly"
( unclosed "{<" _loc__3_ ">}" _loc__5_ )
-# 37840 "parsing/parser.ml"
+# 38067 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37850 "parsing/parser.ml"
+# 38077 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37856 "parsing/parser.ml"
+# 38083 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 37889 "parsing/parser.ml"
+# 38116 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _3 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 37903 "parsing/parser.ml"
+# 38130 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37911 "parsing/parser.ml"
+# 38138 "parsing/parser.ml"
in
-# 2403 "parsing/parser.mly"
+# 2417 "parsing/parser.mly"
( Pexp_send(_1, _3) )
-# 37917 "parsing/parser.ml"
+# 38144 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37927 "parsing/parser.ml"
+# 38154 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 37933 "parsing/parser.ml"
+# 38160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 740 "parsing/parser.mly"
(string)
-# 37967 "parsing/parser.ml"
+# 38194 "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
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 910 "parsing/parser.mly"
+# 914 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 37983 "parsing/parser.ml"
+# 38210 "parsing/parser.ml"
in
-# 2405 "parsing/parser.mly"
+# 2419 "parsing/parser.mly"
( mkinfix _1 _2 _3 )
-# 37989 "parsing/parser.ml"
+# 38216 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37999 "parsing/parser.ml"
+# 38226 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38005 "parsing/parser.ml"
+# 38232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2407 "parsing/parser.mly"
+# 2421 "parsing/parser.mly"
( Pexp_extension _1 )
-# 38031 "parsing/parser.ml"
+# 38258 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38039 "parsing/parser.ml"
+# 38266 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38045 "parsing/parser.ml"
+# 38272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _3 =
- let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+ let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 2408 "parsing/parser.mly"
+# 2422 "parsing/parser.mly"
(Lident "()")
-# 38095 "parsing/parser.ml"
+# 38322 "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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38104 "parsing/parser.ml"
+# 38331 "parsing/parser.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38116 "parsing/parser.ml"
+# 38343 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38125 "parsing/parser.ml"
+# 38352 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2409 "parsing/parser.mly"
+# 2423 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
-# 38132 "parsing/parser.ml"
+# 38359 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38142 "parsing/parser.ml"
+# 38369 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38148 "parsing/parser.ml"
+# 38375 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2411 "parsing/parser.mly"
+# 2425 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 38205 "parsing/parser.ml"
+# 38432 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38215 "parsing/parser.ml"
+# 38442 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38221 "parsing/parser.ml"
+# 38448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2413 "parsing/parser.mly"
+# 2427 "parsing/parser.mly"
( let (exten, fields) = _2 in
Pexp_record(fields, exten) )
-# 38263 "parsing/parser.ml"
+# 38490 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38272 "parsing/parser.ml"
+# 38499 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38278 "parsing/parser.ml"
+# 38505 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2416 "parsing/parser.mly"
+# 2430 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 38322 "parsing/parser.ml"
+# 38549 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38332 "parsing/parser.ml"
+# 38559 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38338 "parsing/parser.ml"
+# 38565 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38399 "parsing/parser.ml"
+# 38626 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38408 "parsing/parser.ml"
+# 38635 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
-# 2418 "parsing/parser.mly"
+# 2432 "parsing/parser.mly"
( let (exten, fields) = _4 in
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos)
(Pexp_record(fields, exten))) )
-# 38417 "parsing/parser.ml"
+# 38644 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38427 "parsing/parser.ml"
+# 38654 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38433 "parsing/parser.ml"
+# 38660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2422 "parsing/parser.mly"
+# 2436 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 38491 "parsing/parser.ml"
+# 38718 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38501 "parsing/parser.ml"
+# 38728 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38507 "parsing/parser.ml"
+# 38734 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 38548 "parsing/parser.ml"
+# 38775 "parsing/parser.ml"
in
-# 2424 "parsing/parser.mly"
+# 2438 "parsing/parser.mly"
( Pexp_array(_2) )
-# 38553 "parsing/parser.ml"
+# 38780 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38563 "parsing/parser.ml"
+# 38790 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38569 "parsing/parser.ml"
+# 38796 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 38610 "parsing/parser.ml"
+# 38837 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2426 "parsing/parser.mly"
+# 2440 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 38617 "parsing/parser.ml"
+# 38844 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38627 "parsing/parser.ml"
+# 38854 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38633 "parsing/parser.ml"
+# 38860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2428 "parsing/parser.mly"
+# 2442 "parsing/parser.mly"
( Pexp_array [] )
-# 38666 "parsing/parser.ml"
+# 38893 "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
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38675 "parsing/parser.ml"
+# 38902 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38681 "parsing/parser.ml"
+# 38908 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 38736 "parsing/parser.ml"
+# 38963 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38746 "parsing/parser.ml"
+# 38973 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38755 "parsing/parser.ml"
+# 38982 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
-# 2430 "parsing/parser.mly"
+# 2444 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
-# 38762 "parsing/parser.ml"
+# 38989 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38772 "parsing/parser.ml"
+# 38999 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38778 "parsing/parser.ml"
+# 39005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38831 "parsing/parser.ml"
+# 39058 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38840 "parsing/parser.ml"
+# 39067 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
-# 2432 "parsing/parser.mly"
+# 2446 "parsing/parser.mly"
( (* TODO: review the location of Pexp_array *)
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) )
-# 38848 "parsing/parser.ml"
+# 39075 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38858 "parsing/parser.ml"
+# 39085 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38864 "parsing/parser.ml"
+# 39091 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 38919 "parsing/parser.ml"
+# 39146 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2436 "parsing/parser.mly"
+# 2450 "parsing/parser.mly"
( unclosed "[|" _loc__3_ "|]" _loc__5_ )
-# 38926 "parsing/parser.ml"
+# 39153 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38936 "parsing/parser.ml"
+# 39163 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 38942 "parsing/parser.ml"
+# 39169 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 38983 "parsing/parser.ml"
+# 39210 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2438 "parsing/parser.mly"
+# 2452 "parsing/parser.mly"
( fst (mktailexp _loc__3_ _2) )
-# 38989 "parsing/parser.ml"
+# 39216 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38999 "parsing/parser.ml"
+# 39226 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39005 "parsing/parser.ml"
+# 39232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 39046 "parsing/parser.ml"
+# 39273 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2440 "parsing/parser.mly"
+# 2454 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 39053 "parsing/parser.ml"
+# 39280 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39063 "parsing/parser.ml"
+# 39290 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39069 "parsing/parser.ml"
+# 39296 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 39124 "parsing/parser.ml"
+# 39351 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39134 "parsing/parser.ml"
+# 39361 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 39143 "parsing/parser.ml"
+# 39370 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2442 "parsing/parser.mly"
+# 2456 "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:(_startpos__3_, _endpos) tail_exp in
Pexp_open(od, list_exp) )
-# 39155 "parsing/parser.ml"
+# 39382 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39165 "parsing/parser.ml"
+# 39392 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39171 "parsing/parser.ml"
+# 39398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _3 =
- let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+ let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 2447 "parsing/parser.mly"
+# 2461 "parsing/parser.mly"
(Lident "[]")
-# 39221 "parsing/parser.ml"
+# 39448 "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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39230 "parsing/parser.ml"
+# 39457 "parsing/parser.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39242 "parsing/parser.ml"
+# 39469 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 39251 "parsing/parser.ml"
+# 39478 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2448 "parsing/parser.mly"
+# 2462 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
-# 39258 "parsing/parser.ml"
+# 39485 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39268 "parsing/parser.ml"
+# 39495 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39274 "parsing/parser.ml"
+# 39501 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2665 "parsing/parser.mly"
+# 2678 "parsing/parser.mly"
( es )
-# 39329 "parsing/parser.ml"
+# 39556 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2451 "parsing/parser.mly"
+# 2465 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 39336 "parsing/parser.ml"
+# 39563 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39346 "parsing/parser.ml"
+# 39573 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39352 "parsing/parser.ml"
+# 39579 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 39449 "parsing/parser.ml"
+# 39676 "parsing/parser.ml"
in
let _5 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 39459 "parsing/parser.ml"
+# 39686 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 39465 "parsing/parser.ml"
+# 39692 "parsing/parser.ml"
in
let od =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39476 "parsing/parser.ml"
+# 39703 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1569 "parsing/parser.mly"
+# 1583 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 39485 "parsing/parser.ml"
+# 39712 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2454 "parsing/parser.mly"
+# 2468 "parsing/parser.mly"
( let modexp =
mkexp_attrs ~loc:(_startpos__3_, _endpos)
(Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
Pexp_open(od, modexp) )
-# 39498 "parsing/parser.ml"
+# 39725 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39508 "parsing/parser.ml"
+# 39735 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39514 "parsing/parser.ml"
+# 39741 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 39601 "parsing/parser.ml"
+# 39828 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 39607 "parsing/parser.ml"
+# 39834 "parsing/parser.ml"
in
let _loc__8_ = (_startpos__8_, _endpos__8_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2460 "parsing/parser.mly"
+# 2474 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__8_ )
-# 39615 "parsing/parser.ml"
+# 39842 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 916 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 39625 "parsing/parser.ml"
+# 39852 "parsing/parser.ml"
in
-# 2356 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( _1 )
-# 39631 "parsing/parser.ml"
+# 39858 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39662 "parsing/parser.ml"
+# 39889 "parsing/parser.ml"
in
-# 2748 "parsing/parser.mly"
+# 2761 "parsing/parser.mly"
( Ppat_var (_1) )
-# 39668 "parsing/parser.ml"
+# 39895 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39677 "parsing/parser.ml"
+# 39904 "parsing/parser.ml"
in
-# 2749 "parsing/parser.mly"
+# 2762 "parsing/parser.mly"
( _1 )
-# 39683 "parsing/parser.ml"
+# 39910 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2750 "parsing/parser.mly"
+# 2763 "parsing/parser.mly"
( _1 )
-# 39708 "parsing/parser.ml"
+# 39935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2755 "parsing/parser.mly"
+# 2768 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 39750 "parsing/parser.ml"
+# 39977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2757 "parsing/parser.mly"
+# 2770 "parsing/parser.mly"
( _1 )
-# 39775 "parsing/parser.ml"
+# 40002 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39840 "parsing/parser.ml"
+# 40067 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 39850 "parsing/parser.ml"
+# 40077 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 39856 "parsing/parser.ml"
+# 40083 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2759 "parsing/parser.mly"
+# 2772 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 39865 "parsing/parser.ml"
+# 40092 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 39946 "parsing/parser.ml"
+# 40173 "parsing/parser.ml"
in
let _4 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39957 "parsing/parser.ml"
+# 40184 "parsing/parser.ml"
in
let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 39968 "parsing/parser.ml"
+# 40195 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 39974 "parsing/parser.ml"
+# 40201 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2761 "parsing/parser.mly"
+# 2774 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc
(Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6))
_3 )
-# 39986 "parsing/parser.ml"
+# 40213 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2769 "parsing/parser.mly"
+# 2782 "parsing/parser.mly"
( Ppat_any )
-# 40012 "parsing/parser.ml"
+# 40239 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40020 "parsing/parser.ml"
+# 40247 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40026 "parsing/parser.ml"
+# 40253 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2771 "parsing/parser.mly"
+# 2784 "parsing/parser.mly"
( Ppat_constant _1 )
-# 40052 "parsing/parser.ml"
+# 40279 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40060 "parsing/parser.ml"
+# 40287 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40066 "parsing/parser.ml"
+# 40293 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2773 "parsing/parser.mly"
+# 2786 "parsing/parser.mly"
( Ppat_interval (_1, _3) )
-# 40106 "parsing/parser.ml"
+# 40333 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40115 "parsing/parser.ml"
+# 40342 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40121 "parsing/parser.ml"
+# 40348 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40152 "parsing/parser.ml"
+# 40379 "parsing/parser.ml"
in
-# 2775 "parsing/parser.mly"
+# 2788 "parsing/parser.mly"
( Ppat_construct(_1, None) )
-# 40158 "parsing/parser.ml"
+# 40385 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40167 "parsing/parser.ml"
+# 40394 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40173 "parsing/parser.ml"
+# 40400 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2777 "parsing/parser.mly"
+# 2790 "parsing/parser.mly"
( Ppat_variant(_1, None) )
-# 40199 "parsing/parser.ml"
+# 40426 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40207 "parsing/parser.ml"
+# 40434 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40213 "parsing/parser.ml"
+# 40440 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40252 "parsing/parser.ml"
+# 40479 "parsing/parser.ml"
in
-# 2779 "parsing/parser.mly"
+# 2792 "parsing/parser.mly"
( Ppat_type (_2) )
-# 40258 "parsing/parser.ml"
+# 40485 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40268 "parsing/parser.ml"
+# 40495 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40274 "parsing/parser.ml"
+# 40501 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40319 "parsing/parser.ml"
+# 40546 "parsing/parser.ml"
in
-# 2781 "parsing/parser.mly"
+# 2794 "parsing/parser.mly"
( Ppat_open(_1, _3) )
-# 40325 "parsing/parser.ml"
+# 40552 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40335 "parsing/parser.ml"
+# 40562 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40341 "parsing/parser.ml"
+# 40568 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _3 =
- let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+ let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 2782 "parsing/parser.mly"
+# 2795 "parsing/parser.mly"
(Lident "[]")
-# 40391 "parsing/parser.ml"
+# 40618 "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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40400 "parsing/parser.ml"
+# 40627 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40411 "parsing/parser.ml"
+# 40638 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2783 "parsing/parser.mly"
+# 2796 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 40420 "parsing/parser.ml"
+# 40647 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40430 "parsing/parser.ml"
+# 40657 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40436 "parsing/parser.ml"
+# 40663 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _3 =
- let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
+ let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 2784 "parsing/parser.mly"
+# 2797 "parsing/parser.mly"
(Lident "()")
-# 40486 "parsing/parser.ml"
+# 40713 "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
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40495 "parsing/parser.ml"
+# 40722 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40506 "parsing/parser.ml"
+# 40733 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2785 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 40515 "parsing/parser.ml"
+# 40742 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40525 "parsing/parser.ml"
+# 40752 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40531 "parsing/parser.ml"
+# 40758 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 40590 "parsing/parser.ml"
+# 40817 "parsing/parser.ml"
in
-# 2787 "parsing/parser.mly"
+# 2800 "parsing/parser.mly"
( Ppat_open (_1, _4) )
-# 40596 "parsing/parser.ml"
+# 40823 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40606 "parsing/parser.ml"
+# 40833 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40612 "parsing/parser.ml"
+# 40839 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2789 "parsing/parser.mly"
+# 2802 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 40669 "parsing/parser.ml"
+# 40896 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40679 "parsing/parser.ml"
+# 40906 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40685 "parsing/parser.ml"
+# 40912 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2791 "parsing/parser.mly"
+# 2804 "parsing/parser.mly"
( expecting _loc__4_ "pattern" )
-# 40734 "parsing/parser.ml"
+# 40961 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40744 "parsing/parser.ml"
+# 40971 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40750 "parsing/parser.ml"
+# 40977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2793 "parsing/parser.mly"
+# 2806 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 40793 "parsing/parser.ml"
+# 41020 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40803 "parsing/parser.ml"
+# 41030 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40809 "parsing/parser.ml"
+# 41036 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2795 "parsing/parser.mly"
+# 2808 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 40863 "parsing/parser.ml"
+# 41090 "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
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40872 "parsing/parser.ml"
+# 41099 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40878 "parsing/parser.ml"
+# 41105 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2797 "parsing/parser.mly"
+# 2810 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 40935 "parsing/parser.ml"
+# 41162 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40945 "parsing/parser.ml"
+# 41172 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 40951 "parsing/parser.ml"
+# 41178 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2799 "parsing/parser.mly"
+# 2812 "parsing/parser.mly"
( expecting _loc__4_ "type" )
-# 41000 "parsing/parser.ml"
+# 41227 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 41010 "parsing/parser.ml"
+# 41237 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 41016 "parsing/parser.ml"
+# 41243 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3419 "parsing/parser.mly"
+# 3437 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 41099 "parsing/parser.ml"
+# 41326 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 41109 "parsing/parser.ml"
+# 41336 "parsing/parser.ml"
in
-# 3848 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
( _1, _2 )
-# 41115 "parsing/parser.ml"
+# 41342 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2802 "parsing/parser.mly"
+# 2815 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__7_ )
-# 41123 "parsing/parser.ml"
+# 41350 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 41133 "parsing/parser.ml"
+# 41360 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 41139 "parsing/parser.ml"
+# 41366 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2804 "parsing/parser.mly"
+# 2817 "parsing/parser.mly"
( Ppat_extension _1 )
-# 41165 "parsing/parser.ml"
+# 41392 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 918 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 41173 "parsing/parser.ml"
+# 41400 "parsing/parser.ml"
in
-# 2765 "parsing/parser.mly"
+# 2778 "parsing/parser.mly"
( _1 )
-# 41179 "parsing/parser.ml"
+# 41406 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 41200 "parsing/parser.ml"
+# 41427 "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) =
-# 3756 "parsing/parser.mly"
+# 3774 "parsing/parser.mly"
( _1 )
-# 41208 "parsing/parser.ml"
+# 41435 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 756 "parsing/parser.mly"
(string)
-# 41229 "parsing/parser.ml"
+# 41456 "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) =
-# 3757 "parsing/parser.mly"
+# 3775 "parsing/parser.mly"
( _1 )
-# 41237 "parsing/parser.ml"
+# 41464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3758 "parsing/parser.mly"
+# 3776 "parsing/parser.mly"
( "and" )
-# 41262 "parsing/parser.ml"
+# 41489 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3759 "parsing/parser.mly"
+# 3777 "parsing/parser.mly"
( "as" )
-# 41287 "parsing/parser.ml"
+# 41514 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3760 "parsing/parser.mly"
+# 3778 "parsing/parser.mly"
( "assert" )
-# 41312 "parsing/parser.ml"
+# 41539 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3761 "parsing/parser.mly"
+# 3779 "parsing/parser.mly"
( "begin" )
-# 41337 "parsing/parser.ml"
+# 41564 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3762 "parsing/parser.mly"
+# 3780 "parsing/parser.mly"
( "class" )
-# 41362 "parsing/parser.ml"
+# 41589 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3763 "parsing/parser.mly"
+# 3781 "parsing/parser.mly"
( "constraint" )
-# 41387 "parsing/parser.ml"
+# 41614 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3764 "parsing/parser.mly"
+# 3782 "parsing/parser.mly"
( "do" )
-# 41412 "parsing/parser.ml"
+# 41639 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3765 "parsing/parser.mly"
+# 3783 "parsing/parser.mly"
( "done" )
-# 41437 "parsing/parser.ml"
+# 41664 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3766 "parsing/parser.mly"
+# 3784 "parsing/parser.mly"
( "downto" )
-# 41462 "parsing/parser.ml"
+# 41689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3767 "parsing/parser.mly"
+# 3785 "parsing/parser.mly"
( "else" )
-# 41487 "parsing/parser.ml"
+# 41714 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3768 "parsing/parser.mly"
+# 3786 "parsing/parser.mly"
( "end" )
-# 41512 "parsing/parser.ml"
+# 41739 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3769 "parsing/parser.mly"
+# 3787 "parsing/parser.mly"
( "exception" )
-# 41537 "parsing/parser.ml"
+# 41764 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3770 "parsing/parser.mly"
+# 3788 "parsing/parser.mly"
( "external" )
-# 41562 "parsing/parser.ml"
+# 41789 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3771 "parsing/parser.mly"
+# 3789 "parsing/parser.mly"
( "false" )
-# 41587 "parsing/parser.ml"
+# 41814 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3772 "parsing/parser.mly"
+# 3790 "parsing/parser.mly"
( "for" )
-# 41612 "parsing/parser.ml"
+# 41839 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3773 "parsing/parser.mly"
+# 3791 "parsing/parser.mly"
( "fun" )
-# 41637 "parsing/parser.ml"
+# 41864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3774 "parsing/parser.mly"
+# 3792 "parsing/parser.mly"
( "function" )
-# 41662 "parsing/parser.ml"
+# 41889 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3775 "parsing/parser.mly"
+# 3793 "parsing/parser.mly"
( "functor" )
-# 41687 "parsing/parser.ml"
+# 41914 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3776 "parsing/parser.mly"
+# 3794 "parsing/parser.mly"
( "if" )
-# 41712 "parsing/parser.ml"
+# 41939 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3777 "parsing/parser.mly"
+# 3795 "parsing/parser.mly"
( "in" )
-# 41737 "parsing/parser.ml"
+# 41964 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3778 "parsing/parser.mly"
+# 3796 "parsing/parser.mly"
( "include" )
-# 41762 "parsing/parser.ml"
+# 41989 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3779 "parsing/parser.mly"
+# 3797 "parsing/parser.mly"
( "inherit" )
-# 41787 "parsing/parser.ml"
+# 42014 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3780 "parsing/parser.mly"
+# 3798 "parsing/parser.mly"
( "initializer" )
-# 41812 "parsing/parser.ml"
+# 42039 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3781 "parsing/parser.mly"
+# 3799 "parsing/parser.mly"
( "lazy" )
-# 41837 "parsing/parser.ml"
+# 42064 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3782 "parsing/parser.mly"
+# 3800 "parsing/parser.mly"
( "let" )
-# 41862 "parsing/parser.ml"
+# 42089 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3783 "parsing/parser.mly"
+# 3801 "parsing/parser.mly"
( "match" )
-# 41887 "parsing/parser.ml"
+# 42114 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3784 "parsing/parser.mly"
+# 3802 "parsing/parser.mly"
( "method" )
-# 41912 "parsing/parser.ml"
+# 42139 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3785 "parsing/parser.mly"
+# 3803 "parsing/parser.mly"
( "module" )
-# 41937 "parsing/parser.ml"
+# 42164 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3786 "parsing/parser.mly"
+# 3804 "parsing/parser.mly"
( "mutable" )
-# 41962 "parsing/parser.ml"
+# 42189 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3787 "parsing/parser.mly"
+# 3805 "parsing/parser.mly"
( "new" )
-# 41987 "parsing/parser.ml"
+# 42214 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3788 "parsing/parser.mly"
+# 3806 "parsing/parser.mly"
( "nonrec" )
-# 42012 "parsing/parser.ml"
+# 42239 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3789 "parsing/parser.mly"
+# 3807 "parsing/parser.mly"
( "object" )
-# 42037 "parsing/parser.ml"
+# 42264 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3790 "parsing/parser.mly"
+# 3808 "parsing/parser.mly"
( "of" )
-# 42062 "parsing/parser.ml"
+# 42289 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3791 "parsing/parser.mly"
+# 3809 "parsing/parser.mly"
( "open" )
-# 42087 "parsing/parser.ml"
+# 42314 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3792 "parsing/parser.mly"
+# 3810 "parsing/parser.mly"
( "or" )
-# 42112 "parsing/parser.ml"
+# 42339 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3793 "parsing/parser.mly"
+# 3811 "parsing/parser.mly"
( "private" )
-# 42137 "parsing/parser.ml"
+# 42364 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3794 "parsing/parser.mly"
+# 3812 "parsing/parser.mly"
( "rec" )
-# 42162 "parsing/parser.ml"
+# 42389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3795 "parsing/parser.mly"
+# 3813 "parsing/parser.mly"
( "sig" )
-# 42187 "parsing/parser.ml"
+# 42414 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3796 "parsing/parser.mly"
+# 3814 "parsing/parser.mly"
( "struct" )
-# 42212 "parsing/parser.ml"
+# 42439 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3797 "parsing/parser.mly"
+# 3815 "parsing/parser.mly"
( "then" )
-# 42237 "parsing/parser.ml"
+# 42464 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3798 "parsing/parser.mly"
+# 3816 "parsing/parser.mly"
( "to" )
-# 42262 "parsing/parser.ml"
+# 42489 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3799 "parsing/parser.mly"
+# 3817 "parsing/parser.mly"
( "true" )
-# 42287 "parsing/parser.ml"
+# 42514 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3800 "parsing/parser.mly"
+# 3818 "parsing/parser.mly"
( "try" )
-# 42312 "parsing/parser.ml"
+# 42539 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3801 "parsing/parser.mly"
+# 3819 "parsing/parser.mly"
( "type" )
-# 42337 "parsing/parser.ml"
+# 42564 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3802 "parsing/parser.mly"
+# 3820 "parsing/parser.mly"
( "val" )
-# 42362 "parsing/parser.ml"
+# 42589 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3803 "parsing/parser.mly"
+# 3821 "parsing/parser.mly"
( "virtual" )
-# 42387 "parsing/parser.ml"
+# 42614 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3804 "parsing/parser.mly"
+# 3822 "parsing/parser.mly"
( "when" )
-# 42412 "parsing/parser.ml"
+# 42639 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3805 "parsing/parser.mly"
+# 3823 "parsing/parser.mly"
( "while" )
-# 42437 "parsing/parser.ml"
+# 42664 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3806 "parsing/parser.mly"
+# 3824 "parsing/parser.mly"
( "with" )
-# 42462 "parsing/parser.ml"
+# 42689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.type_exception * string Asttypes.loc option) =
-# 3083 "parsing/parser.mly"
+# 3096 "parsing/parser.mly"
( _1 )
-# 42487 "parsing/parser.ml"
+# 42714 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined5 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 42563 "parsing/parser.ml"
+# 42790 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined5_ in
let attrs2 =
let _1 = _1_inlined4 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 42572 "parsing/parser.ml"
+# 42799 "parsing/parser.ml"
in
let lid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42583 "parsing/parser.ml"
+# 42810 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42594 "parsing/parser.ml"
+# 42821 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 42602 "parsing/parser.ml"
+# 42829 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3092 "parsing/parser.mly"
+# 3105 "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 )
-# 42615 "parsing/parser.ml"
+# 42842 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2590 "parsing/parser.mly"
+# 2603 "parsing/parser.mly"
( _2 )
-# 42647 "parsing/parser.ml"
+# 42874 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2592 "parsing/parser.mly"
+# 2605 "parsing/parser.mly"
( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) )
-# 42682 "parsing/parser.ml"
+# 42909 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2478 "parsing/parser.mly"
+# 2495 "parsing/parser.mly"
( xs )
-# 42735 "parsing/parser.ml"
+# 42962 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2594 "parsing/parser.mly"
+# 2607 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 42743 "parsing/parser.ml"
+# 42970 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 42770 "parsing/parser.ml"
+# 42997 "parsing/parser.ml"
in
let xs =
let items =
-# 953 "parsing/parser.mly"
+# 957 "parsing/parser.mly"
( [] )
-# 42776 "parsing/parser.ml"
+# 43003 "parsing/parser.ml"
in
-# 1372 "parsing/parser.mly"
+# 1386 "parsing/parser.mly"
( items )
-# 42781 "parsing/parser.ml"
+# 43008 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 42787 "parsing/parser.ml"
+# 43014 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 875 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 42796 "parsing/parser.ml"
+# 43023 "parsing/parser.ml"
in
-# 1365 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( _1 )
-# 42802 "parsing/parser.ml"
+# 43029 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 42843 "parsing/parser.ml"
+# 43070 "parsing/parser.ml"
in
let xs =
let items =
let _1 =
let _1 =
let attrs =
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 42853 "parsing/parser.ml"
+# 43080 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1393 "parsing/parser.mly"
( mkstrexp e attrs )
-# 42858 "parsing/parser.ml"
+# 43085 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 887 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 42866 "parsing/parser.ml"
+# 43093 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 906 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 42876 "parsing/parser.ml"
+# 43103 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 959 "parsing/parser.mly"
( x )
-# 42882 "parsing/parser.ml"
+# 43109 "parsing/parser.ml"
in
-# 1372 "parsing/parser.mly"
+# 1386 "parsing/parser.mly"
( items )
-# 42888 "parsing/parser.ml"
+# 43115 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 42894 "parsing/parser.ml"
+# 43121 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 875 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 42903 "parsing/parser.ml"
+# 43130 "parsing/parser.ml"
in
-# 1365 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( _1 )
-# 42909 "parsing/parser.ml"
+# 43136 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1394 "parsing/parser.mly"
+# 1408 "parsing/parser.mly"
( val_of_let_bindings ~loc:_sloc _1 )
-# 42937 "parsing/parser.ml"
+# 43164 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 42973 "parsing/parser.ml"
+# 43200 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1397 "parsing/parser.mly"
+# 1411 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
Pstr_extension (_1, add_docs_attrs docs _2) )
-# 42984 "parsing/parser.ml"
+# 43211 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 922 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 42994 "parsing/parser.ml"
+# 43221 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43000 "parsing/parser.ml"
+# 43227 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1400 "parsing/parser.mly"
+# 1414 "parsing/parser.mly"
( Pstr_attribute _1 )
-# 43026 "parsing/parser.ml"
+# 43253 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 922 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 43034 "parsing/parser.ml"
+# 43261 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43040 "parsing/parser.ml"
+# 43267 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1404 "parsing/parser.mly"
+# 1418 "parsing/parser.mly"
( pstr_primitive _1 )
-# 43066 "parsing/parser.ml"
+# 43293 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43074 "parsing/parser.ml"
+# 43301 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43080 "parsing/parser.ml"
+# 43307 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1406 "parsing/parser.mly"
+# 1420 "parsing/parser.mly"
( pstr_primitive _1 )
-# 43106 "parsing/parser.ml"
+# 43333 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43114 "parsing/parser.ml"
+# 43341 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43120 "parsing/parser.ml"
+# 43347 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 43157 "parsing/parser.ml"
+# 43384 "parsing/parser.ml"
in
-# 2927 "parsing/parser.mly"
+# 2940 "parsing/parser.mly"
( _1 )
-# 43162 "parsing/parser.ml"
+# 43389 "parsing/parser.ml"
in
-# 2910 "parsing/parser.mly"
+# 2923 "parsing/parser.mly"
( _1 )
-# 43168 "parsing/parser.ml"
+# 43395 "parsing/parser.ml"
in
-# 1408 "parsing/parser.mly"
+# 1422 "parsing/parser.mly"
( pstr_type _1 )
-# 43174 "parsing/parser.ml"
+# 43401 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43184 "parsing/parser.ml"
+# 43411 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43190 "parsing/parser.ml"
+# 43417 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 43277 "parsing/parser.ml"
+# 43504 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( List.rev xs )
-# 43284 "parsing/parser.ml"
+# 43511 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43294 "parsing/parser.ml"
+# 43521 "parsing/parser.ml"
in
let _4 =
-# 3676 "parsing/parser.mly"
+# 3694 "parsing/parser.mly"
( Recursive )
-# 43300 "parsing/parser.ml"
+# 43527 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 43307 "parsing/parser.ml"
+# 43534 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3175 "parsing/parser.mly"
+# 3193 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 43319 "parsing/parser.ml"
+# 43546 "parsing/parser.ml"
in
-# 3158 "parsing/parser.mly"
+# 3176 "parsing/parser.mly"
( _1 )
-# 43325 "parsing/parser.ml"
+# 43552 "parsing/parser.ml"
in
-# 1410 "parsing/parser.mly"
+# 1424 "parsing/parser.mly"
( pstr_typext _1 )
-# 43331 "parsing/parser.ml"
+# 43558 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43341 "parsing/parser.ml"
+# 43568 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43347 "parsing/parser.ml"
+# 43574 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 43441 "parsing/parser.ml"
+# 43668 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1106 "parsing/parser.mly"
+# 1110 "parsing/parser.mly"
( List.rev xs )
-# 43448 "parsing/parser.ml"
+# 43675 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43458 "parsing/parser.ml"
+# 43685 "parsing/parser.ml"
in
let _4 =
- let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3678 "parsing/parser.mly"
+# 3696 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 43469 "parsing/parser.ml"
+# 43696 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 43477 "parsing/parser.ml"
+# 43704 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3175 "parsing/parser.mly"
+# 3193 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 43489 "parsing/parser.ml"
+# 43716 "parsing/parser.ml"
in
-# 3158 "parsing/parser.mly"
+# 3176 "parsing/parser.mly"
( _1 )
-# 43495 "parsing/parser.ml"
+# 43722 "parsing/parser.ml"
in
-# 1410 "parsing/parser.mly"
+# 1424 "parsing/parser.mly"
( pstr_typext _1 )
-# 43501 "parsing/parser.ml"
+# 43728 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43511 "parsing/parser.ml"
+# 43738 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43517 "parsing/parser.ml"
+# 43744 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1412 "parsing/parser.mly"
+# 1426 "parsing/parser.mly"
( pstr_exception _1 )
-# 43543 "parsing/parser.ml"
+# 43770 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43551 "parsing/parser.ml"
+# 43778 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43557 "parsing/parser.ml"
+# 43784 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 43622 "parsing/parser.ml"
+# 43849 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43634 "parsing/parser.ml"
+# 43861 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 43642 "parsing/parser.ml"
+# 43869 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1438 "parsing/parser.mly"
+# 1452 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let body = Mb.mk name body ~attrs ~loc ~docs in
Pstr_module body, ext )
-# 43655 "parsing/parser.ml"
+# 43882 "parsing/parser.ml"
in
-# 1414 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 43661 "parsing/parser.ml"
+# 43888 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43671 "parsing/parser.ml"
+# 43898 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43677 "parsing/parser.ml"
+# 43904 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 43758 "parsing/parser.ml"
+# 43985 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43770 "parsing/parser.ml"
+# 43997 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 43778 "parsing/parser.ml"
+# 44005 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1473 "parsing/parser.mly"
+# 1487 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
ext,
Mb.mk name body ~attrs ~loc ~docs
)
-# 43793 "parsing/parser.ml"
+# 44020 "parsing/parser.ml"
in
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 43799 "parsing/parser.ml"
+# 44026 "parsing/parser.ml"
in
-# 1461 "parsing/parser.mly"
+# 1475 "parsing/parser.mly"
( _1 )
-# 43805 "parsing/parser.ml"
+# 44032 "parsing/parser.ml"
in
-# 1416 "parsing/parser.mly"
+# 1430 "parsing/parser.mly"
( pstr_recmodule _1 )
-# 43811 "parsing/parser.ml"
+# 44038 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43821 "parsing/parser.ml"
+# 44048 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43827 "parsing/parser.ml"
+# 44054 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1418 "parsing/parser.mly"
+# 1432 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 43853 "parsing/parser.ml"
+# 44080 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43861 "parsing/parser.ml"
+# 44088 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43867 "parsing/parser.ml"
+# 44094 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1420 "parsing/parser.mly"
+# 1434 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 43893 "parsing/parser.ml"
+# 44120 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43901 "parsing/parser.ml"
+# 44128 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 43907 "parsing/parser.ml"
+# 44134 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 43979 "parsing/parser.ml"
+# 44206 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 43999 "parsing/parser.ml"
+# 44226 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44011 "parsing/parser.ml"
+# 44238 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 44019 "parsing/parser.ml"
+# 44246 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1811 "parsing/parser.mly"
+# 1825 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id body ~virt ~params ~attrs ~loc ~docs
)
-# 44034 "parsing/parser.ml"
+# 44261 "parsing/parser.ml"
in
-# 1114 "parsing/parser.mly"
+# 1118 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 44040 "parsing/parser.ml"
+# 44267 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1814 "parsing/parser.mly"
( _1 )
-# 44046 "parsing/parser.ml"
+# 44273 "parsing/parser.ml"
in
-# 1422 "parsing/parser.mly"
+# 1436 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 44052 "parsing/parser.ml"
+# 44279 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 44062 "parsing/parser.ml"
+# 44289 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 44068 "parsing/parser.ml"
+# 44295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1424 "parsing/parser.mly"
+# 1438 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 44094 "parsing/parser.ml"
+# 44321 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 44102 "parsing/parser.ml"
+# 44329 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 44108 "parsing/parser.ml"
+# 44335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 44166 "parsing/parser.ml"
+# 44393 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 44175 "parsing/parser.ml"
+# 44402 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1510 "parsing/parser.mly"
+# 1524 "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
)
-# 44189 "parsing/parser.ml"
+# 44416 "parsing/parser.ml"
in
-# 1426 "parsing/parser.mly"
+# 1440 "parsing/parser.mly"
( pstr_include _1 )
-# 44195 "parsing/parser.ml"
+# 44422 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 939 "parsing/parser.mly"
+# 943 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 44205 "parsing/parser.ml"
+# 44432 "parsing/parser.ml"
in
-# 1428 "parsing/parser.mly"
+# 1442 "parsing/parser.mly"
( _1 )
-# 44211 "parsing/parser.ml"
+# 44438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3741 "parsing/parser.mly"
+# 3759 "parsing/parser.mly"
( "-" )
-# 44236 "parsing/parser.ml"
+# 44463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3742 "parsing/parser.mly"
+# 3760 "parsing/parser.mly"
( "-." )
-# 44261 "parsing/parser.ml"
+# 44488 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _5 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 44316 "parsing/parser.ml"
+# 44543 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined1_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 44325 "parsing/parser.ml"
+# 44552 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 44330 "parsing/parser.ml"
+# 44557 "parsing/parser.ml"
in
-# 3449 "parsing/parser.mly"
+# 3467 "parsing/parser.mly"
( _1 )
-# 44336 "parsing/parser.ml"
+# 44563 "parsing/parser.ml"
in
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44346 "parsing/parser.ml"
+# 44573 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3435 "parsing/parser.mly"
+# 3453 "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 )
-# 44357 "parsing/parser.ml"
+# 44584 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 44391 "parsing/parser.ml"
+# 44618 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44402 "parsing/parser.ml"
+# 44629 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3439 "parsing/parser.mly"
+# 3457 "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 [] )
-# 44413 "parsing/parser.ml"
+# 44640 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase) = let arg =
# 124 "<standard.mly>"
( None )
-# 44445 "parsing/parser.ml"
+# 44672 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined1_ in
let dir =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44456 "parsing/parser.ml"
+# 44683 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44465 "parsing/parser.ml"
+# 44692 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 44498 "parsing/parser.ml"
+# 44725 "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
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3643 "parsing/parser.mly"
+# 3661 "parsing/parser.mly"
( let (s, _, _) = _1 in Pdir_string s )
-# 44511 "parsing/parser.ml"
+# 44738 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44519 "parsing/parser.ml"
+# 44746 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44525 "parsing/parser.ml"
+# 44752 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44537 "parsing/parser.ml"
+# 44764 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44546 "parsing/parser.ml"
+# 44773 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 691 "parsing/parser.mly"
(string * char option)
-# 44579 "parsing/parser.ml"
+# 44806 "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
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3644 "parsing/parser.mly"
+# 3662 "parsing/parser.mly"
( let (n, m) = _1 in Pdir_int (n ,m) )
-# 44592 "parsing/parser.ml"
+# 44819 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44600 "parsing/parser.ml"
+# 44827 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44606 "parsing/parser.ml"
+# 44833 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44618 "parsing/parser.ml"
+# 44845 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44627 "parsing/parser.ml"
+# 44854 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3645 "parsing/parser.mly"
+# 3663 "parsing/parser.mly"
( Pdir_ident _1 )
-# 44669 "parsing/parser.ml"
+# 44896 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44677 "parsing/parser.ml"
+# 44904 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44683 "parsing/parser.ml"
+# 44910 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44695 "parsing/parser.ml"
+# 44922 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44704 "parsing/parser.ml"
+# 44931 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3646 "parsing/parser.mly"
+# 3664 "parsing/parser.mly"
( Pdir_ident _1 )
-# 44746 "parsing/parser.ml"
+# 44973 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44754 "parsing/parser.ml"
+# 44981 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44760 "parsing/parser.ml"
+# 44987 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44772 "parsing/parser.ml"
+# 44999 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44781 "parsing/parser.ml"
+# 45008 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_inlined2_ in
let _v : (Parsetree.toplevel_phrase) = let arg =
- let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
let x =
let _1 =
-# 3647 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( Pdir_bool false )
-# 44823 "parsing/parser.ml"
+# 45050 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44831 "parsing/parser.ml"
+# 45058 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44837 "parsing/parser.ml"
+# 45064 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44849 "parsing/parser.ml"
+# 45076 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44858 "parsing/parser.ml"
+# 45085 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_inlined2_ in
let _v : (Parsetree.toplevel_phrase) = let arg =
- let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
let x =
let _1 =
-# 3648 "parsing/parser.mly"
+# 3666 "parsing/parser.mly"
( Pdir_bool true )
-# 44900 "parsing/parser.ml"
+# 45127 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 944 "parsing/parser.mly"
+# 948 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 44908 "parsing/parser.ml"
+# 45135 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 44914 "parsing/parser.ml"
+# 45141 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44926 "parsing/parser.ml"
+# 45153 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3639 "parsing/parser.mly"
+# 3657 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44935 "parsing/parser.ml"
+# 45162 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 44977 "parsing/parser.ml"
+# 45204 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1393 "parsing/parser.mly"
( mkstrexp e attrs )
-# 44982 "parsing/parser.ml"
+# 45209 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 887 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 44990 "parsing/parser.ml"
+# 45217 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 875 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 44999 "parsing/parser.ml"
+# 45226 "parsing/parser.ml"
in
-# 1154 "parsing/parser.mly"
+# 1158 "parsing/parser.mly"
( Ptop_def _1 )
-# 45005 "parsing/parser.ml"
+# 45232 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 45038 "parsing/parser.ml"
+# 45265 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 875 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 45046 "parsing/parser.ml"
+# 45273 "parsing/parser.ml"
in
-# 1158 "parsing/parser.mly"
+# 1162 "parsing/parser.mly"
( Ptop_def _1 )
-# 45052 "parsing/parser.ml"
+# 45279 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.toplevel_phrase) =
-# 1162 "parsing/parser.mly"
+# 1166 "parsing/parser.mly"
( _1 )
-# 45084 "parsing/parser.ml"
+# 45311 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.toplevel_phrase) =
-# 1165 "parsing/parser.mly"
+# 1169 "parsing/parser.mly"
( raise End_of_file )
-# 45109 "parsing/parser.ml"
+# 45336 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3341 "parsing/parser.mly"
+# 3359 "parsing/parser.mly"
( ty )
-# 45134 "parsing/parser.ml"
+# 45361 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 45162 "parsing/parser.ml"
+# 45389 "parsing/parser.ml"
in
-# 1045 "parsing/parser.mly"
+# 1049 "parsing/parser.mly"
( xs )
-# 45167 "parsing/parser.ml"
+# 45394 "parsing/parser.ml"
in
-# 3344 "parsing/parser.mly"
+# 3362 "parsing/parser.mly"
( Ptyp_tuple tys )
-# 45173 "parsing/parser.ml"
+# 45400 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 45183 "parsing/parser.ml"
+# 45410 "parsing/parser.ml"
in
-# 3346 "parsing/parser.mly"
+# 3364 "parsing/parser.mly"
( _1 )
-# 45189 "parsing/parser.ml"
+# 45416 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2668 "parsing/parser.mly"
+# 2681 "parsing/parser.mly"
( (Some _2, None) )
-# 45221 "parsing/parser.ml"
+# 45448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2669 "parsing/parser.mly"
+# 2682 "parsing/parser.mly"
( (Some _2, Some _4) )
-# 45267 "parsing/parser.ml"
+# 45494 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2670 "parsing/parser.mly"
+# 2683 "parsing/parser.mly"
( (None, Some _2) )
-# 45299 "parsing/parser.ml"
+# 45526 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2671 "parsing/parser.mly"
+# 2684 "parsing/parser.mly"
( syntax_error() )
-# 45331 "parsing/parser.ml"
+# 45558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2672 "parsing/parser.mly"
+# 2685 "parsing/parser.mly"
( syntax_error() )
-# 45363 "parsing/parser.ml"
+# 45590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 3001 "parsing/parser.mly"
+# 3014 "parsing/parser.mly"
( (Ptype_abstract, Public, None) )
-# 45381 "parsing/parser.ml"
+# 45608 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 3003 "parsing/parser.mly"
+# 3016 "parsing/parser.mly"
( _2 )
-# 45413 "parsing/parser.ml"
+# 45640 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3600 "parsing/parser.mly"
+# 3618 "parsing/parser.mly"
( _1 )
-# 45438 "parsing/parser.ml"
+# 45665 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) =
-# 3018 "parsing/parser.mly"
+# 3031 "parsing/parser.mly"
( _2, _1 )
-# 45470 "parsing/parser.ml"
+# 45697 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 3011 "parsing/parser.mly"
+# 3024 "parsing/parser.mly"
( [] )
-# 45488 "parsing/parser.ml"
+# 45715 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_p_ in
let _endpos = _endpos_p_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 3013 "parsing/parser.mly"
+# 3026 "parsing/parser.mly"
( [p] )
-# 45513 "parsing/parser.ml"
+# 45740 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 45553 "parsing/parser.ml"
+# 45780 "parsing/parser.ml"
in
-# 1017 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 45558 "parsing/parser.ml"
+# 45785 "parsing/parser.ml"
in
-# 3015 "parsing/parser.mly"
+# 3028 "parsing/parser.mly"
( ps )
-# 45564 "parsing/parser.ml"
+# 45791 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3023 "parsing/parser.mly"
+# 3036 "parsing/parser.mly"
( Ptyp_var tyvar )
-# 45597 "parsing/parser.ml"
+# 45824 "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
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 45606 "parsing/parser.ml"
+# 45833 "parsing/parser.ml"
in
-# 3026 "parsing/parser.mly"
+# 3039 "parsing/parser.mly"
( _1 )
-# 45612 "parsing/parser.ml"
+# 45839 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3025 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
( Ptyp_any )
-# 45638 "parsing/parser.ml"
+# 45865 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 920 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 45646 "parsing/parser.ml"
+# 45873 "parsing/parser.ml"
in
-# 3026 "parsing/parser.mly"
+# 3039 "parsing/parser.mly"
( _1 )
-# 45652 "parsing/parser.ml"
+# 45879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3030 "parsing/parser.mly"
+# 3043 "parsing/parser.mly"
( NoVariance, NoInjectivity )
-# 45670 "parsing/parser.ml"
+# 45897 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3031 "parsing/parser.mly"
+# 3044 "parsing/parser.mly"
( Covariant, NoInjectivity )
-# 45695 "parsing/parser.ml"
+# 45922 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3032 "parsing/parser.mly"
+# 3045 "parsing/parser.mly"
( Contravariant, NoInjectivity )
-# 45720 "parsing/parser.ml"
+# 45947 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3033 "parsing/parser.mly"
+# 3046 "parsing/parser.mly"
( NoVariance, Injective )
-# 45745 "parsing/parser.ml"
+# 45972 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3034 "parsing/parser.mly"
+# 3047 "parsing/parser.mly"
( Covariant, Injective )
-# 45777 "parsing/parser.ml"
+# 46004 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3034 "parsing/parser.mly"
+# 3047 "parsing/parser.mly"
( Covariant, Injective )
-# 45809 "parsing/parser.ml"
+# 46036 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3035 "parsing/parser.mly"
+# 3048 "parsing/parser.mly"
( Contravariant, Injective )
-# 45841 "parsing/parser.ml"
+# 46068 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 3035 "parsing/parser.mly"
+# 3048 "parsing/parser.mly"
( Contravariant, Injective )
-# 45873 "parsing/parser.ml"
+# 46100 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 683 "parsing/parser.mly"
(string)
-# 45894 "parsing/parser.ml"
+# 46121 "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.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3037 "parsing/parser.mly"
+# 3050 "parsing/parser.mly"
( if _1 = "+!" then Covariant, Injective else
if _1 = "-!" then Contravariant, Injective else
expecting _loc__1_ "type_variance" )
-# 45905 "parsing/parser.ml"
+# 46132 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 729 "parsing/parser.mly"
(string)
-# 45926 "parsing/parser.ml"
+# 46153 "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.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3041 "parsing/parser.mly"
+# 3054 "parsing/parser.mly"
( if _1 = "!+" then Covariant, Injective else
if _1 = "!-" then Contravariant, Injective else
expecting _loc__1_ "type_variance" )
-# 45937 "parsing/parser.ml"
+# 46164 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 45971 "parsing/parser.ml"
+# 46198 "parsing/parser.ml"
in
let xs =
let _1 =
-# 953 "parsing/parser.mly"
+# 957 "parsing/parser.mly"
( [] )
-# 45977 "parsing/parser.ml"
+# 46204 "parsing/parser.ml"
in
-# 1185 "parsing/parser.mly"
+# 1189 "parsing/parser.mly"
( _1 )
-# 45982 "parsing/parser.ml"
+# 46209 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 45988 "parsing/parser.ml"
+# 46215 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 879 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 45997 "parsing/parser.ml"
+# 46224 "parsing/parser.ml"
in
-# 1178 "parsing/parser.mly"
+# 1182 "parsing/parser.mly"
( _1 )
-# 46003 "parsing/parser.ml"
+# 46230 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 46051 "parsing/parser.ml"
+# 46278 "parsing/parser.ml"
in
let xs =
let _1 =
let _1 =
let _1 =
let attrs =
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 46061 "parsing/parser.ml"
+# 46288 "parsing/parser.ml"
in
-# 1379 "parsing/parser.mly"
+# 1393 "parsing/parser.mly"
( mkstrexp e attrs )
-# 46066 "parsing/parser.ml"
+# 46293 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( Ptop_def [_1] )
-# 46072 "parsing/parser.ml"
+# 46299 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 895 "parsing/parser.mly"
+# 899 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 46080 "parsing/parser.ml"
+# 46307 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 959 "parsing/parser.mly"
( x )
-# 46086 "parsing/parser.ml"
+# 46313 "parsing/parser.ml"
in
-# 1185 "parsing/parser.mly"
+# 1189 "parsing/parser.mly"
( _1 )
-# 46092 "parsing/parser.ml"
+# 46319 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 46098 "parsing/parser.ml"
+# 46325 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 879 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 46107 "parsing/parser.ml"
+# 46334 "parsing/parser.ml"
in
-# 1178 "parsing/parser.mly"
+# 1182 "parsing/parser.mly"
( _1 )
-# 46113 "parsing/parser.ml"
+# 46340 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) =
-# 3519 "parsing/parser.mly"
+# 3537 "parsing/parser.mly"
( _2 )
-# 46152 "parsing/parser.ml"
+# 46379 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3520 "parsing/parser.mly"
+# 3538 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 46193 "parsing/parser.ml"
+# 46420 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) = let _loc__2_ = (_startpos__2_, _endpos__2_) in
-# 3521 "parsing/parser.mly"
+# 3539 "parsing/parser.mly"
( expecting _loc__2_ "operator" )
-# 46226 "parsing/parser.ml"
+# 46453 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3522 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( expecting _loc__3_ "module-expr" )
-# 46266 "parsing/parser.ml"
+# 46493 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (
# 705 "parsing/parser.mly"
(string)
-# 46287 "parsing/parser.ml"
+# 46514 "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) =
-# 3525 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( _1 )
-# 46295 "parsing/parser.ml"
+# 46522 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3526 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( _1 )
-# 46320 "parsing/parser.ml"
+# 46547 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3594 "parsing/parser.mly"
+# 3612 "parsing/parser.mly"
( _1 )
-# 46345 "parsing/parser.ml"
+# 46572 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 46392 "parsing/parser.ml"
+# 46619 "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
Parsetree.attributes) = let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 46406 "parsing/parser.ml"
+# 46633 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46414 "parsing/parser.ml"
+# 46641 "parsing/parser.ml"
in
let attrs =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46420 "parsing/parser.ml"
+# 46647 "parsing/parser.ml"
in
let _1 =
-# 3734 "parsing/parser.mly"
+# 3752 "parsing/parser.mly"
( Fresh )
-# 46425 "parsing/parser.ml"
+# 46652 "parsing/parser.ml"
in
-# 1951 "parsing/parser.mly"
+# 1965 "parsing/parser.mly"
( (label, mutable_, Cfk_virtual ty), attrs )
-# 46430 "parsing/parser.ml"
+# 46657 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 46477 "parsing/parser.ml"
+# 46704 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 46491 "parsing/parser.ml"
+# 46718 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46499 "parsing/parser.ml"
+# 46726 "parsing/parser.ml"
in
let _2 =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46505 "parsing/parser.ml"
+# 46732 "parsing/parser.ml"
in
let _1 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 46510 "parsing/parser.ml"
+# 46737 "parsing/parser.ml"
in
-# 1953 "parsing/parser.mly"
+# 1967 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 46515 "parsing/parser.ml"
+# 46742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 46568 "parsing/parser.ml"
+# 46795 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 46583 "parsing/parser.ml"
+# 46810 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46591 "parsing/parser.ml"
+# 46818 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46599 "parsing/parser.ml"
+# 46826 "parsing/parser.ml"
in
let _1 =
-# 3738 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( Override )
-# 46605 "parsing/parser.ml"
+# 46832 "parsing/parser.ml"
in
-# 1953 "parsing/parser.mly"
+# 1967 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 46610 "parsing/parser.ml"
+# 46837 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (
# 705 "parsing/parser.mly"
(string)
-# 46664 "parsing/parser.ml"
+# 46891 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 46678 "parsing/parser.ml"
+# 46905 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46686 "parsing/parser.ml"
+# 46913 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46693 "parsing/parser.ml"
+# 46920 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3737 "parsing/parser.mly"
+# 3755 "parsing/parser.mly"
( Fresh )
-# 46699 "parsing/parser.ml"
+# 46926 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__7_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1956 "parsing/parser.mly"
+# 1970 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 46719 "parsing/parser.ml"
+# 46946 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (
# 705 "parsing/parser.mly"
(string)
-# 46779 "parsing/parser.ml"
+# 47006 "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
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3493 "parsing/parser.mly"
+# 3511 "parsing/parser.mly"
( _1 )
-# 46794 "parsing/parser.ml"
+# 47021 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46802 "parsing/parser.ml"
+# 47029 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46811 "parsing/parser.ml"
+# 47038 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3738 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( Override )
-# 46818 "parsing/parser.ml"
+# 47045 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1956 "parsing/parser.mly"
+# 1970 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 46837 "parsing/parser.ml"
+# 47064 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3831 "parsing/parser.mly"
+# 3849 "parsing/parser.mly"
( _1 )
-# 46906 "parsing/parser.ml"
+# 47133 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46918 "parsing/parser.ml"
+# 47145 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3835 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( _1 )
-# 46926 "parsing/parser.ml"
+# 47153 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2872 "parsing/parser.mly"
+# 2885 "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 )
-# 46939 "parsing/parser.ml"
+# 47166 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.virtual_flag) =
-# 3698 "parsing/parser.mly"
+# 3716 "parsing/parser.mly"
( Concrete )
-# 46957 "parsing/parser.ml"
+# 47184 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.virtual_flag) =
-# 3699 "parsing/parser.mly"
+# 3717 "parsing/parser.mly"
( Virtual )
-# 46982 "parsing/parser.ml"
+# 47209 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3722 "parsing/parser.mly"
+# 3740 "parsing/parser.mly"
( Immutable )
-# 47007 "parsing/parser.ml"
+# 47234 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3723 "parsing/parser.mly"
+# 3741 "parsing/parser.mly"
( Mutable )
-# 47039 "parsing/parser.ml"
+# 47266 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3724 "parsing/parser.mly"
+# 3742 "parsing/parser.mly"
( Mutable )
-# 47071 "parsing/parser.ml"
+# 47298 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3729 "parsing/parser.mly"
+# 3747 "parsing/parser.mly"
( Public )
-# 47096 "parsing/parser.ml"
+# 47323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3730 "parsing/parser.mly"
+# 3748 "parsing/parser.mly"
( Private )
-# 47128 "parsing/parser.ml"
+# 47355 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3731 "parsing/parser.mly"
+# 3749 "parsing/parser.mly"
( Private )
-# 47160 "parsing/parser.ml"
+# 47387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 47222 "parsing/parser.ml"
+# 47449 "parsing/parser.ml"
in
-# 967 "parsing/parser.mly"
+# 971 "parsing/parser.mly"
( xs )
-# 47227 "parsing/parser.ml"
+# 47454 "parsing/parser.ml"
in
-# 2972 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( _1 )
-# 47233 "parsing/parser.ml"
+# 47460 "parsing/parser.ml"
in
let _endpos__6_ = _endpos_xs_ in
let _5 =
let _1 = _1_inlined2 in
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 47242 "parsing/parser.ml"
+# 47469 "parsing/parser.ml"
in
let _3 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47253 "parsing/parser.ml"
+# 47480 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3208 "parsing/parser.mly"
+# 3226 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_type
(_3,
~manifest:_5
~priv:_4
~loc:(make_loc _sloc))) )
-# 47270 "parsing/parser.ml"
+# 47497 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.with_constraint) = let _5 =
let _1 = _1_inlined2 in
-# 3289 "parsing/parser.mly"
+# 3307 "parsing/parser.mly"
( _1 )
-# 47325 "parsing/parser.ml"
+# 47552 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47337 "parsing/parser.ml"
+# 47564 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3221 "parsing/parser.mly"
+# 3239 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_typesubst
(_3,
~params:_2
~manifest:_5
~loc:(make_loc _sloc))) )
-# 47352 "parsing/parser.ml"
+# 47579 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47403 "parsing/parser.ml"
+# 47630 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47414 "parsing/parser.ml"
+# 47641 "parsing/parser.ml"
in
-# 3229 "parsing/parser.mly"
+# 3247 "parsing/parser.mly"
( Pwith_module (_2, _4) )
-# 47420 "parsing/parser.ml"
+# 47647 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47471 "parsing/parser.ml"
+# 47698 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47482 "parsing/parser.ml"
+# 47709 "parsing/parser.ml"
in
-# 3231 "parsing/parser.mly"
+# 3249 "parsing/parser.mly"
( Pwith_modsubst (_2, _4) )
-# 47488 "parsing/parser.ml"
+# 47715 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47546 "parsing/parser.ml"
+# 47773 "parsing/parser.ml"
in
-# 3233 "parsing/parser.mly"
+# 3251 "parsing/parser.mly"
( Pwith_modtype (l, rhs) )
-# 47552 "parsing/parser.ml"
+# 47779 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 883 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 47610 "parsing/parser.ml"
+# 47837 "parsing/parser.ml"
in
-# 3235 "parsing/parser.mly"
+# 3253 "parsing/parser.mly"
( Pwith_modtypesubst (l, rhs) )
-# 47616 "parsing/parser.ml"
+# 47843 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3238 "parsing/parser.mly"
+# 3256 "parsing/parser.mly"
( Public )
-# 47641 "parsing/parser.ml"
+# 47868 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3239 "parsing/parser.mly"
+# 3257 "parsing/parser.mly"
( Private )
-# 47673 "parsing/parser.ml"
+# 47900 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let use_file =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1828 lexer lexbuf) : (Parsetree.toplevel_phrase list))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1846 lexer lexbuf) : (Parsetree.toplevel_phrase list))
and toplevel_phrase =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1808 lexer lexbuf) : (Parsetree.toplevel_phrase))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1826 lexer lexbuf) : (Parsetree.toplevel_phrase))
and parse_val_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1802 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1820 lexer lexbuf) : (Longident.t))
and parse_pattern =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1798 lexer lexbuf) : (Parsetree.pattern))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1816 lexer lexbuf) : (Parsetree.pattern))
and parse_mty_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1794 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1812 lexer lexbuf) : (Longident.t))
+
+and parse_module_type =
+ fun lexer lexbuf ->
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1808 lexer lexbuf) : (Parsetree.module_type))
+
+and parse_module_expr =
+ fun lexer lexbuf ->
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1804 lexer lexbuf) : (Parsetree.module_expr))
and parse_mod_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1790 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1800 lexer lexbuf) : (Longident.t))
and parse_mod_ext_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1786 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1796 lexer lexbuf) : (Longident.t))
and parse_expression =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1782 lexer lexbuf) : (Parsetree.expression))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1792 lexer lexbuf) : (Parsetree.expression))
and parse_core_type =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1778 lexer lexbuf) : (Parsetree.core_type))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1788 lexer lexbuf) : (Parsetree.core_type))
and parse_constr_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1774 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1784 lexer lexbuf) : (Longident.t))
and parse_any_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1756 lexer lexbuf) : (Longident.t))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1766 lexer lexbuf) : (Longident.t))
and interface =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry `Simplified 1752 lexer lexbuf) : (Parsetree.signature))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1762 lexer lexbuf) : (Parsetree.signature))
and implementation =
fun lexer lexbuf ->
let use_file =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1828 initial_position) : (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1846 initial_position) : (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint)
and toplevel_phrase =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1808 initial_position) : (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1826 initial_position) : (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint)
and parse_val_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1802 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1820 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_pattern =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1798 initial_position) : (Parsetree.pattern) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1816 initial_position) : (Parsetree.pattern) MenhirInterpreter.checkpoint)
and parse_mty_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1794 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1812 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+
+ and parse_module_type =
+ fun initial_position ->
+ (Obj.magic (MenhirInterpreter.start 1808 initial_position) : (Parsetree.module_type) MenhirInterpreter.checkpoint)
+
+ and parse_module_expr =
+ fun initial_position ->
+ (Obj.magic (MenhirInterpreter.start 1804 initial_position) : (Parsetree.module_expr) MenhirInterpreter.checkpoint)
and parse_mod_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1790 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1800 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_mod_ext_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1786 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1796 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_expression =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1782 initial_position) : (Parsetree.expression) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1792 initial_position) : (Parsetree.expression) MenhirInterpreter.checkpoint)
and parse_core_type =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1778 initial_position) : (Parsetree.core_type) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1788 initial_position) : (Parsetree.core_type) MenhirInterpreter.checkpoint)
and parse_constr_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1774 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1784 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_any_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1756 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1766 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and interface =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1752 initial_position) : (Parsetree.signature) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1762 initial_position) : (Parsetree.signature) MenhirInterpreter.checkpoint)
and implementation =
fun initial_position ->
end
-# 3867 "parsing/parser.mly"
+# 3885 "parsing/parser.mly"
-# 47810 "parsing/parser.ml"
+# 48053 "parsing/parser.ml"
# 269 "<standard.mly>"
-# 47815 "parsing/parser.ml"
+# 48058 "parsing/parser.ml"
val parse_mty_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
+val parse_module_type: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.module_type)
+
+val parse_module_expr: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Parsetree.module_expr)
+
val parse_mod_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_mod_ext_longident: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Longident.t)
val parse_mty_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
+ val parse_module_type: Lexing.position -> (Parsetree.module_type) MenhirInterpreter.checkpoint
+
+ val parse_module_expr: Lexing.position -> (Parsetree.module_expr) MenhirInterpreter.checkpoint
+
val parse_mod_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
val parse_mod_ext_longident: Lexing.position -> (Longident.t) MenhirInterpreter.checkpoint
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Sebastien Hinderer, projet Cambium, INRIA Paris *
+#* *
+#* Copyright 2021 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# This file contains all the macros used to describe the current version of
+# OCaml. It first defines the basic components and then computes all
+# the different variants of the version used across the build system.
+
+# For the M4 macros defined below, we use the OCAML__ (with a double
+# underscore) to distinguish them from the C preprocessor macros which
+# use a single underscore, since the two families of macros coexist
+# in configure.ac.
+
+# The following macro, OCAML__DEVELOPMENT_VERSION, should be either
+# [true] of [false].
+
+m4_define([OCAML__DEVELOPMENT_VERSION], [false])
+
+# The three following components (major, minor and patch level) MUST be
+# integers. They MUST NOT be left-padded with zeros and all of them,
+# including the patchlevel, are mandatory.
+
+m4_define([OCAML__VERSION_MAJOR], [4])
+m4_define([OCAML__VERSION_MINOR], [14])
+m4_define([OCAML__VERSION_PATCHLEVEL], [0])
+# Note that the OCAML__VERSION_EXTRA string defined below is always empty
+# for officially-released versions of OCaml.
+m4_define([OCAML__VERSION_EXTRA], [])
+
+# The OCAML__VERSION_EXTRA_PREFIX macro defined below should be a
+# single character:
+# Either [~] to mean that we are approaching the OCaml public release
+# OCAML__VERSION_MAJOR.OCAML__VERSION_MINOR.OCAML__VERSION_PATCHLEVEL
+# and with an empty OCAML__VERSION_EXTRA string;
+# Or [+] to give more info about this specific version.
+# Development releases, for instance, should use a [+] prefix.
+m4_define([OCAML__VERSION_EXTRA_PREFIX], [+])
+m4_define([OCAML__VERSION_SHORT], [OCAML__VERSION_MAJOR.OCAML__VERSION_MINOR])
+# The OCAML__VERSION below must be in the format specified in stdlib/sys.mli
+m4_define([OCAML__VERSION],
+ [m4_do(
+ OCAML__VERSION_SHORT.OCAML__VERSION_PATCHLEVEL,
+ m4_if(OCAML__VERSION_EXTRA,[],[],
+ OCAML__VERSION_EXTRA_PREFIX[]OCAML__VERSION_EXTRA))])
+
+# Generate the VERSION file
+# The following command is invoked when autoconf is run to generate configure
+# from configure.ac, not while configure itself is run.
+# In other words, both VERSION and configure are produced by invoking
+# autoconf (usually done by calling tools/autogen for this project)
+m4_syscmd([cat > VERSION << END_OF_VERSION_FILE
+]OCAML__VERSION[
+
+# Starting with OCaml 4.14, although the version string that appears above is
+# still correct and this file can thus still be used to figure it out,
+# the version itself is actually defined in the build-aux/ocaml_version.m4
+# file (See the OCAML__VERSION* macros there.)
+# To update the present VERSION file:
+# 1. Update build-aux/ocaml_version.m4
+# 2. Run tools/autogen.
+# 3. If you are in a context where version control matters,
+# commit the changes to both build-aux/ocaml_version.m4 and VERSION.
+# The version string must be in the format described in stdlib/sys.mli
+END_OF_VERSION_FILE
+])
+
+# Other variants of the version needed here and there in the compiler
+
+m4_define([OCAML__VERSION_NUMBER],
+ [m4_format(
+ [%d%02d%02d],
+ OCAML__VERSION_MAJOR,
+ OCAML__VERSION_MINOR,
+ OCAML__VERSION_PATCHLEVEL)])
+
+m4_define([OCAML__RELEASE_EXTRA],
+ m4_if(OCAML__VERSION_EXTRA,[],[None],
+ ['Some (]m4_if(OCAML__VERSION_EXTRA_PREFIX,+,[Plus],
+ [Tilde])[, "]OCAML__VERSION_EXTRA[")']))]))
| Pisout -> Kisout
| Pbintofint bi -> comp_bint_primitive bi "of_int" args
| Pintofbint bi -> comp_bint_primitive bi "to_int" args
- | Pcvtbint(Pint32, Pnativeint) -> Kccall("caml_nativeint_of_int32", 1)
- | Pcvtbint(Pnativeint, Pint32) -> Kccall("caml_nativeint_to_int32", 1)
- | Pcvtbint(Pint32, Pint64) -> Kccall("caml_int64_of_int32", 1)
- | Pcvtbint(Pint64, Pint32) -> Kccall("caml_int64_to_int32", 1)
- | Pcvtbint(Pnativeint, Pint64) -> Kccall("caml_int64_of_nativeint", 1)
- | Pcvtbint(Pint64, Pnativeint) -> Kccall("caml_int64_to_nativeint", 1)
+ | Pcvtbint(src, dst) ->
+ begin match (src, dst) with
+ | (Pint32, Pnativeint) -> Kccall("caml_nativeint_of_int32", 1)
+ | (Pnativeint, Pint32) -> Kccall("caml_nativeint_to_int32", 1)
+ | (Pint32, Pint64) -> Kccall("caml_int64_of_int32", 1)
+ | (Pint64, Pint32) -> Kccall("caml_int64_to_int32", 1)
+ | (Pnativeint, Pint64) -> Kccall("caml_int64_of_nativeint", 1)
+ | (Pint64, Pnativeint) -> Kccall("caml_int64_to_nativeint", 1)
+ | ((Pint32 | Pint64 | Pnativeint), _) ->
+ fatal_error "Bytegen.comp_primitive: invalid Pcvtbint cast"
+ end
| Pnegbint bi -> comp_bint_primitive bi "neg" args
| Paddbint bi -> comp_bint_primitive bi "add" args
| Psubbint bi -> comp_bint_primitive bi "sub" args
| Pint_as_pointer -> Kccall("caml_int_as_pointer", 1)
| Pbytes_to_string -> Kccall("caml_string_of_bytes", 1)
| Pbytes_of_string -> Kccall("caml_bytes_of_string", 1)
- | _ -> fatal_error "Bytegen.comp_primitive"
+ (* The cases below are handled in [comp_expr] before the [comp_primitive] call
+ (in the order in which they appear below),
+ so they should never be reached in this function. *)
+ | Pignore | Popaque
+ | Pnot | Psequand | Psequor
+ | Praise _
+ | Pmakearray _ | Pduparray _
+ | Pfloatcomp _
+ | Pmakeblock _
+ | Pfloatfield _
+ ->
+ fatal_error "Bytegen.comp_primitive"
let is_immed n = immed_min <= n && n <= immed_max
\n#endif\
\n#include <caml/mlvalues.h>\
\n#include <caml/startup.h>\
-\n#include <caml/sys.h>\n";
+\n#include <caml/sys.h>\
+\n#include <caml/misc.h>\n";
output_string outchan "static int caml_code[] = {\n";
Symtable.init();
clear_crc_interfaces ();
(* The entry point *)
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\
+\nint main_os(int argc, char_os **argv)\
\n{\
\n caml_byte_program_mode = COMPLETE_EXE;\
\n caml_startup_code(caml_code, sizeof(caml_code),\
utils/domainstate.cmo \
utils/binutils.cmo \
utils/lazy_backtrack.cmo \
- utils/diffing.cmo
+ utils/diffing.cmo \
+ utils/diffing_with_keys.cmo
UTILS_CMI =
PARSING = \
typing/path.cmo \
typing/primitive.cmo \
typing/type_immediacy.cmo \
+ typing/shape.cmo \
typing/types.cmo \
typing/btype.cmo \
typing/oprint.cmo \
lambda/translcore.cmo \
lambda/translclass.cmo \
lambda/translmod.cmo \
+ lambda/tmc.cmo \
lambda/simplif.cmo \
lambda/runtimedef.cmo
LAMBDA_CMI =
OPTTOPLEVEL = \
toplevel/genprintval.cmo \
toplevel/topcommon.cmo \
+ toplevel/native/tophooks.cmo \
toplevel/native/topeval.cmo \
toplevel/native/trace.cmo \
toplevel/toploop.cmo \
toplevel/native/topmain.cmo
OPTTOPLEVEL_CMI = \
toplevel/topcommon.cmi \
+ toplevel/native/tophooks.cmi \
toplevel/native/topeval.cmi \
toplevel/native/trace.cmi \
toplevel/toploop.cmi \
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.13.1.
+# Generated by GNU Autoconf 2.69 for OCaml 4.14.0.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.13.1'
-PACKAGE_STRING='OCaml 4.13.1'
+PACKAGE_VERSION='4.14.0'
+PACKAGE_STRING='OCaml 4.14.0'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
frame_pointers
profinfo_width
profinfo
+install_ocamlnat
install_source_artifacts
install_bytecode_programs
mksharedlibrpath
mkexedebugflag
mkexe
fpic
-libraries_man_section
-programs_man_section
extralibs
syslib
outputobj
ac_tool_prefix
DIRECT_CPP
CC
+OCAML_VERSION_SHORT
+OCAML_VERSION_EXTRA
+OCAML_VERSION_PATCHLEVEL
+OCAML_VERSION_MINOR
+OCAML_VERSION_MAJOR
+OCAML_RELEASE_EXTRA
+OCAML_DEVELOPMENT_VERSION
VERSION
native_compiler
CONFIGURE_ARGS
enable_ocamldoc
with_odoc
enable_ocamltest
+enable_native_toplevel
enable_frame_pointers
enable_naked_pointers
enable_naked_pointers_checker
# 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.13.1 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.14.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OCaml 4.13.1:";;
+ short | recursive ) echo "Configuration of OCaml 4.14.0:";;
esac
cat <<\_ACEOF
--disable-bigarray-lib do not build the legacy separate bigarray library
--disable-ocamldoc do not build the ocamldoc documentation system
--disable-ocamltest do not build the ocamltest driver
+ --enable-native-toplevel
+ build the native toplevel
--enable-frame-pointers use frame pointers in runtime and generated code
--disable-naked-pointers
do not allow naked pointers
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.13.1
+OCaml configure 4.14.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
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.13.1, which was
+It was created by OCaml $as_me 4.14.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
-{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.13.1" >&5
-$as_echo "$as_me: Configuring OCaml version 4.13.1" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.14.0" >&5
+$as_echo "$as_me: Configuring OCaml version 4.14.0" >&6;}
# Configuration variables
## Command-line arguments passed to configure
CONFIGURE_ARGS="$*"
-# Command-line tools section of the Unix manual
-programs_man_section=1
-
-# Library section of the Unix manual
-libraries_man_section=3
-
# Command to build executalbes
# In general this command is supposed to use the CFLAGs- and LDFLAGS-
# related variables (OC_CFLAGS and OC_LDFLAGS for ocaml-specific
ocamlc_cppflags=""
oc_ldflags=""
oc_dll_ldflags=""
-with_sharedlibs=true
ostype="Unix"
SO="so"
toolchain="cc"
-VERSION=4.13.1
+VERSION=4.14.0
+
+OCAML_DEVELOPMENT_VERSION=false
+
+OCAML_RELEASE_EXTRA=None
+
+OCAML_VERSION_MAJOR=4
+
+OCAML_VERSION_MINOR=14
+
+OCAML_VERSION_PATCHLEVEL=0
+
+OCAML_VERSION_EXTRA=
+
+OCAML_VERSION_SHORT=4.14
# Note: This is present for the flexdll bootstrap where it exposed as the old
-
-
+
## Generated files
ac_config_files="$ac_config_files Makefile.config"
+ac_config_files="$ac_config_files stdlib/sys.ml"
+
+ac_config_files="$ac_config_files manual/src/version.tex"
+
+ac_config_files="$ac_config_files manual/src/html_processing/src/common.ml"
+
ac_config_files="$ac_config_files tools/eventlog_metadata"
ac_config_headers="$ac_config_headers runtime/caml/m.h"
ac_config_headers="$ac_config_headers runtime/caml/s.h"
+ac_config_headers="$ac_config_headers runtime/caml/version.h"
+
+
+# Definitions related to the version of OCaml
+$as_echo "#define OCAML_VERSION_MAJOR 4" >>confdefs.h
+
+$as_echo "#define OCAML_VERSION_MINOR 14" >>confdefs.h
+
+$as_echo "#define OCAML_VERSION_PATCHLEVEL 0" >>confdefs.h
+
+$as_echo "#define OCAML_VERSION_ADDITIONAL \"\"" >>confdefs.h
+
+ $as_echo "#define OCAML_VERSION_EXTRA \"\"" >>confdefs.h
+
+$as_echo "#define OCAML_VERSION 41400" >>confdefs.h
+
+$as_echo "#define OCAML_VERSION_STRING \"4.14.0\"" >>confdefs.h
+
# Checks for system types
fi
+# Check whether --enable-native-toplevel was given.
+if test "${enable_native_toplevel+set}" = set; then :
+ enableval=$enable_native_toplevel;
+fi
+
+
# Check whether --enable-frame-pointers was given.
if test "${enable_frame_pointers+set}" = set; then :
enableval=$enable_frame_pointers;
otherlibraries="dynlink"
if test x"$enable_unix_lib" != "xno"; then :
+ enable_unix_lib=yes
if test x"$enable_bigarray_lib" != "xno"; then :
otherlibraries="$otherlibraries $unixlib bigarray"
else
cc_warnings='-Wall -Wdeclaration-after-statement' ;;
esac
-case $enable_warn_error,4.13.1 in #(
- yes,*|,*+dev*) :
+case $enable_warn_error,false in #(
+ yes,*|,true) :
cc_warnings="$cc_warnings $warn_error_flag" ;; #(
*) :
;;
common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
internal_cppflags='-DUNICODE -D_UNICODE'
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -d2VolatileMetadata-" >&5
+$as_echo_n "checking whether the C compiler supports -d2VolatileMetadata-... " >&6; }
+ saved_CFLAGS="$CFLAGS"
+ CFLAGS="-d2VolatileMetadata- $CFLAGS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int main() { return 0; }
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cl_has_volatile_metadata=true
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+ cl_has_volatile_metadata=false
+ { $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
+ CFLAGS="$saved_CFLAGS"
+
+ if test "x$cl_has_volatile_metadata" = "xtrue"; then :
+ internal_cflags='-d2VolatileMetadata-'
+fi
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
xlc-*) :
# [enable_shared=yes])
if test x"$enable_shared" = "xno"; then :
- with_sharedlibs=false
+ supports_shared_libraries=false
case $host in #(
*-pc-windows|*-w64-mingw32) :
as_fn_error $? "Cannot build native Win32 with --disable-shared" "$LINENO" 5 ;; #(
*) :
;;
esac
+else
+ supports_shared_libraries=true
fi
# Define flexlink chain and flags correctly for the different Windows ports
;;
esac
-if test x"$enable_shared" != 'xno'; then :
+if test x"$supports_shared_libraries" != 'xfalse'; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for flexdll sources" >&5
$as_echo_n "checking for flexdll sources... " >&6; }
fi
-if test x"$have_flexdll_h" = 'xno'; then :
- case $host in #(
- *-*-cygwin*) :
- if $with_sharedlibs; then :
- with_sharedlibs=false
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexdll.h not found: shared library support disabled." >&5
-$as_echo "$as_me: WARNING: flexdll.h not found: shared library support disabled." >&2;}
-
-fi ;; #(
- *-w64-mingw32|*-pc-windows) :
+case $have_flexdll_h,$supports_shared_libraries,$host in #(
+ no,true,*-*-cygwin*) :
+ supports_shared_libraries=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexdll.h not found: shared library support disabled." >&5
+$as_echo "$as_me: WARNING: flexdll.h not found: shared library support disabled." >&2;} ;; #(
+ no,*,*-w64-mingw32|no,*,*-pc-windows) :
as_fn_error $? "flexdll.h is required for native Win32" "$LINENO" 5 ;; #(
*) :
;;
esac
-fi
-if test -z "$flexdir" -o x"$have_flexdll_h" = 'xno'; then :
- case $host in #(
- *-*-cygwin*) :
- if $with_sharedlibs; then :
- if test -z "$flexlink"; then :
- with_sharedlibs=false
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexlink/flexdll.h not found: shared library support disabled." >&5
-$as_echo "$as_me: WARNING: flexlink/flexdll.h not found: shared library support disabled." >&2;}
-
-fi
-fi ;; #(
- *-w64-mingw32|*-pc-windows) :
- if test -z "$flexlink"; then :
- as_fn_error $? "flexlink is required for native Win32" "$LINENO" 5
-fi ;; #(
+case $flexdir,$supports_shared_libraries,$flexlink,$host in #(
+ ,true,,*-*-cygwin*) :
+ supports_shared_libraries=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexlink not found: shared library support disabled." >&5
+$as_echo "$as_me: WARNING: flexlink not found: shared library support disabled." >&2;} ;; #(
+ ,*,,*-w64-mingw32|,*,,*-pc-windows) :
+ as_fn_error $? "flexlink is required for native Win32" "$LINENO" 5 ;; #(
*) :
;;
esac
-fi
-case $CC,$host in #(
+case $cc_basename,$host in #(
*,*-*-darwin*) :
mkexe="$mkexe -Wl,-no_compact_unwind";
$as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
mathlib="" ;; #(
*,*-*-cygwin*) :
common_cppflags="$common_cppflags -U_WIN32"
- if $with_sharedlibs; then :
+ if $supports_shared_libraries; then :
mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
mkexedebugflag="-link -g"
else
# Shared library support
-shared_libraries_supported=false
sharedlib_cflags=''
mksharedlib='shared-libs-not-available'
rpath=''
mksharedlib="$CC -shared \
-flat_namespace -undefined suppress -Wl,-no_compact_unwind \
\$(LDFLAGS)"
- shared_libraries_supported=true ;; #(
+ supports_shared_libraries=true ;; #(
*-*-mingw32) :
mksharedlib='$(FLEXLINK)'
mkmaindll='$(FLEXLINK) -maindll'
mksharedlib="$mksharedlib -link \"$oc_dll_ldflags\""
mkmaindll="$mkmaindll -link \"$oc_dll_ldflags\""
-fi
- shared_libraries_supported=$with_sharedlibs ;; #(
+fi ;; #(
*-pc-windows) :
mksharedlib='$(FLEXLINK)'
- mkmaindll='$(FLEXLINK) -maindll'
- shared_libraries_supported=$with_sharedlibs ;; #(
+ mkmaindll='$(FLEXLINK) -maindll' ;; #(
*-*-cygwin*) :
mksharedlib='$(FLEXLINK)'
- mkmaindll='$(FLEXLINK) -maindll'
- shared_libraries_supported=$with_sharedlibs ;; #(
+ mkmaindll='$(FLEXLINK) -maindll' ;; #(
powerpc-ibm-aix*) :
case $ocaml_cv_cc_vendor in #(
xlc*) :
mksharedlib="$CC -qmkshrobj -G \$(LDFLAGS)"
- shared_libraries_supported=true ;; #(
+ supports_shared_libraries=true ;; #(
*) :
;;
esac ;; #(
mksharedlib="$CC -shared"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
- shared_libraries_supported=true ;; #(
+ supports_shared_libraries=true ;; #(
*-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
|*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*) :
sharedlib_cflags="-fPIC"
- case $CC,$host in #(
- gcc*,powerpc-*-linux*) :
+ case $cc_basename,$host in #(
+ *gcc*,powerpc-*-linux*) :
mksharedlib="$CC -shared -mbss-plt \$(LDFLAGS)" ;; #(
+ *,i[3456]86-*) :
+ # Disable DT_TEXTREL warnings on Linux and BSD i386
+ # See https://github.com/ocaml/ocaml/issues/9800
+ mksharedlib="$CC -shared \$(LDFLAGS) -Wl,-z,notext" ;; #(
*) :
mksharedlib="$CC -shared \$(LDFLAGS)" ;;
esac
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
natdynlinkopts="-Wl,-E"
- shared_libraries_supported=true ;; #(
+ supports_shared_libraries=true ;; #(
*) :
;;
esac
natdynlink=false
-if test x"$shared_libraries_supported" = 'xtrue'; then :
+if test x"$supports_shared_libraries" = 'xtrue'; then :
case "$host" in #(
*-*-cygwin*) :
natdynlink=true ;; #(
natdynlink=true ;; #(
aarch64-*-freebsd*) :
natdynlink=true ;; #(
+ aarch64-*-openbsd*) :
+ natdynlink=true ;; #(
riscv*-*-linux*) :
natdynlink=true ;; #(
*) :
esac
fi
+case $enable_native_toplevel,$natdynlink in #(
+ yes,false) :
+ as_fn_error $? "The native toplevel requires native dynlink support" "$LINENO" 5 ;; #(
+ yes,*) :
+ install_ocamlnat=true ;; #(
+ *) :
+ install_ocamlnat=false ;;
+esac
+
# Try to work around the Skylake/Kaby Lake processor bug.
-case "$CC,$host" in #(
+case "$cc_basename,$host" in #(
*gcc*,x86_64-*|*gcc*,i686-*) :
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fno-tree-vrp" >&5
arch=amd64; system=netbsd ;; #(
x86_64-*-openbsd*) :
arch=amd64; system=openbsd ;; #(
+ x86_64-*-haiku*) :
+ arch=amd64; system=beos ;; #(
arm64-*-darwin*) :
arch=arm64; system=macosx ;; #(
aarch64-*-darwin*) :
arch=arm64; system=linux ;; #(
aarch64-*-freebsd*) :
arch=arm64; system=freebsd ;; #(
+ aarch64-*-openbsd*) :
+ arch=arm64; system=openbsd ;; #(
x86_64-*-cygwin*) :
arch=amd64; system=cygwin ;; #(
riscv64-*-linux*) :
fi
if test -z "$PARTIALLD"; then :
- case "$arch,$CC,$system,$model" in #(
- amd64,gcc*,macosx,*) :
+ case "$arch,$cc_basename,$system,$model" in #(
+ amd64,*gcc*,macosx,*) :
PACKLD_FLAGS=' -arch x86_64' ;; #(
- power,gcc*,elf,ppc) :
+ power,*gcc*,elf,ppc) :
PACKLD_FLAGS=' -m elf32ppclinux' ;; #(
- power,gcc*,elf,ppc64) :
+ power,*gcc*,elf,ppc64) :
PACKLD_FLAGS=' -m elf64ppc' ;; #(
- power,gcc*,elf,ppc64le) :
+ power,*gcc*,elf,ppc64le) :
PACKLD_FLAGS=' -m elf64lppc' ;; #(
*) :
PACKLD_FLAGS='' ;;
# output filename. Don't assume that all C compilers understand GNU -ofoo
# form, so ensure that the definition includes a space at the end (which is
# achieved using the $(EMPTY) expansion trick).
- if test x"$CC" = "xcl"; then :
+ if test x"$cc_basename" = "xcl"; then :
# For the Microsoft C compiler there must be no space at the end of the
# string.
PACKLD="link -lib -nologo $machine -out:"
# e.g. Ubuntu >= 17.10 for i386, which uses the glibc dynamic loader.
case $arch in #(
- amd64|s390x|none) :
+ amd64|arm64|s390x|none) :
# ocamlopt generates PIC code or doesn't generate code at all
;; #(
*) :
# 1. AS, used to assemble the code generated by the ocamlopt native compiler
# 2. ASPP, to assemble other assembly files that may require preprocessing
# In general, "$CC -c" is used as a default value for both AS and ASPP.
-# On a few platforms (Windows) both values are overriden.
+# On a few platforms (Windows) both values are overridden.
# On other platforms, (Linux with GCC) the assembler AS is called directly
# to avoiding forking a C compiler process for each compilation by ocamlopt.
-# Both AS and ASPP can be overriden by the user.
+# Both AS and ASPP can be overridden by the user.
default_as="$CC -c"
default_aspp="$CC -c"
if test "$ac_res" != no; then :
test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+fi
+
+ ac_fn_c_check_func "$LINENO" "socketpair" "ac_cv_func_socketpair"
+if test "x$ac_cv_func_socketpair" = xyes; then :
+ $as_echo "#define HAS_SOCKETPAIR 1" >>confdefs.h
+
fi
;; #(
*-*-haiku) :
fi
+## Unix domain sockets support on Windows
+
+case $host in #(
+ *-*-mingw32|*-pc-windows) :
+ for ac_header in afunix.h
+do :
+ ac_fn_c_check_header_compile "$LINENO" "afunix.h" "ac_cv_header_afunix_h" "#include <winsock2.h>
+"
+if test "x$ac_cv_header_afunix_h" = xyes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_AFUNIX_H 1
+_ACEOF
+ $as_echo "#define HAS_AFUNIX_H 1" >>confdefs.h
+
+fi
+
+done
+ ;; #(
+ *) :
+ ;;
+esac
+
## IPv6 support
ipv6=true
esac
## shared library support
-if $shared_libraries_supported; then :
+if $supports_shared_libraries; then :
case $host in #(
*-*-mingw32|*-pc-windows|*-*-cygwin*) :
- supports_shared_libraries=$shared_libraries_supported; DLLIBS="" ;; #(
+ DLLIBS="" ;; #(
*) :
ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
if test "x$ac_cv_func_dlopen" = xyes; then :
## Determine if the POSIX threads library is supported
-if test x"$enable_systhreads" = "xno"; then :
- systhread_support=false
- { $as_echo "$as_me:${as_lineno-$LINENO}: the Win32/POSIX threads library is disabled" >&5
-$as_echo "$as_me: the Win32/POSIX threads library is disabled" >&6;}
-else
- case $host in #(
+case $enable_systhreads,$enable_unix_lib in #(
+ yes,no) :
+ systhread_support=false
+ as_fn_error $? "the Win32/POSIX threads library requires the unix library" "$LINENO" 5 ;; #(
+ no,*|*,no) :
+ systhread_support=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: the Win32/POSIX threads library is disabled" >&5
+$as_echo "$as_me: the Win32/POSIX threads library is disabled" >&6;} ;; #(
+ *) :
+ case $host in #(
*-*-mingw32|*-pc-windows) :
systhread_support=true
otherlibraries="$otherlibraries systhreads"
ac_compiler_gnu=$ac_cv_c_compiler_gnu
;;
+esac ;;
esac
-fi
## Does the assembler support debug prefix map and CFI directives
as_has_debug_prefix_map=false
## Frame pointers
if test x"$enable_frame_pointers" = "xyes"; then :
- case "$host,$CC" in #(
+ case "$host,$cc_basename" in #(
x86_64-*-linux*,gcc*|x86_64-*-linux*,clang*) :
common_cflags="$common_cflags -g -fno-omit-frame-pointer"
frame_pointers=true
-case $enable_ocamltest,4.13.1 in #(
- yes,*|,*+dev*) :
+case $enable_ocamltest,false in #(
+ yes,*|,true) :
ocamltest='ocamltest' ;; #(
*) :
ocamltest='' ;;
# 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.13.1, which was
+This file was extended by OCaml $as_me 4.14.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
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.13.1
+OCaml config.status 4.14.0
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
case $ac_config_target in
"Makefile.build_config") CONFIG_FILES="$CONFIG_FILES Makefile.build_config" ;;
"Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;;
+ "stdlib/sys.ml") CONFIG_FILES="$CONFIG_FILES stdlib/sys.ml" ;;
+ "manual/src/version.tex") CONFIG_FILES="$CONFIG_FILES manual/src/version.tex" ;;
+ "manual/src/html_processing/src/common.ml") CONFIG_FILES="$CONFIG_FILES manual/src/html_processing/src/common.ml" ;;
"tools/eventlog_metadata") CONFIG_FILES="$CONFIG_FILES tools/eventlog_metadata" ;;
"runtime/caml/m.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/m.h" ;;
"runtime/caml/s.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/s.h" ;;
+ "runtime/caml/version.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/version.h" ;;
"libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;;
*) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
for (key in D) D_is_set[key] = 1
FS = "\a"
}
-/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\r?\$)/ {
line = \$ 0
- split(line, arg, " ")
+ split(line, arg, /[ \r\t]/)
if (arg[1] == "#") {
defundef = arg[2]
mac1 = arg[3]
# Require Autoconf 2.69 for repeatability in CI
AC_PREREQ([2.69])
AC_INIT([OCaml],
- m4_esyscmd([head -n1 VERSION | tr -d '\r\n']),
+ [OCAML__VERSION],
[caml-list@inria.fr],
[ocaml],
[http://www.ocaml.org])
## Command-line arguments passed to configure
CONFIGURE_ARGS="$*"
-# Command-line tools section of the Unix manual
-programs_man_section=1
-
-# Library section of the Unix manual
-libraries_man_section=3
-
# Command to build executalbes
# In general this command is supposed to use the CFLAGs- and LDFLAGS-
# related variables (OC_CFLAGS and OC_LDFLAGS for ocaml-specific
ocamlc_cppflags=""
oc_ldflags=""
oc_dll_ldflags=""
-with_sharedlibs=true
ostype="Unix"
SO="so"
toolchain="cc"
AC_SUBST([CONFIGURE_ARGS])
AC_SUBST([native_compiler])
AC_SUBST([VERSION], [AC_PACKAGE_VERSION])
+AC_SUBST([OCAML_DEVELOPMENT_VERSION], [OCAML__DEVELOPMENT_VERSION])
+AC_SUBST([OCAML_RELEASE_EXTRA], [OCAML__RELEASE_EXTRA])
+AC_SUBST([OCAML_VERSION_MAJOR], [OCAML__VERSION_MAJOR])
+AC_SUBST([OCAML_VERSION_MINOR], [OCAML__VERSION_MINOR])
+AC_SUBST([OCAML_VERSION_PATCHLEVEL], [OCAML__VERSION_PATCHLEVEL])
+AC_SUBST([OCAML_VERSION_EXTRA], [OCAML__VERSION_EXTRA])
+AC_SUBST([OCAML_VERSION_SHORT], [OCAML__VERSION_SHORT])
AC_SUBST([CC])
# Note: This is present for the flexdll bootstrap where it exposed as the old
# TOOLPREF variable. It would be better if flexdll where updated to require
AC_SUBST([outputobj])
AC_SUBST([syslib])
AC_SUBST([extralibs])
-AC_SUBST([programs_man_section])
-AC_SUBST([libraries_man_section])
AC_SUBST([fpic])
AC_SUBST([mkexe])
AC_SUBST([mkexedebugflag])
AC_SUBST([mksharedlibrpath])
AC_SUBST([install_bytecode_programs])
AC_SUBST([install_source_artifacts])
+AC_SUBST([install_ocamlnat])
AC_SUBST([profinfo])
AC_SUBST([profinfo_width])
AC_SUBST([frame_pointers])
AC_CONFIG_FILES([Makefile.build_config])
AC_CONFIG_FILES([Makefile.config])
+AC_CONFIG_FILES([stdlib/sys.ml])
+AC_CONFIG_FILES([manual/src/version.tex])
+AC_CONFIG_FILES([manual/src/html_processing/src/common.ml])
AC_CONFIG_FILES([tools/eventlog_metadata])
AC_CONFIG_HEADERS([runtime/caml/m.h])
AC_CONFIG_HEADERS([runtime/caml/s.h])
+AC_CONFIG_HEADERS([runtime/caml/version.h])
+
+# Definitions related to the version of OCaml
+AC_DEFINE([OCAML_VERSION_MAJOR], [OCAML__VERSION_MAJOR])
+AC_DEFINE([OCAML_VERSION_MINOR], [OCAML__VERSION_MINOR])
+AC_DEFINE([OCAML_VERSION_PATCHLEVEL], [OCAML__VERSION_PATCHLEVEL])
+m4_if([OCAML__VERSION_EXTRA],[], [],
+ [AC_DEFINE([OCAML_VERSION_ADDITIONAL], ["][OCAML__VERSION_EXTRA]["])
+ AC_DEFINE([OCAML_VERSION_EXTRA], ["][OCAML__VERSION_EXTRA]["])])
+AC_DEFINE([OCAML_VERSION], [OCAML__VERSION_NUMBER])
+AC_DEFINE([OCAML_VERSION_STRING], ["][OCAML__VERSION]["])
# Checks for system types
[AS_HELP_STRING([--disable-ocamltest],
[do not build the ocamltest driver])])
+AC_ARG_ENABLE([native-toplevel],
+ [AS_HELP_STRING([--enable-native-toplevel],
+ [build the native toplevel])])
+
AC_ARG_ENABLE([frame-pointers],
[AS_HELP_STRING([--enable-frame-pointers],
[use frame pointers in runtime and generated code])])
otherlibraries="dynlink"
AS_IF([test x"$enable_unix_lib" != "xno"],
- [AS_IF([test x"$enable_bigarray_lib" != "xno"],
+ [enable_unix_lib=yes
+ AS_IF([test x"$enable_bigarray_lib" != "xno"],
[otherlibraries="$otherlibraries $unixlib bigarray"],
[otherlibraries="$otherlibraries $unixlib"])])
AS_IF([test x"$enable_str_lib" != "xno"],
warn_error_flag='-Werror'
cc_warnings='-Wall -Wdeclaration-after-statement'])
-AS_CASE([$enable_warn_error,AC_PACKAGE_VERSION],
- [yes,*|,*+dev*],
+AS_CASE([$enable_warn_error,OCAML__DEVELOPMENT_VERSION],
+ [yes,*|,true],
[cc_warnings="$cc_warnings $warn_error_flag"])
# We select high optimization levels, provided we can turn off:
[common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
internal_cppflags='-DUNICODE -D_UNICODE'
+ OCAML_CL_HAS_VOLATILE_METADATA
+ AS_IF([test "x$cl_has_volatile_metadata" = "xtrue"],
+ [internal_cflags='-d2VolatileMetadata-'])
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
[xlc-*],
# [enable_shared=yes])
AS_IF([test x"$enable_shared" = "xno"],
- [with_sharedlibs=false
+ [supports_shared_libraries=false
AS_CASE([$host],
[*-pc-windows|*-w64-mingw32],
- [AC_MSG_ERROR([Cannot build native Win32 with --disable-shared])])])
+ [AC_MSG_ERROR([Cannot build native Win32 with --disable-shared])])],
+ [supports_shared_libraries=true])
# Define flexlink chain and flags correctly for the different Windows ports
AS_CASE([$host],
[flexdll_chain='msvc64'
flexlink_flags="-x64 -merge-manifest -stack 33554432"])
-AS_IF([test x"$enable_shared" != 'xno'], [
+AS_IF([test x"$supports_shared_libraries" != 'xfalse'], [
AC_MSG_CHECKING([for flexdll sources])
AS_IF([test x"$with_flexdll" = "xno"],
[flexdir=''
])
])
-AS_IF([test x"$have_flexdll_h" = 'xno'],
- [AS_CASE([$host],
- [*-*-cygwin*],
- [AS_IF([$with_sharedlibs],
- [with_sharedlibs=false
- AC_MSG_WARN([flexdll.h not found: shared library support disabled.])
- ])],
- [*-w64-mingw32|*-pc-windows],
- [AC_MSG_ERROR([flexdll.h is required for native Win32])])])
-
-AS_IF([test -z "$flexdir" -o x"$have_flexdll_h" = 'xno'],
- [AS_CASE([$host],
- [*-*-cygwin*],
- [AS_IF([$with_sharedlibs],
- [AS_IF([test -z "$flexlink"],
- [with_sharedlibs=false
- AC_MSG_WARN(
- [flexlink/flexdll.h not found: shared library support disabled.])
- ])])],
- [*-w64-mingw32|*-pc-windows],
- [AS_IF([test -z "$flexlink"],
- [AC_MSG_ERROR([flexlink is required for native Win32])])])])
-
-AS_CASE([$CC,$host],
+AS_CASE([$have_flexdll_h,$supports_shared_libraries,$host],
+ [no,true,*-*-cygwin*],
+ [supports_shared_libraries=false
+ AC_MSG_WARN([flexdll.h not found: shared library support disabled.])],
+ [no,*,*-w64-mingw32|no,*,*-pc-windows],
+ [AC_MSG_ERROR([flexdll.h is required for native Win32])])
+
+AS_CASE([$flexdir,$supports_shared_libraries,$flexlink,$host],
+ [,true,,*-*-cygwin*],
+ [supports_shared_libraries=false
+ AC_MSG_WARN([flexlink not found: shared library support disabled.])],
+ [,*,,*-w64-mingw32|,*,,*-pc-windows],
+ [AC_MSG_ERROR([flexlink is required for native Win32])])
+
+AS_CASE([$cc_basename,$host],
[*,*-*-darwin*],
[mkexe="$mkexe -Wl,-no_compact_unwind";
AC_DEFINE([HAS_ARCH_CODE32], [1])],
[*,*-*-haiku*], [mathlib=""],
[*,*-*-cygwin*],
[common_cppflags="$common_cppflags -U_WIN32"
- AS_IF([$with_sharedlibs],
+ AS_IF([$supports_shared_libraries],
[mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
mkexedebugflag="-link -g"],
[mkexe="$mkexe -Wl,--stack,16777216"
# Shared library support
-shared_libraries_supported=false
sharedlib_cflags=''
mksharedlib='shared-libs-not-available'
rpath=''
[mksharedlib="$CC -shared \
-flat_namespace -undefined suppress -Wl,-no_compact_unwind \
\$(LDFLAGS)"
- shared_libraries_supported=true],
+ supports_shared_libraries=true],
[*-*-mingw32],
[mksharedlib='$(FLEXLINK)'
mkmaindll='$(FLEXLINK) -maindll'
AS_IF([test -n "$oc_dll_ldflags"],[
mksharedlib="$mksharedlib -link \"$oc_dll_ldflags\""
- mkmaindll="$mkmaindll -link \"$oc_dll_ldflags\""])
- shared_libraries_supported=$with_sharedlibs],
+ mkmaindll="$mkmaindll -link \"$oc_dll_ldflags\""])],
[*-pc-windows],
[mksharedlib='$(FLEXLINK)'
- mkmaindll='$(FLEXLINK) -maindll'
- shared_libraries_supported=$with_sharedlibs],
+ mkmaindll='$(FLEXLINK) -maindll'],
[*-*-cygwin*],
[mksharedlib='$(FLEXLINK)'
- mkmaindll='$(FLEXLINK) -maindll'
- shared_libraries_supported=$with_sharedlibs],
+ mkmaindll='$(FLEXLINK) -maindll'],
[powerpc-ibm-aix*],
[AS_CASE([$ocaml_cv_cc_vendor],
[xlc*],
[mksharedlib="$CC -qmkshrobj -G \$(LDFLAGS)"
- shared_libraries_supported=true])],
+ supports_shared_libraries=true])],
[*-*-solaris*],
[sharedlib_cflags="-fPIC"
mksharedlib="$CC -shared"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
- shared_libraries_supported=true],
+ supports_shared_libraries=true],
[[*-*-linux*|*-*-freebsd[3-9]*|*-*-freebsd[1-9][0-9]*\
|*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*]],
[sharedlib_cflags="-fPIC"
- AS_CASE([$CC,$host],
- [gcc*,powerpc-*-linux*],
+ AS_CASE([$cc_basename,$host],
+ [*gcc*,powerpc-*-linux*],
[mksharedlib="$CC -shared -mbss-plt \$(LDFLAGS)"],
+ [[*,i[3456]86-*]],
+ # Disable DT_TEXTREL warnings on Linux and BSD i386
+ # See https://github.com/ocaml/ocaml/issues/9800
+ [mksharedlib="$CC -shared \$(LDFLAGS) -Wl,-z,notext"],
[mksharedlib="$CC -shared \$(LDFLAGS)"])
oc_ldflags="$oc_ldflags -Wl,-E"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
natdynlinkopts="-Wl,-E"
- shared_libraries_supported=true])])
+ supports_shared_libraries=true])])
AS_IF([test -z "$mkmaindll"], [mkmaindll=$mksharedlib])
natdynlink=false
-AS_IF([test x"$shared_libraries_supported" = 'xtrue'],
+AS_IF([test x"$supports_shared_libraries" = 'xtrue'],
[AS_CASE(["$host"],
[*-*-cygwin*], [natdynlink=true],
[*-*-mingw32], [natdynlink=true],
[earm*-*-netbsd*], [natdynlink=true],
[aarch64-*-linux*], [natdynlink=true],
[aarch64-*-freebsd*], [natdynlink=true],
+ [aarch64-*-openbsd*], [natdynlink=true],
[riscv*-*-linux*], [natdynlink=true])])
+AS_CASE([$enable_native_toplevel,$natdynlink],
+ [yes,false],
+ [AC_MSG_ERROR(m4_normalize([
+ The native toplevel requires native dynlink support]))],
+ [yes,*],
+ [install_ocamlnat=true],
+ [install_ocamlnat=false])
+
# Try to work around the Skylake/Kaby Lake processor bug.
-AS_CASE(["$CC,$host"],
+AS_CASE(["$cc_basename,$host"],
[*gcc*,x86_64-*|*gcc*,i686-*],
[OCAML_CC_HAS_FNO_TREE_VRP
AS_IF([$cc_has_fno_tree_vrp],
[arch=amd64; system=netbsd],
[x86_64-*-openbsd*],
[arch=amd64; system=openbsd],
+ [x86_64-*-haiku*],
+ [arch=amd64; system=beos],
[arm64-*-darwin*],
[arch=arm64; system=macosx],
[aarch64-*-darwin*],
[arch=arm64; system=linux],
[aarch64-*-freebsd*],
[arch=arm64; system=freebsd],
+ [aarch64-*-openbsd*],
+ [arch=arm64; system=openbsd],
[x86_64-*-cygwin*],
[arch=amd64; system=cygwin],
[riscv64-*-linux*],
AC_CHECK_TOOL([DIRECT_LD],[ld])
AS_IF([test -z "$PARTIALLD"],
- [AS_CASE(["$arch,$CC,$system,$model"],
- [amd64,gcc*,macosx,*], [PACKLD_FLAGS=' -arch x86_64'],
- [power,gcc*,elf,ppc], [PACKLD_FLAGS=' -m elf32ppclinux'],
- [power,gcc*,elf,ppc64], [PACKLD_FLAGS=' -m elf64ppc'],
- [power,gcc*,elf,ppc64le], [PACKLD_FLAGS=' -m elf64lppc'],
+ [AS_CASE(["$arch,$cc_basename,$system,$model"],
+ [amd64,*gcc*,macosx,*], [PACKLD_FLAGS=' -arch x86_64'],
+ [power,*gcc*,elf,ppc], [PACKLD_FLAGS=' -m elf32ppclinux'],
+ [power,*gcc*,elf,ppc64], [PACKLD_FLAGS=' -m elf64ppc'],
+ [power,*gcc*,elf,ppc64le], [PACKLD_FLAGS=' -m elf64lppc'],
[PACKLD_FLAGS=''])
# The string for PACKLD must be capable of being concatenated with the
# output filename. Don't assume that all C compilers understand GNU -ofoo
# form, so ensure that the definition includes a space at the end (which is
# achieved using the $(EMPTY) expansion trick).
- AS_IF([test x"$CC" = "xcl"],
+ AS_IF([test x"$cc_basename" = "xcl"],
# For the Microsoft C compiler there must be no space at the end of the
# string.
[PACKLD="link -lib -nologo $machine -out:"],
# e.g. Ubuntu >= 17.10 for i386, which uses the glibc dynamic loader.
AS_CASE([$arch],
- [amd64|s390x|none],
+ [amd64|arm64|s390x|none],
# ocamlopt generates PIC code or doesn't generate code at all
[],
[AS_CASE([$host],
# 1. AS, used to assemble the code generated by the ocamlopt native compiler
# 2. ASPP, to assemble other assembly files that may require preprocessing
# In general, "$CC -c" is used as a default value for both AS and ASPP.
-# On a few platforms (Windows) both values are overriden.
+# On a few platforms (Windows) both values are overridden.
# On other platforms, (Linux with GCC) the assembler AS is called directly
# to avoiding forking a C compiler process for each compilation by ocamlopt.
-# Both AS and ASPP can be overriden by the user.
+# Both AS and ASPP can be overridden by the user.
default_as="$CC -c"
default_aspp="$CC -c"
AS_CASE([$host],
[*-*-mingw32|*-pc-windows],
[cclibs="$cclibs -lws2_32"
- AC_SEARCH_LIBS([socket], [ws2_32])],
+ AC_SEARCH_LIBS([socket], [ws2_32])
+ AC_CHECK_FUNC([socketpair], [AC_DEFINE([HAS_SOCKETPAIR])])],
[*-*-haiku],
[cclibs="$cclibs -lnetwork"
AC_SEARCH_LIBS([socket], [network])],
AC_CHECK_FUNC([inet_aton], [AC_DEFINE([HAS_INET_ATON])])
+## Unix domain sockets support on Windows
+
+AS_CASE([$host],
+ [*-*-mingw32|*-pc-windows],
+ [AC_CHECK_HEADERS([afunix.h], [AC_DEFINE([HAS_AFUNIX_H])], [],
+ [#include <winsock2.h>])])
+
## IPv6 support
ipv6=true
[AC_CHECK_FUNC([strtod_l], [AC_DEFINE([HAS_STRTOD_L])])])
## shared library support
-AS_IF([$shared_libraries_supported],
+AS_IF([$supports_shared_libraries],
[AS_CASE([$host],
[*-*-mingw32|*-pc-windows|*-*-cygwin*],
- [supports_shared_libraries=$shared_libraries_supported; DLLIBS=""],
+ [DLLIBS=""],
[AC_CHECK_FUNC([dlopen],
[supports_shared_libraries=true DLLIBS=""],
[AC_CHECK_LIB([dl], [dlopen],
## Determine if the POSIX threads library is supported
-AS_IF([test x"$enable_systhreads" = "xno"],
- [systhread_support=false
- AC_MSG_NOTICE([the Win32/POSIX threads library is disabled])],
+AS_CASE([$enable_systhreads,$enable_unix_lib],
+ [yes,no],
+ [systhread_support=false
+ AC_MSG_ERROR([the Win32/POSIX threads library requires the unix library])],
+ [no,*|*,no],
+ [systhread_support=false
+ AC_MSG_NOTICE([the Win32/POSIX threads library is disabled])],
[AS_CASE([$host],
[*-*-mingw32|*-pc-windows],
[systhread_support=true
## Frame pointers
AS_IF([test x"$enable_frame_pointers" = "xyes"],
- [AS_CASE(["$host,$CC"],
+ [AS_CASE(["$host,$cc_basename"],
[x86_64-*-linux*,gcc*|x86_64-*-linux*,clang*],
[common_cflags="$common_cflags -g -fno-omit-frame-pointer"
frame_pointers=true
-AS_CASE([$enable_ocamltest,AC_PACKAGE_VERSION],
- [yes,*|,*+dev*],[ocamltest='ocamltest'],
+AS_CASE([$enable_ocamltest,OCAML__DEVELOPMENT_VERSION],
+ [yes,*|,true],[ocamltest='ocamltest'],
[ocamltest=''])
AS_IF([test x"$enable_flambda" = "xyes"],
debugger_lexer.cmi \
debugger_config.cmi \
debugcom.cmi \
- ../typing/ctype.cmi \
checkpoints.cmi \
breakpoints.cmi \
command_line.cmi
debugger_lexer.cmx \
debugger_config.cmx \
debugcom.cmx \
- ../typing/ctype.cmx \
checkpoints.cmx \
breakpoints.cmx \
command_line.cmi
../file_formats/cmi_format.cmx \
../utils/clflags.cmx \
checkpoints.cmx
+ocamldebug_entry.cmo : \
+ $(UNIXDIR)/unix.cmi
+ocamldebug_entry.cmx : \
+ $(UNIXDIR)/unix.cmx
parameters.cmo : \
../utils/load_path.cmi \
../typing/envaux.cmi \
show_source time_travel program_management frames eval \
show_information loadprinter debugger_parser command_line main
-all_modules := $(compiler_modules) $(debugger_modules)
+compiler_objects := $(addsuffix .cmo,$(compiler_modules))
-all_objects := $(addsuffix .cmo,$(all_modules))
+debugger_objects := $(addsuffix .cmo,$(debugger_modules))
libraries = $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(UNIXDIR)/unix.cma $(DYNLINKDIR)/dynlink.cma
all: ocamldebug$(EXE)
-ocamldebug$(EXE): $(libraries) $(all_objects)
+ocamldebug.cmo: $(debugger_objects)
+ $(CAMLC) -pack $(COMPFLAGS) -o $@ $^
+
+ocamldebug$(EXE): $(libraries) $(compiler_objects) ocamldebug.cmo \
+ ocamldebug_entry.cmo
$(CAMLC) $(LINKFLAGS) -o $@ -linkall $^
install:
rm -f ocamldebug ocamldebug.exe
rm -f *.cmo *.cmi
-%.cmo: %.ml
+ocamldebug_entry.cmo: ocamldebug_entry.ml ocamldebug.cmo
$(CAMLC) -c $(COMPFLAGS) $<
+%.cmo: %.ml
+ $(CAMLC) -c $(COMPFLAGS) -for-pack ocamldebug $<
+
%.cmi: %.mli
- $(CAMLC) -c $(COMPFLAGS) $<
+ $(CAMLC) -c $(COMPFLAGS) -for-pack ocamldebug $<
depend: beforedepend
$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mli *.ml \
in
begin try
let (v, ty) = Eval.expression !selected_event env expr in
- match (Ctype.repr ty).desc with
+ match get_desc ty with
| Tarrow _ ->
add_breakpoint_after_pc (Remote_value.closure_code v)
| _ ->
end
| E_item(arg, n) ->
let (v, ty) = expression event env arg in
- begin match (Ctype.repr(Ctype.expand_head_opt env ty)).desc with
+ begin match get_desc (Ctype.expand_head_opt env ty) with
Ttuple ty_list ->
if n < 1 || n > List.length ty_list
then raise(Error(Tuple_index(ty, List.length ty_list, n)))
end
| E_field(arg, lbl) ->
let (v, ty) = expression event env arg in
- begin match (Ctype.repr(Ctype.expand_head_opt env ty)).desc with
+ begin match get_desc (Ctype.expand_head_opt env ty) with
Tconstr(path, _, _) ->
let tydesc = Env.find_type path env in
begin match tydesc.type_kind with
]
let function_placeholder () =
- raise Not_found
+ failwith "custom printer tried to invoke a function from the debuggee"
let report report_error error =
eprintf "Debugger [version %s] environment error:@ @[@;%a@]@.;"
| Cmi_format.Error e ->
report Cmi_format.report_error e;
exit 2
-
-let _ =
- Unix.handle_unix_error main ()
--- /dev/null
+let _ =
+ Unix.handle_unix_error Ocamldebug.Main.main ()
| None -> ()
| Some pass -> set_save_ir_after pass true
end
+ | "dump-into-file" -> Clflags.dump_into_file := true
+ | "dump-dir" -> Clflags.dump_dir := Some v
| _ ->
if not (List.mem name !can_discard) then begin
i.source_file i.output_prefix i.module_name i.env)
|> print_if i.ppf_dump Clflags.dump_typedtree
Printtyped.implementation_with_coercion
+ |> print_if i.ppf_dump Clflags.dump_shape
+ (fun fmt {Typedtree.shape; _} -> Shape.print fmt shape)
let implementation info ~backend =
Profile.record_call info.source_file @@ fun () ->
let read_clflags_from_env () =
set_from_env Clflags.color Clflags.color_reader;
+ if
+ Option.is_none !Clflags.color &&
+ Option.is_some (Sys.getenv_opt "NO_COLOR")
+ then
+ Clflags.color := Some Misc.Color.Never;
set_from_env Clflags.error_style Clflags.error_style_reader;
()
+let rec make_directory dir =
+ if Sys.file_exists dir then () else
+ begin
+ make_directory (Filename.dirname dir);
+ Sys.mkdir dir 0o777
+ end
+
let with_ppf_dump ~file_prefix f =
+ let with_ch ch =
+ let ppf = Format.formatter_of_out_channel ch in
+ ppf,
+ (fun () ->
+ Format.pp_print_flush ppf ();
+ close_out ch)
+ in
let ppf_dump, finally =
- if not !Clflags.dump_into_file
- then Format.err_formatter, ignore
- else
- let ch = open_out (file_prefix ^ ".dump") in
- let ppf = Format.formatter_of_out_channel ch in
- ppf,
- (fun () ->
- Format.pp_print_flush ppf ();
- close_out ch)
+ match !Clflags.dump_dir, !Clflags.dump_into_file with
+ | None, false -> Format.err_formatter, ignore
+ | None, true -> with_ch (open_out (file_prefix ^ ".dump"))
+ | Some d, _ ->
+ let () = make_directory Filename.(dirname @@ concat d @@ file_prefix) in
+ let _, ch =
+ Filename.open_temp_file ~temp_dir:d (file_prefix ^ ".") ".dump"
+ in
+ with_ch ch
+
in
Misc.try_finally (fun () -> f ppf_dump) ~always:finally
"<dir> Add <dir> to the run-time search path for shared libraries"
;;
+let mk_eval f =
+ "-e", Arg.String f,
+ "<script> Evaluate given script"
+;;
+
let mk_function_sections f =
if Config.function_sections then
"-function-sections", Arg.Unit f,
" unannotated unboxable types will not be unboxed (default)"
;;
+let mk_force_tmc f =
+ "-force-tmc", Arg.Unit f, " Rewrite all possible TMC calls"
+;;
+
let mk_unsafe f =
"-unsafe", Arg.Unit f,
" Do not compile bounds checking on array and string access"
"-dump-into-file", Arg.Unit f, " dump output like -dlambda into <target>.dump"
;;
+let mk_dump_dir f =
+ "-dump-dir", Arg.String f,
+ "<dir> dump output like -dlambda into <dir>/<target>.dump"
+;;
+
let mk_dparsetree f =
"-dparsetree", Arg.Unit f, " (undocumented)"
;;
"-dtypedtree", Arg.Unit f, " (undocumented)"
;;
+let mk_dshape f =
+ "-dshape", Arg.Unit f, " (undocumented)"
+;;
+
let mk_drawlambda f =
"-drawlambda", Arg.Unit f, " (undocumented)"
;;
val _no_strict_sequence : unit -> unit
val _strict_formats : unit -> unit
val _no_strict_formats : unit -> unit
+ val _force_tmc : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
val _unsafe_string : unit -> unit
val _dsource : unit -> unit
val _dparsetree : unit -> unit
val _dtypedtree : unit -> unit
+ val _dshape : unit -> unit
val _drawlambda : unit -> unit
val _dlambda : unit -> unit
val _dtimings : unit -> unit
val _dprofile : unit -> unit
val _dump_into_file : unit -> unit
+ val _dump_dir : string -> unit
val _args: string -> string array
val _args0: string -> string array
val _args0 : string -> string array
val _color : string -> unit
val _error_style : string -> unit
+ val _eval: string -> unit
end
;;
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
+ mk_force_tmc F._force_tmc;
mk_unboxed_types F._unboxed_types;
mk_no_unboxed_types F._no_unboxed_types;
mk_unsafe F._unsafe;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
+ mk_dshape F._dshape;
mk_drawlambda F._drawlambda;
mk_dlambda F._dlambda;
mk_dinstr F._dinstr;
mk_dtimings F._dtimings;
mk_dprofile F._dprofile;
mk_dump_into_file F._dump_into_file;
+ mk_dump_dir F._dump_dir;
mk_args F._args;
mk_args0 F._args0;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
+ mk_dshape F._dshape;
mk_drawlambda F._drawlambda;
mk_dlambda F._dlambda;
mk_dinstr F._dinstr;
mk_args F._args;
mk_args0 F._args0;
+ mk_eval F._eval;
]
end;;
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
+ mk_force_tmc F._force_tmc;
mk_unbox_closures F._unbox_closures;
mk_unbox_closures_factor F._unbox_closures_factor;
mk_inline_max_unroll F._inline_max_unroll;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
+ mk_dshape F._dshape;
mk_drawlambda F._drawlambda;
mk_dlambda F._dlambda;
mk_drawclambda F._drawclambda;
mk_dtimings F._dtimings;
mk_dprofile F._dprofile;
mk_dump_into_file F._dump_into_file;
+ mk_dump_dir F._dump_dir;
mk_dump_pass F._dump_pass;
mk_args F._args;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
+ mk_dshape F._dshape;
mk_drawlambda F._drawlambda;
+ mk_dlambda F._dlambda;
mk_drawclambda F._drawclambda;
mk_dclambda F._dclambda;
mk_dcmm_invariants F._dcmm_invariants;
mk_dinterval F._dinterval;
mk_dstartup F._dstartup;
mk_dump_pass F._dump_pass;
+ mk_eval F._eval;
]
end;;
mk_strict_formats F._strict_formats;
mk_no_strict_formats F._no_strict_formats;
mk_thread F._thread;
+ mk_force_tmc F._force_tmc;
mk_unboxed_types F._unboxed_types;
mk_no_unboxed_types F._no_unboxed_types;
mk_unsafe_string F._unsafe_string;
let _drawlambda = set dump_rawlambda
let _dsource = set dump_source
let _dtypedtree = set dump_typedtree
+ let _dshape = set dump_shape
let _dunique_ids = set unique_ids
let _dno_unique_ids = clear unique_ids
let _dlocations = set locations
let _dprofile () = profile_columns := Profile.all_columns
let _dtimings () = profile_columns := [`Time]
let _dump_into_file = set dump_into_file
+ let _dump_dir s = dump_dir := Some s
let _for_pack s = for_package := (Some s)
let _g = set debug
let _i = set print_types
let _noprompt = set noprompt
let _nopromptcont = set nopromptcont
let _stdin () = (* placeholder: file_argument ""*) ()
+ let _force_tmc = set force_tmc
let _version () = print_version ()
let _vnum () = print_version_num ()
+ let _eval (_:string) = ()
end
module Topmain = struct
"Profiling with \"gprof\" (option `-p') is only supported up to \
OCaml 4.08.0"
let _shared () = shared := true; dlcode := true
+ let _force_tmc = set force_tmc
let _v () = Compenv.print_version_and_library "native-code compiler"
end
let _pp s = Clflags.preprocessor := (Some s)
let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx))
let _thread = set Clflags.use_threads
+ let _force_tmc = set force_tmc
let _v () = Compenv.print_version_and_library "documentation generator"
let _verbose = set Clflags.verbose
let _version = Compenv.print_version_string
let _output_complete_exe () =
_output_complete_obj (); output_complete_executable := true
let _output_obj () = output_c_object := true; custom_runtime := true
+ let _force_tmc = set force_tmc
let _use_prims s = use_prims := s
let _use_runtime s = use_runtime := s
let _v () = Compenv.print_version_and_library "compiler"
val _no_strict_sequence : unit -> unit
val _strict_formats : unit -> unit
val _no_strict_formats : unit -> unit
+ val _force_tmc : unit -> unit
val _unboxed_types : unit -> unit
val _no_unboxed_types : unit -> unit
val _unsafe_string : unit -> unit
val _dsource : unit -> unit
val _dparsetree : unit -> unit
val _dtypedtree : unit -> unit
+ val _dshape : unit -> unit
val _drawlambda : unit -> unit
val _dlambda : unit -> unit
val _dtimings : unit -> unit
val _dprofile : unit -> unit
val _dump_into_file : unit -> unit
+ val _dump_dir : string -> unit
val _args: string -> string array
val _args0: string -> string array
val _args0 : string -> string array
val _color : string -> unit
val _error_style : string -> unit
+ val _eval: string -> unit
end
;;
Location.report_exception ppf x;
2
| () ->
- Profile.print Format.std_formatter !Clflags.profile_columns;
+ Compmisc.with_ppf_dump ~file_prefix:"profile"
+ (fun ppf -> Profile.print ppf !Clflags.profile_columns);
0
Location.report_exception ppf x;
2
| () ->
- Profile.print Format.std_formatter !Clflags.profile_columns;
- 0
+ Compmisc.with_ppf_dump ~file_prefix:"profile"
+ (fun ppf -> Profile.print ppf !Clflags.profile_columns);
+ 0
;**************************************************************************
(env
- (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))))
+ (dev (flags (:standard -w +a-4-9-40-41-42-44-45-48-66-67-70)))
+ (release (flags (:standard -w +a-4-9-40-41-42-44-45-48-66-67-70))))
;; Too annoying to get to work. Use (copy_files# ...) instead
; (include_subdirs unqualified)
(library
(name ocamlcommon)
(wrapped false)
- (flags (:standard -principal -nostdlib))
+ (flags (:standard -principal -nostdlib \ -short-paths))
(libraries stdlib)
(modules_without_implementation
annot asttypes cmo_format outcometree parsetree)
config build_path_prefix_map misc identifiable numbers arg_helper clflags
profile terminfo ccomp warnings consistbl strongly_connected_components
targetint load_path int_replace_polymorphic_compare binutils local_store
- lazy_backtrack diffing
+ lazy_backtrack diffing diffing_with_keys
;; PARSING
location longident docstrings syntaxerr ast_helper camlinternalMenhirLib
asttypes parsetree
;; TYPING
- ident path primitive types btype oprint subst predef datarepr
+ ident path primitive shape types btype oprint subst predef datarepr
cmi_format persistent_env env type_immediacy errortrace
typedtree printtyped ctype printtyp includeclass mtype envaux includecore
tast_iterator tast_mapper signature_group cmt_format untypeast
annot outcometree
;; lambda/
- debuginfo lambda matching printlambda runtimedef simplif switch
+ debuginfo lambda matching printlambda runtimedef tmc simplif switch
translattribute translclass translcore translmod translobj translprim
;; bytecomp/
emit emitaux emitenv
interf interval
linear linearize linscan
- liveness mach printcmm printlinear printmach proc reg reload reloadgen
+ liveness mach
+ polling printcmm printlinear printmach proc
+ reg reload reloadgen
schedgen scheduling selectgen selection spill split
strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc
cmt_imports : (string * Digest.t option) list;
cmt_interface_digest : Digest.t option;
cmt_use_summaries : bool;
+ cmt_uid_to_loc : Location.t Shape.Uid.Tbl.t;
+ cmt_impl_shape : Shape.t option; (* None for mli *)
}
type error =
if vd1.Types.val_loc <> vd2.Types.val_loc then
value_deps := (vd1, vd2) :: !value_deps
-let save_cmt filename modname binary_annots sourcefile initial_env cmi =
+let save_cmt filename modname binary_annots sourcefile initial_env cmi shape =
if !Clflags.binary_annotations && not !Clflags.print_types then begin
Misc.output_to_file_via_temporary
~mode:[Open_binary] filename
cmt_imports = List.sort compare (Env.imports ());
cmt_interface_digest = this_crc;
cmt_use_summaries = need_to_clear_env;
+ cmt_uid_to_loc = Env.get_uid_to_loc_tbl ();
+ cmt_impl_shape = shape;
} in
output_cmt oc cmt)
end;
cmt_imports : crcs;
cmt_interface_digest : Digest.t option;
cmt_use_summaries : bool;
+ cmt_uid_to_loc : Location.t Shape.Uid.Tbl.t;
+ cmt_impl_shape : Shape.t option; (* None for mli *)
}
type error =
string option -> (* source file *)
Env.t -> (* initial env *)
Cmi_format.cmi_infos option -> (* if a .cmi was generated *)
+ Shape.t option ->
unit
(* Miscellaneous functions *)
| Never_local (* [@local never] *)
| Default_local (* [@local maybe] or no [@local] attribute *)
+type poll_attribute =
+ | Error_poll (* [@poll error] *)
+ | Default_poll (* no [@poll] attribute *)
+
type function_kind = Curried | Tupled
type let_kind = Strict | Alias | StrictOpt
inline : inline_attribute;
specialise : specialise_attribute;
local: local_attribute;
+ poll: poll_attribute;
is_a_functor: bool;
stub: bool;
+ tmc_candidate: bool;
}
type scoped_location = Debuginfo.Scoped_location.t
let const_unit = const_int 0
+let max_arity () =
+ if !Clflags.native_code then 126 else max_int
+ (* 126 = 127 (the maximal number of parameters supported in C--)
+ - 1 (the hidden parameter containing the environment) *)
+
+let lfunction ~kind ~params ~return ~body ~attr ~loc =
+ assert (List.length params <= max_arity ());
+ Lfunction { kind; params; return; body; attr; loc }
+
let lambda_unit = Lconst const_unit
let default_function_attribute = {
inline = Default_inline;
specialise = Default_specialise;
local = Default_local;
+ poll = Default_poll;
is_a_functor = false;
stub = false;
+ tmc_candidate = false;
}
let default_stub_attribute =
For that reason, they should not include cycles.
*)
-exception Not_simple
-
let max_raw = 32
let make_key e =
+ let exception Not_simple in
let count = ref 0 (* Used for controlling size *)
and make_key = Ident.make_key_generator () in
(* make_key is used for normalizing let-bound variables *)
| Curried -> true
| Tupled -> false
-let max_arity () =
- if !Clflags.native_code then 126 else max_int
- (* 126 = 127 (the maximal number of parameters supported in C--)
- - 1 (the hidden parameter containing the environment) *)
+let find_exact_application kind ~arity args =
+ match kind with
+ | Curried ->
+ if arity <> List.length args
+ then None
+ else Some args
+ | Tupled ->
+ begin match args with
+ | [Lprim(Pmakeblock _, tupled_args, _)] ->
+ if arity <> List.length tupled_args
+ then None
+ else Some tupled_args
+ | [Lconst(Const_block (_, const_args))] ->
+ if arity <> List.length const_args
+ then None
+ else Some (List.map (fun cst -> Lconst cst) const_args)
+ | _ -> None
+ end
let reset () =
raise_count := 0
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of integer_comparison
- (* Comparions that return int (not bool like above) for ordering *)
+ (* Comparisons that return int (not bool like above) for ordering *)
| Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
| Poffsetint of int
| Poffsetref of int
| Never_local (* [@local never] *)
| Default_local (* [@local maybe] or no [@local] attribute *)
+type poll_attribute =
+ | Error_poll (* [@poll error] *)
+ | Default_poll (* no [@poll] attribute *)
+
type function_kind = Curried | Tupled
type let_kind = Strict | Alias | StrictOpt
inline : inline_attribute;
specialise : specialise_attribute;
local: local_attribute;
+ poll: poll_attribute;
is_a_functor: bool;
stub: bool;
+ tmc_candidate: bool;
}
type scoped_location = Debuginfo.Scoped_location.t
| Levent of lambda * lambda_event
| Lifused of Ident.t * lambda
-and lfunction =
+and lfunction = private
{ kind: function_kind;
params: (Ident.t * value_kind) list;
return: value_kind;
sw_numblocks: int; (* Number of tag block cases *)
sw_blocks: (int * lambda) list; (* Tag block cases *)
sw_failaction : lambda option} (* Action to take if failure *)
+
and lambda_event =
{ lev_loc: scoped_location;
lev_kind: lambda_event_kind;
val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda
val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
+val lfunction :
+ kind:function_kind ->
+ params:(Ident.t * value_kind) list ->
+ return:value_kind ->
+ body:lambda ->
+ attr:function_attribute -> (* specified with [@inline] attribute *)
+ loc:scoped_location ->
+ lambda
+
+
val iter_head_constructor: (lambda -> unit) -> lambda -> unit
(** [iter_head_constructor f lam] apply [f] to only the first level of
sub expressions of [lam]. It does not recursively traverse the
val default_stub_attribute : function_attribute
val function_is_curried : lfunction -> bool
+val find_exact_application :
+ function_kind -> arity:int -> lambda list -> lambda list option
val max_arity : unit -> int
(** Maximal number of parameters for a function, or in other words,
(Lprim (Pfield 1, [ arg ], loc), Alias) :: rem
let divide_variant ~scopes row ctx { cases = cl; args; default = def } =
- let row = Btype.row_repr row in
let rec divide = function
| [] -> { args; cells = [] }
| ((p, patl), action) :: rem
in
let head = Simple.head p in
let variants = divide rem in
- if
- try Btype.row_field_repr (List.assoc lab row.row_fields) = Rabsent
- with Not_found -> true
- then
+ if row_field_repr (get_row_field lab row) = Rabsent then
variants
else
let tag = Btype.hash_variant lab in
let gtint = Pintcomp Cgt
- type act = Lambda.lambda
-
type loc = Lambda.scoped_location
+ type arg = Lambda.lambda
+ type test = Lambda.lambda
+ type act = Lambda.lambda
let make_prim p args = Lprim (p, args, Loc_unknown)
let make_isin h arg = Lprim (Pnot, [ make_isout h arg ], Loc_unknown)
+ let make_is_nonzero arg =
+ if !Clflags.native_code then
+ Lprim (Pintcomp Cne,
+ [arg; Lconst (Const_base (Const_int 0))],
+ Loc_unknown)
+ else
+ arg
+
+ let arg_as_test arg = arg
+
let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
let make_switch loc arg cases acts =
(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)
+ if !Clflags.native_code then
+ Lifthenelse(Lprim (Pisint, [ arg ], loc), act1, act2)
+ else
+ (* PR#10681: we use [arg] directly as the test here;
+ it generates better bytecode for this common case
+ (typically options and lists), but would prevent
+ some optimizations with the native compiler. *)
+ Lifthenelse (arg, act2, act1)
| n, 0, _, [] ->
(* The type defines constant constructors only *)
call_switcher loc fail_opt arg 0 (n - 1) consts
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
+ if row_closed row then
List.iter
(fun (_, f) ->
- match Btype.row_field_repr f with
+ match row_field_repr f with
| Rabsent
- | Reither (true, _ :: _, _, _) ->
+ | Reither (true, _ :: _, _) ->
()
| _ -> incr num_constr)
- row.row_fields
+ (row_fields row)
else
num_constr := max_int;
let test_int_or_block arg if_int if_block =
| Pint_as_pointer -> "Pint_as_pointer"
| Popaque -> "Popaque"
-let function_attribute ppf { inline; specialise; local; is_a_functor; stub } =
- if is_a_functor then
+let function_attribute ppf t =
+ if t.is_a_functor then
fprintf ppf "is_a_functor@ ";
- if stub then
+ if t.stub then
fprintf ppf "stub@ ";
- begin match inline with
+ begin match t.inline with
| Default_inline -> ()
| Always_inline -> fprintf ppf "always_inline@ "
| Hint_inline -> fprintf ppf "hint_inline@ "
| Never_inline -> fprintf ppf "never_inline@ "
| Unroll i -> fprintf ppf "unroll(%i)@ " i
end;
- begin match specialise with
+ begin match t.specialise with
| Default_specialise -> ()
| Always_specialise -> fprintf ppf "always_specialise@ "
| Never_specialise -> fprintf ppf "never_specialise@ "
end;
- begin match local with
+ begin match t.local with
| Default_local -> ()
| Always_local -> fprintf ppf "always_local@ "
| Never_local -> fprintf ppf "never_local@ "
+ end;
+ if t.tmc_candidate then
+ fprintf ppf "tail_mod_cons@ ";
+ begin match t.poll with
+ | Default_poll -> ()
+ | Error_poll -> fprintf ppf "error_poll@ "
end
let apply_tailcall_attribute ppf = function
Lapply{ap with ap_func = simplif ~try_depth ap.ap_func;
ap_args = List.map (simplif ~try_depth) ap.ap_args}
| Lfunction{kind; params; return; body = l; attr; loc} ->
- Lfunction{kind; params; return; body = simplif ~try_depth l; attr; loc}
+ lfunction ~kind ~params ~return ~body:(simplif ~try_depth l) ~attr ~loc
| Llet(str, kind, v, l1, l2) ->
Llet(str, kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
| Lmutlet(kind, v, l1, l2) ->
*)
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 arity = List.length params in
+ Lambda.find_exact_application kind ~arity args
let beta_reduce params body args =
List.fold_left2 (fun l (param, kind) arg -> Llet(Strict, kind, param, arg, l))
type of the merged function taking [params @ params'] as
parameters is the type returned after applying [params']. *)
let return = return2 in
- Lfunction{kind; params = params @ params'; return; body; attr; loc}
+ lfunction ~kind ~params:(params @ params') ~return ~body ~attr ~loc
| body ->
- Lfunction{kind; params; return = return1; body; attr; loc}
+ lfunction ~kind ~params ~return:return1 ~body ~attr ~loc
end
| Llet(_str, _k, v, Lvar w, l2) when optimize ->
Hashtbl.add subst v (simplif (Lvar w));
let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body ~attr ~loc =
let rec aux map = function
- | Llet(Strict, k, id, (Lifthenelse(Lvar optparam, _, _) as def), rest) when
+ (* When compiling [fun ?(x=expr) -> body], this is first translated
+ to:
+ [fun *opt* ->
+ let x =
+ match *opt* with
+ | None -> expr
+ | Some *sth* -> *sth*
+ in
+ body]
+ We want to detect the let binding to put it into the wrapper instead of
+ the inner function.
+ We need to find which optional parameter the binding corresponds to,
+ which is why we need a deep pattern matching on the expected result of
+ the pattern-matching compiler for options.
+ *)
+ | Llet(Strict, k, id,
+ (Lifthenelse(Lprim (Pisint, [Lvar optparam], _), _, _) as def),
+ rest) when
Ident.name optparam = "*opt*" && List.mem_assoc optparam params
&& not (List.mem_assoc optparam map)
->
in
let body = Lambda.rename subst body in
let inner_fun =
- Lfunction { kind = Curried;
- params = List.map (fun id -> id, Pgenval) new_ids;
- return; body; attr; loc; }
+ lfunction ~kind:Curried
+ ~params:(List.map (fun id -> id, Pgenval) new_ids)
+ ~return ~body ~attr ~loc
in
(wrapper_body, (inner_id, inner_fun))
in
try
let body, inner = aux [] body in
let attr = default_stub_attribute in
- [(fun_id, Lfunction{kind; params; return; body; attr; loc}); inner]
+ [(fun_id, lfunction ~kind ~params ~return ~body ~attr ~loc); inner]
with Exit ->
- [(fun_id, Lfunction{kind; params; return; body; attr; loc})]
+ [(fun_id, lfunction ~kind ~params ~return ~body ~attr ~loc)]
(* Simplify local let-bound functions: if all occurrences are
fully-applied function calls in the same "tail scope", replace the
rewrite lam
(* The entry point:
- simplification + emission of tailcall annotations, if needed. *)
+ simplification
+ + rewriting of tail-modulo-cons calls
+ + emission of tailcall annotations, if needed
+*)
let simplify_lambda lam =
let lam =
)
|> simplify_exits
|> simplify_lets
+ |> Tmc.rewrite
in
if !Clflags.annotations
|| Warnings.is_active (Warnings.Wrong_tailcall_expectation true)
act_store : 'ctx -> 'a -> int ;
act_store_shared : 'ctx -> 'a -> int ; }
-exception Not_simple
-
module type Stored = sig
type t
type key
val ltint : primitive
val geint : primitive
val gtint : primitive
- type act
+
type loc
+ type arg
+ type test
+ type act
+
+ val bind : arg -> (arg -> act) -> act
+ val make_const : int -> arg
+ val make_offset : arg -> int -> arg
+ val make_prim : primitive -> arg list -> test
+ val make_isout : arg -> arg -> test
+ val make_isin : arg -> arg -> test
+ val make_is_nonzero : arg -> test
+ val arg_as_test : arg -> test
+
+ val make_if : test -> act -> act -> act
+ val make_switch : loc -> arg -> int array -> act array -> act
- val bind : act -> (act -> act) -> act
- val make_const : int -> act
- val make_offset : act -> int -> act
- val make_prim : primitive -> act list -> act
- val make_isout : act -> act -> act
- val make_isin : act -> act -> act
- val make_if : act -> act -> act -> act
- val make_switch : loc -> act -> int array -> act array -> act
val make_catch : act -> int * (act -> act)
val make_exit : int -> act
end
and get_low cases i =
let r,_,_ = cases.(i) in
r
+ and get_high cases i =
+ let _,r,_ = cases.(i) in
+ r
type ctests = {
mutable n : int ;
and make_if_ne arg i ifso ifnot =
make_if_test Arg.neint arg i ifso ifnot
+ let make_if_nonzero arg ifso ifnot =
+ Arg.make_if (Arg.make_is_nonzero arg) ifso ifnot
+
+ let make_if_bool arg ifso ifnot =
+ Arg.make_if (Arg.arg_as_test arg) ifso ifnot
+
let do_make_if_out h arg ifso ifno =
Arg.make_if (Arg.make_isout h arg) ifso ifno
and right = {s with cases=right} in
if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
- Arg.make_if
- ctx.arg
- (c_test ctx right) (c_test ctx left)
+ if lcases = 2 && get_high cases 1+ctx.off = 1 then
+ make_if_bool
+ ctx.arg
+ (c_test ctx right) (c_test ctx left)
+ else
+ make_if_nonzero
+ ctx.arg
+ (c_test ctx right) (c_test ctx left)
else if less_tests cright cleft then
make_if_lt
ctx.arg (lim+ctx.off)
act_store : 'ctx -> 'a -> int ;
act_store_shared : 'ctx -> 'a -> int ; }
-exception Not_simple
-
module type Stored = sig
type t
type key
val ltint : primitive
val geint : primitive
val gtint : primitive
- (* type of actions *)
- type act
+
(* type of source locations *)
type loc
+ (* type of switch scrutinees *)
+ type arg
+ (* type of tests on scrutinees *)
+ type test
+ (* type of actions *)
+ type act
(* Various constructors, for making a binder,
adding one integer, etc. *)
- val bind : act -> (act -> act) -> act
- val make_const : int -> act
- val make_offset : act -> int -> act
- val make_prim : primitive -> act list -> act
- val make_isout : act -> act -> act
- val make_isin : act -> act -> act
- val make_if : act -> act -> act -> act
+
+ (* [bind arg cont] should bind the expression arg to a variable,
+ then call [cont] on that variable, and return the term made of
+ the binding and the result of the call. *)
+ val bind : arg -> (arg -> act) -> act
+ (* [make_const n] generates a term for the integer constant [n] *)
+ val make_const : int -> arg
+ (* [make_offset arg n] generates a term for adding the constant
+ integer [n] to the term [arg] *)
+ val make_offset : arg -> int -> arg
+ (* [make_prim p args] generates a test using the primitive operation [p]
+ applied to arguments [args] *)
+ val make_prim : primitive -> arg list -> test
+ (* [make_isout h arg] generates a test that holds when [arg] is out of
+ the interval [0, h] *)
+ val make_isout : arg -> arg -> test
+ (* [make_isin h arg] generates a test that holds when [arg] is in
+ the interval [0, h] *)
+ val make_isin : arg -> arg -> test
+ (* [make_is_nonzero arg] generates a test that holds when [arg] is any
+ value except 0 *)
+ val make_is_nonzero : arg -> test
+ (* [arg_as_test arg] casts [arg], known to be either 0 or 1,
+ to a boolean test *)
+ val arg_as_test : arg -> test
+ (* [make_if cond ifso ifnot] generates a conditional branch *)
+ val make_if : test -> act -> act -> act
(* construct an actual switch :
make_switch arg cases acts
NB: cases is in the value form *)
- val make_switch : loc -> act -> int array -> act array -> act
+ val make_switch : loc -> arg -> int array -> act array -> act
+
(* Build last minute sharing of action stuff *)
val make_catch : act -> int * (act -> act)
val make_exit : int -> act
-
end
val zyva :
Arg.loc ->
(int * int) ->
- Arg.act ->
+ Arg.arg ->
(int * int * int) array ->
(Arg.act, _) t_store ->
Arg.act
(* Output test sequence, sharing tracked *)
val test_sequence :
- Arg.act ->
+ Arg.arg ->
(int * int * int) array ->
(Arg.act, _) t_store ->
Arg.act
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frédéric Bour *)
+(* Gabriel Scherer, projet Partout, INRIA Saclay *)
+(* Basile Clément, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Lambda
+
+(* Error-reporting information for ambiguous TMC calls *)
+type tmc_call_information = {
+ loc: scoped_location;
+ explicit: bool;
+}
+type subterm_information = {
+ tmc_calls: tmc_call_information list;
+}
+type ambiguous_arguments = {
+ explicit: bool;
+ (** When [explicit = true], we have an ambiguity between
+ arguments containing calls that have been explicitly
+ marked [@tailcall]. Otherwise we have an ambiguity
+ between un-annotated calls. *)
+ arguments: subterm_information list;
+}
+
+type error =
+ | Ambiguous_constructor_arguments of ambiguous_arguments
+
+exception Error of Location.t * error
+
+
+type 'offset destination = {
+ var: Ident.t;
+ offset: 'offset;
+ loc : Debuginfo.Scoped_location.t;
+}
+and offset = Offset of lambda
+(** In the OCaml value model, interior pointers are not allowed. To
+ represent the "placeholder to mutate" in DPS code, we thus use a pair
+ of the block containing the placeholder, and the offset of the
+ placeholder within the block.
+
+ In the common case, this offset is an arbitrary lambda expression, typically
+ a constant integer or a variable. We define ['a destination] as parametrized
+ over the offset type to represent formal destination parameters (where
+ the offset is an Ident.t), and maybe in the future statically-known
+ offsets (where the offset is an integer).
+*)
+
+let offset_code (Offset t) = t
+
+let add_dst_params ({var; offset} : Ident.t destination) params =
+ (var, Pgenval) :: (offset, Pintval) :: params
+
+let add_dst_args ({var; offset} : offset destination) args =
+ Lvar var :: offset_code offset :: args
+
+let assign_to_dst {var; offset; loc} lam =
+ Lprim(Psetfield_computed(Pointer, Heap_initialization),
+ [Lvar var; offset_code offset; lam], loc)
+
+module Constr : sig
+ (** The type [Constr.t] represents a reified constructor with
+ a single hole, which can be either directly applied to a [lambda]
+ term, or be used to create a fresh [lambda destination] with
+ a placeholder. *)
+ type t = {
+ tag : int;
+ flag: Asttypes.mutable_flag;
+ shape : block_shape;
+ before: lambda list;
+ after: lambda list;
+ loc : Debuginfo.Scoped_location.t;
+ }
+
+ (** [apply constr e] plugs the expression [e] in the hole of the
+ constructor [const]. *)
+ val apply : t -> lambda -> lambda
+
+ (** [with_placeholder constr body] binds a placeholder
+ for the constructor [constr] within the scope of [body]. *)
+ val with_placeholder : t -> (offset destination -> lambda) -> lambda
+
+ (** We may want to delay the application of a constructor to a later
+ time. This may move the constructor application below some
+ effectful expressions (for example if we move into a context of
+ the form [foo; bar_with_tmc_inside]), and we want to preserve
+ the evaluation order of the other arguments of the
+ constructor. So we bind them before proceeding, unless they are
+ obviously side-effect free.
+
+ [delay_impure ~block_id constr body] binds all inpure arguments
+ of the constructor [constr] within the scope of [body], which is
+ passed a pure constructor.
+
+ [block_id] is a counter that is used as a suffix in the generated
+ variable names, for readability purposes. *)
+ val delay_impure : block_id:int -> t -> (t -> lambda) -> lambda
+end = struct
+ type t = {
+ tag : int;
+ flag: Asttypes.mutable_flag;
+ shape : block_shape;
+ before: lambda list;
+ after: lambda list;
+ loc : Debuginfo.Scoped_location.t;
+ }
+
+ let apply constr t =
+ let block_args = List.append constr.before @@ t :: constr.after in
+ Lprim (Pmakeblock (constr.tag, constr.flag, constr.shape),
+ block_args, constr.loc)
+
+ let tmc_placeholder =
+ (* we choose a placeholder whose tagged representation will be
+ reconizable. *)
+ Lconst (Const_base (Const_int (0xBBBB / 2)))
+
+ let with_placeholder constr (body : offset destination -> lambda) =
+ let k_with_placeholder =
+ apply { constr with flag = Mutable } tmc_placeholder in
+ let placeholder_pos = List.length constr.before in
+ let placeholder_pos_lam = Lconst (Const_base (Const_int placeholder_pos)) in
+ let block_var = Ident.create_local "block" in
+ Llet (Strict, Pgenval, block_var, k_with_placeholder,
+ body {
+ var = block_var;
+ offset = Offset placeholder_pos_lam ;
+ loc = constr.loc;
+ })
+
+ let delay_impure : block_id:int -> t -> (t -> lambda) -> lambda =
+ let bind_list ~block_id ~arg_offset lambdas k =
+ let can_be_delayed =
+ (* Note that the delayed subterms will be used
+ exactly once in the linear-static subterm. So
+ we are happy to delay constants, which we would
+ not want to duplicate. *)
+ function
+ | Lvar _ | Lconst _ -> true
+ | _ -> false in
+ let bindings, args =
+ lambdas
+ |> List.mapi (fun i lam ->
+ if can_be_delayed lam then (None, lam)
+ else begin
+ let v = Ident.create_local
+ (Printf.sprintf "block%d_arg%d" block_id (arg_offset + i)) in
+ (Some (v, lam), Lvar v)
+ end)
+ |> List.split in
+ let body = k args in
+ List.fold_right (fun binding body ->
+ match binding with
+ | None -> body
+ | Some (v, lam) -> Llet(Strict, Pgenval, v, lam, body)
+ ) bindings body in
+ fun ~block_id constr body ->
+ bind_list ~block_id ~arg_offset:0 constr.before @@ fun vbefore ->
+ let arg_offset = List.length constr.before + 1 in
+ bind_list ~block_id ~arg_offset constr.after @@ fun vafter ->
+ body { constr with before = vbefore; after = vafter }
+end
+
+(** The type ['a Dps.t] (destination-passing-style) represents a
+ version of ['a] that is parametrized over a [lambda destination].
+ A [lambda Dps.t] is a code fragment in destination-passing-style,
+ a [(lambda * lambda) Dps.t] represents two subterms parametrized
+ over the same destination. *)
+module Dps : sig
+ type 'a dps = tail:bool -> dst:offset destination -> 'a
+ (** A term parameterized over a destination. The [tail] argument
+ is passed by the caller to indicate whether the term will be placed
+ in tail-position -- this allows to generate correct @tailcall
+ annotations. *)
+
+ type 'a t
+
+ val make : lambda dps -> lambda t
+ val run : lambda t -> lambda dps
+ val delay_constructor : Constr.t -> lambda t -> lambda t
+
+ val lambda : lambda -> lambda t
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val pair : 'a t -> 'b t -> ('a * 'b) t
+ val unit : unit t
+end = struct
+ type 'a dps = tail:bool -> dst:offset destination -> 'a
+
+ type 'a t = {
+ code : delayed:Constr.t list -> 'a dps;
+ delayed_use_count : int;
+ }
+ (** We want to optimize nested constructors, for example:
+
+ {[
+ (x () :: y () :: tmc call)
+ ]}
+
+ which would naively generate (in a DPS context parametrized
+ over a location dst.i):
+
+ {[
+ let dstx = x () :: Placeholder in
+ dst.i <- dstx;
+ let dsty = y () :: Placeholder in
+ dstx.1 <- dsty;
+ tmc dsty.1 call
+ ]}
+
+ when we would rather hope for
+
+ {[
+ let vx = x () in
+ let dsty = y () :: Placeholder in
+ dst.i <- vx :: dsty;
+ tmc dsty.1 call
+ ]}
+
+ The idea is that the unoptimized version first creates a
+ destination site [dstx], which is then used by the following
+ code. If we keep track of the current destination:
+
+ {[
+ (* Destination is [dst.i] *)
+ let dstx = x () :: Placeholder in
+ dst.i (* Destination *) <- dstx;
+ (* Destination is [dstx.1] *)
+ let dsty = y () :: Placeholder in
+ dstx.1 (* Destination *) <- dsty;
+ (* Destination is [dsty.1] *)
+ tmc dsty.1 call
+ ]}
+
+ Instead of binding the whole newly-created destination, we can
+ simply let-bind the non-placeholder arguments (in order to
+ preserve execution order), and keep track of a list of blocks to
+ be created along with the current destination. Instead of seeing
+ a DPS fragment as writing to a destination, we see it as a term
+ with shape [dst.i <- C .] where [C .] is a linear context consisting
+ only of constructor applications.
+
+ {[
+ (* Destination is [dst.i <- C .] *)
+ let vx = x () in
+ (* Destination is [dst.i <- C (vx :: .)] *)
+ let vy = y () in
+ (* Destination is [dst.i <- C (vx :: vy :: .)] *)
+ (* Making a call: reify the destination *)
+ let dsty = vy :: Placeholder in
+ dst.i <- vx :: dsty;
+ tmc dsty.1 call
+ ]}
+
+ The [delayed] argument represents the context [C] as a list of
+ reified constructors, to allow both to build the final holey
+ block ([vy :: Placeholder]) at the recursive call site, and
+ the delayed constructor applications ([vx :: dsty]).
+
+ In practice, it is not desirable to perform this simplification
+ when there are multiple TMC calls (e.g. in different branches of
+ an [if] block), because it would cause duplication of the nested
+ constructor applications. The [delayed_use_count] field keeps track
+ of this information, it counts the number of syntactic use sites
+ of the delayed constructors, if any, in the generated code.
+ *)
+
+ let write_to_dst dst delayed t =
+ assign_to_dst dst @@
+ List.fold_left (fun t constr -> Constr.apply constr t) t delayed
+
+ let lambda (v : lambda) : lambda t = {
+ code = (fun ~delayed ~tail:_ ~dst ->
+ write_to_dst dst delayed v
+ );
+ delayed_use_count = 1;
+ }
+ (** Create a new destination-passing-style term which is simply
+ setting the destination with the given [v], hence "returning"
+ it.
+ *)
+
+ let unit : unit t = {
+ code = (fun ~delayed:_ ~tail:_ ~dst:_ ->
+ ()
+ );
+ delayed_use_count = 0;
+ }
+
+ let map (f : 'a -> 'b) (d : 'a t) : 'b t = {
+ code = (fun ~delayed ~tail ~dst ->
+ f @@ d.code ~delayed ~tail ~dst);
+ delayed_use_count = d.delayed_use_count;
+ }
+
+ let pair (da : 'a t) (db : 'b t) : ('a * 'b) t = {
+ code = (fun ~delayed ~tail ~dst ->
+ (da.code ~delayed ~tail ~dst, db.code ~delayed ~tail ~dst));
+ delayed_use_count =
+ da.delayed_use_count + db.delayed_use_count;
+ }
+
+ let run (d : 'a t) : 'a dps =
+ fun ~tail ~dst ->
+ d.code ~tail ~dst ~delayed:[]
+
+ let reify_delay (dps : lambda dps) : lambda t = {
+ code = (fun ~delayed ~tail ~dst ->
+ match delayed with
+ | [] -> dps ~tail ~dst
+ | x :: xs ->
+ Constr.with_placeholder x @@ fun new_dst ->
+ Lsequence (
+ write_to_dst dst xs (Lvar new_dst.var),
+ dps ~tail ~dst:new_dst)
+ );
+ delayed_use_count = 1;
+ }
+
+ let ensures_affine (d : lambda t) : lambda t =
+ if d.delayed_use_count <= 1 then
+ d
+ else
+ reify_delay (run d)
+ (** Ensures that the resulting term does not duplicate delayed
+ constructors by reifying them now if needed.
+ *)
+
+ let make (dps : 'a dps) : 'a t =
+ reify_delay dps
+
+ let delay_constructor constr d =
+ let d = ensures_affine d in {
+ code = (fun ~delayed ~tail ~dst ->
+ let block_id = List.length delayed in
+ Constr.delay_impure ~block_id constr @@ fun constr ->
+ d.code ~tail ~dst ~delayed:(constr :: delayed));
+ delayed_use_count = d.delayed_use_count;
+ }
+end
+
+(** The TMC transformation requires information flows in two opposite
+ directions: the information of which callsites can be rewritten in
+ destination-passing-style flows from the leaves of the code to the
+ root, and the information on whether we remain in tail-position
+ flows from the root to the leaves -- and also the knowledge of
+ which version of the function we currently want to generate, the
+ direct version or a destination-passing-style version.
+
+ To clarify this double flow of information, we split the TMC
+ transform in two steps:
+
+ 1. A function [choice t] that takes a term and processes it from
+ leaves to root; it produces a "code choice", a piece of data of
+ type [lambda Choice.t], that contains information on how to transform the
+ input term [t] *parameterized* over the (still missing) contextual
+ information.
+
+ 2. Code-production operators that have contextual information
+ to transform a "code choice" into the final code.
+
+ The code-production choices for a single term have type [lambda Choice.t];
+ using a parametrized type ['a Choice.t] is useful to represent
+ simultaneous choices over several subterms; for example
+ [(lambda * lambda) Choice.t] makes a choice for a pair of terms,
+ for example the [then] and [else] cases of a conditional. With
+ this parameter, ['a Choice.t] has an applicative structure, which
+ is useful to write the actual code transformation in the {!choice}
+ function.
+*)
+module Choice = struct
+ type 'a t = {
+ dps : 'a Dps.t;
+ direct : unit -> 'a;
+ tmc_calls : tmc_call_information list;
+ benefits_from_dps: bool;
+ explicit_tailcall_request: bool;
+ }
+ (**
+ An ['a Choice.t] represents code that may be written
+ in destination-passing style if its usage context allows it.
+ More precisely:
+
+ - If the surrounding context is already in destination-passing
+ style, it has a destination available, we should produce the
+ code in [dps] -- a function parametrized over the destination.
+
+ - If the surrounding context is in direct style (no destination
+ is available), we should produce the fallback code from
+ [direct].
+
+ (Note: [direct] is also a function (on [unit]) to ensure that any
+ effects performed during code production will only happen once we
+ do know that we want to produce the direct-style code.)
+
+ - [tmc_calls] tracks the function calls in the subterms that are
+ in tail-modulo-cons position and get rewritten into tailcalls
+ in the [dps] version.
+
+ - [benefits_from_dps] is true when the [dps] calls strictly more
+ TMC functions than the [direct] version. See the
+ {!choice_makeblock} case.
+
+ - [explicit_tailcall_request] is true when the user
+ used a [@tailcall] annotation on the optimizable callsite.
+ When one of several calls could be optimized, we expect that
+ exactly one of them will be annotated by the user, or fail
+ because the situation is ambiguous.
+ *)
+
+ let lambda (v : lambda) : lambda t = {
+ dps = Dps.lambda v;
+ direct = (fun () -> v);
+ tmc_calls = [];
+ benefits_from_dps = false;
+ explicit_tailcall_request = false;
+ }
+
+ let map f s = {
+ dps = Dps.map f s.dps;
+ direct = (fun () -> f (s.direct ()));
+ tmc_calls = s.tmc_calls;
+ benefits_from_dps = s.benefits_from_dps;
+ explicit_tailcall_request = s.explicit_tailcall_request;
+ }
+ (** Apply function [f] to the transformed term. *)
+
+ let direct (c : 'a t) : 'a =
+ c.direct ()
+
+ let dps (c : lambda t) ~tail ~dst =
+ Dps.run c.dps ~tail ~dst
+
+ let pair ((c1, c2) : 'a t * 'b t) : ('a * 'b) t = {
+ dps = Dps.pair c1.dps c2.dps;
+ direct = (fun () -> (c1.direct (), c2.direct ()));
+ tmc_calls =
+ c1.tmc_calls @ c2.tmc_calls;
+ benefits_from_dps =
+ c1.benefits_from_dps || c2.benefits_from_dps;
+ explicit_tailcall_request =
+ c1.explicit_tailcall_request || c2.explicit_tailcall_request;
+ }
+
+ let unit = {
+ dps = Dps.unit;
+ direct = (fun () -> ());
+ tmc_calls = [];
+ benefits_from_dps = false;
+ explicit_tailcall_request = false;
+ }
+ (* Remark: we could define [pure v] as [map (fun () -> v) unit],
+ but we prefer to have the code explicit about using [unit],
+ in particular as it ignores the destination argument. *)
+
+ module Syntax = struct
+ let (let+) a f = map f a
+ let (and+) a1 a2 = pair (a1, a2)
+ end
+ open Syntax
+
+ let option (c : 'a t option) : 'a option t =
+ match c with
+ | None -> let+ () = unit in None
+ | Some c -> let+ v = c in Some v
+
+ let rec list (c : 'a t list) : 'a list t =
+ match c with
+ | [] -> let+ () = unit in []
+ | c :: cs ->
+ let+ v = c
+ and+ vs = list cs
+ in v :: vs
+
+ (** The [find_*] machinery is used to locate a single subterm to
+ optimize among a list of subterms. If there are several possible
+ choices, we require that exactly one of them be annotated with
+ [@tailcall], or we report an ambiguity. *)
+ type 'a tmc_call_search =
+ | No_tmc_call of 'a list
+ | Nonambiguous of 'a zipper
+ | Ambiguous of { explicit: bool; subterms: 'a t list; }
+
+ and 'a zipper = {
+ rev_before : 'a list;
+ choice : 'a t;
+ after: 'a list
+ }
+
+ let find_nonambiguous_tmc_call choices =
+ let has_tmc_calls c = c.tmc_calls <> [] in
+ let is_explicit s = s.explicit_tailcall_request in
+ let nonambiguous ~only_explicit_calls choices =
+ (* here is how we will compute the result once we know that there
+ is an unambiguously-determined tmc call, and whether
+ an explicit request was necessary to disambiguate *)
+ let rec split rev_before : 'a t list -> 'a zipper = function
+ | [] -> assert false (* we know there is at least one choice *)
+ | c :: rest ->
+ if has_tmc_calls c && (not only_explicit_calls || is_explicit c) then
+ { rev_before; choice = c; after = List.map direct rest }
+ else
+ split (direct c :: rev_before) rest
+ in split [] choices
+ in
+ let tmc_call_subterms =
+ List.filter (fun c -> has_tmc_calls c) choices
+ in
+ match tmc_call_subterms with
+ | [] ->
+ No_tmc_call (List.map direct choices)
+ | [ _one ] ->
+ Nonambiguous (nonambiguous ~only_explicit_calls:false choices)
+ | several_subterms ->
+ let explicit_subterms = List.filter is_explicit several_subterms in
+ begin match explicit_subterms with
+ | [] ->
+ Ambiguous {
+ explicit = false;
+ subterms = several_subterms;
+ }
+ | [ _one ] ->
+ Nonambiguous (nonambiguous ~only_explicit_calls:true choices)
+ | several_explicit_subterms ->
+ Ambiguous {
+ explicit = true;
+ subterms = several_explicit_subterms;
+ }
+ end
+end
+
+open Choice.Syntax
+
+type context = {
+ specialized: specialized Ident.Map.t;
+}
+and specialized = {
+ arity: int;
+ dps_id: Ident.t;
+ direct_kind: function_kind;
+}
+
+let llets lk vk bindings body =
+ List.fold_right (fun (var, def) body ->
+ Llet (lk, vk, var, def, body)
+ ) bindings body
+
+let find_candidate = function
+ | Lfunction lfun when lfun.attr.tmc_candidate -> Some lfun
+ | _ -> None
+
+let declare_binding ctx (var, def) =
+ match find_candidate def with
+ | None -> ctx
+ | Some lfun ->
+ let arity = List.length lfun.params in
+ let dps_id = Ident.create_local (Ident.name var ^ "_dps") in
+ let direct_kind = lfun.kind in
+ let cand = { arity; dps_id; direct_kind; } in
+ { specialized = Ident.Map.add var cand ctx.specialized }
+
+let rec choice ctx t =
+ let rec choice ctx ~tail t =
+ match t with
+ | (Lvar _ | Lmutvar _ | Lconst _ | Lfunction _ | Lsend _
+ | Lassign _ | Lfor _ | Lwhile _) ->
+ let t = traverse ctx t in
+ Choice.lambda t
+
+ (* [choice_prim] handles most primitives, but the important case
+ of construction [Lprim(Pmakeblock(...), ...)] is handled by
+ [choice_makeblock] *)
+ | Lprim (prim, primargs, loc) ->
+ choice_prim ctx ~tail prim primargs loc
+
+ (* [choice_apply] handles applications, in particular tail-calls which
+ generate Set choices at the leaves *)
+ | Lapply apply ->
+ choice_apply ctx ~tail apply
+ (* other cases use the [lift] helper that takes the sub-terms in tail
+ position and the context around them, and generates a choice for
+ the whole term from choices for the tail subterms. *)
+ | Lsequence (l1, l2) ->
+ let l1 = traverse ctx l1 in
+ let+ l2 = choice ctx ~tail l2 in
+ Lsequence (l1, l2)
+ | Lifthenelse (l1, l2, l3) ->
+ let l1 = traverse ctx l1 in
+ let+ (l2, l3) = choice_pair ctx ~tail (l2, l3) in
+ Lifthenelse (l1, l2, l3)
+ | Lmutlet (vk, var, def, body) ->
+ (* mutable bindings are not TMC-specialized *)
+ let def = traverse ctx def in
+ let+ body = choice ctx ~tail body in
+ Lmutlet (vk, var, def, body)
+ | Llet (lk, vk, var, def, body) ->
+ let ctx, bindings = traverse_let ctx var def in
+ let+ body = choice ctx ~tail body in
+ llets lk vk bindings body
+ | Lletrec (bindings, body) ->
+ let ctx, bindings = traverse_letrec ctx bindings in
+ let+ body = choice ctx ~tail body in
+ Lletrec(bindings, body)
+ | Lswitch (l1, sw, loc) ->
+ (* decompose *)
+ let consts_lhs, consts_rhs = List.split sw.sw_consts in
+ let blocks_lhs, blocks_rhs = List.split sw.sw_blocks in
+ (* transform *)
+ let l1 = traverse ctx l1 in
+ let+ consts_rhs = choice_list ctx ~tail consts_rhs
+ and+ blocks_rhs = choice_list ctx ~tail blocks_rhs
+ and+ sw_failaction = choice_option ctx ~tail sw.sw_failaction in
+ (* rebuild *)
+ let sw_consts = List.combine consts_lhs consts_rhs in
+ let sw_blocks = List.combine blocks_lhs blocks_rhs in
+ let sw = { sw with sw_consts; sw_blocks; sw_failaction; } in
+ Lswitch (l1, sw, loc)
+ | Lstringswitch (l1, cases, fail, loc) ->
+ (* decompose *)
+ let cases_lhs, cases_rhs = List.split cases in
+ (* transform *)
+ let l1 = traverse ctx l1 in
+ let+ cases_rhs = choice_list ctx ~tail cases_rhs
+ and+ fail = choice_option ctx ~tail fail in
+ (* rebuild *)
+ let cases = List.combine cases_lhs cases_rhs in
+ Lstringswitch (l1, cases, fail, loc)
+ | Lstaticraise (id, ls) ->
+ let ls = traverse_list ctx ls in
+ Choice.lambda (Lstaticraise (id, ls))
+ | Ltrywith (l1, id, l2) ->
+ (* in [try l1 with id -> l2], the term [l1] is
+ not in tail-call position (after it returns
+ we need to remove the exception handler),
+ so it is not transformed here *)
+ let l1 = traverse ctx l1 in
+ let+ l2 = choice ctx ~tail l2 in
+ Ltrywith (l1, id, l2)
+ | Lstaticcatch (l1, ids, l2) ->
+ (* In [static-catch l1 with ids -> l2],
+ the term [l1] is in fact in tail-position *)
+ let+ l1 = choice ctx ~tail l1
+ and+ l2 = choice ctx ~tail l2 in
+ Lstaticcatch (l1, ids, l2)
+ | Levent (lam, lev) ->
+ let+ lam = choice ctx ~tail lam in
+ Levent (lam, lev)
+ | Lifused (x, lam) ->
+ let+ lam = choice ctx ~tail lam in
+ Lifused (x, lam)
+
+ and choice_apply ctx ~tail apply =
+ let exception No_tmc in
+ try
+ let explicit_tailcall_request =
+ match apply.ap_tailcall with
+ | Default_tailcall -> false
+ | Tailcall_expectation true -> true
+ | Tailcall_expectation false -> raise No_tmc
+ in
+ match apply.ap_func with
+ | Lvar f ->
+ let specialized =
+ try Ident.Map.find f ctx.specialized
+ with Not_found ->
+ if tail then
+ Location.prerr_warning
+ (Debuginfo.Scoped_location.to_location apply.ap_loc)
+ Warnings.Tmc_breaks_tailcall;
+ raise No_tmc;
+ in
+ let args =
+ (* Support of tupled functions: the [function_kind] of the
+ direct-style function is identical to the one of the
+ input function, which may be Tupled, but the dps
+ function is always Curried.
+
+ [find_exact_application] is in charge of recovering the
+ "real" argument list of a possibly-tupled call. *)
+ let kind, arity = specialized.direct_kind, specialized.arity in
+ match Lambda.find_exact_application kind ~arity apply.ap_args with
+ | None -> raise No_tmc
+ | Some args -> args
+ in
+ let tailcall tail =
+ (* If we are calling a tmc-specializable function in tail
+ context, then both the direct-style and dps-style calls
+ must be tailcalls. *)
+ if tail
+ then Tailcall_expectation true
+ else Default_tailcall
+ in
+ {
+ Choice.dps = Dps.make (fun ~tail ~dst ->
+ Lapply { apply with
+ ap_func = Lvar specialized.dps_id;
+ ap_args = add_dst_args dst args;
+ ap_tailcall = tailcall tail;
+ });
+ direct = (fun () ->
+ Lapply { apply with ap_tailcall = tailcall tail });
+ explicit_tailcall_request;
+ tmc_calls = [{
+ loc = apply.ap_loc;
+ explicit = explicit_tailcall_request;
+ }];
+ benefits_from_dps = true;
+ }
+ | _nontail -> raise No_tmc
+ with No_tmc ->
+ let apply_no_bailout =
+ (* [@tailcall false] is interpreted as a bailout annotation: "we
+ are (knowingly) leaving the dps calling convention". It only
+ has sense in the DPS version of the generated code, not in
+ direct style. *)
+ let ap_tailcall =
+ match apply.ap_tailcall with
+ | Tailcall_expectation false when tail -> Default_tailcall
+ | other -> other
+ in
+ { apply with ap_tailcall } in
+ { (Choice.lambda (Lapply apply)) with
+ direct = (fun () -> Lapply apply_no_bailout);
+ }
+
+ and choice_makeblock ctx ~tail:_ (tag, flag, shape) blockargs loc =
+ let choices = List.map (choice ctx ~tail:false) blockargs in
+ match Choice.find_nonambiguous_tmc_call choices with
+ | Choice.No_tmc_call args ->
+ Choice.lambda @@ Lprim (Pmakeblock (tag, flag, shape), args, loc)
+ | Choice.Ambiguous { explicit; subterms = ambiguous_subterms } ->
+ (* An ambiguous term should not lead to an error if it not
+ used in TMC position. Consider for example:
+
+ {[
+ type t = ... | K of t * (t * t)
+ let[@tail_mod_cons] rec map f = function
+ | [...]
+ | K (t, (u, v)) -> K ((map[@tailcall]) f t, (map f u, map f v))
+ ]}
+
+ Calling [choice_makeblock] on the K constructor, we need to
+ determine whether its two arguments are ambiguous, which is
+ done by calling [choice] on each argument to see if they
+ would be TMC-able and if they are explicitly annotated.
+
+ These calls give the following results:
+ - there is an explicitly-requested tailcall in the first
+ argument
+ - the second argument is a nested pair whose arguments
+ themselves are ambiguous -- with no explicit annotation.
+
+ This determines that the arguments of K are not ambiguous,
+ as only one of them is annotated. But note that the nested
+ pair, in isolation, is ambiguous. This inner ambiguity is
+ innocuous and should not result in an error, as we never
+ use this inner pair in TMC position, only in direct style.
+
+ This example shows that it would be incorrect to fail with
+ an error whenever [choice] finds an ambiguity. Instead we
+ only error when generating the [dps] version of the
+ corresponding code; requesting the [direct] version is
+ accepted and produces the expected direct code.
+ *)
+ let term_choice =
+ let+ args = Choice.list choices in
+ Lprim (Pmakeblock(tag, flag, shape), args, loc)
+ in
+ { term_choice with
+ Choice.dps = Dps.make (fun ~tail:_ ~dst:_ ->
+ let arguments =
+ let info (t : lambda Choice.t) : subterm_information = {
+ tmc_calls = t.tmc_calls;
+ } in
+ {
+ explicit;
+ arguments = List.map info ambiguous_subterms;
+ }
+ in
+ raise (Error (Debuginfo.Scoped_location.to_location loc,
+ Ambiguous_constructor_arguments arguments))
+ );
+ }
+ | Choice.Nonambiguous { Choice.rev_before; choice; after } ->
+ let constr = Constr.{
+ tag;
+ flag;
+ shape;
+ before = List.rev rev_before;
+ after;
+ loc;
+ } in
+ assert (choice.tmc_calls <> []);
+ {
+ Choice.direct = (fun () ->
+ if not choice.benefits_from_dps then
+ Constr.apply constr (Choice.direct choice)
+ else
+ Constr.with_placeholder constr @@ fun new_dst ->
+ Lsequence(Choice.dps choice ~tail:false ~dst:new_dst,
+ Lvar new_dst.var));
+ benefits_from_dps =
+ (* Whether or not the caller provides a destination,
+ we can always provide a destination to our settable
+ subterm, so the number of TMC sub-calls is identical
+ in the [direct] and [dps] versions. *)
+ false;
+ dps = Dps.delay_constructor constr choice.dps;
+ tmc_calls =
+ choice.tmc_calls;
+ explicit_tailcall_request =
+ choice.explicit_tailcall_request;
+ }
+
+ and choice_prim ctx ~tail prim primargs loc =
+ match prim with
+ (* The important case is the construction case *)
+ | Pmakeblock (tag, flag, shape) ->
+ choice_makeblock ctx ~tail (tag, flag, shape) primargs loc
+
+ (* Some primitives have arguments in tail-position *)
+ | Popaque ->
+ let l1 = match primargs with
+ | [l1] -> l1
+ | _ -> invalid_arg "choice_prim" in
+ let+ l1 = choice ctx ~tail l1 in
+ Lprim (Popaque, [l1], loc)
+ | (Psequand | Psequor) as shortcutop ->
+ let l1, l2 = match primargs with
+ | [l1; l2] -> l1, l2
+ | _ -> invalid_arg "choice_prim" in
+ let l1 = traverse ctx l1 in
+ let+ l2 = choice ctx ~tail l2 in
+ Lprim (shortcutop, [l1; l2], loc)
+
+ (* in common cases we just return *)
+ | Pbytes_to_string | Pbytes_of_string
+ | Pgetglobal _ | Psetglobal _
+ | Pfield _ | Pfield_computed
+ | Psetfield _ | Psetfield_computed _
+ | Pfloatfield _ | Psetfloatfield _
+ | Pccall _
+ | Praise _
+ | Pnot
+ | Pnegint | Paddint | Psubint | Pmulint | Pdivint _ | Pmodint _
+ | Pandint | Porint | Pxorint
+ | Plslint | Plsrint | Pasrint
+ | Pintcomp _
+ | Poffsetint _ | Poffsetref _
+ | Pintoffloat | Pfloatofint
+ | Pnegfloat | Pabsfloat
+ | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
+ | Pfloatcomp _
+ | Pstringlength | Pstringrefu | Pstringrefs
+ | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
+ | Parraylength _ | Parrayrefu _ | Parraysetu _ | Parrayrefs _ | Parraysets _
+ | Pisint | Pisout
+ | Pignore
+ | Pcompare_ints | Pcompare_floats | Pcompare_bints _
+
+ (* we don't handle array indices as destinations yet *)
+ | (Pmakearray _ | Pduparray _)
+
+ (* we don't handle { foo with x = ...; y = recursive-call } *)
+ | Pduprecord _
+
+ (* operations returning boxed values could be considered
+ constructions someday *)
+ | Pbintofint _ | Pintofbint _
+ | Pcvtbint _
+ | Pnegbint _
+ | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _
+ | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _
+ | Pbintcomp _
+
+ (* more common cases... *)
+ | Pbigarrayref _ | Pbigarrayset _
+ | Pbigarraydim _
+ | Pstring_load_16 _ | Pstring_load_32 _ | Pstring_load_64 _
+ | Pbytes_load_16 _ | Pbytes_load_32 _ | Pbytes_load_64 _
+ | Pbytes_set_16 _ | Pbytes_set_32 _ | Pbytes_set_64 _
+ | Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_64 _
+ | Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
+ | Pctconst _
+ | Pbswap16
+ | Pbbswap _
+ | Pint_as_pointer
+ ->
+ let primargs = traverse_list ctx primargs in
+ Choice.lambda (Lprim (prim, primargs, loc))
+
+ and choice_list ctx ~tail terms =
+ Choice.list (List.map (choice ctx ~tail) terms)
+ and choice_pair ctx ~tail (t1, t2) =
+ Choice.pair (choice ctx ~tail t1, choice ctx ~tail t2)
+ and choice_option ctx ~tail t =
+ Choice.option (Option.map (choice ctx ~tail) t)
+
+ in choice ctx t
+
+and traverse ctx = function
+ | Llet (lk, vk, var, def, body) ->
+ let ctx, bindings = traverse_let ctx var def in
+ let body = traverse ctx body in
+ llets lk vk bindings body
+ | Lletrec (bindings, body) ->
+ let ctx, bindings = traverse_letrec ctx bindings in
+ Lletrec (bindings, traverse ctx body)
+ | lam ->
+ shallow_map (traverse ctx) lam
+
+and traverse_let outer_ctx var def =
+ let inner_ctx = declare_binding outer_ctx (var, def) in
+ let bindings = traverse_binding outer_ctx inner_ctx (var, def) in
+ inner_ctx, bindings
+
+and traverse_letrec ctx bindings =
+ let ctx = List.fold_left declare_binding ctx bindings in
+ let bindings = List.concat_map (traverse_binding ctx ctx) bindings in
+ ctx, bindings
+
+and traverse_binding outer_ctx inner_ctx (var, def) =
+ match find_candidate def with
+ | None -> [(var, traverse outer_ctx def)]
+ | Some lfun ->
+ let special = Ident.Map.find var inner_ctx.specialized in
+ let fun_choice = choice outer_ctx ~tail:true lfun.body in
+ if fun_choice.Choice.tmc_calls = [] then
+ Location.prerr_warning
+ (Debuginfo.Scoped_location.to_location lfun.loc)
+ Warnings.Unused_tmc_attribute;
+ let direct =
+ let { kind; params; return; body = _; attr; loc } = lfun in
+ let body = Choice.direct fun_choice in
+ lfunction ~kind ~params ~return ~body ~attr ~loc in
+ let dps =
+ let dst_param = {
+ var = Ident.create_local "dst";
+ offset = Ident.create_local "offset";
+ loc = lfun.loc;
+ } in
+ let dst = { dst_param with offset = Offset (Lvar dst_param.offset) } in
+ Lambda.duplicate @@ lfunction
+ ~kind:
+ (* Support of Tupled function: see [choice_apply]. *)
+ Curried
+ ~params:(add_dst_params dst_param lfun.params)
+ ~return:lfun.return
+ ~body:(Choice.dps ~tail:true ~dst:dst fun_choice)
+ ~attr:lfun.attr
+ ~loc:lfun.loc
+ in
+ let dps_var = special.dps_id in
+ [(var, direct); (dps_var, dps)]
+
+and traverse_list ctx terms =
+ List.map (traverse ctx) terms
+
+let rewrite t =
+ let ctx = { specialized = Ident.Map.empty } in
+ traverse ctx t
+
+let () =
+ Location.register_error_of_exn
+ (function
+ | Error (loc,
+ Ambiguous_constructor_arguments
+ { explicit = false; arguments }) ->
+ let print_msg ppf =
+ Format.pp_print_text ppf
+ "[@tail_mod_cons]: this constructor application may be \
+ TMC-transformed in several different ways. Please \
+ disambiguate by adding an explicit [@tailcall] \
+ attribute to the call that should be made \
+ tail-recursive, or a [@tailcall false] attribute on \
+ calls that should not be transformed."
+ in
+ let submgs =
+ let sub (info : tmc_call_information) =
+ let loc = Debuginfo.Scoped_location.to_location info.loc in
+ Location.msg ~loc "This call could be annotated." in
+ arguments
+ |> List.map (fun t -> t.tmc_calls)
+ |> List.flatten
+ |> List.map sub
+ in
+ Some (Location.errorf ~loc ~sub:submgs "%t" print_msg)
+ | Error (loc,
+ Ambiguous_constructor_arguments
+ { explicit = true; arguments }) ->
+ let print_msg ppf =
+ Format.pp_print_text ppf
+ "[@tail_mod_cons]: this constructor application may be \
+ TMC-transformed in several different ways. Only one of \
+ the arguments may become a TMC call, but several \
+ arguments contain calls that are explicitly marked as \
+ tail-recursive. Please fix the conflict by reviewing \
+ and fixing the conflicting annotations."
+ in
+ let submgs =
+ let sub (info : tmc_call_information) =
+ let loc = Debuginfo.Scoped_location.to_location info.loc in
+ Location.msg ~loc "This call is explicitly annotated." in
+ arguments
+ |> List.map (fun t -> t.tmc_calls)
+ |> List.flatten
+ |> List.filter (fun (info: tmc_call_information) -> info.explicit)
+ |> List.map sub
+ in
+ Some (Location.errorf ~loc ~sub:submgs "%t" print_msg)
+ | _ ->
+ None
+ )
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Frédéric Bour *)
+(* Gabriel Scherer, projet Partout, INRIA Saclay *)
+(* Basile Clément, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Tail-modulo-cons optimization.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+*)
+
+(** TMC (Tail Modulo Cons) is a code transformation that
+ rewrites transformed functions in destination-passing-style, in
+ such a way that certain calls that were not in tail position in the
+ original program become tail-calls in the transformed program.
+
+ As a classic example, the following program
+ {|
+ let[@tail_mod_cons] rec map f = function
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ y :: map f xs
+ |}
+ becomes (expressed in almost-source-form; the translation is in
+ fact at the Lambda-level)
+ {|
+ let rec map f = function
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ let dst = y :: Placeholder in
+ map_dps dst 1 f xs; dst
+ and map_dps dst offset f = function
+ | [] ->
+ dst.offset <- []
+ | x :: xs ->
+ let y = f x in
+ let dst' = y :: Placeholder in
+ dst.offset <- dst';
+ map_dps dst 1 f fx
+ |}
+
+ In this example, the expression (y :: map f xs) had a call in
+ non-tail-position, and it gets rewritten into tail-calls. TMC
+ handles all such cases where the continuation of the call
+ (what needs to be done after the return) is a "construction", the
+ creation of a (possibly nested) data block.
+
+ The code transformation generates two versions of the
+ input function, the "direct" version with the same type and
+ behavior as the original one (here just [map]), and
+ the "destination-passing-style" version (here [map_dps]).
+
+ Any call to the original function from outside the let..rec
+ declaration gets transformed into a call into the direct version,
+ which will itself call the destination-passing-style versions on
+ recursive calls that may benefit from it (they are in tail-position
+ modulo constructors).
+
+ Because of this inherent code duplication, the transformation may
+ not always improve performance. In this implementation, TMC is
+ opt-in, we only transform functions that the user has annotated
+ with an attribute to request the transformation.
+*)
+
+open Lambda
+
+val rewrite : lambda -> lambda
| {txt=("local"|"ocaml.local")} -> true
| _ -> false
+let is_tmc_attribute = function
+ | {txt=("tail_mod_cons"|"ocaml.tail_mod_cons")} -> true
+ | _ -> false
+
+let is_poll_attribute = function
+ | {txt=("poll")} -> true
+ | _ -> false
+
let find_attribute p attributes =
let inline_attribute, other_attributes =
List.partition (fun a -> p a.Parsetree.attr_name) attributes
]
payload
+let parse_poll_attribute attr =
+ match attr with
+ | None -> Default_poll
+ | Some {Parsetree.attr_name = {txt; loc}; attr_payload = payload} ->
+ parse_id_payload txt loc
+ ~default:Default_poll
+ ~empty:Default_poll
+ [
+ "error", Error_poll;
+ ]
+ payload
+
let get_inline_attribute l =
let attr, _ = find_attribute is_inline_attribute l in
parse_inline_attribute attr
let attr, _ = find_attribute is_local_attribute l in
parse_local_attribute attr
+let get_poll_attribute l =
+ let attr, _ = find_attribute is_poll_attribute l in
+ parse_poll_attribute attr
+
let check_local_inline loc attr =
match attr.local, attr.inline with
| Always_local, (Always_inline | Hint_inline | Unroll _) ->
| _ ->
()
+let check_poll_inline loc attr =
+ match attr.poll, attr.inline with
+ | Error_poll, (Always_inline | Hint_inline | Unroll _) ->
+ Location.prerr_warning loc
+ (Warnings.Inlining_impossible
+ "[@poll error] is incompatible with inlining")
+ | _ ->
+ ()
+
+let check_poll_local loc attr =
+ match attr.poll, attr.local with
+ | Error_poll, Always_local ->
+ Location.prerr_warning loc
+ (Warnings.Inlining_impossible
+ "[@poll error] is incompatible with local function optimization")
+ | _ ->
+ ()
+
+let lfunction_with_attr ~attr { kind; params; return; body; attr=_; loc } =
+ lfunction ~kind ~params ~return ~body ~attr ~loc
+
let add_inline_attribute expr loc attributes =
match expr, get_inline_attribute attributes with
| expr, Default_inline -> expr
end;
let attr = { attr with inline } in
check_local_inline loc attr;
- Lfunction { funct with attr = attr }
+ check_poll_inline loc attr;
+ lfunction_with_attr ~attr funct
| expr, (Always_inline | Hint_inline | Never_inline | Unroll _) ->
Location.prerr_warning loc
(Warnings.Misplaced_attribute "inline");
(Warnings.Duplicated_attribute "specialise")
end;
let attr = { attr with specialise } in
- Lfunction { funct with attr }
+ lfunction_with_attr ~attr funct
| expr, (Always_specialise | Never_specialise) ->
Location.prerr_warning loc
(Warnings.Misplaced_attribute "specialise");
end;
let attr = { attr with local } in
check_local_inline loc attr;
- Lfunction { funct with attr }
+ check_poll_local loc attr;
+ lfunction_with_attr ~attr funct
| expr, (Always_local | Never_local) ->
Location.prerr_warning loc
(Warnings.Misplaced_attribute "local");
expr
+let add_tmc_attribute expr loc attributes =
+ let is_tmc_attribute a = is_tmc_attribute a.Parsetree.attr_name in
+ if List.exists is_tmc_attribute attributes then
+ match expr with
+ | Lfunction funct ->
+ if funct.attr.tmc_candidate then
+ Location.prerr_warning loc
+ (Warnings.Duplicated_attribute "tail_mod_cons");
+ let attr = { funct.attr with tmc_candidate = true } in
+ lfunction_with_attr ~attr funct
+ | expr ->
+ Location.prerr_warning loc
+ (Warnings.Misplaced_attribute "tail_mod_cons");
+ expr
+ else
+ expr
+
+let add_poll_attribute expr loc attributes =
+ match expr, get_poll_attribute attributes with
+ | expr, Default_poll -> expr
+ | Lfunction({ attr = { stub = false } as attr } as funct), poll ->
+ begin match attr.poll with
+ | Default_poll -> ()
+ | Error_poll ->
+ Location.prerr_warning loc
+ (Warnings.Duplicated_attribute "error_poll")
+ end;
+ let attr = { attr with poll } in
+ check_poll_inline loc attr;
+ check_poll_local loc attr;
+ let attr = { attr with inline = Never_inline; local = Never_local } in
+ lfunction_with_attr ~attr funct
+ | expr, Error_poll ->
+ Location.prerr_warning loc
+ (Warnings.Misplaced_attribute "error_poll");
+ expr
+
(* Get the [@inlined] attribute payload (or default if not present).
It also returns the expression without this attribute. This is
used to ensure that this attribute is not misplaced: If it
let check_attribute e {Parsetree.attr_name = { txt; loc }; _} =
match txt with
| "inline" | "ocaml.inline"
- | "specialise" | "ocaml.specialise" -> begin
+ | "specialise" | "ocaml.specialise"
+ | "poll" -> begin
match e.exp_desc with
| Texp_function _ -> ()
| _ ->
let lam =
add_local_attribute lam loc attr
in
+ let lam =
+ add_tmc_attribute lam loc attr
+ in
+ let lam =
+ (* last because poll overrides inline and local *)
+ add_poll_attribute lam loc attr
+ in
lam
match body with
| Lfunction {kind = Curried; params = params'; body = body'; attr; loc}
when List.length params + List.length params' <= Lambda.max_arity() ->
- Lfunction {kind = Curried; params = params @ params';
- return = Pgenval;
- body = body'; attr;
- loc}
+ lfunction ~kind:Curried ~params:(params @ params')
+ ~return:Pgenval
+ ~body:body'
+ ~attr
+ ~loc
| _ ->
- Lfunction {kind = Curried; params; return = Pgenval;
- body;
- attr = default_function_attribute;
- loc = Loc_unknown}
+ lfunction ~kind:Curried ~params ~return:Pgenval
+ ~body
+ ~attr:default_function_attribute
+ ~loc:Loc_unknown
let lapply ap =
match ap.ap_func with
(inh_init,
let build params rem =
let param = name_pattern "param" pat in
- Lfunction {kind = Curried; params = (param, Pgenval)::params;
- return = Pgenval;
- attr = default_function_attribute;
- loc = of_location ~scopes pat.pat_loc;
- body = Matching.for_function ~scopes pat.pat_loc
- None (Lvar param) [pat, rem] partial}
+ Lambda.lfunction
+ ~kind:Curried ~params:((param, Pgenval)::params)
+ ~return:Pgenval
+ ~attr:default_function_attribute
+ ~loc:(of_location ~scopes pat.pat_loc)
+ ~body:(Matching.for_function ~scopes pat.pat_loc
+ None (Lvar param) [pat, rem] partial)
in
begin match obj_init with
Lfunction {kind = Curried; params; body = rem} -> build params rem
(inh_init, transl_vals cla true StrictOpt vals cl_init)
| Tcl_constraint (cl, _, vals, meths, concr_meths) ->
let virt_meths =
- List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
- let concr_meths = Concr.elements concr_meths in
+ List.filter (fun lab -> not (MethSet.mem lab concr_meths)) meths in
+ let concr_meths = MethSet.elements concr_meths in
let narrow_args =
[Lvar cla;
transl_meth_list vals;
transl_class_rebind ~scopes obj_init cl vf in
let build params rem =
let param = name_pattern "param" pat in
- Lfunction {kind = Curried; params = (param, Pgenval)::params;
- return = Pgenval;
- attr = default_function_attribute;
- loc = of_location ~scopes pat.pat_loc;
- body = Matching.for_function ~scopes pat.pat_loc
- None (Lvar param) [pat, rem] partial}
+ Lambda.lfunction
+ ~kind:Curried ~params:((param, Pgenval)::params)
+ ~return:Pgenval
+ ~attr:default_function_attribute
+ ~loc:(of_location ~scopes pat.pat_loc)
+ ~body:(Matching.for_function ~scopes pat.pat_loc
+ None (Lvar param) [pat, rem] partial)
in
(path, path_lam,
match obj_init with
(* Rewrite a closure using builtins. Improves native code size. *)
-let rec module_path = function
- Lvar id ->
- let s = Ident.name id in s <> "" && s.[0] >= 'A' && s.[0] <= 'Z'
- | Lprim(Pfield _, [p], _) -> module_path p
- | Lprim(Pgetglobal _, [], _) -> true
- | _ -> false
-
let const_path local = function
Lvar id -> not (List.mem id local)
| Lconst _ -> true
| Lfunction {kind = Curried; body} ->
let fv = free_variables body in
List.for_all (fun x -> not (Ident.Set.mem x fv)) local
- | p -> module_path p
+ | _ -> false
let rec builtin_meths self env env2 body =
let const_path = const_path (env::self) in
let concrete = (vflag = Concrete)
and lclass lam =
- let cl_init = llets (Lfunction{kind = Curried;
- attr = default_function_attribute;
- loc = Loc_unknown;
- return = Pgenval;
- params = [cla, Pgenval]; body = cl_init}) in
+ let cl_init = llets (Lambda.lfunction
+ ~kind:Curried
+ ~attr:default_function_attribute
+ ~loc:Loc_unknown
+ ~return:Pgenval
+ ~params:[cla, Pgenval] ~body:cl_init) in
Llet(Strict, Pgenval, class_init, cl_init, lam (free_variables cl_init))
and lbody fv =
if List.for_all (fun id -> not (Ident.Set.mem id fv)) ids then
Loc_unknown))))
and lbody_virt lenvs =
Lprim(Pmakeblock(0, Immutable, None),
- [lambda_unit; Lfunction{kind = Curried;
- attr = default_function_attribute;
- loc = Loc_unknown;
- return = Pgenval;
- params = [cla, Pgenval]; body = cl_init};
+ [lambda_unit; Lambda.lfunction
+ ~kind:Curried
+ ~attr:default_function_attribute
+ ~loc:Loc_unknown
+ ~return:Pgenval
+ ~params:[cla, Pgenval] ~body:cl_init;
lambda_unit; lenvs],
Loc_unknown)
in
in
let lclass lam =
Llet(Strict, Pgenval, class_init,
- Lfunction{kind = Curried; params = [cla, Pgenval];
- return = Pgenval;
- attr = default_function_attribute;
- loc = Loc_unknown;
- body = def_ids cla cl_init}, lam)
+ Lambda.lfunction
+ ~kind:Curried ~params:[cla, Pgenval]
+ ~return:Pgenval
+ ~attr:default_function_attribute
+ ~loc:Loc_unknown
+ ~body:(def_ids cla cl_init), lam)
and lcache lam =
if inh_keys = [] then Llet(Alias, Pgenval, cached, Lvar tables, lam) else
Llet(Strict, Pgenval, cached,
lset cached 0 (Lvar env_init))))
and lclass_virt () =
lset cached 0
- (Lfunction
- {
- kind = Curried;
- attr = default_function_attribute;
- loc = Loc_unknown;
- return = Pgenval;
- params = [cla, Pgenval];
- body = def_ids cla cl_init;
- }
- )
+ (Lambda.lfunction
+ ~kind:Curried
+ ~attr:default_function_attribute
+ ~loc:Loc_unknown
+ ~return:Pgenval
+ ~params:[cla, Pgenval]
+ ~body:(def_ids cla cl_init))
in
let lupdate_cache =
if ids = [] then ldirect () else
| Texp_for(param, _, low, high, dir, body) ->
Lfor(param, transl_exp ~scopes low, transl_exp ~scopes high, dir,
event_before ~scopes body (transl_exp ~scopes body))
- | Texp_send(_, _, Some exp) -> transl_exp ~scopes exp
- | Texp_send(expr, met, None) ->
- let obj = transl_exp ~scopes expr in
- let loc = of_location ~scopes e.exp_loc in
+ | Texp_send(expr, met) ->
let lam =
+ let loc = of_location ~scopes e.exp_loc in
match met with
- Tmeth_val id -> Lsend (Self, Lvar id, obj, [], loc)
+ | Tmeth_val id ->
+ let obj = transl_exp ~scopes expr in
+ Lsend (Self, Lvar id, obj, [], loc)
| Tmeth_name nm ->
+ let obj = transl_exp ~scopes expr in
let (tag, cache) = Translobj.meth obj nm in
let kind = if cache = [] then Public else Cached in
Lsend (kind, tag, obj, cache, loc)
+ | Tmeth_ancestor(meth, path_self) ->
+ let self = transl_value_path loc e.exp_env path_self in
+ Lapply {ap_loc = loc;
+ ap_func = Lvar meth;
+ ap_args = [self];
+ ap_tailcall = Default_tailcall;
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise}
in
event_after ~scopes e lam
| Texp_new (cl, {Location.loc=loc}, _) ->
ap_specialised=Default_specialise;
},
List.fold_right
- (fun (path, _, expr) rem ->
- let var = transl_value_path loc e.exp_env path in
+ (fun (id, _, expr) rem ->
Lsequence(transl_setinstvar ~scopes Loc_unknown
- (Lvar cpy) var expr, rem))
+ (Lvar cpy) (Lvar id) expr, rem))
modifs
(Lvar cpy))
| Texp_letmodule(None, loc, Mp_present, modl, body) ->
transl_exp ~scopes e
| `Other ->
(* other cases compile to a lazy block holding a function *)
- let fn = Lfunction {kind = Curried;
- params= [Ident.create_local "param", Pgenval];
- return = Pgenval;
- attr = default_function_attribute;
- loc = of_location ~scopes e.exp_loc;
- body = transl_exp ~scopes e} in
+ let fn = lfunction ~kind:Curried
+ ~params:[Ident.create_local "param", Pgenval]
+ ~return:Pgenval
+ ~attr:default_function_attribute
+ ~loc:(of_location ~scopes e.exp_loc)
+ ~body:(transl_exp ~scopes e) in
Lprim(Pmakeblock(Config.lazy_tag, Mutable, None), [fn],
of_location ~scopes e.exp_loc)
end
let body =
match build_apply handle ((Lvar id_arg, optional)::args') l with
Lfunction{kind = Curried; params = ids; return;
- body = lam; attr; loc} ->
- Lfunction{kind = Curried;
- params = (id_arg, Pgenval)::ids;
- return;
- body = lam; attr;
- loc}
- | Levent(Lfunction{kind = Curried; params = ids; return;
- body = lam; attr; loc}, _) ->
- Lfunction{kind = Curried; params = (id_arg, Pgenval)::ids;
- return;
- body = lam; attr;
- loc}
+ body = lam; attr; loc}
+ when List.length ids < Lambda.max_arity () ->
+ lfunction ~kind:Curried
+ ~params:((id_arg, Pgenval)::ids)
+ ~return
+ ~body:lam ~attr
+ ~loc
| lam ->
- Lfunction{kind = Curried; params = [id_arg, Pgenval];
- return = Pgenval; body = lam;
- attr = default_stub_attribute; loc = loc}
+ lfunction ~kind:Curried ~params:[id_arg, Pgenval]
+ ~return:Pgenval ~body:lam
+ ~attr:default_stub_attribute ~loc
in
List.fold_left
(fun body (id, lam) -> Llet(Strict, Pgenval, id, lam, body))
in
let attr = default_function_attribute in
let loc = of_location ~scopes e.exp_loc in
- let lam = Lfunction{kind; params; return; body; attr; loc} in
+ let lam = lfunction ~kind ~params ~return ~body ~attr ~loc in
Translattribute.add_function_attributes lam e.exp_loc e.exp_attributes
(* Like transl_exp, but used when a new scope was just introduced. *)
let x, y, z = List.fold_left rewrite_case ([], [], []) pat_expr_list in
List.rev x, List.rev y, List.rev z
in
- let static_catch body val_ids handler =
+ (* In presence of exception patterns, the code we generate for
+
+ match <scrutinees> with
+ | <val-patterns> -> <val-actions>
+ | <exn-patterns> -> <exn-actions>
+
+ looks like
+
+ staticcatch
+ (try (exit <val-exit> <scrutinees>)
+ with <exn-patterns> -> <exn-actions>)
+ with <val-exit> <val-ids> ->
+ match <val-ids> with <val-patterns> -> <val-actions>
+
+ In particular, the 'exit' in the value case ensures that the
+ value actions run outside the try..with exception handler.
+ *)
+ let static_catch scrutinees val_ids handler =
let id = Typecore.name_pattern "exn" (List.map fst exn_cases) in
let static_exception_id = next_raise_count () in
Lstaticcatch
- (Ltrywith (Lstaticraise (static_exception_id, body), id,
+ (Ltrywith (Lstaticraise (static_exception_id, scrutinees), id,
Matching.for_trywith ~scopes e.exp_loc (Lvar id) exn_cases),
(static_exception_id, val_ids),
handler)
in
let attr = default_function_attribute in
let loc = of_location ~scopes case.c_rhs.exp_loc in
- Lfunction{kind; params; return; body; attr; loc}
+ lfunction ~kind ~params ~return ~body ~attr ~loc
in
Lapply{
ap_loc = of_location ~scopes loc;
| _ ->
name_lambda strict funct
(fun id ->
- Lfunction
- {
- kind = Curried;
- params = List.rev params;
- return = Pgenval;
- attr = { default_function_attribute with
+ lfunction
+ ~kind:Curried
+ ~params:(List.rev params)
+ ~return:Pgenval
+ ~attr:{ default_function_attribute with
is_a_functor = true;
- stub = true; };
- loc = loc;
- body = apply_coercion
+ stub = true; }
+ ~loc
+ ~body:(apply_coercion
loc Strict cc_res
(Lapply{
ap_loc=loc;
ap_tailcall=Default_tailcall;
ap_inlined=Default_inline;
ap_specialised=Default_specialise;
- })})
+ })))
and wrap_id_pos_list loc id_pos_list get_field lam =
let fv = free_variables lam in
[] -> []
| Sig_value(subid, {val_kind=Val_reg; val_type=ty; val_loc=loc},_) :: rem ->
let init_v =
- match Ctype.expand_head env ty with
- {desc = Tarrow(_,_,_,_)} ->
+ match get_desc (Ctype.expand_head env ty) with
+ Tarrow(_,_,_,_) ->
const_int 0 (* camlinternalMod.Function *)
- | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
+ | Tconstr(p, _, _) when Path.same p Predef.path_lazy_t ->
const_int 1 (* camlinternalMod.Lazy *)
| _ ->
let not_a_function =
([], transl_module ~scopes res_coercion body_path body)
functor_params_rev
in
- Lfunction {
- kind = Curried;
- params;
- return = Pgenval;
- attr = {
+ lfunction
+ ~kind:Curried
+ ~params
+ ~return:Pgenval
+ ~attr:{
inline = inline_attribute;
specialise = Default_specialise;
local = Default_local;
+ poll = Default_poll;
is_a_functor = true;
stub = false;
- };
- loc;
- body;
- }
+ tmc_candidate = false;
+ }
+ ~loc
+ ~body
(* Compile a module expression *)
match params with
| [] -> body
| _ ->
- Lfunction{ kind = Curried;
- params;
- return = Pgenval;
- attr = default_stub_attribute;
- loc;
- body; }
+ lfunction ~kind:Curried
+ ~params
+ ~return:Pgenval
+ ~attr:default_stub_attribute
+ ~loc
+ ~body
let lambda_primitive_needs_event_after = function
(* We add an event after any primitive resulting in a C call that
#**************************************************************************
ROOTDIR = ..
-include $(ROOTDIR)/Makefile.config
+include $(ROOTDIR)/Makefile.common
-DESTDIR ?=
-INSTALL_DIR=$(DESTDIR)$(MANDIR)/man$(PROGRAMS_MAN_SECTION)
+MANPAGES = $(addsuffix .1,\
+ ocaml ocamlc ocamlc.opt ocamlcp ocamldebug ocamldep ocamldoc ocamllex \
+ ocamlmktop ocamlopt ocamlopt.opt ocamloptp ocamlprof ocamlrun ocamlyacc)
+.PHONY: install
install:
- for i in *.m; do cp \
- $$i $(INSTALL_DIR)/`basename $$i .m`.$(PROGRAMS_MAN_SECTION); done
- echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlc.$(PROGRAMS_MAN_SECTION)' \
- > $(INSTALL_DIR)/ocamlc.opt.$(PROGRAMS_MAN_SECTION)
- echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlopt.$(PROGRAMS_MAN_SECTION)' \
- > $(INSTALL_DIR)/ocamlopt.opt.$(PROGRAMS_MAN_SECTION)
- echo '.so man$(PROGRAMS_MAN_SECTION)/ocamlcp.$(PROGRAMS_MAN_SECTION)' \
- > $(INSTALL_DIR)/ocamloptp.$(PROGRAMS_MAN_SECTION)
+ $(MKDIR) $(INSTALL_PROGRAMS_MAN_DIR)
+ $(INSTALL_DATA) $(MANPAGES) $(INSTALL_PROGRAMS_MAN_DIR)
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAML 1
+
+.SH NAME
+ocaml \- The OCaml interactive toplevel
+
+.SH SYNOPSIS
+.B ocaml
+[
+.I options
+]
+[
+.I object-files
+]
+[
+.I script-file
+]
+.SH DESCRIPTION
+
+The
+.BR ocaml (1)
+command is the toplevel system for OCaml,
+that permits interactive use of the OCaml system through a
+read-eval-print loop. In this mode, the system repeatedly reads OCaml
+phrases from the input, then typechecks, compiles and evaluates
+them, then prints the inferred type and result value, if any. The
+system prints a # (hash) prompt before reading each phrase.
+
+A toplevel phrase can span several lines. It is terminated by ;; (a
+double-semicolon). The syntax of toplevel phrases is as follows.
+
+The toplevel system is started by the command
+.BR ocaml (1).
+Phrases are read on standard input, results are printed on standard
+output, errors on standard error. End-of-file on standard input
+terminates
+.BR ocaml (1).
+
+If one or more
+.I object-files
+(ending in .cmo or .cma) are given, they are loaded silently before
+starting the toplevel.
+
+If a
+.I script-file
+is given, phrases are read silently from the file, errors printed on
+standard error.
+.BR ocaml (1)
+exits after the execution of the last phrase.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocaml (1).
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+source and compiled files. By default, the current directory is
+searched first, then the standard library directory. Directories added
+with
+.B \-I
+are searched after the current directory, in the order in which they
+were given on the command line, but before the standard library
+directory.
+.IP
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.IP
+Directories can also be added to the search path once the toplevel
+is running with the
+.B #directory
+directive.
+.TP
+.BI \-init \ file
+Load the given file instead of the default initialization file.
+See the "Initialization file" section below.
+.TP
+.B \-labels
+Labels are not ignored in types, labels may be used in applications,
+and labelled parameters can be given in any order. This is the default.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks. Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+.TP
+.B \-noinit
+Do not load any initialization file.
+See the "Initialization file" section below.
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.B \-noprompt
+Do not display any prompt when waiting for input.
+.TP
+.B \-nopromptcont
+Do not display the secondary prompt when waiting for continuation lines in
+multi-line inputs. This should be used e.g. when running
+.BR ocaml (1)
+in an
+.BR emacs (1)
+window.
+.TP
+.B \-nostdlib
+Do not include the standard library directory in the list of
+directories searched for source and compiled files.
+.TP
+.BI \-open \ module
+Opens the given module before starting the toplevel. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were input.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way. When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in
+.B \-principal
+mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking. By default,
+only recursive types where the recursion goes through an object type
+are supported.
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\ bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-stdin
+Read the standard input as a script file rather than starting an
+interactive session.
+.TP
+.B \-strict\-sequence
+Force the left-hand part of each sequence to have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off on array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore slightly faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\ bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-no\-version
+Do not print the version banner at startup.
+.TP
+.BI \-w \ warning\-list
+Enable or disable warnings according to the argument
+.IR warning-list .
+See
+.BR ocamlc (1)
+for the syntax of the
+.I warning\-list
+argument.
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as fatal the warnings described by the argument
+.IR warning\-list .
+Note that a warning is not triggered (and does not trigger an error) if
+it is disabled by the
+.B \-w
+option. See
+.BR ocamlc (1)
+for the syntax of the
+.I warning\-list
+argument.
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+If \-color is not provided, "OCAML_COLOR" is not set and the environment
+variable "NO_COLOR" is set, then color output is disabled. Otherwise,
+the default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.BI \- \ file
+Use
+.I file
+as a script file name, even when it starts with a hyphen (-).
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH INITIALIZATION FILE
+
+When
+.BR ocaml (1)
+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 (
+.B HOME
+variable).
+You can specify a different initialization file
+by using the
+.BI \-init \ file
+option, and disable initialization files by using the
+.B \-noinit
+option.
+
+Note that you can also use the
+.B #use
+directive to read phrases from a file.
+
+.SH ENVIRONMENT VARIABLES
+.TP
+.B OCAMLTOP_UTF_8
+When printing string values, non-ascii bytes (>0x7E) are printed as
+decimal escape sequence if
+.B OCAMLTOP_UTF_8
+is set to false. Otherwise they are printed unescaped.
+.TP
+.B TERM
+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
+.IR The\ OCaml\ user's\ manual ,
+chapter "The toplevel system".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAML 1
-
-.SH NAME
-ocaml \- The OCaml interactive toplevel
-
-.SH SYNOPSIS
-.B ocaml
-[
-.I options
-]
-[
-.I object-files
-]
-[
-.I script-file
-]
-.SH DESCRIPTION
-
-The
-.BR ocaml (1)
-command is the toplevel system for OCaml,
-that permits interactive use of the OCaml system through a
-read-eval-print loop. In this mode, the system repeatedly reads OCaml
-phrases from the input, then typechecks, compiles and evaluates
-them, then prints the inferred type and result value, if any. The
-system prints a # (hash) prompt before reading each phrase.
-
-A toplevel phrase can span several lines. It is terminated by ;; (a
-double-semicolon). The syntax of toplevel phrases is as follows.
-
-The toplevel system is started by the command
-.BR ocaml (1).
-Phrases are read on standard input, results are printed on standard
-output, errors on standard error. End-of-file on standard input
-terminates
-.BR ocaml (1).
-
-If one or more
-.I object-files
-(ending in .cmo or .cma) are given, they are loaded silently before
-starting the toplevel.
-
-If a
-.I script-file
-is given, phrases are read silently from the file, errors printed on
-standard error.
-.BR ocaml (1)
-exits after the execution of the last phrase.
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocaml (1).
-.TP
-.B \-absname
-Show absolute filenames in error messages.
-.TP
-.BI \-I \ directory
-Add the given directory to the list of directories searched for
-source and compiled files. By default, the current directory is
-searched first, then the standard library directory. Directories added
-with
-.B \-I
-are searched after the current directory, in the order in which they
-were given on the command line, but before the standard library
-directory.
-.IP
-If the given directory starts with
-.BR + ,
-it is taken relative to the
-standard library directory. For instance,
-.B \-I\ +compiler-libs
-adds the subdirectory
-.B compiler-libs
-of the standard library to the search path.
-.IP
-Directories can also be added to the search path once the toplevel
-is running with the
-.B #directory
-directive.
-.TP
-.BI \-init \ file
-Load the given file instead of the default initialization file.
-See the "Initialization file" section below.
-.TP
-.B \-labels
-Labels are not ignored in types, labels may be used in applications,
-and labelled parameters can be given in any order. This is the default.
-.TP
-.B \-no\-app\-funct
-Deactivates the applicative behaviour of functors. With this option,
-each functor application generates new types in its result and
-applying the same functor twice to the same argument yields two
-incompatible structures.
-.TP
-.B \-noassert
-Do not compile assertion checks. Note that the special form
-.B assert\ false
-is always compiled because it is typed specially.
-.TP
-.B \-noinit
-Do not load any initialization file.
-See the "Initialization file" section below.
-.TP
-.B \-nolabels
-Ignore non-optional labels in types. Labels cannot be used in
-applications, and parameter order becomes strict.
-.TP
-.B \-noprompt
-Do not display any prompt when waiting for input.
-.TP
-.B \-nopromptcont
-Do not display the secondary prompt when waiting for continuation lines in
-multi-line inputs. This should be used e.g. when running
-.BR ocaml (1)
-in an
-.BR emacs (1)
-window.
-.TP
-.B \-nostdlib
-Do not include the standard library directory in the list of
-directories searched for source and compiled files.
-.TP
-.BI \-open \ module
-Opens the given module before starting the toplevel. If several
-.B \-open
-options are given, they are processed in order, just as if
-the statements open! module1;; ... open! moduleN;; were input.
-.TP
-.BI \-ppx \ command
-After parsing, pipe the abstract syntax tree through the preprocessor
-.IR command .
-The module
-.BR Ast_mapper (3)
-implements the external interface of a preprocessor.
-.TP
-.B \-principal
-Check information path during type-checking, to make sure that all
-types are derived in a principal way. When using labelled arguments
-and/or polymorphic methods, this flag is required to ensure future
-versions of the compiler will be able to infer types correctly, even
-if internal algorithms change.
-All programs accepted in
-.B \-principal
-mode are also accepted in the
-default mode with equivalent types, but different binary signatures,
-and this may slow down type checking; yet it is a good idea to
-use it once before publishing source code.
-.TP
-.B \-rectypes
-Allow arbitrary recursive types during type-checking. By default,
-only recursive types where the recursion goes through an object type
-are supported.
-.TP
-.B \-safe\-string
-Enforce the separation between types
-.BR string \ and\ bytes ,
-thereby making strings read-only. This is the default.
-.TP
-.B \-short\-paths
-When a type is visible under several module-paths, use the shortest
-one when printing the type's name in inferred interfaces and error and
-warning messages.
-.TP
-.B \-stdin
-Read the standard input as a script file rather than starting an
-interactive session.
-.TP
-.B \-strict\-sequence
-Force the left-hand part of each sequence to have type unit.
-.TP
-.B \-unboxed\-types
-When a type is unboxable (i.e. a record with a single argument or a
-concrete datatype with a single constructor of one argument) it will
-be unboxed unless annotated with
-.BR [@@ocaml.boxed] .
-.TP
-.B \-no-unboxed\-types
-When a type is unboxable it will be boxed unless annotated with
-.BR [@@ocaml.unboxed] .
-This is the default.
-.TP
-.B \-unsafe
-Turn bound checking off on array and string accesses (the
-.BR v.(i) and s.[i]
-constructs). Programs compiled with
-.B \-unsafe
-are therefore slightly faster, but unsafe: anything can happen if the program
-accesses an array or string outside of its bounds.
-.TP
-.B \-unsafe\-string
-Identify the types
-.BR string \ and\ bytes ,
-thereby making strings writable.
-This is intended for compatibility with old source code and should not
-be used with new software.
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.B \-no\-version
-Do not print the version banner at startup.
-.TP
-.BI \-w \ warning\-list
-Enable or disable warnings according to the argument
-.IR warning-list .
-See
-.BR ocamlc (1)
-for the syntax of the
-.I warning\-list
-argument.
-.TP
-.BI \-warn\-error \ warning\-list
-Mark as fatal the warnings described by the argument
-.IR warning\-list .
-Note that a warning is not triggered (and does not trigger an error) if
-it is disabled by the
-.B \-w
-option. See
-.BR ocamlc (1)
-for the syntax of the
-.I warning\-list
-argument.
-.TP
-.BI \-color \ mode
-Enable or disable colors in compiler messages (especially warnings and errors).
-The following modes are supported:
-
-.B auto
-use heuristics to enable colors only if the output supports them (an
-ANSI-compatible tty terminal);
-
-.B always
-enable colors unconditionally;
-
-.B never
-disable color output.
-
-The default setting is
-.B auto,
-and the current heuristic
-checks that the "TERM" environment variable exists and is
-not empty or "dumb", and that isatty(stderr) holds.
-
-The environment variable "OCAML_COLOR" is considered if \-color is not
-provided. Its values are auto/always/never as above.
-
-.TP
-.BI \-error\-style \ mode
-Control the way error messages and warnings are printed.
-The following modes are supported:
-
-.B short
-only print the error and its location;
-
-.B contextual
-like "short", but also display the source code snippet corresponding
-to the location of the error.
-
-The default setting is
-.B contextual.
-
-The environment variable "OCAML_ERROR_STYLE" is considered if
-\-error\-style is not provided. Its values are short/contextual as
-above.
-
-.TP
-.B \-warn\-help
-Show the description of all available warning numbers.
-.TP
-.BI \- \ file
-Use
-.I file
-as a script file name, even when it starts with a hyphen (-).
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH INITIALIZATION FILE
-
-When
-.BR ocaml (1)
-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 (
-.B HOME
-variable).
-You can specify a different initialization file
-by using the
-.BI \-init \ file
-option, and disable initialization files by using the
-.B \-noinit
-option.
-
-Note that you can also use the
-.B #use
-directive to read phrases from a file.
-
-.SH ENVIRONMENT VARIABLES
-.TP
-.B OCAMLTOP_UTF_8
-When printing string values, non-ascii bytes (>0x7E) are printed as
-decimal escape sequence if
-.B OCAMLTOP_UTF_8
-is set to false. Otherwise they are printed unescaped.
-.TP
-.B TERM
-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
-.IR The\ OCaml\ user's\ manual ,
-chapter "The toplevel system".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLC 1
+
+.SH NAME
+ocamlc \- The OCaml bytecode compiler
+
+.SH SYNOPSIS
+.B ocamlc
+[
+.I options
+]
+.I filename ...
+
+.B ocamlc.opt
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The OCaml bytecode compiler
+.BR ocamlc (1)
+compiles OCaml source files to bytecode object files and links
+these object files to produce standalone bytecode executable files.
+These executable files are then run by the bytecode interpreter
+.BR ocamlrun (1).
+
+The
+.BR ocamlc (1)
+command has a command-line interface similar to the one of
+most C compilers. It accepts several types of arguments and processes them
+sequentially, after all options have been processed:
+
+Arguments ending in .mli are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file
+.IR x \&.mli,
+the
+.BR ocamlc (1)
+compiler produces a compiled interface
+in the file
+.IR x \&.cmi.
+
+Arguments ending in .ml are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects. From the file
+.IR x \&.ml,
+the
+.BR ocamlc (1)
+compiler produces compiled object bytecode in the file
+.IR x \&.cmo.
+
+If the interface file
+.IR x \&.mli
+exists, the implementation
+.IR x \&.ml
+is checked against the corresponding compiled interface
+.IR x \&.cmi,
+which is assumed to exist. If no interface
+.IR x \&.mli
+is provided, the compilation of
+.IR x \&.ml
+produces a compiled interface file
+.IR x \&.cmi
+in addition to the compiled object code file
+.IR x \&.cmo.
+The file
+.IR x \&.cmi
+produced
+corresponds to an interface that exports everything that is defined in
+the implementation
+.IR x \&.ml.
+
+Arguments ending in .cmo are taken to be compiled object bytecode. These
+files are linked together, along with the object files obtained
+by compiling .ml arguments (if any), and the OCaml standard
+library, to produce a standalone executable program. The order in
+which .cmo and.ml arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given
+.IR x \&.cmo
+file must come before all .cmo files that refer to the unit
+.IR x .
+
+Arguments ending in .cma are taken to be libraries of object bytecode.
+A library of object bytecode packs in a single file a set of object
+bytecode files (.cmo files). Libraries are built with
+.B ocamlc\ \-a
+(see the description of the
+.B \-a
+option below). The object files
+contained in the library are linked as regular .cmo files (see above),
+in the order specified when the .cma file was built. The only
+difference is that if an object file
+contained in a library is not referenced anywhere in the program, then
+it is not linked in.
+
+Arguments ending in .c are passed to the C compiler, which generates
+a .o object file. This object file is linked with the program if the
+.B \-custom
+flag is set (see the description of
+.B \-custom
+below).
+
+Arguments ending in .o or .a are assumed to be C object files and
+libraries. They are passed to the C linker when linking in
+.B \-custom
+mode (see the description of
+.B \-custom
+below).
+
+Arguments ending in .so
+are assumed to be C shared libraries (DLLs). During linking, they are
+searched for external C functions referenced from the OCaml code,
+and their names are written in the generated bytecode executable.
+The run-time system
+.BR ocamlrun (1)
+then loads them dynamically at program start-up time.
+
+The output of the linking phase is a file containing compiled bytecode
+that can be executed by the OCaml bytecode interpreter:
+the command
+.BR ocamlrun (1).
+If
+.B caml.out
+is the name of the file produced by the linking phase, the command
+.B ocamlrun caml.out
+.IR arg1 \ \ arg2 \ ... \ argn
+executes the compiled code contained in
+.BR caml.out ,
+passing it as arguments the character strings
+.I arg1
+to
+.IR argn .
+(See
+.BR ocamlrun (1)
+for more details.)
+
+On most systems, the file produced by the linking
+phase can be run directly, as in:
+.B ./caml.out
+.IR arg1 \ \ arg2 \ ... \ argn .
+The produced file has the executable bit set, and it manages to launch
+the bytecode interpreter by itself.
+
+.B ocamlc.opt
+is the same compiler as
+.BR ocamlc ,
+but compiled with the native-code compiler
+.BR ocamlopt (1).
+Thus, it behaves exactly like
+.BR ocamlc ,
+but compiles faster.
+.B ocamlc.opt
+may not be available in all installations of OCaml.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlc (1).
+.TP
+.B \-a
+Build a library (.cma file) with the object files (.cmo files) given
+on the command line, instead of linking them into an executable
+file. The name of the library must be set with the
+.B \-o
+option.
+.IP
+If
+.BR \-custom , \ \-cclib \ or \ \-ccopt
+options are passed on the command
+line, these options are stored in the resulting .cma library. Then,
+linking with this library automatically adds back the
+.BR \-custom , \ \-cclib \ and \ \-ccopt
+options as if they had been provided on the
+command line, unless the
+.B \-noautolink
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-annot
+Deprecated since 4.11. Please use
+.BR \-bin-annot
+instead.
+.TP
+.B \-bin\-annot
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file
+.IR src .ml
+is put into file
+.IR src .cmt.
+In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The annotation files produced by
+.B \-bin\-annot
+contain more information
+and are much more compact than the files produced by
+.BR \-annot .
+.TP
+.B \-c
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+.TP
+.BI \-cc \ ccomp
+Use
+.I ccomp
+as the C linker when linking in "custom runtime" mode (see the
+.B \-custom
+option) and as the C compiler for compiling .c source files.
+.TP
+.BI \-cclib\ -l libname
+Pass the
+.BI \-l libname
+option to the C linker when linking in "custom runtime" mode (see the
+.B \-custom
+option). This causes the given C library to be linked with the program.
+.TP
+.BI \-ccopt \ option
+Pass the given
+.I option
+to the C compiler and linker, when linking in
+"custom runtime" mode (see the
+.B \-custom
+option). For instance,
+.BI \-ccopt\ \-L dir
+causes the C linker to search for C libraries in
+directory
+.IR dir .
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+If \-color is not provided, "OCAML_COLOR" is not set and the environment
+variable "NO_COLOR" is set, then color output is disabled. Otherwise,
+the default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-compat\-32
+Check that the generated bytecode executable can run on 32-bit
+platforms and signal an error if it cannot. This is useful when
+compiling bytecode on a 64-bit machine.
+.TP
+.B \-config
+Print the version number of
+.BR ocamlc (1)
+and a detailed summary of its configuration, then exit.
+.TP
+.BI \-config-var
+Print the value of a specific configuration variable
+from the
+.B \-config
+output, then exit. If the variable does not exist,
+the exit code is non-zero.
+.TP
+.B \-custom
+Link in "custom runtime" mode. In the default linking mode, the
+linker produces bytecode that is intended to be executed with the
+shared runtime system,
+.BR ocamlrun (1).
+In the custom runtime mode, the
+linker produces an output file that contains both the runtime system
+and the bytecode for the program. The resulting file is larger, but it
+can be executed directly, even if the
+.BR ocamlrun (1)
+command is not
+installed. Moreover, the "custom runtime" mode enables linking OCaml
+code with user-defined C functions.
+
+Never use the
+.BR strip (1)
+command on executables produced by
+.BR ocamlc\ \-custom ,
+this would remove the bytecode part of the executable.
+
+Security warning: never set the "setuid" or "setgid" bits on
+executables produced by
+.BR ocamlc\ \-custom ,
+this would make them vulnerable to attacks.
+.TP
+.BI \-depend\ ocamldep-args
+Compute dependencies, as ocamldep would do.
+.TP
+.BI \-dllib\ \-l libname
+Arrange for the C shared library
+.BI dll libname .so
+to be loaded dynamically by the run-time system
+.BR ocamlrun (1)
+at program start-up time.
+.TP
+.BI \-dllpath \ dir
+Adds the directory
+.I dir
+to the run-time search path for shared
+C libraries. At link-time, shared libraries are searched in the
+standard search path (the one corresponding to the
+.B \-I
+option).
+The
+.B \-dllpath
+option simply stores
+.I dir
+in the produced
+executable file, where
+.BR ocamlrun (1)
+can find it and use it.
+.TP
+.BI \-for\-pack \ module\-path
+Generate an object file (.cmo file) that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with
+.BR \-pack .
+For instance,
+.B ocamlc\ \-for\-pack\ P\ \-c\ A.ml
+will generate a.cmo that can later be used with
+.BR "ocamlc -pack -o P.cmo a.cmo" .
+Note: you can still pack a module that was compiled without
+.B \-for\-pack
+but in this case exceptions will be printed with the wrong names.
+.TP
+.B \-g
+Add debugging information while compiling and linking. This option is
+required in order to be able to debug the program with
+.BR ocamldebug (1)
+and to produce stack backtraces when
+the program terminates on an uncaught exception.
+.TP
+.B \-i
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (.ml
+file). No compiled files (.cmo and .cmi files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (.mli file) for a file: just
+redirect the standard output of the compiler to a .mli file, and edit
+that file to remove all declarations of unexported names.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmi), compiled object code files
+(.cmo), libraries (.cma), and C libraries specified with
+.BI \-cclib\ \-l xxx
+.RB .
+By default, the current directory is searched first, then the
+standard library directory. Directories added with
+.B \-I
+are searched
+after the current directory, in the order in which they were given on
+the command line, but before the standard library directory. See also
+option
+.BR \-nostdlib .
+
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.BI \-intf\-suffix \ string
+Recognize file names ending with
+.I string
+as interface files (instead of the default .mli).
+.TP
+.B \-keep-docs
+Keep documentation strings in generated .cmi files.
+.TP
+.B \-keep-locs
+Keep locations in generated .cmi files.
+.TP
+.B \-labels
+Labels are not ignored in types, labels may be used in applications,
+and labelled parameters can be given in any order. This is the default.
+.TP
+.B \-linkall
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library (option
+.BR \-a ),
+setting the
+.B \-linkall
+option forces all subsequent links of programs involving that library
+to link all the modules contained in the library.
+When compiling a module (option
+.BR \-c ),
+setting the
+.B \-linkall
+option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+.TP
+.B \-make\-runtime
+Build a custom runtime system (in the file specified by option
+.BR \-o )
+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 option
+.B ocamlc\ \-use\-runtime
+.IR runtime-name .
+.TP
+.B \-match\-context\-rows
+Set number of rows of context used during pattern matching
+compilation. Lower values cause faster compilation, but
+less optimized code. The default value is 32.
+.TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks. Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+This flag has no effect when linking already-compiled files.
+.TP
+.B \-noautolink
+When linking .cma libraries, ignore
+.BR \-custom , \ \-cclib \ and \ \-ccopt
+options potentially contained in the libraries (if these options were
+given when building the libraries). This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set
+.B \-noautolink
+and pass the correct C libraries and options on the command line.
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.B \-nostdlib
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (.cmi), compiled
+object code files (.cmo), libraries (.cma), and C libraries specified
+with
+.BI \-cclib\ \-l xxx
+.RB .
+See also option
+.BR \-I .
+.TP
+.BI \-o \ exec\-file
+Specify the name of the output file produced by the linker. The
+default output name is
+.BR a.out ,
+in keeping with the Unix tradition. If the
+.B \-a
+option is given, specify the name of the library
+produced. If the
+.B \-pack
+option is given, specify the name of the
+packed object file produced. If the
+.B \-output\-obj
+or
+.B \-output\-complete\-obj
+option is given,
+specify the name of the output file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.B \-opaque
+Interface file compiled with this option are marked so that other
+compilation units depending on it will not rely on any implementation
+details of the compiled implementation. The native compiler will not
+access the .cmx file of this unit -- nor warn if it is absent. This can
+improve speed of compilation, for both initial and incremental builds,
+at the expense of performance of the generated code.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
+.TP
+.B \-output\-obj
+Cause the linker to produce a C object file instead of a bytecode
+executable file. This is useful to wrap OCaml code as a C library,
+callable from any C program. The name of the output object file
+must be set with the
+.B \-o
+option. This
+option can also be used to produce a C source file (.c extension) or
+a compiled shared/dynamic library (.so extension).
+.TP
+.B \-output\-complete\-obj
+Same as
+.B \-output\-obj
+except when creating an object file where it includes the runtime and
+autolink libraries.
+.TP
+.B \-pack
+Build a bytecode object file (.cmo file) and its associated compiled
+interface (.cmi) that combines the object
+files given on the command line, making them appear as sub-modules of
+the output .cmo file. The name of the output .cmo file must be
+given with the
+.B \-o
+option. For instance,
+.B ocamlc\ \-pack\ \-o\ p.cmo\ a.cmo\ b.cmo\ c.cmo
+generates compiled files p.cmo and p.cmi describing a compilation
+unit having three sub-modules A, B and C, corresponding to the
+contents of the object files a.cmo, b.cmo and c.cmo. These
+contents can be referenced as P.A, P.B and P.C in the remainder
+of the program.
+.TP
+.BI \-pp \ command
+Cause the compiler to call the given
+.I command
+as a preprocessor for each source file. The output of
+.I command
+is redirected to
+an intermediate file, which is compiled. If there are no compilation
+errors, the intermediate file is deleted afterwards. The name of this
+file is built from the basename of the source file with the
+extension .ppi for an interface (.mli) file and .ppo for an
+implementation (.ml) file.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way. When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in
+.B \-principal
+mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking. By default,
+only recursive types where the recursion goes through an object type
+are supported. Note that once you have created an interface using this
+flag, you must use it again for all dependencies.
+.TP
+.BI \-runtime\-variant \ suffix
+Add
+.I suffix
+to the name of the runtime library that will be used by the program.
+If OCaml was configured with option
+.BR \-with\-debug\-runtime ,
+then the
+.B d
+suffix is supported and gives a debug version of the runtime.
+.TP
+.BI \-stop\-after \ pass
+Stop compilation after the given compilation pass. The currently
+supported passes are:
+.BR parsing ,
+.BR typing .
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\ bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-strict\-sequence
+Force the left-hand part of each sequence to have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off for array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore
+slightly faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\ bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.BI \-use\-runtime \ runtime\-name
+Generate a bytecode executable file that can be executed on the custom
+runtime system
+.IR runtime\-name ,
+built earlier with
+.B ocamlc\ \-make\-runtime
+.IR runtime\-name .
+.TP
+.B \-v
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+.TP
+.B \-verbose
+Print all external commands before they are executed, in particular
+invocations of the C compiler and linker in
+.B \-custom
+mode. Useful to debug C library problems.
+.TP
+.BR \-vnum \ or\ \-version
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+.TP
+.BI \-w \ warning\-list
+Enable, disable, or mark as fatal the warnings specified by the argument
+.IR warning\-list .
+
+Each warning can be
+.IR enabled \ or\ disabled ,
+and each warning can be
+.IR fatal \ or
+.IR non-fatal .
+If a warning is disabled, it isn't displayed and doesn't affect
+compilation in any way (even if it is fatal). If a warning is enabled,
+it is displayed normally by the compiler whenever the source code
+triggers it. If it is enabled and fatal, the compiler will also stop
+with an error after displaying it.
+
+The
+.I warning\-list
+argument is either a mnemonic warning specifier or a sequence of single
+character warning specifiers, with no separators between them. A mnemonic
+warning specifier is one of the following
+
+.BI + name
+\ \ Enable warning
+.IR name .
+
+.BI \- name
+\ \ Disable warning
+.IR name .
+
+.BI @ name
+\ \ Enable and mark as fatal warning
+.IR name .
+
+A single character warning specifier is one of the following:
+
+.BI + num
+\ \ Enable warning number
+.IR num .
+
+.BI \- num
+\ \ Disable warning number
+.IR num .
+
+.BI @ num
+\ \ Enable and mark as fatal warning number
+.IR num .
+
+.BI + num1 .. num2
+\ \ Enable all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI \- num1 .. num2
+\ \ Disable all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI @ num1 .. num2
+\ \ Enable and mark as fatal all warnings between
+.I num1
+and
+.I num2
+(inclusive).
+
+.BI + letter
+\ \ Enable the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.BI \- letter
+\ \ Disable the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.BI @ letter
+\ \ Enable and mark as fatal the set of warnings corresponding to
+.IR letter .
+The letter may be uppercase or lowercase.
+
+.I uppercase\-letter
+\ \ Enable the set of warnings corresponding to
+.IR uppercase\-letter .
+
+.I lowercase\-letter
+\ \ Disable the set of warnings corresponding to
+.IR lowercase\-letter .
+
+The warning numbers and mnemonic names are as follows.
+
+.B 1 [comment-start]
+.br
+Suspicious-looking start-of-comment mark.
+
+.B 2 [comment-not-end]
+.br
+Suspicious-looking end-of-comment mark.
+
+.B 3
+.br
+Deprecated feature.
+
+.B 4 [fragile-match]
+.br
+Fragile pattern matching: matching that will remain
+complete even if additional constructors are added to one of the
+variant types matched.
+
+.B 5 [ignored-partial-application]
+.br
+Partially applied function: expression whose result has
+function type and is ignored.
+
+.B 6 [labels-omitted]
+.br
+Label omitted in function application.
+
+.B 7 [method-override]
+.br
+Method overridden without using the "method!" keyword.
+
+.B 8 [partial-match]
+.br
+Partial match: missing cases in pattern-matching.
+
+.B 9 [missing-record-field-pattern]
+.br
+Missing fields in a record pattern.
+
+.B 10 [non-unit-statement]
+.br
+Expression on the left-hand side of a sequence that doesn't
+have type
+.B unit
+(and that is not a function, see warning number 5).
+
+.B 11 [redundant-case]
+.br
+Redundant case in a pattern matching (unused match case).
+
+.B 12 [redundant-subpat]
+.br
+Redundant sub-pattern in a pattern-matching.
+
+.B 13 [instance-variable-override]
+.br
+Override of an instance variable.
+
+.B 14 [illegal-backslash]
+.br
+Illegal backslash escape in a string constant.
+
+.B 15 [implicit-public-methods]
+.br
+Private method made public implicitly.
+
+.B 16 [unerasable-optional-argument]
+.br
+Unerasable optional argument.
+
+.B 17 [undeclared-virtual-method]
+.br
+Undeclared virtual method.
+
+.B 18 [not-principal]
+.br
+Non-principal type.
+
+.B 19 [non-principal-labels]
+.br
+Type without principality.
+
+.B 20 [ignored-extra-argument]
+.br
+Unused function argument.
+
+.B 21 [nonreturning-statement]
+.br
+Non-returning statement.
+
+.B 22 [preprocessor]
+.br
+Preprocessor warning.
+
+.B 23 [useless-record-with]
+.br
+Useless record
+.B with
+clause.
+
+.B 24 [bad-module-name]
+.br
+Bad module name: the source file name is not a valid OCaml module name.
+
+.B 25
+.br
+Deprecated: now part of warning 8.
+
+.B 26 [unused-var]
+.br
+Suspicious unused variable: unused variable that is bound with
+.BR let \ or \ as ,
+and doesn't start with an underscore (_) character.
+
+.B 27 [unused-var-strict]
+.br
+Innocuous unused variable: unused variable that is not bound with
+.BR let \ nor \ as ,
+and doesn't start with an underscore (_) character.
+
+.B 28 [wildcard-arg-to-constant-constr]
+.br
+A pattern contains a constant constructor applied to the underscore (_)
+pattern.
+
+.B 29 [eol-in-string]
+.br
+A non-escaped end-of-line was found in a string constant. This may
+cause portability problems between Unix and Windows.
+
+.B 30 [duplicate-definitions]
+.br
+Two labels or constructors of the same name are defined in two
+mutually recursive types.
+
+.B 31 [module-linked-twice]
+.br
+A module is linked twice in the same executable.
+
+.B 32 [unused-value-declaration]
+.br
+Unused value declaration.
+
+.B 33 [unused-open]
+.br
+Unused open statement.
+
+.B 34 [unused-type-declaration]
+.br
+Unused type declaration.
+
+.B 35 [unused-for-index]
+.br
+Unused for-loop index.
+
+.B 36 [unused-ancestor]
+.br
+Unused ancestor variable.
+
+.B 37 [unused-constructor]
+.br
+Unused constructor.
+
+.B 38 [unused-extension]
+.br
+Unused extension constructor.
+
+.B 39 [unused-rec-flag]
+.br
+Unused rec flag.
+
+.B 40 [name-out-of-scope]
+.br
+Constructor or label name used out of scope.
+
+.B 41 [ambiguous-name]
+.br
+Ambiguous constructor or label name.
+
+.B 42 [disambiguated-name]
+.br
+Disambiguated constructor or label name.
+
+.B 43 [nonoptional-label]
+.br
+Nonoptional label applied as optional.
+
+.B 44 [open-shadow-identifier]
+.br
+Open statement shadows an already defined identifier.
+
+.B 45 [open-shadow-label-constructor]
+.br
+Open statement shadows an already defined label or constructor.
+
+.B 46 [bad-env-variable]
+.br
+Error in environment variable.
+
+.B 47 [attribute-payload]
+.br
+Illegal attribute payload.
+
+.B 48 [eliminated-optional-arguments]
+.br
+Implicit elimination of optional arguments.
+
+.B 49 [no-cmi-file]
+.br
+Missing cmi file when looking up module alias.
+
+.B 50 [unexpected-docstring]
+.br
+Unexpected documentation comment.
+
+.B 51 [wrong-tailcall-expectation]
+.br
+Function call annotated with an incorrect @tailcall attribute
+
+.B 52 [fragile-literal-pattern]
+.br
+Fragile constant pattern.
+
+.B 53 [misplaced-attribute]
+.br
+Attribute cannot appear in this context.
+
+.B 54 [duplicated-attribute]
+.br
+Attribute used more than once on an expression.
+
+.B 55 [inlining-impossible]
+.br
+Inlining impossible.
+
+.B 56 [unreachable-case]
+.br
+Unreachable case in a pattern-matching (based on type information).
+
+.B 57 [ambiguous-var-in-pattern-guard]
+.br
+Ambiguous or-pattern variables under guard.
+
+.B 58 [no-cmx-file]
+.br
+Missing cmx file.
+
+
+.B 59 [flambda-assignment-to-non-mutable-value]
+.br
+Assignment on non-mutable value.
+
+.B 60 [unused-module]
+.br
+Unused module declaration.
+
+.B 61 [unboxable-type-in-prim-decl]
+.br
+Unannotated unboxable type in primitive declaration.
+
+.B 62 [constraint-on-gadt]
+.br
+Type constraint on GADT type declaration.
+
+.B 63 [erroneous-printed-signature]
+.br
+Erroneous printed signature.
+
+.B 64 [unsafe-array-syntax-without-parsing]
+.br
+-unsafe used with a preprocessor returning a syntax tree.
+
+.B 65 [redefining-unit]
+.br
+Type declaration defining a new '()' constructor.
+
+.B 66 [unused-open-bang]
+.br
+Unused open! statement.
+
+.B 67 [unused-functor-parameter]
+.br
+Unused functor parameter.
+
+.B 68 [match-on-mutable-state-prevent-uncurry]
+.br
+Pattern-matching depending on mutable state prevents the remaining
+arguments from being uncurried.
+
+.B 69 [unused-field]
+.br
+Unused record field.
+
+.B 70 [missing-mli]
+.br
+Missing interface file.
+
+.B 71 [unused-tmc-attribute]
+.br
+Unused @tail_mod_cons attribute
+
+.B 72 [tmc-breaks-tailcall]
+.br
+A tail call is turned into a non-tail call by the @tail_mod_cons
+transformation.
+
+
+The letters stand for the following sets of warnings. Any letter not
+mentioned here corresponds to the empty set.
+
+.B A
+\ all warnings
+
+.B C
+\ 1, 2
+
+.B D
+\ 3
+
+.B E
+\ 4
+
+.B F
+\ 5
+
+.B K
+\ 32, 33, 34, 35, 36, 37, 38, 39
+
+.B L
+\ 6
+
+.B M
+\ 7
+
+.B P
+\ 8
+
+.B R
+\ 9
+
+.B S
+\ 10
+
+.B U
+\ 11, 12
+
+.B V
+\ 13
+
+.B X
+\ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 30
+
+.B Y
+\ 26
+
+.B Z
+\ 27
+
+.IP
+The default setting is
+.BR \-w\ +a\-4\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66..70 .
+Note that warnings
+.BR 5 \ and \ 10
+are not always triggered, depending on the internals of the type checker.
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as errors the warnings specified in the argument
+.IR warning\-list .
+The compiler will stop with an error when one of these
+warnings is emitted. The
+.I warning\-list
+has the same meaning as for
+the
+.B \-w
+option: a
+.B +
+sign (or an uppercase letter) marks the corresponding warnings as fatal, a
+.B \-
+sign (or a lowercase letter) turns them back into non-fatal warnings, and a
+.B @
+sign both enables and marks as fatal the corresponding warnings.
+
+Note: it is not recommended to use the
+.B \-warn\-error
+option in production code, because it will almost certainly prevent
+compiling your program with later versions of OCaml when they add new
+warnings or modify existing warnings.
+
+The default setting is
+.B \-warn\-error \-a+31
+(only warning 31 is fatal).
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.B \-where
+Print the location of the standard library, then exit.
+.TP
+.B \-with-runtime
+Include the runtime system in the generated program. This is the default.
+.TP
+.B \-without-runtime
+The compiler does not include the runtime system (nor a reference to it) in the
+generated program; it must be supplied separately.
+.TP
+.BI \- \ file
+Process
+.I file
+as a file name, even if it starts with a dash (-) character.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlopt (1), \ ocamlrun (1), \ ocaml (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Batch compilation".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLC 1
-
-.SH NAME
-ocamlc \- The OCaml bytecode compiler
-
-.SH SYNOPSIS
-.B ocamlc
-[
-.I options
-]
-.I filename ...
-
-.B ocamlc.opt
-[
-.I options
-]
-.I filename ...
-
-.SH DESCRIPTION
-
-The OCaml bytecode compiler
-.BR ocamlc (1)
-compiles OCaml source files to bytecode object files and links
-these object files to produce standalone bytecode executable files.
-These executable files are then run by the bytecode interpreter
-.BR ocamlrun (1).
-
-The
-.BR ocamlc (1)
-command has a command-line interface similar to the one of
-most C compilers. It accepts several types of arguments and processes them
-sequentially, after all options have been processed:
-
-Arguments ending in .mli are taken to be source files for
-compilation unit interfaces. Interfaces specify the names exported by
-compilation units: they declare value names with their types, define
-public data types, declare abstract data types, and so on. From the
-file
-.IR x \&.mli,
-the
-.BR ocamlc (1)
-compiler produces a compiled interface
-in the file
-.IR x \&.cmi.
-
-Arguments ending in .ml are taken to be source files for compilation
-unit implementations. Implementations provide definitions for the
-names exported by the unit, and also contain expressions to be
-evaluated for their side-effects. From the file
-.IR x \&.ml,
-the
-.BR ocamlc (1)
-compiler produces compiled object bytecode in the file
-.IR x \&.cmo.
-
-If the interface file
-.IR x \&.mli
-exists, the implementation
-.IR x \&.ml
-is checked against the corresponding compiled interface
-.IR x \&.cmi,
-which is assumed to exist. If no interface
-.IR x \&.mli
-is provided, the compilation of
-.IR x \&.ml
-produces a compiled interface file
-.IR x \&.cmi
-in addition to the compiled object code file
-.IR x \&.cmo.
-The file
-.IR x \&.cmi
-produced
-corresponds to an interface that exports everything that is defined in
-the implementation
-.IR x \&.ml.
-
-Arguments ending in .cmo are taken to be compiled object bytecode. These
-files are linked together, along with the object files obtained
-by compiling .ml arguments (if any), and the OCaml standard
-library, to produce a standalone executable program. The order in
-which .cmo and.ml arguments are presented on the command line is
-relevant: compilation units are initialized in that order at
-run-time, and it is a link-time error to use a component of a unit
-before having initialized it. Hence, a given
-.IR x \&.cmo
-file must come before all .cmo files that refer to the unit
-.IR x .
-
-Arguments ending in .cma are taken to be libraries of object bytecode.
-A library of object bytecode packs in a single file a set of object
-bytecode files (.cmo files). Libraries are built with
-.B ocamlc\ \-a
-(see the description of the
-.B \-a
-option below). The object files
-contained in the library are linked as regular .cmo files (see above),
-in the order specified when the .cma file was built. The only
-difference is that if an object file
-contained in a library is not referenced anywhere in the program, then
-it is not linked in.
-
-Arguments ending in .c are passed to the C compiler, which generates
-a .o object file. This object file is linked with the program if the
-.B \-custom
-flag is set (see the description of
-.B \-custom
-below).
-
-Arguments ending in .o or .a are assumed to be C object files and
-libraries. They are passed to the C linker when linking in
-.B \-custom
-mode (see the description of
-.B \-custom
-below).
-
-Arguments ending in .so
-are assumed to be C shared libraries (DLLs). During linking, they are
-searched for external C functions referenced from the OCaml code,
-and their names are written in the generated bytecode executable.
-The run-time system
-.BR ocamlrun (1)
-then loads them dynamically at program start-up time.
-
-The output of the linking phase is a file containing compiled bytecode
-that can be executed by the OCaml bytecode interpreter:
-the command
-.BR ocamlrun (1).
-If
-.B caml.out
-is the name of the file produced by the linking phase, the command
-.B ocamlrun caml.out
-.IR arg1 \ \ arg2 \ ... \ argn
-executes the compiled code contained in
-.BR caml.out ,
-passing it as arguments the character strings
-.I arg1
-to
-.IR argn .
-(See
-.BR ocamlrun (1)
-for more details.)
-
-On most systems, the file produced by the linking
-phase can be run directly, as in:
-.B ./caml.out
-.IR arg1 \ \ arg2 \ ... \ argn .
-The produced file has the executable bit set, and it manages to launch
-the bytecode interpreter by itself.
-
-.B ocamlc.opt
-is the same compiler as
-.BR ocamlc ,
-but compiled with the native-code compiler
-.BR ocamlopt (1).
-Thus, it behaves exactly like
-.BR ocamlc ,
-but compiles faster.
-.B ocamlc.opt
-may not be available in all installations of OCaml.
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocamlc (1).
-.TP
-.B \-a
-Build a library (.cma file) with the object files (.cmo files) given
-on the command line, instead of linking them into an executable
-file. The name of the library must be set with the
-.B \-o
-option.
-.IP
-If
-.BR \-custom , \ \-cclib \ or \ \-ccopt
-options are passed on the command
-line, these options are stored in the resulting .cma library. Then,
-linking with this library automatically adds back the
-.BR \-custom , \ \-cclib \ and \ \-ccopt
-options as if they had been provided on the
-command line, unless the
-.B \-noautolink
-option is given. Additionally, a substring
-.B $CAMLORIGIN
-inside a
-.BR \ \-ccopt
-options will be replaced by the full path to the .cma library,
-excluding the filename.
-.B \-absname
-Show absolute filenames in error messages.
-.TP
-.B \-annot
-Deprecated since 4.11. Please use
-.BR \-bin-annot
-instead.
-.TP
-.B \-bin\-annot
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc) in binary format. The information for file
-.IR src .ml
-is put into file
-.IR src .cmt.
-In case of a type error, dump
-all the information inferred by the type-checker before the error.
-The annotation files produced by
-.B \-bin\-annot
-contain more information
-and are much more compact than the files produced by
-.BR \-annot .
-.TP
-.B \-c
-Compile only. Suppress the linking phase of the
-compilation. Source code files are turned into compiled files, but no
-executable file is produced. This option is useful to
-compile modules separately.
-.TP
-.BI \-cc \ ccomp
-Use
-.I ccomp
-as the C linker when linking in "custom runtime" mode (see the
-.B \-custom
-option) and as the C compiler for compiling .c source files.
-.TP
-.BI \-cclib\ -l libname
-Pass the
-.BI \-l libname
-option to the C linker when linking in "custom runtime" mode (see the
-.B \-custom
-option). This causes the given C library to be linked with the program.
-.TP
-.BI \-ccopt \ option
-Pass the given
-.I option
-to the C compiler and linker, when linking in
-"custom runtime" mode (see the
-.B \-custom
-option). For instance,
-.BI \-ccopt\ \-L dir
-causes the C linker to search for C libraries in
-directory
-.IR dir .
-.TP
-.BI \-color \ mode
-Enable or disable colors in compiler messages (especially warnings and errors).
-The following modes are supported:
-
-.B auto
-use heuristics to enable colors only if the output supports them (an
-ANSI-compatible tty terminal);
-
-.B always
-enable colors unconditionally;
-
-.B never
-disable color output.
-
-The default setting is
-.B auto,
-and the current heuristic
-checks that the "TERM" environment variable exists and is
-not empty or "dumb", and that isatty(stderr) holds.
-
-The environment variable "OCAML_COLOR" is considered if \-color is not
-provided. Its values are auto/always/never as above.
-
-.TP
-.BI \-error\-style \ mode
-Control the way error messages and warnings are printed.
-The following modes are supported:
-
-.B short
-only print the error and its location;
-
-.B contextual
-like "short", but also display the source code snippet corresponding
-to the location of the error.
-
-The default setting is
-.B contextual.
-
-The environment variable "OCAML_ERROR_STYLE" is considered if
-\-error\-style is not provided. Its values are short/contextual as
-above.
-
-.TP
-.B \-compat\-32
-Check that the generated bytecode executable can run on 32-bit
-platforms and signal an error if it cannot. This is useful when
-compiling bytecode on a 64-bit machine.
-.TP
-.B \-config
-Print the version number of
-.BR ocamlc (1)
-and a detailed summary of its configuration, then exit.
-.TP
-.BI \-config-var
-Print the value of a specific configuration variable
-from the
-.B \-config
-output, then exit. If the variable does not exist,
-the exit code is non-zero.
-.TP
-.B \-custom
-Link in "custom runtime" mode. In the default linking mode, the
-linker produces bytecode that is intended to be executed with the
-shared runtime system,
-.BR ocamlrun (1).
-In the custom runtime mode, the
-linker produces an output file that contains both the runtime system
-and the bytecode for the program. The resulting file is larger, but it
-can be executed directly, even if the
-.BR ocamlrun (1)
-command is not
-installed. Moreover, the "custom runtime" mode enables linking OCaml
-code with user-defined C functions.
-
-Never use the
-.BR strip (1)
-command on executables produced by
-.BR ocamlc\ \-custom ,
-this would remove the bytecode part of the executable.
-
-Security warning: never set the "setuid" or "setgid" bits on
-executables produced by
-.BR ocamlc\ \-custom ,
-this would make them vulnerable to attacks.
-.TP
-.BI \-depend\ ocamldep-args
-Compute dependencies, as ocamldep would do.
-.TP
-.BI \-dllib\ \-l libname
-Arrange for the C shared library
-.BI dll libname .so
-to be loaded dynamically by the run-time system
-.BR ocamlrun (1)
-at program start-up time.
-.TP
-.BI \-dllpath \ dir
-Adds the directory
-.I dir
-to the run-time search path for shared
-C libraries. At link-time, shared libraries are searched in the
-standard search path (the one corresponding to the
-.B \-I
-option).
-The
-.B \-dllpath
-option simply stores
-.I dir
-in the produced
-executable file, where
-.BR ocamlrun (1)
-can find it and use it.
-.TP
-.BI \-for\-pack \ module\-path
-Generate an object file (.cmo file) that can later be included
-as a sub-module (with the given access path) of a compilation unit
-constructed with
-.BR \-pack .
-For instance,
-.B ocamlc\ \-for\-pack\ P\ \-c\ A.ml
-will generate a.cmo that can later be used with
-.BR "ocamlc -pack -o P.cmo a.cmo" .
-Note: you can still pack a module that was compiled without
-.B \-for\-pack
-but in this case exceptions will be printed with the wrong names.
-.TP
-.B \-g
-Add debugging information while compiling and linking. This option is
-required in order to be able to debug the program with
-.BR ocamldebug (1)
-and to produce stack backtraces when
-the program terminates on an uncaught exception.
-.TP
-.B \-i
-Cause the compiler to print all defined names (with their inferred
-types or their definitions) when compiling an implementation (.ml
-file). No compiled files (.cmo and .cmi files) are produced.
-This can be useful to check the types inferred by the
-compiler. Also, since the output follows the syntax of interfaces, it
-can help in writing an explicit interface (.mli file) for a file: just
-redirect the standard output of the compiler to a .mli file, and edit
-that file to remove all declarations of unexported names.
-.TP
-.BI \-I \ directory
-Add the given directory to the list of directories searched for
-compiled interface files (.cmi), compiled object code files
-(.cmo), libraries (.cma), and C libraries specified with
-.BI \-cclib\ \-l xxx
-.RB .
-By default, the current directory is searched first, then the
-standard library directory. Directories added with
-.B \-I
-are searched
-after the current directory, in the order in which they were given on
-the command line, but before the standard library directory. See also
-option
-.BR \-nostdlib .
-
-If the given directory starts with
-.BR + ,
-it is taken relative to the
-standard library directory. For instance,
-.B \-I\ +compiler-libs
-adds the subdirectory
-.B compiler-libs
-of the standard library to the search path.
-.TP
-.BI \-impl \ filename
-Compile the file
-.I filename
-as an implementation file, even if its extension is not .ml.
-.TP
-.BI \-intf \ filename
-Compile the file
-.I filename
-as an interface file, even if its extension is not .mli.
-.TP
-.BI \-intf\-suffix \ string
-Recognize file names ending with
-.I string
-as interface files (instead of the default .mli).
-.TP
-.B \-keep-docs
-Keep documentation strings in generated .cmi files.
-.TP
-.B \-keep-locs
-Keep locations in generated .cmi files.
-.TP
-.B \-labels
-Labels are not ignored in types, labels may be used in applications,
-and labelled parameters can be given in any order. This is the default.
-.TP
-.B \-linkall
-Force all modules contained in libraries to be linked in. If this
-flag is not given, unreferenced modules are not linked in. When
-building a library (option
-.BR \-a ),
-setting the
-.B \-linkall
-option forces all subsequent links of programs involving that library
-to link all the modules contained in the library.
-When compiling a module (option
-.BR \-c ),
-setting the
-.B \-linkall
-option ensures that this module will
-always be linked if it is put in a library and this library is linked.
-.TP
-.B \-make\-runtime
-Build a custom runtime system (in the file specified by option
-.BR \-o )
-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 option
-.B ocamlc\ \-use\-runtime
-.IR runtime-name .
-.TP
-.B \-match\-context\-rows
-Set number of rows of context used during pattern matching
-compilation. Lower values cause faster compilation, but
-less optimized code. The default value is 32.
-.TP
-.B \-no-alias-deps
-Do not record dependencies for module aliases.
-.TP
-.B \-no\-app\-funct
-Deactivates the applicative behaviour of functors. With this option,
-each functor application generates new types in its result and
-applying the same functor twice to the same argument yields two
-incompatible structures.
-.TP
-.B \-noassert
-Do not compile assertion checks. Note that the special form
-.B assert\ false
-is always compiled because it is typed specially.
-This flag has no effect when linking already-compiled files.
-.TP
-.B \-noautolink
-When linking .cma libraries, ignore
-.BR \-custom , \ \-cclib \ and \ \-ccopt
-options potentially contained in the libraries (if these options were
-given when building the libraries). This can be useful if a library
-contains incorrect specifications of C libraries or C options; in this
-case, during linking, set
-.B \-noautolink
-and pass the correct C libraries and options on the command line.
-.TP
-.B \-nolabels
-Ignore non-optional labels in types. Labels cannot be used in
-applications, and parameter order becomes strict.
-.TP
-.B \-nostdlib
-Do not automatically add the standard library directory to the list of
-directories searched for compiled interface files (.cmi), compiled
-object code files (.cmo), libraries (.cma), and C libraries specified
-with
-.BI \-cclib\ \-l xxx
-.RB .
-See also option
-.BR \-I .
-.TP
-.BI \-o \ exec\-file
-Specify the name of the output file produced by the linker. The
-default output name is
-.BR a.out ,
-in keeping with the Unix tradition. If the
-.B \-a
-option is given, specify the name of the library
-produced. If the
-.B \-pack
-option is given, specify the name of the
-packed object file produced. If the
-.B \-output\-obj
-or
-.B \-output\-complete\-obj
-option is given,
-specify the name of the output file produced.
-This can also be used when compiling an interface or implementation
-file, without linking, in which case it sets the name of the cmi or
-cmo file, and also sets the module name to the file name up to the
-first dot.
-.TP
-.B \-opaque
-Interface file compiled with this option are marked so that other
-compilation units depending on it will not rely on any implementation
-details of the compiled implementation. The native compiler will not
-access the .cmx file of this unit -- nor warn if it is absent. This can
-improve speed of compilation, for both initial and incremental builds,
-at the expense of performance of the generated code.
-.TP
-.BI \-open \ module
-Opens the given module before processing the interface or
-implementation files. If several
-.B \-open
-options are given, they are processed in order, just as if
-the statements open! module1;; ... open! moduleN;; were added
-at the top of each file.
-.TP
-.B \-output\-obj
-Cause the linker to produce a C object file instead of a bytecode
-executable file. This is useful to wrap OCaml code as a C library,
-callable from any C program. The name of the output object file
-must be set with the
-.B \-o
-option. This
-option can also be used to produce a C source file (.c extension) or
-a compiled shared/dynamic library (.so extension).
-.TP
-.B \-output\-complete\-obj
-Same as
-.B \-output\-obj
-except when creating an object file where it includes the runtime and
-autolink libraries.
-.TP
-.B \-pack
-Build a bytecode object file (.cmo file) and its associated compiled
-interface (.cmi) that combines the object
-files given on the command line, making them appear as sub-modules of
-the output .cmo file. The name of the output .cmo file must be
-given with the
-.B \-o
-option. For instance,
-.B ocamlc\ \-pack\ \-o\ p.cmo\ a.cmo\ b.cmo\ c.cmo
-generates compiled files p.cmo and p.cmi describing a compilation
-unit having three sub-modules A, B and C, corresponding to the
-contents of the object files a.cmo, b.cmo and c.cmo. These
-contents can be referenced as P.A, P.B and P.C in the remainder
-of the program.
-.TP
-.BI \-pp \ command
-Cause the compiler to call the given
-.I command
-as a preprocessor for each source file. The output of
-.I command
-is redirected to
-an intermediate file, which is compiled. If there are no compilation
-errors, the intermediate file is deleted afterwards. The name of this
-file is built from the basename of the source file with the
-extension .ppi for an interface (.mli) file and .ppo for an
-implementation (.ml) file.
-.TP
-.BI \-ppx \ command
-After parsing, pipe the abstract syntax tree through the preprocessor
-.IR command .
-The module
-.BR Ast_mapper (3)
-implements the external interface of a preprocessor.
-.TP
-.B \-principal
-Check information path during type-checking, to make sure that all
-types are derived in a principal way. When using labelled arguments
-and/or polymorphic methods, this flag is required to ensure future
-versions of the compiler will be able to infer types correctly, even
-if internal algorithms change.
-All programs accepted in
-.B \-principal
-mode are also accepted in the
-default mode with equivalent types, but different binary signatures,
-and this may slow down type checking; yet it is a good idea to
-use it once before publishing source code.
-.TP
-.B \-rectypes
-Allow arbitrary recursive types during type-checking. By default,
-only recursive types where the recursion goes through an object type
-are supported. Note that once you have created an interface using this
-flag, you must use it again for all dependencies.
-.TP
-.BI \-runtime\-variant \ suffix
-Add
-.I suffix
-to the name of the runtime library that will be used by the program.
-If OCaml was configured with option
-.BR \-with\-debug\-runtime ,
-then the
-.B d
-suffix is supported and gives a debug version of the runtime.
-.TP
-.BI \-stop\-after \ pass
-Stop compilation after the given compilation pass. The currently
-supported passes are:
-.BR parsing ,
-.BR typing .
-.TP
-.B \-safe\-string
-Enforce the separation between types
-.BR string \ and\ bytes ,
-thereby making strings read-only. This is the default.
-.TP
-.B \-short\-paths
-When a type is visible under several module-paths, use the shortest
-one when printing the type's name in inferred interfaces and error and
-warning messages.
-.TP
-.B \-strict\-sequence
-Force the left-hand part of each sequence to have type unit.
-.TP
-.B \-unboxed\-types
-When a type is unboxable (i.e. a record with a single argument or a
-concrete datatype with a single constructor of one argument) it will
-be unboxed unless annotated with
-.BR [@@ocaml.boxed] .
-.TP
-.B \-no-unboxed\-types
-When a type is unboxable it will be boxed unless annotated with
-.BR [@@ocaml.unboxed] .
-This is the default.
-.TP
-.B \-unsafe
-Turn bound checking off for array and string accesses (the
-.BR v.(i) and s.[i]
-constructs). Programs compiled with
-.B \-unsafe
-are therefore
-slightly faster, but unsafe: anything can happen if the program
-accesses an array or string outside of its bounds.
-.TP
-.B \-unsafe\-string
-Identify the types
-.BR string \ and\ bytes ,
-thereby making strings writable.
-This is intended for compatibility with old source code and should not
-be used with new software.
-.TP
-.BI \-use\-runtime \ runtime\-name
-Generate a bytecode executable file that can be executed on the custom
-runtime system
-.IR runtime\-name ,
-built earlier with
-.B ocamlc\ \-make\-runtime
-.IR runtime\-name .
-.TP
-.B \-v
-Print the version number of the compiler and the location of the
-standard library directory, then exit.
-.TP
-.B \-verbose
-Print all external commands before they are executed, in particular
-invocations of the C compiler and linker in
-.B \-custom
-mode. Useful to debug C library problems.
-.TP
-.BR \-vnum \ or\ \-version
-Print the version number of the compiler in short form (e.g. "3.11.0"),
-then exit.
-.TP
-.BI \-w \ warning\-list
-Enable, disable, or mark as fatal the warnings specified by the argument
-.IR warning\-list .
-
-Each warning can be
-.IR enabled \ or\ disabled ,
-and each warning can be
-.IR fatal \ or
-.IR non-fatal .
-If a warning is disabled, it isn't displayed and doesn't affect
-compilation in any way (even if it is fatal). If a warning is enabled,
-it is displayed normally by the compiler whenever the source code
-triggers it. If it is enabled and fatal, the compiler will also stop
-with an error after displaying it.
-
-The
-.I warning\-list
-argument is a sequence of warning specifiers, with no separators
-between them. A warning specifier is one of the following:
-
-.BI + num
-\ \ Enable warning number
-.IR num .
-
-.BI \- num
-\ \ Disable warning number
-.IR num .
-
-.BI @ num
-\ \ Enable and mark as fatal warning number
-.IR num .
-
-.BI + num1 .. num2
-\ \ Enable all warnings between
-.I num1
-and
-.I num2
-(inclusive).
-
-.BI \- num1 .. num2
-\ \ Disable all warnings between
-.I num1
-and
-.I num2
-(inclusive).
-
-.BI @ num1 .. num2
-\ \ Enable and mark as fatal all warnings between
-.I num1
-and
-.I num2
-(inclusive).
-
-.BI + letter
-\ \ Enable the set of warnings corresponding to
-.IR letter .
-The letter may be uppercase or lowercase.
-
-.BI \- letter
-\ \ Disable the set of warnings corresponding to
-.IR letter .
-The letter may be uppercase or lowercase.
-
-.BI @ letter
-\ \ Enable and mark as fatal the set of warnings corresponding to
-.IR letter .
-The letter may be uppercase or lowercase.
-
-.I uppercase\-letter
-\ \ Enable the set of warnings corresponding to
-.IR uppercase\-letter .
-
-.I lowercase\-letter
-\ \ Disable the set of warnings corresponding to
-.IR lowercase\-letter .
-
-The warning numbers are as follows.
-
-1
-\ \ \ Suspicious-looking start-of-comment mark.
-
-2
-\ \ \ Suspicious-looking end-of-comment mark.
-
-3
-\ \ \ Deprecated feature.
-
-4
-\ \ \ Fragile pattern matching: matching that will remain
-complete even if additional constructors are added to one of the
-variant types matched.
-
-5
-\ \ \ Partially applied function: expression whose result has
-function type and is ignored.
-
-6
-\ \ \ Label omitted in function application.
-
-7
-\ \ \ Method overridden without using the "method!" keyword.
-
-8
-\ \ \ Partial match: missing cases in pattern-matching.
-
-9
-\ \ \ Missing fields in a record pattern.
-
-10
-\ \ Expression on the left-hand side of a sequence that doesn't
-have type
-.B unit
-(and that is not a function, see warning number 5).
-
-11
-\ \ Redundant case in a pattern matching (unused match case).
-
-12
-\ \ Redundant sub-pattern in a pattern-matching.
-
-13
-\ \ Override of an instance variable.
-
-14
-\ \ Illegal backslash escape in a string constant.
-
-15
-\ \ Private method made public implicitly.
-
-16
-\ \ Unerasable optional argument.
-
-17
-\ \ Undeclared virtual method.
-
-18
-\ \ Non-principal type.
-
-19
-\ \ Type without principality.
-
-20
-\ \ Unused function argument.
-
-21
-\ \ Non-returning statement.
-
-22
-\ \ Preprocessor warning.
-
-23
-\ \ Useless record
-.B with
-clause.
-
-24
-\ \ Bad module name: the source file name is not a valid OCaml module name.
-
-25
-\ \ Deprecated: now part of warning 8.
-
-26
-\ \ Suspicious unused variable: unused variable that is bound with
-.BR let \ or \ as ,
-and doesn't start with an underscore (_) character.
-
-27
-\ \ Innocuous unused variable: unused variable that is not bound with
-.BR let \ nor \ as ,
-and doesn't start with an underscore (_) character.
-
-28
-\ \ A pattern contains a constant constructor applied to the underscore (_)
-pattern.
-
-29
-\ \ A non-escaped end-of-line was found in a string constant. This may
-cause portability problems between Unix and Windows.
-
-30
-\ \ Two labels or constructors of the same name are defined in two
-mutually recursive types.
-
-31
-\ \ A module is linked twice in the same executable.
-
-32
-\ \ Unused value declaration.
-
-33
-\ \ Unused open statement.
-
-34
-\ \ Unused type declaration.
-
-35
-\ \ Unused for-loop index.
-
-36
-\ \ Unused ancestor variable.
-
-37
-\ \ Unused constructor.
-
-38
-\ \ Unused extension constructor.
-
-39
-\ \ Unused rec flag.
-
-40
-\ \ Constructor or label name used out of scope.
-
-41
-\ \ Ambiguous constructor or label name.
-
-42
-\ \ Disambiguated constructor or label name.
-
-43
-\ \ Nonoptional label applied as optional.
-
-44
-\ \ Open statement shadows an already defined identifier.
-
-45
-\ \ Open statement shadows an already defined label or constructor.
-
-46
-\ \ Error in environment variable.
-
-47
-\ \ Illegal attribute payload.
-
-48
-\ \ Implicit elimination of optional arguments.
-
-49
-\ \ Missing cmi file when looking up module alias.
-
-50
-\ \ Unexpected documentation comment.
-
-59
-\ \ Assignment on non-mutable value.
-
-60
-\ \ Unused module declaration.
-
-61
-\ \ Unannotated unboxable type in primitive declaration.
-
-62
-\ \ Type constraint on GADT type declaration.
-
-63
-\ \ Erroneous printed signature.
-
-64
-\ \ -unsafe used with a preprocessor returning a syntax tree.
-
-65
-\ \ Type declaration defining a new '()' constructor.
-
-66
-\ \ Unused open! statement.
-
-67
-\ \ Unused functor parameter.
-
-68
-\ \ Pattern-matching depending on mutable state prevents the remaining
-arguments from being uncurried.
-
-The letters stand for the following sets of warnings. Any letter not
-mentioned here corresponds to the empty set.
-
-.B A
-\ all warnings
-
-.B C
-\ 1, 2
-
-.B D
-\ 3
-
-.B E
-\ 4
-
-.B F
-\ 5
-
-.B K
-\ 32, 33, 34, 35, 36, 37, 38, 39
-
-.B L
-\ 6
-
-.B M
-\ 7
-
-.B P
-\ 8
-
-.B R
-\ 9
-
-.B S
-\ 10
-
-.B U
-\ 11, 12
-
-.B V
-\ 13
-
-.B X
-\ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 30
-
-.B Y
-\ 26
-
-.B Z
-\ 27
-
-.IP
-The default setting is
-.BR \-w\ +a\-4\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66..70 .
-Note that warnings
-.BR 5 \ and \ 10
-are not always triggered, depending on the internals of the type checker.
-.TP
-.BI \-warn\-error \ warning\-list
-Mark as errors the warnings specified in the argument
-.IR warning\-list .
-The compiler will stop with an error when one of these
-warnings is emitted. The
-.I warning\-list
-has the same meaning as for
-the
-.B \-w
-option: a
-.B +
-sign (or an uppercase letter) marks the corresponding warnings as fatal, a
-.B \-
-sign (or a lowercase letter) turns them back into non-fatal warnings, and a
-.B @
-sign both enables and marks as fatal the corresponding warnings.
-
-Note: it is not recommended to use the
-.B \-warn\-error
-option in production code, because it will almost certainly prevent
-compiling your program with later versions of OCaml when they add new
-warnings or modify existing warnings.
-
-The default setting is
-.B \-warn\-error \-a+31
-(only warning 31 is fatal).
-.TP
-.B \-warn\-help
-Show the description of all available warning numbers.
-.TP
-.B \-where
-Print the location of the standard library, then exit.
-.TP
-.B \-with-runtime
-Include the runtime system in the generated program. This is the default.
-.TP
-.B \-without-runtime
-The compiler does not include the runtime system (nor a reference to it) in the
-generated program; it must be supplied separately.
-.TP
-.BI \- \ file
-Process
-.I file
-as a file name, even if it starts with a dash (-) character.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH SEE ALSO
-.BR ocamlopt (1), \ ocamlrun (1), \ ocaml (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Batch compilation".
--- /dev/null
+.so man1/ocamlc.1
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH "OCAMLCP" 1
+
+.SH NAME
+ocamlcp, ocamloptp \- The OCaml profiling compilers
+
+.SH SYNOPSIS
+.B ocamlcp
+[
+.I ocamlc options
+]
+[
+.BI \-P \ flags
+]
+.I filename ...
+
+.B ocamloptp
+[
+.I ocamlopt options
+]
+[
+.BI \-P \ flags
+]
+.I filename ...
+
+.SH DESCRIPTION
+The
+.B ocamlcp
+and
+.B ocamloptp
+commands are front-ends to
+.BR ocamlc (1)
+and
+.BR ocamlopt (1)
+that instrument the source code, adding code to record how many times
+functions are called, branches of conditionals are taken, etc.
+Execution of instrumented code produces an execution profile in the
+file ocamlprof.dump, which can be read using
+.BR ocamlprof (1).
+
+.B ocamlcp
+accepts the same arguments and options as
+.BR ocamlc (1)
+and
+.B ocamloptp
+accepts the same arguments and options as
+.BR ocamlopt (1).
+There is only one exception: in both cases, the
+.B \-pp
+option is not supported. If you need to preprocess your source files,
+you will have to do it separately before calling
+.B ocamlcp
+or
+.BR ocamloptp .
+
+.SH OPTIONS
+
+In addition to the
+.BR ocamlc (1)
+or
+.BR ocamlopt (1)
+options,
+.B ocamlcp
+and
+.B ocamloptp
+accept one option to control the kind of profiling information, the
+.BI \-P \ letters
+option. The
+.I letters
+indicate which parts of the program should be profiled:
+.TP
+.B a
+all options
+.TP
+.B f
+function calls : a count point is set at the beginning of each function body
+.TP
+.B i
+.BR if \ ... \ then \ ... \ else :
+count points are set in both
+.BR then \ and \ else
+branches
+.TP
+.B l
+.BR while , \ for
+loops: a count point is set at the beginning of the loop body
+.TP
+.B m
+.B match
+branches: a count point is set at the beginning of the
+body of each branch of a pattern-matching
+.TP
+.B t
+.BR try \ ... \ with
+branches: a count point is set at the beginning of the body of each
+branch of an exception catcher
+
+.PP
+For instance, compiling with
+.B ocamlcp \-P film
+profiles function calls,
+.BR if \ ... \ then \ ... \ else \ ...,
+loops, and pattern matching.
+
+Calling
+.BR ocamlcp (1)
+or
+.BR ocamloptp (1)
+without the
+.B \-P
+option defaults to
+.BR \-P\ fm ,
+meaning that only function calls and pattern matching are profiled.
+
+Note: for compatibility with previous versions,
+.BR ocamlcp (1)
+also accepts the option
+.B \-p
+with the same argument and meaning as
+.BR \-P .
+
+.SH SEE ALSO
+.BR ocamlc (1),
+.BR ocamlopt (1),
+.BR ocamlprof (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Profiling".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH "OCAMLCP" 1
-
-.SH NAME
-ocamlcp, ocamloptp \- The OCaml profiling compilers
-
-.SH SYNOPSIS
-.B ocamlcp
-[
-.I ocamlc options
-]
-[
-.BI \-P \ flags
-]
-.I filename ...
-
-.B ocamloptp
-[
-.I ocamlopt options
-]
-[
-.BI \-P \ flags
-]
-.I filename ...
-
-.SH DESCRIPTION
-The
-.B ocamlcp
-and
-.B ocamloptp
-commands are front-ends to
-.BR ocamlc (1)
-and
-.BR ocamlopt (1)
-that instrument the source code, adding code to record how many times
-functions are called, branches of conditionals are taken, etc.
-Execution of instrumented code produces an execution profile in the
-file ocamlprof.dump, which can be read using
-.BR ocamlprof (1).
-
-.B ocamlcp
-accepts the same arguments and options as
-.BR ocamlc (1)
-and
-.B ocamloptp
-accepts the same arguments and options as
-.BR ocamlopt (1).
-There is only one exception: in both cases, the
-.B \-pp
-option is not supported. If you need to preprocess your source files,
-you will have to do it separately before calling
-.B ocamlcp
-or
-.BR ocamloptp .
-
-.SH OPTIONS
-
-In addition to the
-.BR ocamlc (1)
-or
-.BR ocamlopt (1)
-options,
-.B ocamlcp
-and
-.B ocamloptp
-accept one option to control the kind of profiling information, the
-.BI \-P \ letters
-option. The
-.I letters
-indicate which parts of the program should be profiled:
-.TP
-.B a
-all options
-.TP
-.B f
-function calls : a count point is set at the beginning of each function body
-.TP
-.B i
-.BR if \ ... \ then \ ... \ else :
-count points are set in both
-.BR then \ and \ else
-branches
-.TP
-.B l
-.BR while , \ for
-loops: a count point is set at the beginning of the loop body
-.TP
-.B m
-.B match
-branches: a count point is set at the beginning of the
-body of each branch of a pattern-matching
-.TP
-.B t
-.BR try \ ... \ with
-branches: a count point is set at the beginning of the body of each
-branch of an exception catcher
-
-.PP
-For instance, compiling with
-.B ocamlcp \-P film
-profiles function calls,
-.BR if \ ... \ then \ ... \ else \ ...,
-loops, and pattern matching.
-
-Calling
-.BR ocamlcp (1)
-or
-.BR ocamloptp (1)
-without the
-.B \-P
-option defaults to
-.BR \-P\ fm ,
-meaning that only function calls and pattern matching are profiled.
-
-Note: for compatibility with previous versions,
-.BR ocamlcp (1)
-also accepts the option
-.B \-p
-with the same argument and meaning as
-.BR \-P .
-
-.SH SEE ALSO
-.BR ocamlc (1),
-.BR ocamlopt (1),
-.BR ocamlprof (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Profiling".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* OCaml *
+.\"* *
+.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
+.\"* *
+.\"* Copyright 2001 Institut National de Recherche en Informatique et *
+.\"* en Automatique. *
+.\"* *
+.\"* All rights reserved. This file is distributed under the terms of *
+.\"* the GNU Lesser General Public License version 2.1, with the *
+.\"* special exception on linking described in the file LICENSE. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLDEBUG 1
+
+.SH NAME
+ocamldebug \- the OCaml source-level replay debugger.
+.SH SYNOPSIS
+.B ocamldebug
+.RI [\ options \ ]\ program \ [\ arguments \ ]
+.SH DESCRIPTION
+.B ocamldebug
+is the OCaml source-level replay debugger.
+
+Before the debugger can be used, the program must be compiled and
+linked with the
+.B \-g
+option: all .cmo and .cma files that are part
+of the program should have been created with
+.BR ocamlc\ \-g ,
+and they must be linked together with
+.BR ocamlc\ \-g .
+
+Compiling with
+.B \-g
+entails no penalty on the running time of
+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
+.BR \-g .
+
+.SH OPTIONS
+A summary of options are included below.
+For a complete description, see the html documentation in the ocaml-doc
+package.
+.TP
+.BI \-c \ count
+Set the maximum number of simultaneously live checkpoints to
+.IR count .
+.TP
+.BI \-cd \ dir
+Run the debugger program from the working directory
+.IR dir ,
+instead of the current working directory. (See also the
+.B cd
+command.)
+.TP
+.B \-emacs
+Tell the debugger it is executed under Emacs. (See
+.I "The OCaml user's manual"
+for information on how to run the debugger under Emacs.)
+Implies
+.BR \-machine-readable .
+.TP
+.BI \-I \ directory
+Add
+.I directory
+to the list of directories searched for source files and
+compiled files. (See also the
+.B directory
+command.)
+.TP
+.BI -machine-readable
+Print information in a format more suitable for machines instead of human
+operators where applicable. For example, when describing a location in a
+program, such as when printing a backtrace, print the program counter and
+character offset in a file instead of the filename, line number, and character
+offset in that line.
+.TP
+.BI \-s \ socket
+Use
+.I socket
+for communicating with the debugged program. See the description
+of the command
+.B set\ socket
+in
+.I "The OCaml user's manual"
+for the format of
+.IR socket .
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH INITIALIZATION FILE
+
+When
+.BR ocamldebug (1)
+is invoked, it will read commands from an initialization file before
+giving control to the user. The default file is
+.B .ocamldebug
+in the current directory if it exists, otherwise
+.B .ocamldebug
+in the user's home directory.
+
+Note that you can also use the
+.B source file
+command to read commands from a file.
+
+.SH SEE ALSO
+.BR ocamlc (1)
+.br
+.IR "The OCaml user's manual" ,
+chapter "The debugger".
+.SH AUTHOR
+This manual page was written by Sven LUTHER <luther@debian.org>,
+for the Debian GNU/Linux system (but may be used by others).
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* OCaml *
-.\"* *
-.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
-.\"* *
-.\"* Copyright 2001 Institut National de Recherche en Informatique et *
-.\"* en Automatique. *
-.\"* *
-.\"* All rights reserved. This file is distributed under the terms of *
-.\"* the GNU Lesser General Public License version 2.1, with the *
-.\"* special exception on linking described in the file LICENSE. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLDEBUG 1
-
-.SH NAME
-ocamldebug \- the OCaml source-level replay debugger.
-.SH SYNOPSIS
-.B ocamldebug
-.RI [\ options \ ]\ program \ [\ arguments \ ]
-.SH DESCRIPTION
-.B ocamldebug
-is the OCaml source-level replay debugger.
-
-Before the debugger can be used, the program must be compiled and
-linked with the
-.B \-g
-option: all .cmo and .cma files that are part
-of the program should have been created with
-.BR ocamlc\ \-g ,
-and they must be linked together with
-.BR ocamlc\ \-g .
-
-Compiling with
-.B \-g
-entails no penalty on the running time of
-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
-.BR \-g .
-
-.SH OPTIONS
-A summary of options are included below.
-For a complete description, see the html documentation in the ocaml-doc
-package.
-.TP
-.BI \-c \ count
-Set the maximum number of simultaneously live checkpoints to
-.IR count .
-.TP
-.BI \-cd \ dir
-Run the debugger program from the working directory
-.IR dir ,
-instead of the current working directory. (See also the
-.B cd
-command.)
-.TP
-.B \-emacs
-Tell the debugger it is executed under Emacs. (See
-.I "The OCaml user's manual"
-for information on how to run the debugger under Emacs.)
-Implies
-.BR \-machine-readable .
-.TP
-.BI \-I \ directory
-Add
-.I directory
-to the list of directories searched for source files and
-compiled files. (See also the
-.B directory
-command.)
-.TP
-.BI -machine-readable
-Print information in a format more suitable for machines instead of human
-operators where applicable. For example, when describing a location in a
-program, such as when printing a backtrace, print the program counter and
-character offset in a file instead of the filename, line number, and character
-offset in that line.
-.TP
-.BI \-s \ socket
-Use
-.I socket
-for communicating with the debugged program. See the description
-of the command
-.B set\ socket
-in
-.I "The OCaml user's manual"
-for the format of
-.IR socket .
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH INITIALIZATION FILE
-
-When
-.BR ocamldebug (1)
-is invoked, it will read commands from an initialization file before
-giving control to the user. The default file is
-.B .ocamldebug
-in the current directory if it exists, otherwise
-.B .ocamldebug
-in the user's home directory.
-
-Note that you can also use the
-.B source file
-command to read commands from a file.
-
-.SH SEE ALSO
-.BR ocamlc (1)
-.br
-.IR "The OCaml user's manual" ,
-chapter "The debugger".
-.SH AUTHOR
-This manual page was written by Sven LUTHER <luther@debian.org>,
-for the Debian GNU/Linux system (but may be used by others).
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLDEP 1
+
+.SH NAME
+ocamldep \- Dependency generator for OCaml
+
+.SH SYNOPSIS
+.B ocamldep
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The
+.BR ocamldep (1)
+command scans a set of OCaml source files
+(.ml and .mli files) for references to external compilation units,
+and outputs dependency lines in a format suitable for the
+.BR make (1)
+utility. This ensures that make will compile the source files in the
+correct order, and recompile those files that need to when a source
+file is modified.
+
+The typical usage is:
+.P
+ocamldep
+.I options
+*.mli *.ml > .depend
+.P
+where .depend is the file that should contain the
+dependencies.
+
+Dependencies are generated both for compiling with the bytecode
+compiler
+.BR ocamlc (1)
+and with the native-code compiler
+.BR ocamlopt (1).
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamldep (1).
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-all
+Generate dependencies on all required files, rather than assuming
+implicit dependencies.
+.TP
+.B \-allow\-approx
+Allow falling back on a lexer-based approximation when parsing fails.
+.TP
+.B \-as\-map
+For the following files, do not include delayed dependencies for
+module aliases.
+This option assumes that they are compiled using options
+"\-no\-alias\-deps \-w \-49", and that those files or their interface are
+passed with the "\-map" option when computing dependencies for other
+files. Note also that for dependencies to be correct in the
+implementation of a map file, its interface should not coerce any of
+the aliases it contains.
+.TP
+.B \-debug\-map
+Dump the delayed dependency map for each map file.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+source files. If a source file foo.ml mentions an external
+compilation unit Bar, a dependency on that unit's interface
+bar.cmi is generated only if the source for bar is found in the
+current directory or in one of the directories specified with
+.BR \-I .
+Otherwise, Bar is assumed to be a module from the standard library,
+and no dependencies are generated. For programs that span multiple
+directories, it is recommended to pass
+.BR ocamldep (1)
+the same
+.B \-I
+options that are passed to the compiler.
+.TP
+.B \-nocwd
+Do not add current working directory to the list of include directories.
+.TP
+.BI \-impl \ file
+Process
+.IR file
+as a .ml file.
+.TP
+.BI \-intf \ file
+Process
+.IR file
+as a .mli file.
+.TP
+.BI \-map \ file
+Read an propagate the delayed dependencies for module aliases in
+.IR file ,
+so that the following files will depend on the
+exported aliased modules if they use them.
+.TP
+.BI \-ml\-synonym \ .ext
+Consider the given extension (with leading dot) to be a synonym for .ml.
+.TP
+.BI \-mli\-synonym \ .ext
+Consider the given extension (with leading dot) to be a synonym for .mli.
+.TP
+.B \-modules
+Output raw dependencies of the form
+.IR filename : \ Module1\ Module2 \ ... \ ModuleN
+where
+.IR Module1 ,\ ..., \ ModuleN
+are the names of the compilation
+units referenced within the file
+.IR filename ,
+but these names are not
+resolved to source file names. Such raw dependencies cannot be used
+by
+.BR make (1),
+but can be post-processed by other tools such as
+.BR Omake (1).
+.TP
+.BI \-native
+Generate dependencies for a pure native-code program (no bytecode
+version). When an implementation file (.ml file) has no explicit
+interface file (.mli file),
+.BR ocamldep (1)
+generates dependencies on the
+bytecode compiled file (.cmo file) to reflect interface changes.
+This can cause unnecessary bytecode recompilations for programs that
+are compiled to native-code only. The flag
+.B \-native
+causes dependencies on native compiled files (.cmx) to be generated instead
+of on .cmo files. (This flag makes no difference if all source files
+have explicit .mli interface files.)
+.TP
+.B \-one-line
+Output one line per file, regardless of the length.
+.TP
+.BI \-open \ module
+Assume that module
+.IR module
+is opened before parsing each of the
+following files.
+.TP
+.BI \-pp \ command
+Cause
+.BR ocamldep (1)
+to call the given
+.I command
+as a preprocessor for each source file.
+.TP
+.BI \-ppx \ command
+Pipe abstract syntax tree through preprocessor
+.IR command .
+.TP
+.B \-shared
+Generate dependencies for native plugin files (.cmxs) in addition to
+native compiled files (.cmx).
+.TP
+.B \-slash
+Under Unix, this option does nothing.
+.TP
+.B \-sort
+Sort files according to their dependencies.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlc (1),
+.BR ocamlopt (1).
+.br
+.IR The\ OCaml\ user's\ manual ,
+chapter "Dependency generator".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLDEP 1
-
-.SH NAME
-ocamldep \- Dependency generator for OCaml
-
-.SH SYNOPSIS
-.B ocamldep
-[
-.I options
-]
-.I filename ...
-
-.SH DESCRIPTION
-
-The
-.BR ocamldep (1)
-command scans a set of OCaml source files
-(.ml and .mli files) for references to external compilation units,
-and outputs dependency lines in a format suitable for the
-.BR make (1)
-utility. This ensures that make will compile the source files in the
-correct order, and recompile those files that need to when a source
-file is modified.
-
-The typical usage is:
-.P
-ocamldep
-.I options
-*.mli *.ml > .depend
-.P
-where .depend is the file that should contain the
-dependencies.
-
-Dependencies are generated both for compiling with the bytecode
-compiler
-.BR ocamlc (1)
-and with the native-code compiler
-.BR ocamlopt (1).
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocamldep (1).
-.TP
-.B \-absname
-Show absolute filenames in error messages.
-.TP
-.B \-all
-Generate dependencies on all required files, rather than assuming
-implicit dependencies.
-.TP
-.B \-allow\-approx
-Allow falling back on a lexer-based approximation when parsing fails.
-.TP
-.B \-as\-map
-For the following files, do not include delayed dependencies for
-module aliases.
-This option assumes that they are compiled using options
-"\-no\-alias\-deps \-w \-49", and that those files or their interface are
-passed with the "\-map" option when computing dependencies for other
-files. Note also that for dependencies to be correct in the
-implementation of a map file, its interface should not coerce any of
-the aliases it contains.
-.TP
-.B \-debug\-map
-Dump the delayed dependency map for each map file.
-.TP
-.BI \-I \ directory
-Add the given directory to the list of directories searched for
-source files. If a source file foo.ml mentions an external
-compilation unit Bar, a dependency on that unit's interface
-bar.cmi is generated only if the source for bar is found in the
-current directory or in one of the directories specified with
-.BR \-I .
-Otherwise, Bar is assumed to be a module from the standard library,
-and no dependencies are generated. For programs that span multiple
-directories, it is recommended to pass
-.BR ocamldep (1)
-the same
-.B \-I
-options that are passed to the compiler.
-.TP
-.B \-nocwd
-Do not add current working directory to the list of include directories.
-.TP
-.BI \-impl \ file
-Process
-.IR file
-as a .ml file.
-.TP
-.BI \-intf \ file
-Process
-.IR file
-as a .mli file.
-.TP
-.BI \-map \ file
-Read an propagate the delayed dependencies for module aliases in
-.IR file ,
-so that the following files will depend on the
-exported aliased modules if they use them.
-.TP
-.BI \-ml\-synonym \ .ext
-Consider the given extension (with leading dot) to be a synonym for .ml.
-.TP
-.BI \-mli\-synonym \ .ext
-Consider the given extension (with leading dot) to be a synonym for .mli.
-.TP
-.B \-modules
-Output raw dependencies of the form
-.IR filename : \ Module1\ Module2 \ ... \ ModuleN
-where
-.IR Module1 ,\ ..., \ ModuleN
-are the names of the compilation
-units referenced within the file
-.IR filename ,
-but these names are not
-resolved to source file names. Such raw dependencies cannot be used
-by
-.BR make (1),
-but can be post-processed by other tools such as
-.BR Omake (1).
-.TP
-.BI \-native
-Generate dependencies for a pure native-code program (no bytecode
-version). When an implementation file (.ml file) has no explicit
-interface file (.mli file),
-.BR ocamldep (1)
-generates dependencies on the
-bytecode compiled file (.cmo file) to reflect interface changes.
-This can cause unnecessary bytecode recompilations for programs that
-are compiled to native-code only. The flag
-.B \-native
-causes dependencies on native compiled files (.cmx) to be generated instead
-of on .cmo files. (This flag makes no difference if all source files
-have explicit .mli interface files.)
-.TP
-.B \-one-line
-Output one line per file, regardless of the length.
-.TP
-.BI \-open \ module
-Assume that module
-.IR module
-is opened before parsing each of the
-following files.
-.TP
-.BI \-pp \ command
-Cause
-.BR ocamldep (1)
-to call the given
-.I command
-as a preprocessor for each source file.
-.TP
-.BI \-ppx \ command
-Pipe abstract syntax tree through preprocessor
-.IR command .
-.TP
-.B \-shared
-Generate dependencies for native plugin files (.cmxs) in addition to
-native compiled files (.cmx).
-.TP
-.B \-slash
-Under Unix, this option does nothing.
-.TP
-.B \-sort
-Sort files according to their dependencies.
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH SEE ALSO
-.BR ocamlc (1),
-.BR ocamlopt (1).
-.br
-.IR The\ OCaml\ user's\ manual ,
-chapter "Dependency generator".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* OCaml *
+.\"* *
+.\"* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *
+.\"* *
+.\"* Copyright 2004 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLDOC 1
+
+\" .de Sh \" Subsection heading
+\" .br
+\" .if t .Sp
+\" .ne 5
+\" .PP
+\" \fB\\$1\fR
+\" .PP
+\" ..
+
+.SH NAME
+ocamldoc \- The OCaml documentation generator
+
+
+.SH SYNOPSIS
+.B ocamldoc
+[
+.I options
+]
+.IR filename \ ...
+
+.SH DESCRIPTION
+
+The OCaml documentation generator
+.BR ocamldoc (1)
+generates documentation from special comments embedded in source files. The
+comments used by
+.B ocamldoc
+are of the form
+.I (** ... *)
+and follow the format described in the
+.IR "The OCaml user's manual" .
+
+.B ocamldoc
+can produce documentation in various formats: HTML, LaTeX, TeXinfo,
+Unix man pages, and
+.BR dot (1)
+dependency graphs. Moreover, users can add their own
+custom generators.
+
+In this manpage, we use the word
+.I element
+to refer to any of the following parts of an OCaml source file: a type
+declaration, a value, 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.
+
+.SH OPTIONS
+
+The following command-line options determine the format for the generated
+documentation generated by
+.BR ocamldoc (1).
+.SS "Options for choosing the output format"
+.TP
+.B \-html
+Generate documentation in HTML default format. The generated HTML pages are
+stored in the current directory, or in the directory specified with the
+.B \-d
+option. You can customize the style of the generated pages by editing the
+generated
+.I style.css
+file, or by providing your own style sheet using option
+.BR \-css\-style .
+The file
+.I style.css
+is not generated if it already exists.
+.TP
+.B \-latex
+Generate documentation in LaTeX default format. The generated LaTeX document
+is saved in file
+.IR ocamldoc.out ,
+or in the file specified with the
+.B -o
+option. The document uses the style file
+.IR ocamldoc.sty .
+This file is generated when using the
+.B \-latex
+option, if it does not already exist. You can change this file to customize
+the style of your LaTeX documentation.
+.TP
+.B \-texi
+Generate documentation in TeXinfo default format. The generated LaTeX document
+is saved in file
+.IR ocamldoc.out ,
+or in the file specified with the
+.B -o
+option.
+.TP
+.B \-man
+Generate documentation as a set of Unix man pages. The generated pages are
+stored in the current directory, or in the directory specified with the
+.B \-d
+option.
+.TP
+.B \-dot
+Generate a dependency graph for the toplevel modules, in a format suitable for
+displaying and processing by
+.IR dot (1).
+The
+.IR dot (1)
+tool is available from
+.IR https://graphviz.org/ .
+The textual representation of the graph is written to the file
+.IR ocamldoc.out ,
+or to the file specified with the
+.B -o
+option. Use
+.BI dot \ ocamldoc.out
+to display it.
+.TP
+.BI \-g \ file
+Dynamically load the given file (which extension usually is .cmo or .cma),
+which defines a custom documentation generator.
+If the given file is a simple one and does not exist in
+the current directory, then
+.B ocamldoc
+looks for it in the custom
+generators default directory, and in the directories specified with the
+.B \-i
+option.
+.TP
+.BI \-customdir
+Display the custom generators default directory.
+.TP
+.BI \-i \ directory
+Add the given directory to the path where to look for custom generators.
+.SS "General options"
+.TP
+.BI \-d \ dir
+Generate files in directory
+.IR dir ,
+rather than the current directory.
+.TP
+.BI \-dump \ file
+Dump collected information into
+.IR file .
+This information can be read with the
+.B \-load
+option in a subsequent invocation of
+.BR ocamldoc (1).
+.TP
+.BI \-hide \ modules
+Hide the given complete module names in the generated documentation.
+.I modules
+is a list of complete module names are separated by commas (,),
+without blanks. For instance:
+.IR Stdlib,M2.M3 .
+.TP
+.B \-inv\-merge\-ml\-mli
+Reverse the precedence of implementations and interfaces when merging.
+All elements in implementation files are kept, and the
+.B \-m
+option indicates which parts of the comments in interface files are merged with
+the comments in implementation files.
+.TP
+.B \-keep\-code
+Always keep the source code for values, methods and instance variables, when
+available. The source code is always kept when a .ml
+file is given, but is by default discarded when a .mli
+is given. This option allows the source code to be always kept.
+.TP
+.BI \-load \ file
+Load information from
+.IR file ,
+which has been produced by
+.BR ocamldoc\ \-dump .
+Several
+.B -load
+options can be given.
+.TP
+.BI \-m \ flags
+Specify merge options between interfaces and implementations.
+.I flags
+can be one or several of the following characters:
+
+.B d
+merge description
+
+.B a
+merge @author
+
+.B v
+merge @version
+
+.B l
+merge @see
+
+.B s
+merge @since
+
+.B o
+merge @deprecated
+
+.B p
+merge @param
+
+.B e
+merge @raise
+
+.B r
+merge @return
+
+.B A
+merge everything
+.TP
+.B \-no\-custom\-tags
+Do not allow custom @-tags.
+.TP
+.B \-no\-stop
+Keep elements placed after the
+.B (**/**)
+special comment.
+.TP
+.BI \-o \ file
+Output the generated documentation to
+.I file
+instead of
+.IR ocamldoc.out .
+This option is meaningful only in conjunction with the
+.BR \-latex , \ \-texi ,\ or \ \-dot
+options.
+.TP
+.BI \-open \ module
+Opens
+.I module
+before typing.
+.TP
+.BI \-pp \ command
+Pipe sources through preprocessor
+.IR command .
+.TP
+.BI \-ppx \ command
+Pipe abstract syntax tree through preprocessor
+.IR command .
+.TP
+.BR \-show\-missed\-crossref
+Show missed cross-reference opportunities.
+.TP
+.B \-sort
+Sort the list of top-level modules before generating the documentation.
+.TP
+.B \-stars
+Remove blank characters until the first asterisk ('*') in each line of comments.
+.TP
+.BI \-t \ title
+Use
+.I title
+as the title for the generated documentation.
+.TP
+.BI \-text \ file
+Consider \fIfile\fR as a .txt file.
+.TP
+.BI \-intro \ file
+Use content of
+.I file
+as
+.B ocamldoc
+text to use as introduction (HTML, LaTeX and TeXinfo only).
+For HTML, the file is used to create the whole "index.html" file.
+.TP
+.B \-v
+Verbose mode. Display progress information.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-warn\-error
+Treat
+.B ocamldoc
+warnings as errors.
+.TP
+.B \-hide\-warnings
+Do not print
+.B ocamldoc
+warnings.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+.SS "Type-checking options"
+.BR ocamldoc (1)
+calls the OCaml type-checker to obtain type information. The
+following options impact the type-checking phase. They have the same meaning
+as for the
+.BR ocamlc (1)\ and \ ocamlopt (1)
+commands.
+.TP
+.BI \-I \ directory
+Add
+.I directory
+to the list of directories search for compiled interface files (.cmi files).
+.TP
+.B \-nolabels
+Ignore non-optional labels in types.
+.TP
+.B \-rectypes
+ Allow arbitrary recursive types. (See the
+.B \-rectypes
+option to
+.BR ocamlc (1).)
+.SS "Options for generating HTML pages"
+The following options apply in conjunction with the
+.B \-html
+option:
+.TP
+.B \-all\-params
+Display the complete list of parameters for functions and methods.
+.TP
+.BI \-charset \ s
+Add information about character encoding being \fIs\fR
+(default is \fBiso-8859-1\fR).
+.TP
+.BI \-css\-style \ filename
+Use
+.I filename
+as the Cascading Style Sheet file.
+.TP
+.B \-colorize\-code
+Colorize the OCaml code enclosed in [ ] and \\{[ ]\\}, using colors to emphasize
+keywords, etc. If the code fragments are not syntactically correct, no color
+is added.
+.TP
+.B \-index\-only
+Generate only index files.
+.TP
+.B \-short\-functors
+Use a short form to display functors:
+.B "module M : functor (A:Module) -> functor (B:Module2) -> sig .. end"
+is displayed as
+.BR "module M (A:Module) (B:Module2) : sig .. end" .
+.SS "Options for generating LaTeX files"
+The following options apply in conjunction with the
+.B \-latex
+option:
+.TP
+.B \-latex\-value\-prefix prefix
+Give a prefix to use for the labels of the values in the generated LaTeX
+document. The default prefix is the empty string. You can also use the options
+.BR -latex-type-prefix ,
+.BR -latex-exception-prefix ,
+.BR -latex-module-prefix ,
+.BR -latex-module-type-prefix ,
+.BR -latex-class-prefix ,
+.BR -latex-class-type-prefix ,
+.BR -latex-attribute-prefix ,\ and
+.BR -latex-method-prefix .
+
+These options are useful when you have, for example, a type and a value
+with the same name. If you do not specify prefixes, LaTeX will complain about
+multiply defined labels.
+.TP
+.BI \-latextitle \ n,style
+Associate style number
+.I n
+to the given LaTeX sectioning command
+.IR style ,
+e.g.
+.BR section or subsection .
+(LaTeX only.) This is useful when including the generated document in another
+LaTeX document, at a given sectioning level. The default association is 1 for
+section, 2 for subsection, 3 for subsubsection, 4 for paragraph and 5 for
+subparagraph.
+.TP
+.B \-noheader
+Suppress header in generated documentation.
+.TP
+.B \-notoc
+Do not generate a table of contents.
+.TP
+.B \-notrailer
+Suppress trailer in generated documentation.
+.TP
+.B \-sepfiles
+Generate one .tex file per toplevel module, instead of the global
+.I ocamldoc.out
+file.
+.SS "Options for generating TeXinfo files"
+The following options apply in conjunction with the
+.B -texi
+option:
+.TP
+.B \-esc8
+Escape accented characters in Info files.
+.TP
+.B
+\-info\-entry
+Specify Info directory entry.
+.TP
+.B \-info\-section
+Specify section of Info directory.
+.TP
+.B \-noheader
+Suppress header in generated documentation.
+.TP
+.B \-noindex
+Do not build index for Info files.
+.TP
+.B \-notrailer
+Suppress trailer in generated documentation.
+.SS "Options for generating dot graphs"
+The following options apply in conjunction with the
+.B \-dot
+option:
+.TP
+.BI \-dot\-colors \ colors
+Specify the colors to use in the generated dot code. When generating module
+dependencies,
+.BR ocamldoc (1)
+uses different colors for modules, depending on the directories in which they
+reside. When generating types dependencies,
+.BR ocamldoc (1)
+uses different colors for types, depending on the modules in which they are
+defined.
+.I colors
+is a list of color names separated by commas (,), as in
+.BR Red,Blue,Green .
+The available colors are the ones supported by the
+.BR dot (1)
+tool.
+.TP
+.B \-dot\-include\-all
+Include all modules in the
+.BR dot (1)
+output, not only modules given on the command line or loaded with the
+.B \-load
+option.
+.TP
+.B \-dot\-reduce
+Perform a transitive reduction of the dependency graph before outputting the
+dot code. This can be useful if there are a lot of transitive dependencies
+that clutter the graph.
+.TP
+.B \-dot\-types
+Output dot code describing the type dependency graph instead of the module
+dependency graph.
+.SS "Options for generating man files"
+The following options apply in conjunction with the
+.B \-man
+option:
+.TP
+.B \-man\-mini
+Generate man pages only for modules, module types, classes and class types,
+instead of pages for all elements.
+.TP
+.BI \-man\-suffix \ suffix
+Set the suffix used for generated man filenames. Default is o, as in
+.IR List.o .
+.TP
+.BI \-man\-section \ section
+Set the section number used for generated man filenames. Default is 3.
+
+
+.SH SEE ALSO
+.BR ocaml (1),
+.BR ocamlc (1),
+.BR ocamlopt (1).
+.br
+.IR "The OCaml user's manual",
+chapter "The documentation generator".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* OCaml *
-.\"* *
-.\"* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *
-.\"* *
-.\"* Copyright 2004 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLDOC 1
-
-\" .de Sh \" Subsection heading
-\" .br
-\" .if t .Sp
-\" .ne 5
-\" .PP
-\" \fB\\$1\fR
-\" .PP
-\" ..
-
-.SH NAME
-ocamldoc \- The OCaml documentation generator
-
-
-.SH SYNOPSIS
-.B ocamldoc
-[
-.I options
-]
-.IR filename \ ...
-
-.SH DESCRIPTION
-
-The OCaml documentation generator
-.BR ocamldoc (1)
-generates documentation from special comments embedded in source files. The
-comments used by
-.B ocamldoc
-are of the form
-.I (** ... *)
-and follow the format described in the
-.IR "The OCaml user's manual" .
-
-.B ocamldoc
-can produce documentation in various formats: HTML, LaTeX, TeXinfo,
-Unix man pages, and
-.BR dot (1)
-dependency graphs. Moreover, users can add their own
-custom generators.
-
-In this manpage, we use the word
-.I element
-to refer to any of the following parts of an OCaml source file: a type
-declaration, a value, 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.
-
-.SH OPTIONS
-
-The following command-line options determine the format for the generated
-documentation generated by
-.BR ocamldoc (1).
-.SS "Options for choosing the output format"
-.TP
-.B \-html
-Generate documentation in HTML default format. The generated HTML pages are
-stored in the current directory, or in the directory specified with the
-.B \-d
-option. You can customize the style of the generated pages by editing the
-generated
-.I style.css
-file, or by providing your own style sheet using option
-.BR \-css\-style .
-The file
-.I style.css
-is not generated if it already exists.
-.TP
-.B \-latex
-Generate documentation in LaTeX default format. The generated LaTeX document
-is saved in file
-.IR ocamldoc.out ,
-or in the file specified with the
-.B -o
-option. The document uses the style file
-.IR ocamldoc.sty .
-This file is generated when using the
-.B \-latex
-option, if it does not already exist. You can change this file to customize
-the style of your LaTeX documentation.
-.TP
-.B \-texi
-Generate documentation in TeXinfo default format. The generated LaTeX document
-is saved in file
-.IR ocamldoc.out ,
-or in the file specified with the
-.B -o
-option.
-.TP
-.B \-man
-Generate documentation as a set of Unix man pages. The generated pages are
-stored in the current directory, or in the directory specified with the
-.B \-d
-option.
-.TP
-.B \-dot
-Generate a dependency graph for the toplevel modules, in a format suitable for
-displaying and processing by
-.IR dot (1).
-The
-.IR dot (1)
-tool is available from
-.IR https://graphviz.org/ .
-The textual representation of the graph is written to the file
-.IR ocamldoc.out ,
-or to the file specified with the
-.B -o
-option. Use
-.BI dot \ ocamldoc.out
-to display it.
-.TP
-.BI \-g \ file
-Dynamically load the given file (which extension usually is .cmo or .cma),
-which defines a custom documentation generator.
-If the given file is a simple one and does not exist in
-the current directory, then
-.B ocamldoc
-looks for it in the custom
-generators default directory, and in the directories specified with the
-.B \-i
-option.
-.TP
-.BI \-customdir
-Display the custom generators default directory.
-.TP
-.BI \-i \ directory
-Add the given directory to the path where to look for custom generators.
-.SS "General options"
-.TP
-.BI \-d \ dir
-Generate files in directory
-.IR dir ,
-rather than the current directory.
-.TP
-.BI \-dump \ file
-Dump collected information into
-.IR file .
-This information can be read with the
-.B \-load
-option in a subsequent invocation of
-.BR ocamldoc (1).
-.TP
-.BI \-hide \ modules
-Hide the given complete module names in the generated documentation.
-.I modules
-is a list of complete module names are separated by commas (,),
-without blanks. For instance:
-.IR Stdlib,M2.M3 .
-.TP
-.B \-inv\-merge\-ml\-mli
-Reverse the precedence of implementations and interfaces when merging.
-All elements in implementation files are kept, and the
-.B \-m
-option indicates which parts of the comments in interface files are merged with
-the comments in implementation files.
-.TP
-.B \-keep\-code
-Always keep the source code for values, methods and instance variables, when
-available. The source code is always kept when a .ml
-file is given, but is by default discarded when a .mli
-is given. This option allows the source code to be always kept.
-.TP
-.BI \-load \ file
-Load information from
-.IR file ,
-which has been produced by
-.BR ocamldoc\ \-dump .
-Several
-.B -load
-options can be given.
-.TP
-.BI \-m \ flags
-Specify merge options between interfaces and implementations.
-.I flags
-can be one or several of the following characters:
-
-.B d
-merge description
-
-.B a
-merge @author
-
-.B v
-merge @version
-
-.B l
-merge @see
-
-.B s
-merge @since
-
-.B o
-merge @deprecated
-
-.B p
-merge @param
-
-.B e
-merge @raise
-
-.B r
-merge @return
-
-.B A
-merge everything
-.TP
-.B \-no\-custom\-tags
-Do not allow custom @-tags.
-.TP
-.B \-no\-stop
-Keep elements placed after the
-.B (**/**)
-special comment.
-.TP
-.BI \-o \ file
-Output the generated documentation to
-.I file
-instead of
-.IR ocamldoc.out .
-This option is meaningful only in conjunction with the
-.BR \-latex , \ \-texi ,\ or \ \-dot
-options.
-.TP
-.BI \-open \ module
-Opens
-.I module
-before typing.
-.TP
-.BI \-pp \ command
-Pipe sources through preprocessor
-.IR command .
-.TP
-.BI \-ppx \ command
-Pipe abstract syntax tree through preprocessor
-.IR command .
-.TP
-.BR \-show\-missed\-crossref
-Show missed cross-reference opportunities.
-.TP
-.B \-sort
-Sort the list of top-level modules before generating the documentation.
-.TP
-.B \-stars
-Remove blank characters until the first asterisk ('*') in each line of comments.
-.TP
-.BI \-t \ title
-Use
-.I title
-as the title for the generated documentation.
-.TP
-.BI \-text \ file
-Consider \fIfile\fR as a .txt file.
-.TP
-.BI \-intro \ file
-Use content of
-.I file
-as
-.B ocamldoc
-text to use as introduction (HTML, LaTeX and TeXinfo only).
-For HTML, the file is used to create the whole "index.html" file.
-.TP
-.B \-v
-Verbose mode. Display progress information.
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.B \-warn\-error
-Treat
-.B ocamldoc
-warnings as errors.
-.TP
-.B \-hide\-warnings
-Do not print
-.B ocamldoc
-warnings.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-.SS "Type-checking options"
-.BR ocamldoc (1)
-calls the OCaml type-checker to obtain type information. The
-following options impact the type-checking phase. They have the same meaning
-as for the
-.BR ocamlc (1)\ and \ ocamlopt (1)
-commands.
-.TP
-.BI \-I \ directory
-Add
-.I directory
-to the list of directories search for compiled interface files (.cmi files).
-.TP
-.B \-nolabels
-Ignore non-optional labels in types.
-.TP
-.B \-rectypes
- Allow arbitrary recursive types. (See the
-.B \-rectypes
-option to
-.BR ocamlc (1).)
-.SS "Options for generating HTML pages"
-The following options apply in conjunction with the
-.B \-html
-option:
-.TP
-.B \-all\-params
-Display the complete list of parameters for functions and methods.
-.TP
-.BI \-charset \ s
-Add information about character encoding being \fIs\fR
-(default is \fBiso-8859-1\fR).
-.TP
-.BI \-css\-style \ filename
-Use
-.I filename
-as the Cascading Style Sheet file.
-.TP
-.B \-colorize\-code
-Colorize the OCaml code enclosed in [ ] and \\{[ ]\\}, using colors to emphasize
-keywords, etc. If the code fragments are not syntactically correct, no color
-is added.
-.TP
-.B \-index\-only
-Generate only index files.
-.TP
-.B \-short\-functors
-Use a short form to display functors:
-.B "module M : functor (A:Module) -> functor (B:Module2) -> sig .. end"
-is displayed as
-.BR "module M (A:Module) (B:Module2) : sig .. end" .
-.SS "Options for generating LaTeX files"
-The following options apply in conjunction with the
-.B \-latex
-option:
-.TP
-.B \-latex\-value\-prefix prefix
-Give a prefix to use for the labels of the values in the generated LaTeX
-document. The default prefix is the empty string. You can also use the options
-.BR -latex-type-prefix ,
-.BR -latex-exception-prefix ,
-.BR -latex-module-prefix ,
-.BR -latex-module-type-prefix ,
-.BR -latex-class-prefix ,
-.BR -latex-class-type-prefix ,
-.BR -latex-attribute-prefix ,\ and
-.BR -latex-method-prefix .
-
-These options are useful when you have, for example, a type and a value
-with the same name. If you do not specify prefixes, LaTeX will complain about
-multiply defined labels.
-.TP
-.BI \-latextitle \ n,style
-Associate style number
-.I n
-to the given LaTeX sectioning command
-.IR style ,
-e.g.
-.BR section or subsection .
-(LaTeX only.) This is useful when including the generated document in another
-LaTeX document, at a given sectioning level. The default association is 1 for
-section, 2 for subsection, 3 for subsubsection, 4 for paragraph and 5 for
-subparagraph.
-.TP
-.B \-noheader
-Suppress header in generated documentation.
-.TP
-.B \-notoc
-Do not generate a table of contents.
-.TP
-.B \-notrailer
-Suppress trailer in generated documentation.
-.TP
-.B \-sepfiles
-Generate one .tex file per toplevel module, instead of the global
-.I ocamldoc.out
-file.
-.SS "Options for generating TeXinfo files"
-The following options apply in conjunction with the
-.B -texi
-option:
-.TP
-.B \-esc8
-Escape accented characters in Info files.
-.TP
-.B
-\-info\-entry
-Specify Info directory entry.
-.TP
-.B \-info\-section
-Specify section of Info directory.
-.TP
-.B \-noheader
-Suppress header in generated documentation.
-.TP
-.B \-noindex
-Do not build index for Info files.
-.TP
-.B \-notrailer
-Suppress trailer in generated documentation.
-.SS "Options for generating dot graphs"
-The following options apply in conjunction with the
-.B \-dot
-option:
-.TP
-.BI \-dot\-colors \ colors
-Specify the colors to use in the generated dot code. When generating module
-dependencies,
-.BR ocamldoc (1)
-uses different colors for modules, depending on the directories in which they
-reside. When generating types dependencies,
-.BR ocamldoc (1)
-uses different colors for types, depending on the modules in which they are
-defined.
-.I colors
-is a list of color names separated by commas (,), as in
-.BR Red,Blue,Green .
-The available colors are the ones supported by the
-.BR dot (1)
-tool.
-.TP
-.B \-dot\-include\-all
-Include all modules in the
-.BR dot (1)
-output, not only modules given on the command line or loaded with the
-.B \-load
-option.
-.TP
-.B \-dot\-reduce
-Perform a transitive reduction of the dependency graph before outputting the
-dot code. This can be useful if there are a lot of transitive dependencies
-that clutter the graph.
-.TP
-.B \-dot\-types
-Output dot code describing the type dependency graph instead of the module
-dependency graph.
-.SS "Options for generating man files"
-The following options apply in conjunction with the
-.B \-man
-option:
-.TP
-.B \-man\-mini
-Generate man pages only for modules, module types, classes and class types,
-instead of pages for all elements.
-.TP
-.BI \-man\-suffix \ suffix
-Set the suffix used for generated man filenames. Default is o, as in
-.IR List.o .
-.TP
-.BI \-man\-section \ section
-Set the section number used for generated man filenames. Default is 3.
-
-
-.SH SEE ALSO
-.BR ocaml (1),
-.BR ocamlc (1),
-.BR ocamlopt (1).
-.br
-.IR "The OCaml user's manual",
-chapter "The documentation generator".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLLEX 1
+
+.SH NAME
+ocamllex \- The OCaml lexer generator
+
+.SH SYNOPSIS
+.B ocamllex
+[
+.BI \-o \ output-file
+]
+[
+.B \-ml
+]
+.I filename.mll
+
+.SH DESCRIPTION
+
+The
+.BR ocamllex (1)
+command generates OCaml lexers from a set of regular
+expressions with associated semantic actions, in the style of
+.BR lex (1).
+
+Running
+.BR ocamllex (1)
+on the input file
+.IR lexer \&.mll
+produces OCaml code for a lexical analyzer in file
+.IR lexer \&.ml.
+
+This file defines one lexing function per entry point in the lexer
+definition. These functions have the same names as the entry
+points. Lexing functions take as argument a lexer buffer, and return
+the semantic attribute of the corresponding entry point.
+
+Lexer buffers are an abstract data type implemented in the standard
+library module Lexing. The functions Lexing.from_channel,
+Lexing.from_string and Lexing.from_function create
+lexer buffers that read from an input channel, a character string, or
+any reading function, respectively.
+
+When used in conjunction with a parser generated by
+.BR ocamlyacc (1),
+the semantic actions compute a value belonging to the type token defined
+by the generated parsing module.
+
+.SH OPTIONS
+
+The
+.BR ocamllex (1)
+command recognizes the following options:
+.TP
+.B \-ml
+Output code that does not use OCaml's built-in automata
+interpreter. Instead, the automaton is encoded by OCaml functions.
+This option is mainly useful for debugging
+.BR ocamllex (1),
+using it for production lexers is not recommended.
+.TP
+.BI \-o \ output\-file
+Specify the name of the output file produced by
+.BR ocamllex (1).
+The default is the input file name, with its extension replaced by .ml.
+.TP
+.B \-q
+Quiet mode.
+.BR ocamllex (1)
+normally outputs informational messages
+to standard output. They are suppressed if option
+.B \-q
+is used.
+.TP
+.BR \-v \ or \ \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlyacc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Lexer and parser generators".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLLEX 1
-
-.SH NAME
-ocamllex \- The OCaml lexer generator
-
-.SH SYNOPSIS
-.B ocamllex
-[
-.BI \-o \ output-file
-]
-[
-.B \-ml
-]
-.I filename.mll
-
-.SH DESCRIPTION
-
-The
-.BR ocamllex (1)
-command generates OCaml lexers from a set of regular
-expressions with associated semantic actions, in the style of
-.BR lex (1).
-
-Running
-.BR ocamllex (1)
-on the input file
-.IR lexer \&.mll
-produces OCaml code for a lexical analyzer in file
-.IR lexer \&.ml.
-
-This file defines one lexing function per entry point in the lexer
-definition. These functions have the same names as the entry
-points. Lexing functions take as argument a lexer buffer, and return
-the semantic attribute of the corresponding entry point.
-
-Lexer buffers are an abstract data type implemented in the standard
-library module Lexing. The functions Lexing.from_channel,
-Lexing.from_string and Lexing.from_function create
-lexer buffers that read from an input channel, a character string, or
-any reading function, respectively.
-
-When used in conjunction with a parser generated by
-.BR ocamlyacc (1),
-the semantic actions compute a value belonging to the type token defined
-by the generated parsing module.
-
-.SH OPTIONS
-
-The
-.BR ocamllex (1)
-command recognizes the following options:
-.TP
-.B \-ml
-Output code that does not use OCaml's built-in automata
-interpreter. Instead, the automaton is encoded by OCaml functions.
-This option is mainly useful for debugging
-.BR ocamllex (1),
-using it for production lexers is not recommended.
-.TP
-.BI \-o \ output\-file
-Specify the name of the output file produced by
-.BR ocamllex (1).
-The default is the input file name, with its extension replaced by .ml.
-.TP
-.B \-q
-Quiet mode.
-.BR ocamllex (1)
-normally outputs informational messages
-to standard output. They are suppressed if option
-.B \-q
-is used.
-.TP
-.BR \-v \ or \ \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH SEE ALSO
-.BR ocamlyacc (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Lexer and parser generators".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* OCaml *
+.\"* *
+.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
+.\"* *
+.\"* Copyright 1999 Institut National de Recherche en Informatique et *
+.\"* en Automatique. *
+.\"* *
+.\"* All rights reserved. This file is distributed under the terms of *
+.\"* the GNU Lesser General Public License version 2.1, with the *
+.\"* special exception on linking described in the file LICENSE. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLMKTOP 1
+
+.SH NAME
+ocamlmktop \- Building custom toplevel systems
+
+.SH SYNOPSIS
+.B ocamlmktop
+[
+.BR \-v | \-version | \-vnum
+]
+[
+.BI \-cclib \ libname
+]
+[
+.BI \-ccopt \ option
+]
+[
+.B \-custom
+[
+.BI \-o \ exec-file
+]
+[
+.BI \-I \ lib-dir
+]
+.I filename ...
+
+.SH DESCRIPTION
+
+The
+.BR ocamlmktop (1)
+command builds OCaml toplevels that
+contain user code preloaded at start-up.
+The
+.BR ocamlmktop (1)
+command takes as argument a set of
+.IR x .cmo
+and
+.IR x .cma
+files, and links them with the object files that implement the
+OCaml toplevel. If the
+.B \-custom
+flag is given, C object files and libraries (.o and .a files) can also
+be given on the command line and are linked in the resulting toplevel.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlmktop (1).
+.TP
+.B \-v
+Print the version string of the compiler and exit.
+.TP
+.BR \-vnum \ or\ \-version
+Print the version number of the compiler in short form and exit.
+.TP
+.BI \-cclib\ \-l libname
+Pass the
+.BI \-l libname
+option to the C linker when linking in
+``custom runtime'' mode (see the corresponding option for
+.BR ocamlc (1).
+.TP
+.B \-ccopt
+Pass the given option to the C compiler and linker, when linking in
+``custom runtime'' mode. See the corresponding option for
+.BR ocamlc (1).
+.TP
+.B \-custom
+Link in ``custom runtime'' mode. See the corresponding option for
+.BR ocamlc (1).
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmo and .cma).
+.TP
+.BI \-o \ exec\-file
+Specify the name of the toplevel file produced by the linker.
+The default is is
+.BR a.out .
+
+.SH SEE ALSO
+.BR ocamlc (1).
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* OCaml *
-.\"* *
-.\"* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
-.\"* *
-.\"* Copyright 1999 Institut National de Recherche en Informatique et *
-.\"* en Automatique. *
-.\"* *
-.\"* All rights reserved. This file is distributed under the terms of *
-.\"* the GNU Lesser General Public License version 2.1, with the *
-.\"* special exception on linking described in the file LICENSE. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLMKTOP 1
-
-.SH NAME
-ocamlmktop \- Building custom toplevel systems
-
-.SH SYNOPSIS
-.B ocamlmktop
-[
-.BR \-v | \-version | \-vnum
-]
-[
-.BI \-cclib \ libname
-]
-[
-.BI \-ccopt \ option
-]
-[
-.B \-custom
-[
-.BI \-o \ exec-file
-]
-[
-.BI \-I \ lib-dir
-]
-.I filename ...
-
-.SH DESCRIPTION
-
-The
-.BR ocamlmktop (1)
-command builds OCaml toplevels that
-contain user code preloaded at start-up.
-The
-.BR ocamlmktop (1)
-command takes as argument a set of
-.IR x .cmo
-and
-.IR x .cma
-files, and links them with the object files that implement the
-OCaml toplevel. If the
-.B \-custom
-flag is given, C object files and libraries (.o and .a files) can also
-be given on the command line and are linked in the resulting toplevel.
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocamlmktop (1).
-.TP
-.B \-v
-Print the version string of the compiler and exit.
-.TP
-.BR \-vnum \ or\ \-version
-Print the version number of the compiler in short form and exit.
-.TP
-.BI \-cclib\ \-l libname
-Pass the
-.BI \-l libname
-option to the C linker when linking in
-``custom runtime'' mode (see the corresponding option for
-.BR ocamlc (1).
-.TP
-.B \-ccopt
-Pass the given option to the C compiler and linker, when linking in
-``custom runtime'' mode. See the corresponding option for
-.BR ocamlc (1).
-.TP
-.B \-custom
-Link in ``custom runtime'' mode. See the corresponding option for
-.BR ocamlc (1).
-.TP
-.BI \-I \ directory
-Add the given directory to the list of directories searched for
-compiled interface files (.cmo and .cma).
-.TP
-.BI \-o \ exec\-file
-Specify the name of the toplevel file produced by the linker.
-The default is is
-.BR a.out .
-
-.SH SEE ALSO
-.BR ocamlc (1).
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLOPT 1
+
+.SH NAME
+
+ocamlopt \- The OCaml native-code compiler
+
+.SH SYNOPSIS
+
+.B ocamlopt
+[
+.I options
+]
+.IR filename \ ...
+
+.B ocamlopt.opt
+(same options)
+
+.SH DESCRIPTION
+
+The OCaml high-performance
+native-code compiler
+.BR ocamlopt (1)
+compiles OCaml source files to native code object files and link these
+object files to produce standalone executables.
+
+The
+.BR ocamlopt (1)
+command has a command-line interface very close to that
+of
+.BR ocamlc (1).
+It accepts the same types of arguments and processes them
+sequentially, after all options have been processed:
+
+Arguments ending in .mli are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file
+.IR x .mli,
+the
+.BR ocamlopt (1)
+compiler produces a compiled interface
+in the file
+.IR x .cmi.
+The interface produced is identical to that
+produced by the bytecode compiler
+.BR ocamlc (1).
+
+Arguments ending in .ml are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects. From the file
+.IR x .ml,
+the
+.BR ocamlopt (1)
+compiler produces two files:
+.IR x .o,
+containing native object code, and
+.IR x .cmx,
+containing extra information for linking and
+optimization of the clients of the unit. The compiled implementation
+should always be referred to under the name
+.IR x .cmx
+(when given a .o file,
+.BR ocamlopt (1)
+assumes that it contains code compiled from C, not from OCaml).
+
+The implementation is checked against the interface file
+.IR x .mli
+(if it exists) as described in the manual for
+.BR ocamlc (1).
+
+Arguments ending in .cmx are taken to be compiled object code. These
+files are linked together, along with the object files obtained
+by compiling .ml arguments (if any), and the OCaml standard
+library, to produce a native-code executable program. The order in
+which .cmx and .ml arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given
+.IR x .cmx
+file must come
+before all .cmx files that refer to the unit
+.IR x .
+
+Arguments ending in .cmxa are taken to be libraries of object code.
+Such a library packs in two files
+.IR lib .cmxa
+and
+.IR lib .a
+a set of object files (.cmx/.o files). Libraries are build with
+.B ocamlopt \-a
+(see the description of the
+.B \-a
+option below). The object
+files contained in the library are linked as regular .cmx files (see
+above), in the order specified when the library was built. The only
+difference is that if an object file contained in a library is not
+referenced anywhere in the program, then it is not linked in.
+
+Arguments ending in .c are passed to the C compiler, which generates
+a .o object file. This object file is linked with the program.
+
+Arguments ending in .o or .a are assumed to be C object files and
+libraries. They are linked with the program.
+
+The output of the linking phase is a regular Unix executable file. It
+does not need
+.BR ocamlrun (1)
+to run.
+
+.B ocamlopt.opt
+is the same compiler as
+.BR ocamlopt ,
+but compiled with itself instead of with the bytecode compiler
+.BR ocamlc (1).
+Thus, it behaves exactly like
+.BR ocamlopt ,
+but compiles faster.
+.B ocamlopt.opt
+is not available in all installations of OCaml.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlopt (1).
+.TP
+.B \-a
+Build a library (.cmxa/.a file) with the object files (.cmx/.o
+files) given on the command line, instead of linking them into an
+executable file. The name of the library must be set with the
+.B \-o
+option.
+
+If
+.BR \-cclib \ or \ \-ccopt
+options are passed on the command
+line, these options are stored in the resulting .cmxa library. Then,
+linking with this library automatically adds back the
+.BR \-cclib \ and \ \-ccopt
+options as if they had been provided on the
+command line, unless the
+.B \-noautolink
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
+.TP
+.B \-absname
+Show absolute filenames in error messages.
+.TP
+.B \-annot
+Deprecated since OCaml 4.11. Please use
+.BR \-bin-annot
+instead.
+.TP
+.B \-bin\-annot
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file
+.IR src .ml
+is put into file
+.IR src .cmt.
+In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The annotation files produced by
+.B \-bin\-annot
+contain more information
+and are much more compact than the files produced by
+.BR \-annot .
+.TP
+.B \-c
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+.TP
+.BI \-cc \ ccomp
+Use
+.I ccomp
+as the C linker called to build the final executable and as the C
+compiler for compiling .c source files.
+.TP
+.BI \-cclib\ \-l libname
+Pass the
+.BI \-l libname
+option to the linker. This causes the given C library to be linked
+with the program.
+.TP
+.BI \-ccopt \ option
+Pass the given option to the C compiler and linker. For instance,
+.BI \-ccopt\ \-L dir
+causes the C linker to search for C libraries in
+directory
+.IR dir .
+.TP
+.BI \-color \ mode
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+
+.B auto
+use heuristics to enable colors only if the output supports them (an
+ANSI-compatible tty terminal);
+
+.B always
+enable colors unconditionally;
+
+.B never
+disable color output.
+
+The environment variable "OCAML_COLOR" is considered if \-color is not
+provided. Its values are auto/always/never as above.
+
+If \-color is not provided, "OCAML_COLOR" is not set and the environment
+variable "NO_COLOR" is set, then color output is disabled. Otherwise,
+the default setting is
+.B auto,
+and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that isatty(stderr) holds.
+
+.TP
+.BI \-error\-style \ mode
+Control the way error messages and warnings are printed.
+The following modes are supported:
+
+.B short
+only print the error and its location;
+
+.B contextual
+like "short", but also display the source code snippet corresponding
+to the location of the error.
+
+The default setting is
+.B contextual.
+
+The environment variable "OCAML_ERROR_STYLE" is considered if
+\-error\-style is not provided. Its values are short/contextual as
+above.
+
+.TP
+.B \-compact
+Optimize the produced code for space rather than for time. This
+results in smaller but slightly slower programs. The default is to
+optimize for speed.
+.TP
+.B \-config
+Print the version number of
+.BR ocamlopt (1)
+and a detailed summary of its configuration, then exit.
+.TP
+.BI \-config-var
+Print the value of a specific configuration variable
+from the
+.B \-config
+output, then exit. If the variable does not exist,
+the exit code is non-zero.
+.TP
+.BI \-depend\ ocamldep-args
+Compute dependencies, as ocamldep would do.
+.TP
+.BI \-for\-pack \ module\-path
+Generate an object file (.cmx and .o files) that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with
+.BR \-pack .
+For instance,
+.B ocamlopt\ \-for\-pack\ P\ \-c\ A.ml
+will generate a.cmx and a.o files that can later be used with
+.BR "ocamlopt -pack -o P.cmx a.cmx" .
+.TP
+.B \-g
+Add debugging information while compiling and linking. This option is
+required in order to produce stack backtraces when
+the program terminates on an uncaught exception (see
+.BR ocamlrun (1)).
+.TP
+.B \-i
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (.ml
+file). No compiled files (.cmo and .cmi files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (.mli file) for a file:
+just redirect the standard output of the compiler to a .mli file,
+and edit that file to remove all declarations of unexported names.
+.TP
+.BI \-I \ directory
+Add the given directory to the list of directories searched for
+compiled interface files (.cmi), compiled object code files (.cmx),
+and libraries (.cmxa). By default, the current directory is searched
+first, then the standard library directory. Directories added with \-I
+are searched after the current directory, in the order in which they
+were given on the command line, but before the standard library
+directory. See also option
+.BR \-nostdlib .
+
+If the given directory starts with
+.BR + ,
+it is taken relative to the
+standard library directory. For instance,
+.B \-I\ +compiler-libs
+adds the subdirectory
+.B compiler-libs
+of the standard library to the search path.
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-inline \ n
+Set aggressiveness of inlining to
+.IR n ,
+where
+.I n
+is a positive
+integer. Specifying
+.B \-inline 0
+prevents all functions from being
+inlined, except those whose body is smaller than the call site. Thus,
+inlining causes no expansion in code size. The default aggressiveness,
+.BR \-inline\ 1 ,
+allows slightly larger functions to be inlined, resulting
+in a slight expansion in code size. Higher values for the
+.B \-inline
+option cause larger and larger functions to become candidate for
+inlining, but can result in a serious increase in code size.
+.TP
+.B \-insn\-sched
+Enables the instruction scheduling pass in the compiler backend.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.BI \-intf\-suffix \ string
+Recognize file names ending with
+.I string
+as interface files (instead of the default .mli).
+.TP
+.B \-keep-docs
+Keep documentation strings in generated .cmi files.
+.TP
+.B \-keep-locs
+Keep locations in generated .cmi files.
+.TP
+.B \-labels
+Labels are not ignored in types, labels may be used in applications,
+and labelled parameters can be given in any order. This is the default.
+.TP
+.B \-linkall
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library
+.RB ( \-a
+flag), setting the
+.B \-linkall
+flag forces all
+subsequent links of programs involving that library to link all the
+modules contained in the library.
+When compiling a module (option
+.BR \-c ),
+setting the
+.B \-linkall
+option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+.TP
+.B \-linscan
+Use linear scan register allocation. Compiling with this allocator is faster
+than with the usual graph coloring allocator, sometimes quite drastically so for
+long functions and modules. On the other hand, the generated code can be a bit
+slower.
+.TP
+.B \-match\-context\-rows
+Set number of rows of context used during pattern matching
+compilation. Lower values cause faster compilation, but
+less optimized code. The default value is 32.
+.TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
+.B \-no\-app\-funct
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+.TP
+.B \-noassert
+Do not compile assertion checks. Note that the special form
+.B assert\ false
+is always compiled because it is typed specially.
+This flag has no effect when linking already-compiled files.
+.TP
+.B \-noautolink
+When linking .cmxa libraries, ignore
+.BR \-cclib \ and \ \-ccopt
+options potentially contained in the libraries (if these options were
+given when building the libraries). This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set
+.B -noautolink
+and pass the correct C libraries and options on the command line.
+.TP
+.B \-nodynlink
+Allow the compiler to use some optimizations that are valid only for code
+that is never dynlinked.
+.TP
+.B \-no\-insn\-sched
+Disables the instruction scheduling pass in the compiler backend.
+.TP
+.B -nostdlib
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (.cmi), compiled
+object code files (.cmx), and libraries (.cmxa). See also option
+.BR \-I .
+.TP
+.B \-nolabels
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+.TP
+.BI \-o \ exec\-file
+Specify the name of the output file produced by the linker. The
+default output name is a.out, in keeping with the Unix tradition. If the
+.B \-a
+option is given, specify the name of the library produced. If the
+.B \-pack
+option is given, specify the name of the packed object file produced.
+If the
+.B \-output\-obj
+option is given, specify the name of the output file produced. If the
+.B \-shared
+option is given, specify the name of plugin file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.B \-opaque
+When compiling a .mli interface file, this has the same effect as the
+.B \-opaque
+option of the bytecode compiler. When compiling a .ml implementation
+file, this produces a .cmx file without cross-module optimization
+information, which reduces recompilation on module change.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
+.TP
+.B \-output\-obj
+Cause the linker to produce a C object file instead of an executable
+file. This is useful to wrap OCaml code as a C library,
+callable from any C program. The name of the output object file
+must be set with the
+.B \-o
+option.
+This option can also be used to produce a compiled shared/dynamic
+library (.so extension).
+.B \-output\-complete\-obj
+Same as
+.B \-output\-obj
+except the object file produced includes the runtime and
+autolink libraries.
+.TP
+.TP
+.B \-pack
+Build an object file (.cmx and .o files) and its associated compiled
+interface (.cmi) that combines the .cmx object
+files given on the command line, making them appear as sub-modules of
+the output .cmx file. The name of the output .cmx file must be
+given with the
+.B \-o
+option. For instance,
+.B ocamlopt\ -pack\ -o\ P.cmx\ A.cmx\ B.cmx\ C.cmx
+generates compiled files P.cmx, P.o and P.cmi describing a
+compilation unit having three sub-modules A, B and C,
+corresponding to the contents of the object files A.cmx, B.cmx and
+C.cmx. These contents can be referenced as P.A, P.B and P.C
+in the remainder of the program.
+
+The .cmx object files being combined must have been compiled with
+the appropriate
+.B \-for\-pack
+option. In the example above,
+A.cmx, B.cmx and C.cmx must have been compiled with
+.BR ocamlopt\ \-for\-pack\ P .
+
+Multiple levels of packing can be achieved by combining
+.B \-pack
+with
+.BR \-for\-pack .
+See
+.IR "The OCaml user's manual" ,
+chapter "Native-code compilation" for more details.
+.TP
+.BI \-pp \ command
+Cause the compiler to call the given
+.I command
+as a preprocessor for each source file. The output of
+.I command
+is redirected to
+an intermediate file, which is compiled. If there are no compilation
+errors, the intermediate file is deleted afterwards.
+.TP
+.BI \-ppx \ command
+After parsing, pipe the abstract syntax tree through the preprocessor
+.IR command .
+The module
+.BR Ast_mapper (3)
+implements the external interface of a preprocessor.
+.TP
+.B \-principal
+Check information path during type-checking, to make sure that all
+types are derived in a principal way. All programs accepted in
+.B \-principal
+mode are also accepted in default mode with equivalent
+types, but different binary signatures.
+.TP
+.B \-rectypes
+Allow arbitrary recursive types during type-checking. By default,
+only recursive types where the recursion goes through an object type
+are supported. Note that once you have created an interface using this
+flag, you must use it again for all dependencies.
+.TP
+.BI \-runtime\-variant \ suffix
+Add
+.I suffix
+to the name of the runtime library that will be used by the program.
+If OCaml was configured with option
+.BR \-with\-debug\-runtime ,
+then the
+.B d
+suffix is supported and gives a debug version of the runtime.
+.TP
+.B \-S
+Keep the assembly code produced during the compilation. The assembly
+code for the source file
+.IR x .ml
+is saved in the file
+.IR x .s.
+.TP
+.BI \-stop\-after \ pass
+Stop compilation after the given compilation pass. The currently
+supported passes are:
+.BR parsing ,
+.BR typing ,
+.BR scheduling ,
+.BR emit .
+.TP
+.BI \-save\-ir\-after \ pass
+Save intermediate representation after the given compilation pass. The currently
+supported passes are:
+.BR scheduling .
+.TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\ bytes ,
+thereby making strings read-only. This is the default.
+.TP
+.B \-shared
+Build a plugin (usually .cmxs) that can be dynamically loaded with
+the
+.B Dynlink
+module. The name of the plugin must be
+set with the
+.B \-o
+option. A plugin can include a number of OCaml
+modules and libraries, and extra native objects (.o, .a files).
+Building native plugins is only supported for some
+operating system. Under some systems (currently,
+only Linux AMD 64), all the OCaml code linked in a plugin must have
+been compiled without the
+.B \-nodynlink
+flag. Some constraints might also
+apply to the way the extra native objects have been compiled (under
+Linux AMD 64, they must contain only position-independent code).
+.TP
+.B \-short\-paths
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages.
+.TP
+.B \-strict\-sequence
+The left-hand part of a sequence must have type unit.
+.TP
+.B \-unboxed\-types
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with
+.BR [@@ocaml.boxed] .
+.TP
+.B \-no-unboxed\-types
+When a type is unboxable it will be boxed unless annotated with
+.BR [@@ocaml.unboxed] .
+This is the default.
+.TP
+.B \-unsafe
+Turn bound checking off for array and string accesses (the
+.BR v.(i) and s.[i]
+constructs). Programs compiled with
+.B \-unsafe
+are therefore
+faster, but unsafe: anything can happen if the program accesses an
+array or string outside of its bounds. Additionally, turn off the
+check for zero divisor in integer division and modulus operations.
+With
+.BR \-unsafe ,
+an integer division (or modulus) by zero can halt the
+program or continue with an unspecified result instead of raising a
+.B Division_by_zero
+exception.
+.TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\ bytes ,
+thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+.TP
+.B \-v
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+.TP
+.B \-verbose
+Print all external commands before they are executed, in particular
+invocations of the assembler, C compiler, and linker.
+.TP
+.BR \-version \ or\ \-vnum
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+.TP
+.BI \-w \ warning\-list
+Enable, disable, or mark as fatal the warnings specified by the argument
+.IR warning\-list .
+See
+.BR ocamlc (1)
+for the syntax of
+.IR warning-list .
+.TP
+.BI \-warn\-error \ warning\-list
+Mark as fatal the warnings specified in the argument
+.IR warning\-list .
+The compiler will stop with an error when one of these
+warnings is emitted. The
+.I warning\-list
+has the same meaning as for
+the
+.B \-w
+option: a
+.B +
+sign (or an uppercase letter) marks the corresponding warnings as fatal, a
+.B \-
+sign (or a lowercase letter) turns them back into non-fatal warnings, and a
+.B @
+sign both enables and marks as fatal the corresponding warnings.
+
+Note: it is not recommended to use the
+.B \-warn\-error
+option in production code, because it will almost certainly prevent
+compiling your program with later versions of OCaml when they add new
+warnings or modify existing warnings.
+
+The default setting is
+.B \-warn\-error \-a+31
+(only warning 31 is fatal).
+.TP
+.B \-warn\-help
+Show the description of all available warning numbers.
+.TP
+.B \-where
+Print the location of the standard library, then exit.
+.TP
+.B \-with-runtime
+Include the runtime system in the generated program. This is the default.
+.TP
+.B \-without-runtime
+The compiler does not include the runtime system (nor a reference to it) in the
+generated program; it must be supplied separately.
+.TP
+.BI \- \ file
+Process
+.I file
+as a file name, even if it starts with a dash (-) character.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH OPTIONS FOR THE IA32 ARCHITECTURE
+
+The IA32 code generator (Intel Pentium, AMD Athlon) supports the
+following additional option:
+.TP
+.B \-ffast\-math
+Use the IA32 instructions to compute
+trigonometric and exponential functions, instead of calling the
+corresponding library routines. The functions affected are:
+.BR atan ,
+.BR atan2 ,
+.BR cos ,
+.BR log ,
+.BR log10 ,
+.BR sin ,
+.B sqrt
+and
+.BR tan .
+The resulting code runs faster, but the range of supported arguments
+and the precision of the result can be reduced. In particular,
+trigonometric operations
+.BR cos ,
+.BR sin ,
+.B tan
+have their range reduced to [\-2^64, 2^64].
+
+.SH OPTIONS FOR THE AMD64 ARCHITECTURE
+
+The AMD64 code generator (64-bit versions of Intel Pentium and AMD
+Athlon) supports the following additional options:
+.TP
+.B \-fPIC
+Generate position-independent machine code. This is the default.
+.TP
+.B \-fno\-PIC
+Generate position-dependent machine code.
+
+.SH OPTIONS FOR THE POWER ARCHITECTURE
+
+The PowerPC code generator supports the following additional options:
+.TP
+.B \-flarge\-toc
+Enables the PowerPC large model allowing the TOC (table of contents) to be
+arbitrarily large. This is the default since 4.11.
+.TP
+.B \-fsmall\-toc
+Enables the PowerPC small model allowing the TOC to be up to 64 kbytes per
+compilation unit. Prior to 4.11 this was the default behaviour.
+\end{options}
+
+.SH OPTIONS FOR THE ARM ARCHITECTURE
+The ARM code generator supports the following additional options:
+.TP
+.B \-farch=armv4|armv5|armv5te|armv6|armv6t2|armv7
+Select the ARM target architecture
+.TP
+.B \-ffpu=soft|vfpv2|vfpv3\-d16|vfpv3
+Select the floating-point hardware
+.TP
+.B \-fPIC
+Generate position-independent machine code.
+.TP
+.B \-fno\-PIC
+Generate position-dependent machine code. This is the default.
+.TP
+.B \-fthumb
+Enable Thumb/Thumb-2 code generation
+.TP
+.B \-fno\-thumb
+Disable Thumb/Thumb-2 code generation
+.P
+The default values for target architecture, floating-point hardware
+and thumb usage were selected at configure-time when building
+.B ocamlopt
+itself. This configuration can be inspected using
+.BR ocamlopt\ \-config .
+Target architecture depends on the "model" setting, while
+floating-point hardware and thumb support are determined from the ABI
+setting in "system" (
+.BR linux_eabi or linux_eabihf ).
+
+.SH SEE ALSO
+.BR ocamlc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Native-code compilation".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLOPT 1
-
-.SH NAME
-
-ocamlopt \- The OCaml native-code compiler
-
-.SH SYNOPSIS
-
-.B ocamlopt
-[
-.I options
-]
-.IR filename \ ...
-
-.B ocamlopt.opt
-(same options)
-
-.SH DESCRIPTION
-
-The OCaml high-performance
-native-code compiler
-.BR ocamlopt (1)
-compiles OCaml source files to native code object files and link these
-object files to produce standalone executables.
-
-The
-.BR ocamlopt (1)
-command has a command-line interface very close to that
-of
-.BR ocamlc (1).
-It accepts the same types of arguments and processes them
-sequentially, after all options have been processed:
-
-Arguments ending in .mli are taken to be source files for
-compilation unit interfaces. Interfaces specify the names exported by
-compilation units: they declare value names with their types, define
-public data types, declare abstract data types, and so on. From the
-file
-.IR x .mli,
-the
-.BR ocamlopt (1)
-compiler produces a compiled interface
-in the file
-.IR x .cmi.
-The interface produced is identical to that
-produced by the bytecode compiler
-.BR ocamlc (1).
-
-Arguments ending in .ml are taken to be source files for compilation
-unit implementations. Implementations provide definitions for the
-names exported by the unit, and also contain expressions to be
-evaluated for their side-effects. From the file
-.IR x .ml,
-the
-.BR ocamlopt (1)
-compiler produces two files:
-.IR x .o,
-containing native object code, and
-.IR x .cmx,
-containing extra information for linking and
-optimization of the clients of the unit. The compiled implementation
-should always be referred to under the name
-.IR x .cmx
-(when given a .o file,
-.BR ocamlopt (1)
-assumes that it contains code compiled from C, not from OCaml).
-
-The implementation is checked against the interface file
-.IR x .mli
-(if it exists) as described in the manual for
-.BR ocamlc (1).
-
-Arguments ending in .cmx are taken to be compiled object code. These
-files are linked together, along with the object files obtained
-by compiling .ml arguments (if any), and the OCaml standard
-library, to produce a native-code executable program. The order in
-which .cmx and .ml arguments are presented on the command line is
-relevant: compilation units are initialized in that order at
-run-time, and it is a link-time error to use a component of a unit
-before having initialized it. Hence, a given
-.IR x .cmx
-file must come
-before all .cmx files that refer to the unit
-.IR x .
-
-Arguments ending in .cmxa are taken to be libraries of object code.
-Such a library packs in two files
-.IR lib .cmxa
-and
-.IR lib .a
-a set of object files (.cmx/.o files). Libraries are build with
-.B ocamlopt \-a
-(see the description of the
-.B \-a
-option below). The object
-files contained in the library are linked as regular .cmx files (see
-above), in the order specified when the library was built. The only
-difference is that if an object file contained in a library is not
-referenced anywhere in the program, then it is not linked in.
-
-Arguments ending in .c are passed to the C compiler, which generates
-a .o object file. This object file is linked with the program.
-
-Arguments ending in .o or .a are assumed to be C object files and
-libraries. They are linked with the program.
-
-The output of the linking phase is a regular Unix executable file. It
-does not need
-.BR ocamlrun (1)
-to run.
-
-.B ocamlopt.opt
-is the same compiler as
-.BR ocamlopt ,
-but compiled with itself instead of with the bytecode compiler
-.BR ocamlc (1).
-Thus, it behaves exactly like
-.BR ocamlopt ,
-but compiles faster.
-.B ocamlopt.opt
-is not available in all installations of OCaml.
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocamlopt (1).
-.TP
-.B \-a
-Build a library (.cmxa/.a file) with the object files (.cmx/.o
-files) given on the command line, instead of linking them into an
-executable file. The name of the library must be set with the
-.B \-o
-option.
-
-If
-.BR \-cclib \ or \ \-ccopt
-options are passed on the command
-line, these options are stored in the resulting .cmxa library. Then,
-linking with this library automatically adds back the
-.BR \-cclib \ and \ \-ccopt
-options as if they had been provided on the
-command line, unless the
-.B \-noautolink
-option is given. Additionally, a substring
-.B $CAMLORIGIN
-inside a
-.BR \ \-ccopt
-options will be replaced by the full path to the .cma library,
-excluding the filename.
-.TP
-.B \-absname
-Show absolute filenames in error messages.
-.TP
-.B \-annot
-Deprecated since OCaml 4.11. Please use
-.BR \-bin-annot
-instead.
-.TP
-.B \-bin\-annot
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc) in binary format. The information for file
-.IR src .ml
-is put into file
-.IR src .cmt.
-In case of a type error, dump
-all the information inferred by the type-checker before the error.
-The annotation files produced by
-.B \-bin\-annot
-contain more information
-and are much more compact than the files produced by
-.BR \-annot .
-.TP
-.B \-c
-Compile only. Suppress the linking phase of the
-compilation. Source code files are turned into compiled files, but no
-executable file is produced. This option is useful to
-compile modules separately.
-.TP
-.BI \-cc \ ccomp
-Use
-.I ccomp
-as the C linker called to build the final executable and as the C
-compiler for compiling .c source files.
-.TP
-.BI \-cclib\ \-l libname
-Pass the
-.BI \-l libname
-option to the linker. This causes the given C library to be linked
-with the program.
-.TP
-.BI \-ccopt \ option
-Pass the given option to the C compiler and linker. For instance,
-.BI \-ccopt\ \-L dir
-causes the C linker to search for C libraries in
-directory
-.IR dir .
-.TP
-.BI \-color \ mode
-Enable or disable colors in compiler messages (especially warnings and errors).
-The following modes are supported:
-
-.B auto
-use heuristics to enable colors only if the output supports them (an
-ANSI-compatible tty terminal);
-
-.B always
-enable colors unconditionally;
-
-.B never
-disable color output.
-
-The default setting is
-.B auto,
-and the current heuristic
-checks that the "TERM" environment variable exists and is
-not empty or "dumb", and that isatty(stderr) holds.
-
-The environment variable "OCAML_COLOR" is considered if \-color is not
-provided. Its values are auto/always/never as above.
-
-.TP
-.BI \-error\-style \ mode
-Control the way error messages and warnings are printed.
-The following modes are supported:
-
-.B short
-only print the error and its location;
-
-.B contextual
-like "short", but also display the source code snippet corresponding
-to the location of the error.
-
-The default setting is
-.B contextual.
-
-The environment variable "OCAML_ERROR_STYLE" is considered if
-\-error\-style is not provided. Its values are short/contextual as
-above.
-
-.TP
-.B \-compact
-Optimize the produced code for space rather than for time. This
-results in smaller but slightly slower programs. The default is to
-optimize for speed.
-.TP
-.B \-config
-Print the version number of
-.BR ocamlopt (1)
-and a detailed summary of its configuration, then exit.
-.TP
-.BI \-config-var
-Print the value of a specific configuration variable
-from the
-.B \-config
-output, then exit. If the variable does not exist,
-the exit code is non-zero.
-.TP
-.BI \-depend\ ocamldep-args
-Compute dependencies, as ocamldep would do.
-.TP
-.BI \-for\-pack \ module\-path
-Generate an object file (.cmx and .o files) that can later be included
-as a sub-module (with the given access path) of a compilation unit
-constructed with
-.BR \-pack .
-For instance,
-.B ocamlopt\ \-for\-pack\ P\ \-c\ A.ml
-will generate a.cmx and a.o files that can later be used with
-.BR "ocamlopt -pack -o P.cmx a.cmx" .
-.TP
-.B \-g
-Add debugging information while compiling and linking. This option is
-required in order to produce stack backtraces when
-the program terminates on an uncaught exception (see
-.BR ocamlrun (1)).
-.TP
-.B \-i
-Cause the compiler to print all defined names (with their inferred
-types or their definitions) when compiling an implementation (.ml
-file). No compiled files (.cmo and .cmi files) are produced.
-This can be useful to check the types inferred by the
-compiler. Also, since the output follows the syntax of interfaces, it
-can help in writing an explicit interface (.mli file) for a file:
-just redirect the standard output of the compiler to a .mli file,
-and edit that file to remove all declarations of unexported names.
-.TP
-.BI \-I \ directory
-Add the given directory to the list of directories searched for
-compiled interface files (.cmi), compiled object code files (.cmx),
-and libraries (.cmxa). By default, the current directory is searched
-first, then the standard library directory. Directories added with \-I
-are searched after the current directory, in the order in which they
-were given on the command line, but before the standard library
-directory. See also option
-.BR \-nostdlib .
-
-If the given directory starts with
-.BR + ,
-it is taken relative to the
-standard library directory. For instance,
-.B \-I\ +compiler-libs
-adds the subdirectory
-.B compiler-libs
-of the standard library to the search path.
-.TP
-.BI \-impl \ filename
-Compile the file
-.I filename
-as an implementation file, even if its extension is not .ml.
-.TP
-.BI \-inline \ n
-Set aggressiveness of inlining to
-.IR n ,
-where
-.I n
-is a positive
-integer. Specifying
-.B \-inline 0
-prevents all functions from being
-inlined, except those whose body is smaller than the call site. Thus,
-inlining causes no expansion in code size. The default aggressiveness,
-.BR \-inline\ 1 ,
-allows slightly larger functions to be inlined, resulting
-in a slight expansion in code size. Higher values for the
-.B \-inline
-option cause larger and larger functions to become candidate for
-inlining, but can result in a serious increase in code size.
-.TP
-.B \-insn\-sched
-Enables the instruction scheduling pass in the compiler backend.
-.TP
-.BI \-intf \ filename
-Compile the file
-.I filename
-as an interface file, even if its extension is not .mli.
-.TP
-.BI \-intf\-suffix \ string
-Recognize file names ending with
-.I string
-as interface files (instead of the default .mli).
-.TP
-.B \-keep-docs
-Keep documentation strings in generated .cmi files.
-.TP
-.B \-keep-locs
-Keep locations in generated .cmi files.
-.TP
-.B \-labels
-Labels are not ignored in types, labels may be used in applications,
-and labelled parameters can be given in any order. This is the default.
-.TP
-.B \-linkall
-Force all modules contained in libraries to be linked in. If this
-flag is not given, unreferenced modules are not linked in. When
-building a library
-.RB ( \-a
-flag), setting the
-.B \-linkall
-flag forces all
-subsequent links of programs involving that library to link all the
-modules contained in the library.
-When compiling a module (option
-.BR \-c ),
-setting the
-.B \-linkall
-option ensures that this module will
-always be linked if it is put in a library and this library is linked.
-.TP
-.B \-linscan
-Use linear scan register allocation. Compiling with this allocator is faster
-than with the usual graph coloring allocator, sometimes quite drastically so for
-long functions and modules. On the other hand, the generated code can be a bit
-slower.
-.TP
-.B \-match\-context\-rows
-Set number of rows of context used during pattern matching
-compilation. Lower values cause faster compilation, but
-less optimized code. The default value is 32.
-.TP
-.B \-no-alias-deps
-Do not record dependencies for module aliases.
-.TP
-.B \-no\-app\-funct
-Deactivates the applicative behaviour of functors. With this option,
-each functor application generates new types in its result and
-applying the same functor twice to the same argument yields two
-incompatible structures.
-.TP
-.B \-noassert
-Do not compile assertion checks. Note that the special form
-.B assert\ false
-is always compiled because it is typed specially.
-This flag has no effect when linking already-compiled files.
-.TP
-.B \-noautolink
-When linking .cmxa libraries, ignore
-.BR \-cclib \ and \ \-ccopt
-options potentially contained in the libraries (if these options were
-given when building the libraries). This can be useful if a library
-contains incorrect specifications of C libraries or C options; in this
-case, during linking, set
-.B -noautolink
-and pass the correct C libraries and options on the command line.
-.TP
-.B \-nodynlink
-Allow the compiler to use some optimizations that are valid only for code
-that is never dynlinked.
-.TP
-.B \-no\-insn\-sched
-Disables the instruction scheduling pass in the compiler backend.
-.TP
-.B -nostdlib
-Do not automatically add the standard library directory to the list of
-directories searched for compiled interface files (.cmi), compiled
-object code files (.cmx), and libraries (.cmxa). See also option
-.BR \-I .
-.TP
-.B \-nolabels
-Ignore non-optional labels in types. Labels cannot be used in
-applications, and parameter order becomes strict.
-.TP
-.BI \-o \ exec\-file
-Specify the name of the output file produced by the linker. The
-default output name is a.out, in keeping with the Unix tradition. If the
-.B \-a
-option is given, specify the name of the library produced. If the
-.B \-pack
-option is given, specify the name of the packed object file produced.
-If the
-.B \-output\-obj
-option is given, specify the name of the output file produced. If the
-.B \-shared
-option is given, specify the name of plugin file produced.
-This can also be used when compiling an interface or implementation
-file, without linking, in which case it sets the name of the cmi or
-cmo file, and also sets the module name to the file name up to the
-first dot.
-.TP
-.B \-opaque
-When compiling a .mli interface file, this has the same effect as the
-.B \-opaque
-option of the bytecode compiler. When compiling a .ml implementation
-file, this produces a .cmx file without cross-module optimization
-information, which reduces recompilation on module change.
-.TP
-.BI \-open \ module
-Opens the given module before processing the interface or
-implementation files. If several
-.B \-open
-options are given, they are processed in order, just as if
-the statements open! module1;; ... open! moduleN;; were added
-at the top of each file.
-.TP
-.B \-output\-obj
-Cause the linker to produce a C object file instead of an executable
-file. This is useful to wrap OCaml code as a C library,
-callable from any C program. The name of the output object file
-must be set with the
-.B \-o
-option.
-This option can also be used to produce a compiled shared/dynamic
-library (.so extension).
-.B \-output\-complete\-obj
-Same as
-.B \-output\-obj
-except the object file produced includes the runtime and
-autolink libraries.
-.TP
-.TP
-.B \-pack
-Build an object file (.cmx and .o files) and its associated compiled
-interface (.cmi) that combines the .cmx object
-files given on the command line, making them appear as sub-modules of
-the output .cmx file. The name of the output .cmx file must be
-given with the
-.B \-o
-option. For instance,
-.B ocamlopt\ -pack\ -o\ P.cmx\ A.cmx\ B.cmx\ C.cmx
-generates compiled files P.cmx, P.o and P.cmi describing a
-compilation unit having three sub-modules A, B and C,
-corresponding to the contents of the object files A.cmx, B.cmx and
-C.cmx. These contents can be referenced as P.A, P.B and P.C
-in the remainder of the program.
-
-The .cmx object files being combined must have been compiled with
-the appropriate
-.B \-for\-pack
-option. In the example above,
-A.cmx, B.cmx and C.cmx must have been compiled with
-.BR ocamlopt\ \-for\-pack\ P .
-
-Multiple levels of packing can be achieved by combining
-.B \-pack
-with
-.BR \-for\-pack .
-See
-.IR "The OCaml user's manual" ,
-chapter "Native-code compilation" for more details.
-.TP
-.BI \-pp \ command
-Cause the compiler to call the given
-.I command
-as a preprocessor for each source file. The output of
-.I command
-is redirected to
-an intermediate file, which is compiled. If there are no compilation
-errors, the intermediate file is deleted afterwards.
-.TP
-.BI \-ppx \ command
-After parsing, pipe the abstract syntax tree through the preprocessor
-.IR command .
-The module
-.BR Ast_mapper (3)
-implements the external interface of a preprocessor.
-.TP
-.B \-principal
-Check information path during type-checking, to make sure that all
-types are derived in a principal way. All programs accepted in
-.B \-principal
-mode are also accepted in default mode with equivalent
-types, but different binary signatures.
-.TP
-.B \-rectypes
-Allow arbitrary recursive types during type-checking. By default,
-only recursive types where the recursion goes through an object type
-are supported. Note that once you have created an interface using this
-flag, you must use it again for all dependencies.
-.TP
-.BI \-runtime\-variant \ suffix
-Add
-.I suffix
-to the name of the runtime library that will be used by the program.
-If OCaml was configured with option
-.BR \-with\-debug\-runtime ,
-then the
-.B d
-suffix is supported and gives a debug version of the runtime.
-.TP
-.B \-S
-Keep the assembly code produced during the compilation. The assembly
-code for the source file
-.IR x .ml
-is saved in the file
-.IR x .s.
-.TP
-.BI \-stop\-after \ pass
-Stop compilation after the given compilation pass. The currently
-supported passes are:
-.BR parsing ,
-.BR typing ,
-.BR scheduling ,
-.BR emit .
-.TP
-.BI \-save\-ir\-after \ pass
-Save intermediate representation after the given compilation pass. The currently
-supported passes are:
-.BR scheduling .
-.TP
-.B \-safe\-string
-Enforce the separation between types
-.BR string \ and\ bytes ,
-thereby making strings read-only. This is the default.
-.TP
-.B \-shared
-Build a plugin (usually .cmxs) that can be dynamically loaded with
-the
-.B Dynlink
-module. The name of the plugin must be
-set with the
-.B \-o
-option. A plugin can include a number of OCaml
-modules and libraries, and extra native objects (.o, .a files).
-Building native plugins is only supported for some
-operating system. Under some systems (currently,
-only Linux AMD 64), all the OCaml code linked in a plugin must have
-been compiled without the
-.B \-nodynlink
-flag. Some constraints might also
-apply to the way the extra native objects have been compiled (under
-Linux AMD 64, they must contain only position-independent code).
-.TP
-.B \-short\-paths
-When a type is visible under several module-paths, use the shortest
-one when printing the type's name in inferred interfaces and error and
-warning messages.
-.TP
-.B \-strict\-sequence
-The left-hand part of a sequence must have type unit.
-.TP
-.B \-unboxed\-types
-When a type is unboxable (i.e. a record with a single argument or a
-concrete datatype with a single constructor of one argument) it will
-be unboxed unless annotated with
-.BR [@@ocaml.boxed] .
-.TP
-.B \-no-unboxed\-types
-When a type is unboxable it will be boxed unless annotated with
-.BR [@@ocaml.unboxed] .
-This is the default.
-.TP
-.B \-unsafe
-Turn bound checking off for array and string accesses (the
-.BR v.(i) and s.[i]
-constructs). Programs compiled with
-.B \-unsafe
-are therefore
-faster, but unsafe: anything can happen if the program accesses an
-array or string outside of its bounds. Additionally, turn off the
-check for zero divisor in integer division and modulus operations.
-With
-.BR \-unsafe ,
-an integer division (or modulus) by zero can halt the
-program or continue with an unspecified result instead of raising a
-.B Division_by_zero
-exception.
-.TP
-.B \-unsafe\-string
-Identify the types
-.BR string \ and\ bytes ,
-thereby making strings writable.
-This is intended for compatibility with old source code and should not
-be used with new software.
-.TP
-.B \-v
-Print the version number of the compiler and the location of the
-standard library directory, then exit.
-.TP
-.B \-verbose
-Print all external commands before they are executed, in particular
-invocations of the assembler, C compiler, and linker.
-.TP
-.BR \-version \ or\ \-vnum
-Print the version number of the compiler in short form (e.g. "3.11.0"),
-then exit.
-.TP
-.BI \-w \ warning\-list
-Enable, disable, or mark as fatal the warnings specified by the argument
-.IR warning\-list .
-See
-.BR ocamlc (1)
-for the syntax of
-.IR warning-list .
-.TP
-.BI \-warn\-error \ warning\-list
-Mark as fatal the warnings specified in the argument
-.IR warning\-list .
-The compiler will stop with an error when one of these
-warnings is emitted. The
-.I warning\-list
-has the same meaning as for
-the
-.B \-w
-option: a
-.B +
-sign (or an uppercase letter) marks the corresponding warnings as fatal, a
-.B \-
-sign (or a lowercase letter) turns them back into non-fatal warnings, and a
-.B @
-sign both enables and marks as fatal the corresponding warnings.
-
-Note: it is not recommended to use the
-.B \-warn\-error
-option in production code, because it will almost certainly prevent
-compiling your program with later versions of OCaml when they add new
-warnings or modify existing warnings.
-
-The default setting is
-.B \-warn\-error \-a+31
-(only warning 31 is fatal).
-.TP
-.B \-warn\-help
-Show the description of all available warning numbers.
-.TP
-.B \-where
-Print the location of the standard library, then exit.
-.TP
-.B \-with-runtime
-Include the runtime system in the generated program. This is the default.
-.TP
-.B \-without-runtime
-The compiler does not include the runtime system (nor a reference to it) in the
-generated program; it must be supplied separately.
-.TP
-.BI \- \ file
-Process
-.I file
-as a file name, even if it starts with a dash (-) character.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH OPTIONS FOR THE IA32 ARCHITECTURE
-
-The IA32 code generator (Intel Pentium, AMD Athlon) supports the
-following additional option:
-.TP
-.B \-ffast\-math
-Use the IA32 instructions to compute
-trigonometric and exponential functions, instead of calling the
-corresponding library routines. The functions affected are:
-.BR atan ,
-.BR atan2 ,
-.BR cos ,
-.BR log ,
-.BR log10 ,
-.BR sin ,
-.B sqrt
-and
-.BR tan .
-The resulting code runs faster, but the range of supported arguments
-and the precision of the result can be reduced. In particular,
-trigonometric operations
-.BR cos ,
-.BR sin ,
-.B tan
-have their range reduced to [\-2^64, 2^64].
-
-.SH OPTIONS FOR THE AMD64 ARCHITECTURE
-
-The AMD64 code generator (64-bit versions of Intel Pentium and AMD
-Athlon) supports the following additional options:
-.TP
-.B \-fPIC
-Generate position-independent machine code. This is the default.
-.TP
-.B \-fno\-PIC
-Generate position-dependent machine code.
-
-.SH OPTIONS FOR THE POWER ARCHITECTURE
-
-The PowerPC code generator supports the following additional options:
-.TP
-.B \-flarge\-toc
-Enables the PowerPC large model allowing the TOC (table of contents) to be
-arbitrarily large. This is the default since 4.11.
-.TP
-.B \-fsmall\-toc
-Enables the PowerPC small model allowing the TOC to be up to 64 kbytes per
-compilation unit. Prior to 4.11 this was the default behaviour.
-\end{options}
-
-.SH OPTIONS FOR THE ARM ARCHITECTURE
-The ARM code generator supports the following additional options:
-.TP
-.B \-farch=armv4|armv5|armv5te|armv6|armv6t2|armv7
-Select the ARM target architecture
-.TP
-.B \-ffpu=soft|vfpv2|vfpv3\-d16|vfpv3
-Select the floating-point hardware
-.TP
-.B \-fPIC
-Generate position-independent machine code.
-.TP
-.B \-fno\-PIC
-Generate position-dependent machine code. This is the default.
-.TP
-.B \-fthumb
-Enable Thumb/Thumb-2 code generation
-.TP
-.B \-fno\-thumb
-Disable Thumb/Thumb-2 code generation
-.P
-The default values for target architecture, floating-point hardware
-and thumb usage were selected at configure-time when building
-.B ocamlopt
-itself. This configuration can be inspected using
-.BR ocamlopt\ \-config .
-Target architecture depends on the "model" setting, while
-floating-point hardware and thumb support are determined from the ABI
-setting in "system" (
-.BR linux_eabi or linux_eabihf ).
-
-.SH SEE ALSO
-.BR ocamlc (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Native-code compilation".
--- /dev/null
+.so man1/ocamlopt.1
--- /dev/null
+.so man1/ocamlcp.1
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLPROF 1
+
+.SH NAME
+ocamlprof \- The OCaml profiler
+
+.SH SYNOPSIS
+.B ocamlprof
+[
+.I options
+]
+.I filename ...
+
+.SH DESCRIPTION
+The
+.B ocamlprof
+command prints execution counts gathered during the execution of a
+OCaml program instrumented with
+.BR ocamlcp (1).
+
+It produces a source listing of the program modules given as arguments
+where execution counts have been inserted as comments. For instance,
+
+.B ocamlprof foo.ml
+
+prints the source code for the foo module, with comments indicating
+how many times the functions in this module have been called. Naturally,
+this information is accurate only if the source file has not been modified
+since the profiling execution took place.
+
+.SH OPTIONS
+
+.TP
+.BI \-f \ dumpfile
+Specifies an alternate dump file of profiling information.
+.TP
+.BI \-F \ string
+Specifies an additional string to be output with profiling information.
+By default,
+.BR ocamlprof (1)
+will annotate programs with comments of the form
+.BI (* \ n \ *)
+where
+.I n
+is the counter value for a profiling point. With option
+.BI \-F \ s
+the annotation will be
+.BI (* \ sn \ *)
+.TP
+.BI \-impl \ filename
+Compile the file
+.I filename
+as an implementation file, even if its extension is not .ml.
+.TP
+.BI \-intf \ filename
+Compile the file
+.I filename
+as an interface file, even if its extension is not .mli.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.BR \-help \ or \ \-\-help
+Display a short usage summary and exit.
+
+.SH SEE ALSO
+.BR ocamlcp (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Profiling".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLPROF 1
-
-.SH NAME
-ocamlprof \- The OCaml profiler
-
-.SH SYNOPSIS
-.B ocamlprof
-[
-.I options
-]
-.I filename ...
-
-.SH DESCRIPTION
-The
-.B ocamlprof
-command prints execution counts gathered during the execution of a
-OCaml program instrumented with
-.BR ocamlcp (1).
-
-It produces a source listing of the program modules given as arguments
-where execution counts have been inserted as comments. For instance,
-
-.B ocamlprof foo.ml
-
-prints the source code for the foo module, with comments indicating
-how many times the functions in this module have been called. Naturally,
-this information is accurate only if the source file has not been modified
-since the profiling execution took place.
-
-.SH OPTIONS
-
-.TP
-.BI \-f \ dumpfile
-Specifies an alternate dump file of profiling information.
-.TP
-.BI \-F \ string
-Specifies an additional string to be output with profiling information.
-By default,
-.BR ocamlprof (1)
-will annotate programs with comments of the form
-.BI (* \ n \ *)
-where
-.I n
-is the counter value for a profiling point. With option
-.BI \-F \ s
-the annotation will be
-.BI (* \ sn \ *)
-.TP
-.BI \-impl \ filename
-Compile the file
-.I filename
-as an implementation file, even if its extension is not .ml.
-.TP
-.BI \-intf \ filename
-Compile the file
-.I filename
-as an interface file, even if its extension is not .mli.
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.BR \-help \ or \ \-\-help
-Display a short usage summary and exit.
-
-.SH SEE ALSO
-.BR ocamlcp (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Profiling".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLRUN 1
+
+.SH NAME
+ocamlrun \- The OCaml bytecode interpreter
+
+.SH SYNOPSIS
+.B ocamlrun
+[
+.I options
+]
+.I filename argument ...
+
+.SH DESCRIPTION
+The
+.BR ocamlrun (1)
+command executes bytecode files produced by the
+linking phase of the
+.BR ocamlc (1)
+command.
+
+The first non-option argument is taken to be the name of the file
+containing the executable bytecode. (That file is searched in the
+executable path as well as in the current directory.) The remaining
+arguments are passed to the OCaml program, in the string array
+.BR Sys.argv .
+Element 0 of this array is the name of the
+bytecode executable file; elements 1 to
+.I n
+are the remaining arguments.
+
+In most cases, the bytecode
+executable files produced by the
+.BR ocamlc (1)
+command are self-executable,
+and manage to launch the
+.BR ocamlrun (1)
+command on themselves automatically.
+
+.SH OPTIONS
+
+The following command-line options are recognized by
+.BR ocamlrun (1).
+.TP
+.B \-b
+When the program aborts due to an uncaught exception, print a detailed
+"back trace" of the execution, showing where the exception was
+raised and which function calls were outstanding at this point. The
+back trace is printed only if the bytecode executable contains
+debugging information, i.e. was compiled and linked with the
+.B \-g
+option to
+.BR ocamlc (1)
+set. This option is equivalent to setting the
+.B b
+flag in the OCAMLRUNPARAM environment variable (see below).
+.TP
+.BI \-I \ dir
+Search the directory
+.I dir
+for dynamically-loaded libraries, in addition to the standard search path.
+.TP
+.BI \-m \ file
+Print the magic number of the bytecode executable
+.I file
+and exit.
+.TP
+.B \-M
+Print the magic number expected for bytecode executables by this version
+of the runtime and exit.
+.TP
+.B \-p
+Print the names of the primitives known to this version of
+.BR ocamlrun (1)
+and exit.
+.TP
+.B \-t
+Increment the trace level for the debug runtime (ignored by the standard
+runtime).
+.TP
+.B \-v
+Direct the memory manager to print verbose messages on standard error.
+This is equivalent to setting
+.B v=63
+in the OCAMLRUNPARAM environment variable (see below).
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+
+.SH ENVIRONMENT VARIABLES
+
+The following environment variable are also consulted:
+.TP
+.B CAML_LD_LIBRARY_PATH
+Additional directories to search for dynamically-loaded libraries.
+.TP
+.B OCAMLLIB
+The directory containing the OCaml standard
+library. (If
+.B OCAMLLIB
+is not set,
+.B CAMLLIB
+will be used instead.) Used to locate the ld.conf configuration file for
+dynamic loading. If not set,
+default to the library directory specified when compiling OCaml.
+.TP
+.B OCAMLRUNPARAM
+Set the runtime system options and garbage collection parameters.
+(If OCAMLRUNPARAM is not set, CAMLRUNPARAM will be used instead.)
+This variable must be a sequence of parameter specifications separated
+by commas.
+A parameter specification is a letter, optionally followed by an =
+sign, a decimal number (or a hexadecimal number prefixed by
+.BR 0x ),
+and an optional multiplier. If the letter is followed by anything
+else, the corresponding option is set to 1. Unknown letters
+are ignored.
+The options are documented below; the options
+.B a, i, l, m, M, n, o, O, s, v, w
+correspond to the fields of the
+.B control
+record documented in
+.IR "The OCaml user's manual",
+chapter "Standard Library", section "Gc".
+
+.RS 7
+.TP
+.BR 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. The default is 2.
+See the Gc module documentation for details.
+.TP
+.B b
+Trigger the printing of a stack backtrace
+when an uncaught exception aborts the program.
+This option takes no argument.
+.TP
+.B c
+(cleanup_on_exit) Shut the runtime down gracefully on exit. The option
+also enables pooling (as in caml_startup_pooled). This mode can be used
+to detect leaks with a third-party memory debugger.
+.TP
+.BR h
+The initial size of the major heap (in words).
+.TP
+.BR H
+Allocate heap chunks by mmapping huge pages. Huge pages are locked into
+memory, and are not swapped.
+.TP
+.BR i \ (major_heap_increment)
+The default size increment for the major heap (in words if greater than 1000,
+else in percents of the heap size).
+.TP
+.BR l \ (stack_limit)
+The limit (in words) of the stack size.
+.TP
+.BR m \ (custom_minor_ratio)
+Bound on floating garbage for out-of-heap memory
+held by custom values in the minor heap. A minor GC is triggered
+when this much memory is held by custom values located in the minor
+heap. Expressed as a percentage of minor heap size.
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+ Default: 100.
+.TP
+.BR M \ (custom_major_ratio)
+Target ratio of floating garbage to
+major heap size for out-of-heap memory held by custom values
+located in the major heap. The GC speed is adjusted
+to try to use this much memory for dead values that are not yet
+collected. Expressed as a percentage of major heap size.
+The default value keeps the out-of-heap floating garbage about the
+same size as the in-heap overhead.
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+Default: 44.
+.TP
+.BR n \ (custom_minor_max_size)
+Maximum amount of out-of-heap
+memory for each custom value allocated in the minor heap. When a custom
+value is allocated on the minor heap and holds more than this many
+bytes, only this value is counted against
+.B custom_minor_ratio
+and the rest is directly counted against
+.BR custom_major_ratio .
+Note: this only applies to values allocated with
+.B caml_alloc_custom_mem
+(e.g. bigarrays).
+Default: 8192 bytes.
+.TP
+.BR o \ (space_overhead)
+The major GC speed setting.
+.TP
+.BR O \ (max_overhead)
+The heap compaction trigger setting.
+.TP
+.B p
+Turn on debugging support for
+.BR ocamlyacc -generated
+parsers. When this option is on,
+the pushdown automaton that executes the parsers prints a
+trace of its actions. This option takes no argument.
+.TP
+.BR R
+Turn on randomization of all hash tables by default (see the
+.B Hashtbl
+module of the standard library). This option takes no
+argument.
+.TP
+.BR s \ (minor_heap_size)
+The size of the minor heap (in words).
+.TP
+.B t
+Set the trace level for the debug runtime (ignored by the standard
+runtime).
+.TP
+.BR v \ (verbose)
+What GC messages to print to stderr. This is a sum of values selected
+from the following:
+
+.B 0x001
+Start and end of major GC cycle.
+
+.B 0x002
+Minor collection and major GC slice.
+
+.B 0x004
+Growing and shrinking of the heap.
+
+.B 0x008
+Resizing of stacks and memory manager tables.
+
+.B 0x010
+Heap compaction.
+
+.BR 0x020
+Change of GC parameters.
+
+.BR 0x040
+Computation of major GC slice size.
+
+.BR 0x080
+Calling of finalisation functions.
+
+.BR 0x100
+Startup messages (loading the bytecode executable file, resolving
+shared libraries).
+
+.BR 0x200
+Computation of compaction-triggering condition.
+
+.BR 0x400
+Output GC statistics at program exit, in the same format as Gc.print_stat.
+.TP
+.BR w \ (window_size)
+Set size of the window used by major GC for smoothing out variations in
+its workload. This is an integer between 1 and 50. (Default: 1)
+.TP
+.BR W
+Print runtime warnings to stderr (such as Channel opened on file dies without
+being closed, unflushed data, etc.)
+
+.RS 0
+The multiplier is
+.BR k ,
+.BR M ,\ or
+.BR G ,
+for multiplication by 2^10, 2^20, and 2^30 respectively.
+
+If the option letter is not recognized, the whole parameter is ignored;
+if the equal sign or the number is missing, the value is taken as 1;
+if the multiplier is not recognized, it is ignored.
+
+For example, on a 32-bit machine under bash, the command
+.B export OCAMLRUNPARAM='s=256k,v=1'
+tells a subsequent
+.B ocamlrun
+to set its initial minor heap size to 1 megabyte and to print
+a message at the start of each major GC cycle.
+.TP
+.B CAMLRUNPARAM
+If OCAMLRUNPARAM is not found in the environment, then CAMLRUNPARAM
+will be used instead. If CAMLRUNPARAM is also not found, then the default
+values will be used.
+.TP
+.B PATH
+List of directories searched to find the bytecode executable file.
+
+.SH SEE ALSO
+.BR ocamlc (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Runtime system".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLRUN 1
-
-.SH NAME
-ocamlrun \- The OCaml bytecode interpreter
-
-.SH SYNOPSIS
-.B ocamlrun
-[
-.I options
-]
-.I filename argument ...
-
-.SH DESCRIPTION
-The
-.BR ocamlrun (1)
-command executes bytecode files produced by the
-linking phase of the
-.BR ocamlc (1)
-command.
-
-The first non-option argument is taken to be the name of the file
-containing the executable bytecode. (That file is searched in the
-executable path as well as in the current directory.) The remaining
-arguments are passed to the OCaml program, in the string array
-.BR Sys.argv .
-Element 0 of this array is the name of the
-bytecode executable file; elements 1 to
-.I n
-are the remaining arguments.
-
-In most cases, the bytecode
-executable files produced by the
-.BR ocamlc (1)
-command are self-executable,
-and manage to launch the
-.BR ocamlrun (1)
-command on themselves automatically.
-
-.SH OPTIONS
-
-The following command-line options are recognized by
-.BR ocamlrun (1).
-.TP
-.B \-b
-When the program aborts due to an uncaught exception, print a detailed
-"back trace" of the execution, showing where the exception was
-raised and which function calls were outstanding at this point. The
-back trace is printed only if the bytecode executable contains
-debugging information, i.e. was compiled and linked with the
-.B \-g
-option to
-.BR ocamlc (1)
-set. This option is equivalent to setting the
-.B b
-flag in the OCAMLRUNPARAM environment variable (see below).
-.TP
-.BI \-I \ dir
-Search the directory
-.I dir
-for dynamically-loaded libraries, in addition to the standard search path.
-.TP
-.B \-p
-Print the names of the primitives known to this version of
-.BR ocamlrun (1)
-and exit.
-.TP
-.B \-v
-Direct the memory manager to print verbose messages on standard error.
-This is equivalent to setting
-.B v=63
-in the OCAMLRUNPARAM environment variable (see below).
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-
-.SH ENVIRONMENT VARIABLES
-
-The following environment variable are also consulted:
-.TP
-.B CAML_LD_LIBRARY_PATH
-Additional directories to search for dynamically-loaded libraries.
-.TP
-.B OCAMLLIB
-The directory containing the OCaml standard
-library. (If
-.B OCAMLLIB
-is not set,
-.B CAMLLIB
-will be used instead.) Used to locate the ld.conf configuration file for
-dynamic loading. If not set,
-default to the library directory specified when compiling OCaml.
-.TP
-.B OCAMLRUNPARAM
-Set the runtime system options and garbage collection parameters.
-(If OCAMLRUNPARAM is not set, CAMLRUNPARAM will be used instead.)
-This variable must be a sequence of parameter specifications separated
-by commas.
-A parameter specification is a letter, optionally followed by an =
-sign, a decimal number (or a hexadecimal number prefixed by
-.BR 0x ),
-and an optional multiplier. If the letter is followed by anything
-else, the corresponding option is set to 1. Unknown letters
-are ignored.
-The options are documented below; the
-last six correspond to the fields of the
-.B control
-record documented in
-.IR "The OCaml user's manual",
-chapter "Standard Library", section "Gc".
-\" FIXME missing: c, H, t, w, W see MPR#7870
-.TP
-.B b
-Trigger the printing of a stack backtrace
-when an uncaught exception aborts the program.
-This option takes no argument.
-.TP
-.B p
-Turn on debugging support for
-.BR ocamlyacc -generated
-parsers. When this option is on,
-the pushdown automaton that executes the parsers prints a
-trace of its actions. This option takes no argument.
-.TP
-.BR R
-Turn on randomization of all hash tables by default (see the
-.B Hashtbl
-module of the standard library). This option takes no
-argument.
-.TP
-.BR h
-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, 1 for the first-fit
-policy, and 2 for the best-fit policy. The default is 2.
-See the Gc module documentation for details.
-.TP
-.BR s \ (minor_heap_size)
-The size of the minor heap (in words).
-.TP
-.BR i \ (major_heap_increment)
-The default size increment for the major heap (in words).
-.TP
-.BR o \ (space_overhead)
-The major GC speed setting.
-.TP
-.BR O \ (max_overhead)
-The heap compaction trigger setting.
-.TP
-.BR l \ (stack_limit)
-The limit (in words) of the stack size.
-.TP
-.BR M \ (custom_major_ratio)
-Target ratio of floating garbage to
-major heap size for out-of-heap memory held by custom values
-located in the major heap. The GC speed is adjusted
-to try to use this much memory for dead values that are not yet
-collected. Expressed as a percentage of major heap size.
-The default value keeps the out-of-heap floating garbage about the
-same size as the in-heap overhead.
-Note: this only applies to values allocated with
-.B caml_alloc_custom_mem
-(e.g. bigarrays).
-Default: 44.
-.TP
-.BR m \ (custom_minor_ratio)
-Bound on floating garbage for out-of-heap memory
-held by custom values in the minor heap. A minor GC is triggered
-when this much memory is held by custom values located in the minor
-heap. Expressed as a percentage of minor heap size.
-Note: this only applies to values allocated with
-.B caml_alloc_custom_mem
-(e.g. bigarrays).
- Default: 100.
-.TP
-.BR n \ (custom_minor_max_size)
-Maximum amount of out-of-heap
-memory for each custom value allocated in the minor heap. When a custom
-value is allocated on the minor heap and holds more than this many
-bytes, only this value is counted against
-.B custom_minor_ratio
-and the rest is directly counted against
-.BR custom_major_ratio .
-Note: this only applies to values allocated with
-.B caml_alloc_custom_mem
-(e.g. bigarrays).
-Default: 8192 bytes.
-.TP
-.BR v \ (verbose)
-What GC messages to print to stderr. This is a sum of values selected
-from the following:
-
-.B 0x001
-Start and end of major GC cycle.
-
-.B 0x002
-Minor collection and major GC slice.
-
-.B 0x004
-Growing and shrinking of the heap.
-
-.B 0x008
-Resizing of stacks and memory manager tables.
-
-.B 0x010
-Heap compaction.
-
-.BR 0x020
-Change of GC parameters.
-
-.BR 0x040
-Computation of major GC slice size.
-
-.BR 0x080
-Calling of finalisation functions.
-
-.BR 0x100
-Startup messages (loading the bytecode executable file, resolving
-shared libraries).
-
-.BR 0x200
-Computation of compaction-triggering condition.
-
-.BR 0x400
-Output GC statistics at program exit, in the same format as Gc.print_stat.
-
-The multiplier is
-.BR k ,
-.BR M ,\ or
-.BR G ,
-for multiplication by 2^10, 2^20, and 2^30 respectively.
-
-If the option letter is not recognized, the whole parameter is ignored;
-if the equal sign or the number is missing, the value is taken as 1;
-if the multiplier is not recognized, it is ignored.
-
-For example, on a 32-bit machine under bash, the command
-.B export OCAMLRUNPARAM='s=256k,v=1'
-tells a subsequent
-.B ocamlrun
-to set its initial minor heap size to 1 megabyte and to print
-a message at the start of each major GC cycle.
-.TP
-.B CAMLRUNPARAM
-If OCAMLRUNPARAM is not found in the environment, then CAMLRUNPARAM
-will be used instead. If CAMLRUNPARAM is also not found, then the default
-values will be used.
-.TP
-.B PATH
-List of directories searched to find the bytecode executable file.
-
-.SH SEE ALSO
-.BR ocamlc (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Runtime system".
--- /dev/null
+.\"**************************************************************************
+.\"* *
+.\"* 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. *
+.\"* *
+.\"**************************************************************************
+.\"
+.TH OCAMLYACC 1
+
+.SH NAME
+ocamlyacc \- The OCaml parser generator
+
+.SH SYNOPSIS
+.B ocamlyacc
+[
+.BI \-b prefix
+] [
+.B \-q
+] [
+.B \-v
+] [
+.B \-version
+] [
+.B \-vnum
+]
+.I filename.mly
+
+.SH DESCRIPTION
+
+The
+.BR ocamlyacc (1)
+command produces a parser from a LALR(1) context-free grammar
+specification with attached semantic actions, in the style of
+.BR yacc (1).
+Assuming the input file is
+.IR grammar \&.mly,
+running
+.B ocamlyacc
+produces OCaml code for a parser in the file
+.IR grammar \&.ml,
+and its interface in file
+.IR grammar \&.mli.
+
+The generated module defines one parsing function per entry point in
+the grammar. These functions have the same names as the entry points.
+Parsing functions take as arguments a lexical analyzer (a function
+from lexer buffers to tokens) and a lexer buffer, and return the
+semantic attribute of the corresponding entry point. Lexical analyzer
+functions are usually generated from a lexer specification by the
+.BR ocamllex (1)
+program. Lexer buffers are an abstract data type
+implemented in the standard library module Lexing. Tokens are values from
+the concrete type token, defined in the interface file
+.IR grammar \&.mli
+produced by
+.BR ocamlyacc (1).
+
+.SH OPTIONS
+
+The
+.BR ocamlyacc (1)
+command recognizes the following options:
+.TP
+.BI \-b prefix
+Name the output files
+.IR prefix \&.ml,
+.IR prefix \&.mli,
+.IR prefix \&.output,
+instead of the default naming convention.
+.TP
+.B \-q
+This option has no effect.
+.TP
+.B \--strict
+Reject grammars with conflicts.
+.TP
+.B \-v
+Generate a description of the parsing tables and a report on conflicts
+resulting from ambiguities in the grammar. The description is put in
+file
+.IR grammar .output.
+.TP
+.B \-version
+Print version string and exit.
+.TP
+.B \-vnum
+Print short version number and exit.
+.TP
+.B \-
+Read the grammar specification from standard input. The default
+output file names are stdin.ml and stdin.mli.
+.TP
+.BI \-\- \ file
+Process
+.I file
+as the grammar specification, even if its name
+starts with a dash (-) character. This option must be the last on the
+command line.
+
+.SH SEE ALSO
+.BR ocamllex (1).
+.br
+.IR "The OCaml user's manual" ,
+chapter "Lexer and parser generators".
+++ /dev/null
-.\"**************************************************************************
-.\"* *
-.\"* 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. *
-.\"* *
-.\"**************************************************************************
-.\"
-.TH OCAMLYACC 1
-
-.SH NAME
-ocamlyacc \- The OCaml parser generator
-
-.SH SYNOPSIS
-.B ocamlyacc
-[
-.BI \-b prefix
-] [
-.B \-q
-] [
-.B \-v
-] [
-.B \-version
-] [
-.B \-vnum
-]
-.I filename.mly
-
-.SH DESCRIPTION
-
-The
-.BR ocamlyacc (1)
-command produces a parser from a LALR(1) context-free grammar
-specification with attached semantic actions, in the style of
-.BR yacc (1).
-Assuming the input file is
-.IR grammar \&.mly,
-running
-.B ocamlyacc
-produces OCaml code for a parser in the file
-.IR grammar \&.ml,
-and its interface in file
-.IR grammar \&.mli.
-
-The generated module defines one parsing function per entry point in
-the grammar. These functions have the same names as the entry points.
-Parsing functions take as arguments a lexical analyzer (a function
-from lexer buffers to tokens) and a lexer buffer, and return the
-semantic attribute of the corresponding entry point. Lexical analyzer
-functions are usually generated from a lexer specification by the
-.BR ocamllex (1)
-program. Lexer buffers are an abstract data type
-implemented in the standard library module Lexing. Tokens are values from
-the concrete type token, defined in the interface file
-.IR grammar \&.mli
-produced by
-.BR ocamlyacc (1).
-
-.SH OPTIONS
-
-The
-.BR ocamlyacc (1)
-command recognizes the following options:
-.TP
-.BI \-b prefix
-Name the output files
-.IR prefix \&.ml,
-.IR prefix \&.mli,
-.IR prefix \&.output,
-instead of the default naming convention.
-.TP
-.B \-q
-This option has no effect.
-.TP
-.B \--strict
-Reject grammars with conflicts.
-.TP
-.B \-v
-Generate a description of the parsing tables and a report on conflicts
-resulting from ambiguities in the grammar. The description is put in
-file
-.IR grammar .output.
-.TP
-.B \-version
-Print version string and exit.
-.TP
-.B \-vnum
-Print short version number and exit.
-.TP
-.B \-
-Read the grammar specification from standard input. The default
-output file names are stdin.ml and stdin.mli.
-.TP
-.BI \-\- \ file
-Process
-.I file
-as the grammar specification, even if its name
-starts with a dash (-) character. This option must be the last on the
-command line.
-
-.SH SEE ALSO
-.BR ocamllex (1).
-.br
-.IR "The OCaml user's manual" ,
-chapter "Lexer and parser generators".
1. Run `make` in the manual directory.
-NB: If you already set `LD_LIBRARY_PATH` (OS X: `DYLD_LIBRARY_PATH`)
- in your environment don't forget to append the absolute paths to
- `otherlibs/unix` and `otherlibs/str` to it.
-
Outputs
-------
-SRC = $(abspath ../..)
--include $(SRC)/Makefile.config
+ROOTDIR = ../..
+-include $(ROOTDIR)/Makefile.build_config
-export LD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
-export DYLD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
-SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_LIBRARY_PATH)
-
-TEXQUOTE = $(SRC)/runtime/ocamlrun ../tools/texquote2
+TEXQUOTE = $(ROOTDIR)/runtime/ocamlrun ../tools/texquote2
FILES = allfiles.tex biblio.tex foreword.tex version.tex cmds/warnings-help.etex ifocamldoc.tex
HTML_FLAGS = -fix -exec xxdate.exe -O
TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s
-# Copy the documentation files from SRC/api_docgen
-APIDOC=$(SRC)/api_docgen
+# Copy the documentation files from ROOTDIR/api_docgen
+APIDOC=$(ROOTDIR)/api_docgen
.PHONY: html_files
.PHONY: latex_files
ifeq ($(DOCUMENTATION_TOOL),odoc)
latex_files:
make -C $(APIDOC) latex
- cp $(APIDOC)/build/latex/*/*.tex library
+ cp $(APIDOC)/odoc/build/latex/*/*.tex library
+
html_files:
make -C $(APIDOC) html
- cp -r $(APIDOC)/build/html/* htmlman
+ cp -r $(APIDOC)/odoc/build/html/* htmlman
+
+ifocamldoc.tex: $(ROOTDIR)/Makefile.build_config
+ $(MAKE) -C $(APIDOC)/odoc build/latex/ifocamldoc.tex
+ cp $(APIDOC)/odoc/build/latex/ifocamldoc.tex $@
else
latex_files:
$(MAKE) -C $(APIDOC) latex
- cp $(APIDOC)/build/latex/*.tex library
+ cp $(APIDOC)/ocamldoc/build/latex/*.tex library
+
html_files:
$(MAKE) -C $(APIDOC) html
mkdir -p htmlman/libref
- cp -r $(APIDOC)/build/html/libref htmlman
- cp -r $(APIDOC)/build/html/compilerlibref htmlman
+ cp -r $(APIDOC)/ocamldoc/build/html/libref htmlman
+ cp -r $(APIDOC)/ocamldoc/build/html/compilerlibref htmlman
cp style.css htmlman/libref
cp style.css htmlman/compilerlibref
+
+ifocamldoc.tex: $(ROOTDIR)/Makefile.build_config
+ $(MAKE) -C $(APIDOC)/ocamldoc build/latex/ifocamldoc.tex
+ cp $(APIDOC)/ocamldoc/build/latex/ifocamldoc.tex $@
endif
manual: files latex_files
$(TEXQUOTE) < $< > $*.texquote_error.tex
mv $*.texquote_error.tex $@
-version.tex: $(SRC)/VERSION
- sed -n -e '1s/^\([0-9]*\.[0-9]*\).*$$/\\def\\ocamlversion{\1}/p' $< > $@
-
-cmds/warnings-help.etex: $(SRC)/utils/warnings.ml $(SRC)/ocamlc
+cmds/warnings-help.etex: $(ROOTDIR)/utils/warnings.ml $(ROOTDIR)/ocamlc
(echo "% This file is generated from (ocamlc -warn-help)";\
echo "% according to a rule in manual/src/Makefile.";\
echo "% In particular, the reference to documentation sections";\
echo "% are inserted through the Makefile, which should be updated";\
echo "% when a new warning is documented.";\
echo "%";\
- $(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
+ $(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -warn-help \
| LC_ALL=C sed -e 's/^ *\([0-9][0-9]*\) *\[\([a-z][a-z-]*\)\]\(.*\)/\\item[\1 "\2"] \3/' \
-e 's/^ *\([0-9A-Z][0-9]*\) *\([^]].*\)/\\item[\1] \2/'\
| sed -e 's/@/\\@/g' \
mv $@.tmp $@;\
done
-ifocamldoc.tex: $(SRC)/Makefile.config
- $(MAKE) -C $(APIDOC) build/latex/ifocamldoc.tex
- cp $(APIDOC)/build/latex/ifocamldoc.tex $@
-
.PHONY: clean
clean:
- rm -f $(FILES) *.texquote_error
+ rm -f $(filter-out version.tex,$(FILES)) *.texquote_error
$(MAKE) -C cmds clean
$(MAKE) -C library clean
$(MAKE) -C refman clean
.PHONY: distclean
distclean: clean
+ rm -f version.tex
$(MAKE) -C html_processing distclean
\input{flambda.tex}
\input{afl-fuzz.tex}
\input{instrumented-runtime.tex}
+\input{tail-mod-cons.tex}
\part{The OCaml library}
\label{p:library}
ROOTDIR = ../../..
include $(ROOTDIR)/Makefile.common
-LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+LD_PATH = $(ROOTDIR)/otherlibs/str $(ROOTDIR)/otherlibs/unix
TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
- -repo-root $(ROOTDIR) -n 80 -v false
+CAMLLATEX = $(OCAMLRUN) $(addprefix -I ,$(LD_PATH)) \
+ $(ROOTDIR)/tools/caml-tex -repo-root $(ROOTDIR) -n 80 -v false
TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+TRANSF = $(OCAMLRUN) $(TOOLS)/transf
FILES = comp.tex top.tex runtime.tex native.tex lexyacc.tex intf-c.tex \
ocamldep.tex profil.tex debugger.tex ocamldoc.tex \
- warnings-help.tex flambda.tex \
+ warnings-help.tex flambda.tex tail-mod-cons.tex \
afl-fuzz.tex instrumented-runtime.tex unified-options.tex
etex-files: $(FILES)
OCaml have been compiled with the "/MD" flag, and therefore
all other object files linked with it should also be compiled with
"/MD".
-\item other systems: you may have to add one or more of "-lcurses",
-"-lm", "-ldl", depending on your OS and C compiler.
+\item other systems: you may have to add one or both of
+"-lm" and "-ldl", depending on your OS and C compiler.
\end{itemize}
\paragraph{Stack backtraces.} When OCaml bytecode produced by
shared library and reinitializing its static data. Therefore, at the moment, the
facility is only useful for building reloadable shared libraries.
+\paragraph{Unix signal handling.} Depending on the target platform and
+operating system, the native-code runtime system may install signal
+handlers for one or several of the "SIGSEGV", "SIGTRAP" and "SIGFPE"
+signals when "caml_startup" is called, and reset these signals to
+their default behaviors when "caml_shutdown" is called. The main
+program written in~C should not try to handle these signals itself.
\section{s:c-advexample}{Advanced example with callbacks}
"caml_alloc_custom" except that the "max" parameter is under the
control of the user (via the "custom_major_ratio",
"custom_minor_ratio", and "custom_minor_max_size" parameters) and
-proportional to the heap sizes.
+proportional to the heap sizes. It has been available since OCaml 4.08.0.
\subsection{ss:c-custom-access}{Accessing custom blocks}
\entree{"CAML_BA_INT64"}{64-bit signed integers}
\entree{"CAML_BA_CAML_INT"}{31- or 63-bit signed integers}
\entree{"CAML_BA_NATIVE_INT"}{32- or 64-bit (platform-native) integers}
+\entree{"CAML_BA_COMPLEX32"}{32-bit single-precision complex numbers}
+\entree{"CAML_BA_COMPLEX64"}{64-bit double-precision complex numbers}
+\entree{"CAML_BA_CHAR"}{8-bit characters}
\end{tableau}
%
\paragraph{Warning:}
in \ref{sss:ocamldoc-target-specific-syntax}) \\
@||@&@ '{!' string '}' @ & insert a cross-reference to an element
(see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\
+@||@&@ '{{!' string '}' inline-text '}' @ & insert a cross-reference with the given text. \\
@||@&@ '{!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
Print the magic number of the bytecode executable given as argument
and exit.
\item["-M"]
-Print the magic number expected by this version of the runtime and exit.
+Print the magic number expected for bytecode executables by this version
+of the runtime and exit.
\item["-p"]
Print the names of the primitives known to this version of
"ocamlrun" and exit.
A parameter specification is an option letter followed by an "="
sign, a decimal number (or an hexadecimal number prefixed by "0x"),
and an optional multiplier. The options are documented below;
- the last six correspond to the fields of the
- "control" record documented in
+ the options "a, i, l, m, M, n, o, O, s, v, w" correspond to
+ the fields of the "control" record documented in
\ifouthtml
\ahref{libref/Gc.html}{Module \texttt{Gc}}.
\else
section~\ref{Gc}.
\fi
\begin{options}
+ \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. The default is "2" (best-fit).
+ See the Gc module documentation for details.
\item[b] (backtrace) Trigger the printing of a stack backtrace
when an uncaught exception aborts the program. An optional argument can
be provided: "b=0" turns backtrace printing off; "b=1" is equivalent to
startup time instead of at backtrace printing time. "b=2" can be used if
the runtime is unable to load debugging information at backtrace
printing time, for example if there are no file descriptors available.
+ \item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see
+ "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.
+ \item[h] The initial size of the major heap (in words).
+ \item[H] Allocate heap chunks by mmapping huge pages. Huge pages are locked into
+ memory, and are not swapped.
+ \item[i] ("major_heap_increment") Default size increment for the
+ major heap. (in words if greater than 1000, else in percents of the
+ head size)
+ \item[l] ("stack_limit") The limit (in words) of the stack size. This is only
+ relevant to the byte-code runtime, as the native code runtime uses the
+ operating system's stack.
+ \item[m] ("custom_minor_ratio") Bound on floating garbage for
+ out-of-heap memory
+ held by custom values in the minor heap. A minor GC is triggered
+ when this much memory is held by custom values located in the minor
+ heap. Expressed as a percentage of minor heap size. Default:
+ 100. Note: this only applies to values allocated with
+ "caml_alloc_custom_mem".
+ \item[M] ("custom_major_ratio") Target ratio of floating garbage to
+ major heap size for out-of-heap memory held by custom values
+ (e.g. bigarrays) located in the major heap. The GC speed is adjusted
+ to try to use this much memory for dead values that are not yet
+ collected. Expressed as a percentage of major heap size. Default:
+ 44. Note: this only applies to values allocated with
+ "caml_alloc_custom_mem".
+ \item[n] ("custom_minor_max_size") Maximum amount of out-of-heap
+ memory for each custom value allocated in the minor heap. When a custom
+ value is allocated on the minor heap and holds more than this many
+ bytes, only this value is counted against "custom_minor_ratio" and
+ the rest is directly counted against "custom_major_ratio".
+ Default: 8192 bytes. Note:
+ this only applies to values allocated with "caml_alloc_custom_mem".
+ \end{options}
+ The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
+ $2^{20}$, and $2^{30}$ respectively.
+ \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[p] (parser trace) Turn on debugging support for
"ocamlyacc"-generated parsers. When this option is on,
the pushdown automaton that executes the parsers prints a
section~\ref{Hashtbl}).
\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, "1" for the first-fit
- policy, and "2" for the best-fit policy. The default is "2" (best-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. This is only
- relevant to the byte-code runtime, as the native code runtime uses the
- operating system's stack.
+ \item[t] Set the trace level for the debug runtime (ignored by the standard runtime).
\item[v] ("verbose") What GC messages to print to stderr. This
is a sum of values selected from the following:
\begin{options}
\item[512 (= 0x200)] Computation of compaction-triggering condition.
\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{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
- \item[M] ("custom_major_ratio") Target ratio of floating garbage to
- major heap size for out-of-heap memory held by custom values
- (e.g. bigarrays) located in the major heap. The GC speed is adjusted
- to try to use this much memory for dead values that are not yet
- collected. Expressed as a percentage of major heap size. Default:
- 44. Note: this only applies to values allocated with
- "caml_alloc_custom_mem".
- \item[m] ("custom_minor_ratio") Bound on floating garbage for
- out-of-heap memory
- held by custom values in the minor heap. A minor GC is triggered
- when this much memory is held by custom values located in the minor
- heap. Expressed as a percentage of minor heap size. Default:
- 100. Note: this only applies to values allocated with
- "caml_alloc_custom_mem".
- \item[n] ("custom_minor_max_size") Maximum amount of out-of-heap
- memory for each custom value allocated in the minor heap. When a custom
- value is allocated on the minor heap and holds more than this many
- bytes, only this value is counted against "custom_minor_ratio" and
- the rest is directly counted against "custom_major_ratio".
- Default: 8192 bytes. Note:
- this only applies to values allocated with "caml_alloc_custom_mem".
- \end{options}
- The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
- $2^{20}$, and $2^{30}$ respectively.
+ \item[w] ("window_size") Set the size of the window used by major GC for smoothing out
+ variations in its workload. This is an integer between 1 and 50.
+ (Default: 1)
+ \item[W] Print runtime warnings to stderr (such as Channel opened on file
+ dies without being closed, unflushed data, etc.)
If the option letter is not recognized, the whole parameter is ignored;
if the equal sign or the number is missing, the value is taken as 1;
--- /dev/null
+\chapter{The ``Tail Modulo Constructor'' program transformation} \label{c:tail_mod_cons}
+%HEVEA\cutname{tail_mod_cons.html}
+
+(Introduced in OCaml 4.14)
+
+Note: this feature is considered experimental, and its interface may
+evolve, with user feedback, in the next few releases of the language.
+
+Consider this natural implementation of the "List.map" function:
+\begin{caml_example*}{verbatim}
+let rec map f l =
+ match l with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ y :: map f xs
+\end{caml_example*}
+
+A well-known limitation of this implementation is that the recursive
+call, "map f xs", is not in \emph{tail} position. The runtime needs to
+remember to continue with "y :: r" after the call returns a value "r",
+therefore this function consumes some amount of call-stack space on
+each recursive call. The stack usage of "map f li" is proportional to
+the length of "li". This is a correctness issue for large lists on
+operating systems with limited stack space -- the dreaded
+"Stack_overflow" exception.
+
+\begin{caml_example}{toplevel}
+List.length (map Fun.id (List.init 1_000_000 Fun.id));;
+\end{caml_example}
+
+In this implementation of "map", the recursive call happens in
+a position that is not a \emph{tail} position in the program, but
+within a datatype constructor application that is itself in
+\emph{tail} position. We say that those positions, that are composed
+of tail positions and constructor applications, are \emph{tail modulo
+ constructor} (TMC) positions -- we sometimes write \emph{tail modulo
+ cons} for brevity.
+
+It is possible to rewrite programs such that tail modulo cons
+positions become tail positions; after this transformation, the
+implementation of "map" above becomes \emph{tail-recursive}, in the
+sense that it only consumes a constant amount of stack space. The
+OCaml compiler implements this transformation on demand, using the
+"[\@tail_mod_cons]" or "[\@ocaml.tail_mod_cons]" attribute on the
+function to transform.
+
+\begin{caml_example*}{verbatim}
+let[@tail_mod_cons] rec map f l =
+ match l with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ y :: map f xs
+\end{caml_example*}
+
+\begin{caml_example}{toplevel}
+List.length (map Fun.id (List.init 1_000_000 Fun.id));;
+\end{caml_example}
+
+This transformation only improves calls in tail-modulo-cons position,
+it does not improve recursive calls that do not fit in this fragment:
+\begin{caml_example*}{verbatim}[warning=71]
+(* does *not* work: addition is not a data constructor *)
+let[@tail_mod_cons] rec length l =
+ match l with
+ | [] -> 0
+ | _ :: xs -> 1 + length xs
+\end{caml_example*}
+
+It is of course possible to use the "[\@tail_mod_cons]" transformation
+on functions that contain some recursive calls in tail-modulo-cons
+position, and some calls in other, arbitrary positions. Only the tail
+calls and tail-modulo-cons calls will happen in constant stack space.
+
+\paragraph{General design} This feature is provided as an explicit
+program transformation, not an implicit optimization. It is
+annotation-driven: the user is expected to express their intent by
+adding annotations in the program using attributes, and will be asked
+to do so in any ambiguous situation.
+
+We expect it to be used mostly by advanced OCaml users needing to get
+some guarantees on the stack-consumption behavior of their
+programs. Our recommendation is to use the "[\@tailcall]" annotation on
+all callsites that should not consume any stack
+space. "[\@tail_mod_cons]" extends the set of functions on which calls
+can be annotated to be tail calls, helping establish stack-consumption
+guarantees in more cases.
+
+\paragraph{Performance} A standard approach to get a tail-recursive
+version of "List.map" is to use an accumulator to collect output
+elements, and reverse it at the end of the traversal.
+
+\begin{caml_example*}{verbatim}
+let rec map f l = map_aux f [] l
+and map_aux f acc l =
+ match l with
+ | [] -> List.rev acc
+ | x :: xs ->
+ let y = f x in
+ map_aux f (y :: acc) xs
+\end{caml_example*}
+
+This version is tail-recursive, but it is measurably slower than the
+simple, non-tail-recursive version. In contrast, the tail-mod-cons
+transformation provides an implementation that has comparable
+performance to the original version, even on small inputs.
+
+\paragraph{Evaluation order} Beware that the tail-modulo-cons
+transformation has an effect on evaluation order: the constructor
+argument that is transformed into tail-position will always be
+evaluated last. Consider the following example:
+
+\begin{caml_example*}{verbatim}
+type 'a two_headed_list =
+ | Nil
+ | Consnoc of 'a * 'a two_headed_list * 'a
+
+let[@tail_mod_cons] rec map f = function
+ | Nil -> Nil
+ | Consnoc (front, body, rear) ->
+ Consnoc (f front, map f body, f rear)
+\end{caml_example*}
+
+Due to the "[\@tail_mod_cons]" transformation, the calls to "f front"
+and "f rear" will be evaluated before "map f body". In particular,
+this is likely to be different from the evaluation order of the
+unannotated version. (The evaluation order of constructor arguments
+is unspecified in OCaml, but many implementations typically use
+left-to-right or right-to-left.)
+
+This effect on evaluation order is one of the reasons why the
+tail-modulo-cons transformation has to be explicitly requested by the
+user, instead of being applied as an automatic optimization.
+
+\paragraph{Why tail-modulo-cons?} Other program transformations, in
+particular a transformation to continuation-passing style (CPS), can
+make all functions tail-recursive, instead of targeting only a small
+fragment. Some reasons to provide builtin support for the less-general
+tail-mod-cons are as follows:
+\begin{itemize}
+\item The tail-mod-cons transformation preserves the performance of
+ the original, non-tail-recursive version, while
+ a continuation-passing-style transformation incurs a measurable
+ constant-factor overhead.
+\item The tail-mod-cons transformation cannot be expressed as
+ a source-to-source transformation of OCaml programs, as it relies on
+ mutable state in type-unsafe ways. In contrast,
+ continuation-passing-style versions can be written by hand, possibly
+ using a convenient monadic notation.
+\end{itemize}
+
+\section{sec:disambiguation}{Disambiguation}
+
+It may happen that several arguments of a constructor are recursive
+calls to a tail-modulo-cons function. The transformation can only turn
+one of these calls into a tail call. The compiler will not make an
+implicit choice, but ask the user to provide an explicit
+disambiguation.
+
+Consider this type of syntactic expressions (assuming some
+pre-existing type "var" of expression variables):
+\begin{caml_example*}{verbatim}
+type var (* some pre-existing type of variables *)
+
+type exp =
+ | Var of var
+ | Let of binding * exp
+and binding = var * exp
+\end{caml_example*}
+
+Consider a "map" function on variables. The direct definition has two
+recursive calls inside arguments of the "Let" constructor, so it gets
+rejected as ambiguous.
+\begin{caml_example*}{verbatim}[error]
+let[@tail_mod_cons] rec map_vars f exp =
+ match exp with
+ | Var v -> Var (f v)
+ | Let ((v, def), body) ->
+ Let ((f v, map_vars f def), map_vars f body)
+\end{caml_example*}
+
+To disambiguate, the user should add a "[\@tailcall]" attribute to the
+recursive call that should be transformed to tail position:
+\begin{caml_example*}{verbatim}
+let[@tail_mod_cons] rec map_vars f exp =
+ match exp with
+ | Var v -> Var (f v)
+ | Let ((v, def), body) ->
+ Let ((f v, map_vars f def), (map_vars[@tailcall]) f body)
+\end{caml_example*}
+Be aware that the resulting function is \emph{not} tail-recursive, the
+recursive call on "def" will consume stack space. However, expression
+trees tend to be right-leaning (lots of "Let" in sequence,
+rather than nested inside each other), so putting the call on "body"
+in tail position is an interesting improvement over the naive
+definition: it gives bounded stack space consumption if we assume
+a bound on the nesting depth of "Let" constructs.
+
+One would also get an error when using conflicting annotations, asking
+for two of the constructor arguments to be put in tail position:
+\begin{caml_example*}{verbatim}[error]
+let[@tail_mod_cons] rec map_vars f exp =
+ match exp with
+ | Var v -> Var (f v)
+ | Let ((v, def), body) ->
+ Let ((f v, (map_vars[@tailcall]) f def), (map_vars[@tailcall]) f body)
+\end{caml_example*}
+
+\section{sec:out-of-tmc}{Danger: getting out of tail-mod-cons}
+
+Due to the nature of the tail-mod-cons transformation
+(see Section~\ref{sec:details} for a presentation of transformation):
+\begin{itemize}
+\item Calls from a tail-mod-cons function to another tail-mod-cons
+ function declared in the same recursive-binding group are
+ transformed into tail calls, as soon as they occur in tail position
+ or tail-modulo-cons position in the source function.
+\item Calls from a function \emph{not} annotated tail-mod-cons to
+ a tail-mod-cons function or, conversely, from a tail-mod-cons
+ function to a non-tail-mod-cons function are transformed into
+ \emph{non}-tail calls, even if they syntactically appear in tail
+ position in the source program.
+\end{itemize}
+
+The fact that calls in tail position in the source program may become
+non-tail calls if they go from a tail-mod-cons to a non-tail-mod-cons
+function is surprising, and the transformation will warn about them.
+
+For example:
+\begin{caml_example*}{verbatim}[warning=71]
+let[@tail_mod_cons] rec flatten = function
+| [] -> []
+| xs :: xss ->
+ let rec append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs -> x :: append_flatten xs xss
+ in append_flatten xs xss
+\end{caml_example*}
+Here the "append_flatten" helper is not annotated with
+"[\@tail_mod_cons]", so the calls "append_flatten xs xss" and "flatten
+xss" will \emph{not} be tail calls. The correct fix here is to annotate
+"append_flatten" to be tail-mod-cons.
+
+\begin{caml_example*}{verbatim}
+let[@tail_mod_cons] rec flatten = function
+| [] -> []
+| xs :: xss ->
+ let[@tail_mod_cons] rec append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs -> x :: append_flatten xs xss
+ in append_flatten xs xss
+\end{caml_example*}
+
+The same warning occurs when "append_flatten" is a non-tail-mod-cons
+function of the same recursive group; using the tail-mod-cons
+transformation is a property of individual functions, not whole
+recursive groups.
+\begin{caml_example*}{verbatim}[warning=71]
+let[@tail_mod_cons] rec flatten = function
+| [] -> []
+| xs :: xss -> append_flatten xs xss
+
+and append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs -> x :: append_flatten xs xss
+\end{caml_example*}
+
+Again, the fix is to specialize "append_flatten" as well:
+\begin{caml_example*}{verbatim}
+let[@tail_mod_cons] rec flatten = function
+| [] -> []
+| xs :: xss -> append_flatten xs xss
+
+and[@tail_mod_cons] append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs -> x :: append_flatten xs xss
+\end{caml_example*}
+
+Non-recursive functions can also be annotated "[\@tail_mod_cons]"; this is
+typically useful for local bindings to recursive functions.
+
+Incorrect version:
+\begin{caml_example*}{verbatim}[warning=51,warning=71]
+let[@tail_mod_cons] rec map_vars f exp =
+ let self exp = map_vars f exp in
+ match exp with
+ | Var v -> Var (f v)
+ | Let ((v, def), body) ->
+ Let ((f v, self def), (self[@tailcall]) body)
+\end{caml_example*}
+
+Recommended fix:
+\begin{caml_example*}{verbatim}
+let[@tail_mod_cons] rec map_vars f exp =
+ let[@tail_mod_cons] self exp = map_vars f exp in
+ match exp with
+ | Var v -> Var (f v)
+ | Let ((v, def), body) ->
+ Let ((f v, self def), (self[@tailcall]) body)
+\end{caml_example*}
+
+In other cases, there is either no benefit in making the called function
+tail-mod-cons, or it is not possible: for example, it is a function
+parameter (the transformation only works with direct calls to
+known functions).
+
+For example, consider a substitution function on binary trees:
+\begin{caml_example*}{verbatim}[warning=72]
+type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
+
+let[@tail_mod_cons] rec bind (f : 'a -> 'a tree) (t : 'a tree) : 'a tree =
+ match t with
+ | Leaf v -> f v
+ | Node (left, right) ->
+ Node (bind f left, (bind[@tailcall]) f right)
+\end{caml_example*}
+
+Here "f" is a function parameter, not a direct call, and the current
+implementation is strictly first-order, it does not support
+tail-mod-cons arguments. In this case, the user should indicate that
+they realize this call to "f v" is not, in fact, in tail position, by
+using "(f[\@tailcall false]) v".
+
+\begin{caml_example*}{verbatim}
+type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
+
+let[@tail_mod_cons] rec bind (f : 'a -> 'a tree) (t : 'a tree) : 'a tree =
+ match t with
+ | Leaf v -> (f[@tailcall false]) v
+ | Node (left, right) ->
+ Node (bind f left, (bind[@tailcall]) f right)
+\end{caml_example*}
+
+\section{sec:details}{Details on the transformation}
+
+To use this advanced feature, it helps to be aware that the function transformation produces a specialized function in destination-passing-style.
+
+Recall our "map" example:
+\begin{caml_example*}{verbatim}
+let rec map f l =
+ match l with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ y :: map f xs
+\end{caml_example*}
+
+Below is a description of the transformed program in pseudo-OCaml
+notation: some operations are not expressible in OCaml source code.
+(The transformation in fact happens on the Lambda intermediate
+representation of the OCaml compiler.)
+
+\begin{verbatim}
+let rec map f l =
+ match l with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ let dst = y ::{mutable} Hole in
+ map_dps f xs dst 1;
+ dst
+
+and map_dps f l dst idx =
+ match l with
+ | [] -> dst.idx <- []
+ | x :: xs ->
+ let y = f x in
+ let dst' = y ::{mutable} Hole in
+ dst.idx <- dst';
+ map_dps f xs dst' 1
+\end{verbatim}
+
+The source version of "map" gets transformed into two functions,
+a \emph{direct-style} version that is also called "map", and
+a \emph{destination-passing-style} version (DPS) called "map_dps". The
+destination-passing-style version does not return a result directly,
+instead it writes it into a memory location specified by two
+additional function parameters, "dst" (a memory block) and "i"
+(a position within the memory block).
+
+The source call "y :: map f xs" gets transformed into the creation of
+a mutable block "y ::{mutable} Hole", whose second parameter is an
+un-initialized \emph{hole}. The block is then passed to "map_dps" as
+a destination parameter (with offset "1").
+
+Notice that "map" does not call itself recursively, it calls
+"map_dps". Then, "map_dps" calls itself recursively, in
+a tail-recursive way.
+
+The call from "map" to "map_dps" is \emph{not} a tail call (this is
+something that we could improve in the future); but this call happens
+only once when invoking "map f l", with all list elements after the
+first one processed in constant stack by "map_dps".
+
+This explains the ``getting out of tail-mod-cons''
+subtleties. Consider our previous example involving mutual recursion
+between "flatten" and "append_flatten".
+\begin{verbatim}
+let[@tail_mod_cons] rec flatten l =
+ match l with
+ | [] -> []
+ | xs :: xss ->
+ append_flatten xs xss
+\end{verbatim}
+
+The call to "append_flatten", which syntactically appears in tail
+position, gets transformed differently depending on whether the
+function has a destination-passing-style version available, that is,
+whether it is itself annotated "[\@tail_mod_cons]":
+\begin{verbatim}
+(* if append_flatten_dps exists *)
+and flatten_dps l dst i =
+ match l with
+ | [] -> dst.i <- []
+ | xs :: xss ->
+ append_flatten_dps xs xss dst i
+
+(* if append_flatten_dps does not exist *)
+and rec flatten_dps l dst i =
+ match l with
+ | [] -> dst.i <- []
+ | xs :: xss ->
+ dst.i <- append_flatten xs xss
+\end{verbatim}
+If "append_flatten" does not have a destination-passing-style version,
+the call gets transformed to a non-tail call.
+
+\section{sec:limitations}{Current limitations}
+
+\paragraph{Purely syntactic criterion} Just like tail calls in
+general, the notion of tail-modulo-constructor position is purely
+syntactic; some simple refactoring will move calls out of
+tail-modulo-constructor position.
+
+\begin{caml_example*}{verbatim}
+(* works as expected *)
+let[@tail_mod_cons] rec map f li =
+ match li with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ y ::
+ (* this call is in TMC position *)
+ map f xs
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}[warning=71]
+(* not optimizable anymore *)
+let[@tail_mod_cons] rec map f li =
+ match li with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ let ys =
+ (* this call is not in TMC position anymore *)
+ map f xs in
+ y :: ys
+\end{caml_example*}
+
+\paragraph{Local, first-order transformation} When a function gets
+transformed with tail-mod-cons, two definitions are generated, one
+providing a direct-style interface and one providing the
+destination-passing-style version. However, not all calls to this
+function in tail-modulo-cons position will use the
+destination-passing-style version and become tail calls:
+\begin{itemize}
+\item The transformation is local: only tail-mod-cons calls to "foo"
+ within the same compilation unit as "foo" become tail calls.
+\item The transformation is first-order: only direct calls to
+ known tail-mod-cons functions become tail calls when in
+ tail-mod-cons position, never calls to function parameters.
+\end{itemize}
+
+Consider the call "Option.map foo x" for example: even if "foo" is
+called in tail-mod-cons position within the definition of
+"Option.map", that call will never become a tail call. (This would be the
+case even if the call to "Option.map" was inside the "Option"
+module.)
+
+In general this limitation is not a problem for recursive functions:
+the first call from an outside module or a higher-order function will
+consume stack space, but further recursive calls in tail-mod-cons
+position will get optimized. For example, if "List.map" is defined as
+a tail-mod-cons function, calls from outside the "List" module will
+not become tail calls when in tail positions, but the recursive calls
+within the definition of "List.map" are in tail-modulo-cons positions
+and do become tail calls: processing the first element of the list
+will consume stack space, but all further elements are handled in
+constant space.
+
+These limitations may be an issue in more complex situations where
+mutual recursion happens between functions, with some functions not
+annotated tail-mod-cons, or defined across different modules, or called
+indirectly, for example through function parameters.
+
+\paragraph{Non-exact calls to tupled functions} OCaml performs an
+implicit optimization for ``tupled'' functions, which take a single
+parameter that is a tuple: "let f (x, y, z) = ...". Direct calls to
+these functions with a tuple literal argument (like "f (a, b, c)") will
+call the ``tupled'' function by passing the parameters directly, instead
+of building a tuple of them. Other calls, either indirect calls or calls
+passing a more complex tuple value (like "let t = (a, b, c) in f t") are
+compiled as ``inexact'' calls that go through a wrapper.
+
+The "[\@tail_mod_cons]" transformation supports tupled functions, but
+will only optimize ``exact'' calls in tail position; direct calls to
+something other than a tuple literal will not become tail calls. The
+user can manually unpack a tuple to force a call to be ``exact'': "let
+(x, y, z) = t in f (x, y, z)". If there is any doubt as to whether a call
+can be tail-mod-cons-optimized or not, one can use the "[\@tailcall]"
+attribute on the called function, which will warn if the
+transformation is not possible.
+
+\begin{caml_example*}{verbatim}[warning=51]
+let rec map (f, l) =
+ match l with
+ | [] -> []
+ | x :: xs ->
+ let y = f x in
+ let args = (f, xs) in
+ (* this inexact call cannot be tail-optimized, so a warning will be raised *)
+ y :: (map[@tailcall]) args
+\end{caml_example*}
\notop{%
\item["-ccopt" \var{option}]
Pass the given option to the C compiler and linker.
-\comp{When linking in ``custom runtime'' mode, for instance}%
-\nat{For instance,}%
+\comp{When linking in ``custom runtime'' mode, for instance }%
+\nat{For instance, }%
"-ccopt -L"\var{dir} causes the C linker to search for C libraries in
-directory \var{dir}.\comp{(See the "-custom" option.)}
+directory \var{dir}. \comp{(See the "-custom" option.)}
}%notop
\notop{%
\item["always"] enable colors unconditionally;
\item["never"] disable color output.
\end{description}
-The default setting is 'auto', and the current heuristic
-checks that the "TERM" environment variable exists and is
-not empty or "dumb", and that 'isatty(stderr)' holds.
The environment variable "OCAML_COLOR" is considered if "-color" is not
provided. Its values are auto/always/never as above.
+
+If "-color" is not provided, "OCAML_COLOR" is not set and the environment
+variable "NO_COLOR" is set, then color output is disabled. Otherwise,
+the default setting is 'auto', and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that 'isatty(stderr)' holds.
}%notop
\notop{%
.PHONY: distclean
distclean:: clean
+distclean::
+ rm -f src/common.ml
+
distclean::
rm -rf .sass-cache
}
document.getElementById("search_results").innerHTML = html;
}
+
+function showHelp () {
+ document.getElementById("search_help").classList.toggle("hide");
+}
}
}
-/* Print adjustements. */
+/* Print adjustments. */
/* This page can be nicely printed or saved to PDF (local version) */
@media print {
margin-left:-1em
}
-@mixin disc {
- content:"●";
- color:$logocolor;
- margin-right:4px;
- margin-left:-1em;
- font-family: $font-sans;
- font-size:13px;
- vertical-align:1px;
+@mixin colored-disc-marker {
+ list-style-type: disc;
+ li::marker { color:$logocolor; }
}
@mixin diamond {
}
}
ul{list-style:none;}
- ul.itemize li::before{@include disc;}
+ ul.itemize {@include colored-disc-marker;}
/* When the TOC is repeated in the main content */
ul.ul-content {
ul{
list-style: none;
li {
- margin-left: 0.5ex;
span {
color:#c88b5f;
}
}
}
/* only for Contents/Foreword in index.html: */
- ul.ul-content li::before{
- @include disc;
- margin-left: 0;
+ ul.ul-content {
+ @include colored-disc-marker;
}
/* table of contents: (manual.001.html): */
ul.toc ul.toc ul.toc{
}
:target{
background-color:rgba(255,215,181,.3)!important;
- box-shadow:0 0 0 1px rgba(255,215,181,.8)!important;
- border-radius:1px
+ box-shadow: inset 0 0 0 1px rgba(255,215,181,.8)!important;
}
:hover>a.section-anchor{
visibility:visible
/* content:"#"; */ /* pre-4.11 */
color:#888
}
-span.number{
- padding-right: 1ex;
+span.number, span.chapter-number {
+ padding-right: 0.5ex;
+}
+ul li .number {
+ width: 3.5ch;
+ display: inline-block;
+ text-align: right;
+}
+#sidebar .number {
+ width: 2.5ch;
}
span.syntax-token {
font-family: $font-mono;
vertical-align: bottom;
}
- .search_comment .search_help {
+ .search_comment .hide {
height: 0;
- opacity: 0;
- font-size: 10px;
- overflow: hidden;
- transition: all 0.5s;
- ul {
- margin-top: 0;
- }
+ visibility : hidden;
+ opacity: 0
}
- .search_comment:hover .search_help {
- height: auto;
- margin-top:-1px;
- opacity: 0.8;
+ .search_comment #search_help {
+ overflow: hidden;
+ font-size: smaller;
background: linear-gradient(to bottom, white 0%, rgb(237, 232, 229) 100%);
transition: all 0.5s;
}
- .search_comment .search_help:hover {
- font-size: 14px;
+ #help_icon {
+ margin-left: 1ex;
+ vertical-align: inherit;
+ cursor: help;
}
+++ /dev/null
-(* ------------ Ocaml Web-manual -------------- *)
-
-(* Copyright San Vu Ngoc, 2020
-
- file: common.ml
-
- This file contains functions that are used by process_api.ml and
- process_manual.ml *)
-
-open Soup
-open Printf
-
-let debug = not (Array.mem "quiet" Sys.argv)
-
-let dbg =
- let printf = Printf.(if debug then kfprintf else ikfprintf) in
- let flush =
- if debug then
- fun ch -> output_char ch '\n'; flush ch
- else
- ignore
- in
- fun fmt -> printf flush stdout fmt
-
-let ( // ) = Filename.concat
-
-let process_dir = Filename.current_dir_name
-
-(* Output directory *)
-let web_dir = Filename.parent_dir_name // "webman"
-
-(* Output for manual *)
-let docs_maindir = web_dir // "manual"
-let docs_file = ( // ) docs_maindir
-
-(* Ouput for API *)
-let api_dir = web_dir // "api"
-
-(* How to go from manual to api *)
-let api_page_url = "../api"
-
-(* How to go from api to manual *)
- let manual_page_url = "../manual"
-
-(* Set this to the directory where to find the html sources of all versions: *)
-let html_maindir = "../htmlman"
-
-(* Where to get the original html files *)
-let html_file = ( // ) html_maindir
-
-let releases_url = "https://ocaml.org/releases/"
-
-let favicon = "favicon.ico"
-
-(**** utilities ****)
-
-let flat_option f o = Option.bind o f
-
-let (<<) f g x = f (g x)
-
-let string_of_opt = Option.value ~default:""
-
-let starts_with substring s =
- let l = String.length substring in
- l <= String.length s &&
- String.sub s 0 l = substring
-
-(**** html processing ****)
-
-(* Return next html element. *)
-let rec next node =
- match next_element node with
- | Some n -> n
- | None -> match parent node with
- | Some p -> next p
- | None -> raise Not_found
-
-let logo_html url =
- "<nav class=\"toc brand\"><a class=\"brand\" href=\"" ^ url ^
- "\" ><img src=\"colour-logo.svg\" class=\"svg\" alt=\"OCaml\" /></a></nav>"
- |> parse
-
-let wrap_body ~classes soup =
- let body = soup $ "body" in
- set_name "div" body;
- List.iter (fun c -> add_class c body) classes;
- wrap body (create_element "body");
- body
-
-(* Add favicon *)
-let add_favicon head =
- parse ({|<link rel="shortcut icon" type="image/x-icon" href="|} ^
- favicon ^ {|">|})
- |> append_child head
-
-(* Update html <head> element with javascript and favicon *)
-let update_head ?(search = false) soup =
- let head = soup $ "head" in
- if search then begin
- create_element "script" ~attributes:["src","search.js"]
- |> append_child head
- end;
- create_element "script" ~attributes:["src","scroll.js"]
- |> append_child head;
- create_element "script" ~attributes:["src","navigation.js"]
- |> append_child head;
- add_favicon head
-
-(* Add version number *)
-let add_version_link nav text url =
- let vnum = create_element "div" ~class_:"toc_version" in
- let a = create_element "a" ~inner_text:text
- ~attributes:["href", url; "id", "version-select"] in
- append_child vnum a;
- prepend_child nav vnum
-
-let add_sidebar_button body =
- let btn = create_element "div" ~id:"sidebar-button" in
- create_element "span" ~inner_text:"☰"
- |> prepend_child btn;
- prepend_child body btn
-
-(* Detect OCaml version from VERSION file *)
-let find_version () =
- let pp = Filename.parent_dir_name in
- let version_file = pp // pp // pp // "VERSION" in
- let major, minor = Scanf.bscanf (Scanf.Scanning.from_file version_file) "%u.%u" (fun x y -> x,y) in
- sprintf "%u.%u" major minor
-
-(*
- Local Variables:
- compile-command:"dune build"
- End:
-*)
--- /dev/null
+(* @configure_input@ *)
+#2 "manual/src/html_processing/src/common.ml.in"
+(* ------------ OCaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: common.ml
+
+ This file contains functions that are used by process_api.ml and
+ process_manual.ml *)
+
+open Soup
+
+let debug = not (Array.mem "quiet" Sys.argv)
+
+let dbg =
+ let printf = Printf.(if debug then kfprintf else ikfprintf) in
+ let flush =
+ if debug then
+ fun ch -> output_char ch '\n'; flush ch
+ else
+ ignore
+ in
+ fun fmt -> printf flush stdout fmt
+
+let ( // ) = Filename.concat
+
+let process_dir = Filename.current_dir_name
+
+(* Output directory *)
+let web_dir = Filename.parent_dir_name // "webman"
+
+(* Output for manual *)
+let docs_maindir = web_dir // "manual"
+let docs_file = ( // ) docs_maindir
+
+(* Output for API *)
+let api_dir = web_dir // "api"
+
+(* How to go from manual to api *)
+let api_page_url = "../api"
+
+(* How to go from api to manual *)
+ let manual_page_url = "../manual"
+
+(* Set this to the directory where to find the html sources of all versions: *)
+let html_maindir = "../htmlman"
+
+(* Where to get the original html files *)
+let html_file = ( // ) html_maindir
+
+let releases_url = "https://ocaml.org/releases/"
+
+let favicon = "favicon.ico"
+
+(**** utilities ****)
+
+let flat_option f o = Option.bind o f
+
+let (<<) f g x = f (g x)
+
+let string_of_opt = Option.value ~default:""
+
+let starts_with substring s =
+ let l = String.length substring in
+ l <= String.length s &&
+ String.sub s 0 l = substring
+
+(**** html processing ****)
+
+(* Return next html element. *)
+let rec next node =
+ match next_element node with
+ | Some n -> n
+ | None -> match parent node with
+ | Some p -> next p
+ | None -> raise Not_found
+
+let logo_html url =
+ "<nav class=\"toc brand\"><a class=\"brand\" href=\"" ^ url ^
+ "\" ><img src=\"colour-logo.svg\" class=\"svg\" alt=\"OCaml\" /></a></nav>"
+ |> parse
+
+let wrap_body ~classes soup =
+ let body = soup $ "body" in
+ set_name "div" body;
+ List.iter (fun c -> add_class c body) classes;
+ wrap body (create_element "body");
+ body
+
+(* Add favicon *)
+let add_favicon head =
+ parse ({|<link rel="shortcut icon" type="image/x-icon" href="|} ^
+ favicon ^ {|">|})
+ |> append_child head
+
+(* Update html <head> element with javascript and favicon *)
+let update_head ?(search = false) soup =
+ let head = soup $ "head" in
+ if search then begin
+ create_element "script" ~attributes:["src","search.js"]
+ |> append_child head
+ end;
+ create_element "script" ~attributes:["src","scroll.js"]
+ |> append_child head;
+ create_element "script" ~attributes:["src","navigation.js"]
+ |> append_child head;
+ add_favicon head
+
+(* Add version number *)
+let add_version_link nav text url =
+ let vnum = create_element "div" ~class_:"toc_version" in
+ let a = create_element "a" ~inner_text:text
+ ~attributes:["href", url; "id", "version-select"] in
+ append_child vnum a;
+ prepend_child nav vnum
+
+let add_sidebar_button body =
+ let btn = create_element "div" ~id:"sidebar-button" in
+ create_element "span" ~inner_text:"☰"
+ |> prepend_child btn;
+ prepend_child body btn
+
+let find_version () = "@OCAML_VERSION_SHORT@"
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
forces to click twice to an external link after entering text. *)
let search_widget with_description =
let search_decription = if with_description
- then {|<span class="search_comment">(search values, type signatures, and descriptions - case sensitive)<div class="search_help"><ul><li>You may search bare values, like <code>map</code>, or indicate the module, like <code>List.map</code>, or type signatures, like <code>int -> float</code>.</li><li>To combine several keywords, just separate them by a space. Quotes "like this" can be used to prevent from splitting words at spaces.</li><li>You may use the special chars <code>^</code> and <code>$</code> to indicate where the matched string should start or end, respectively.</li></ul></div></span>|}
+ then {|<span class="search_comment">(search values, type signatures, and descriptions - case sensitive)<span id="help_icon" onclick="showHelp()">ⓘ</span><div id="search_help" class="hide"><ul><li>You may search bare values, like <code>map</code>, or indicate the module, like <code>List.map</code>, or type signatures, like <code>int -> float</code>.</li><li>To combine several keywords, just separate them by a space. Quotes can be used to prevent from splitting words at spaces. For instance, <code>int array</code> will search for <code>int</code> and/or <code>array</code>, while <code>"int array"</code> will only list functions whose signature contains the <code>int array</code> type.</li><li>You may use the special chars <code>^</code> and <code>$</code> to indicate where the matched string should start or end, respectively. For instance <code>^zip</code> will not show you the <code>unzip</code> function.</li></ul></div></span>|}
else "" in
sprintf {|<div class="api_search"><input type="text" name="apisearch" id="api_search" class="api_search"
oninput = "mySearch(%b);"
(* Normalize non-break spaces to the utf8 \u00A0: *)
|> Re.Str.(global_replace (regexp_string " ") " ")
|> Re.Str.(global_replace reg_chapter)
- (if file = "index.html" then {|<span class="number">\3.</span>|}
- else {|<span class="number">Chapter \3</span>|})
+ (if file = "index.html" then {|<span class="number">\3.</span> |}
+ else {|<span class="chapter-number">Chapter \3</span> |})
(* I think it would be good to replace "chapter" by "tutorial" for part
I. The problem of course is how we number chapters in the other parts. *)
unfriendly. *)
|> Re.Str.(global_replace
(regexp (">[0-9]+\\.\\([0-9]+\\)" ^ preg_anyspace)))
- {|><span class="number">\1</span>|}
+ {|><span class="number">\1</span> |}
|> Re.Str.(global_replace
(regexp ("[0-9]+\\.\\([0-9]+\\(\\.[0-9]+\\)+\\)" ^ preg_anyspace)))
- {|<span class="number">\1</span>|}
+ {|<span class="number">\1</span> |}
(* The API (libref and compilerlibref directories) should be separate
entities, to better distinguish them from the manual. *)
let html = if file = "index.html"
then Re.Str.(global_replace
(regexp ("Part" ^ preg_chapter_space ^ "\\([I|V]+\\)<br>\n"))
- {|<span class="number">\3.</span>|} html)
+ {|<span class="number">\3.</span> |} html)
else html in
(* Set utf8 encoding directly in the html string *)
-SRC = ../../..
+ROOTDIR = ../../..
-CSLDIR = $(SRC)
+CSLDIR = $(ROOTDIR)
-TEXQUOTE = $(SRC)/runtime/ocamlrun ../../tools/texquote2
+TEXQUOTE = $(ROOTDIR)/runtime/ocamlrun ../../tools/texquote2
FILES = core.tex builtin.tex stdlib-blurb.tex compilerlibs.tex \
libunix.tex libstr.tex old.tex libthreads.tex libdynlink.tex
\entree{"getpwnam", "getpwuid"}{always raise "Not_found"}
\entree{"getgrnam", "getgrgid"}{always raise "Not_found"}
\entree{type "socket_domain"}{"PF_INET" is fully supported;
-"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is not supported }
+"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is supported since 4.14.0, but only works on Windows 10 1803 and later.}
\entree{"establish_server"}{not implemented; use threads}
\entree{terminal functions ("tc*")}{not implemented}
\entree{"setsid"}{not implemented}
\end{tabular}
\subsubsection*{sss:stdlib-io}{input/output:}
\begin{tabular}{lll}
+"In_channel" & p.~\stdpageref{In-underscorechannel} & input channels \\
+"Out_channel" & p.~\stdpageref{Out-underscorechannel} & output channels \\
"Format" & p.~\stdpageref{Format} & pretty printing with automatic
indentation and line breaking \\
"Marshal" & p.~\stdpageref{Marshal} & marshaling of data structures \\
\stddocitem{Gc}{memory management control and statistics; finalized values}
\stddocitem{Genlex}{a generic lexical analyzer}
\stddocitem{Hashtbl}{hash tables and hash functions}
+\stddocitem{In_channel}{input channels}
\stddocitem{Int}{integers}
\stddocitem{Int32}{32-bit integers}
\stddocitem{Int64}{64-bit integers}
\stddocitem{Nativeint}{processor-native integers}
\stddocitem{Oo}{object-oriented extension}
\stddocitem{Option}{option values}
+\stddocitem{Out_channel}{output channels}
\stddocitem{Parsing}{the run-time library for parsers generated by \texttt{ocamlyacc}}
\stddocitem{Printexc}{facilities for printing exceptions}
\stddocitem{Printf}{formatting printing functions}
%%% Missing macro
\newcommand{\DeclareUnicodeCharacter}[2]{}
+\newcommand{\DisableLigatures}[1]{}
\ifocamldoc
\newcommand{\stddocitem}[2]{\libdocitem{#1}{#2}}
\documentclass[11pt]{book}
-\usepackage{ae}
+\usepackage{lmodern}% for T1 encoding and support of bold ttfamily
\usepackage[utf8]{inputenc}
\usepackage[T1]{fontenc}
+\usepackage{microtype}
% HEVEA\@def@charset{UTF-8}%
% Unicode character declarations
\DeclareUnicodeCharacter{207A}{{}^{+}}
% 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{ifocamldoc}
\ifocamldoc\else
\usepackage{changepage}
\fi
\input{macros.tex}
+
+% No ligatures in typewriter font
+\DisableLigatures{encoding = T1, family = tt* }
+
% Listing environments
\lstnewenvironment{camloutput}{
\lstset{
% Make _ a normal character in text mode
% it must be the last package included
\usepackage[strings,nohyphen]{underscore}
+% Babel enables a finer control of the catcode of '_'
+% and ensures that '_' is allowed in labels and references.
+\usepackage[english]{babel}
%\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother
ROOTDIR = ../../..
include $(ROOTDIR)/Makefile.common
-LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+LD_PATH = $(ROOTDIR)/otherlibs/str $(ROOTDIR)/otherlibs/unix
TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
- -repo-root $(ROOTDIR) -n 80 -v false
+CAMLLATEX = $(OCAMLRUN) $(addprefix -I ,$(LD_PATH)) \
+ $(ROOTDIR)/tools/caml-tex -repo-root $(ROOTDIR) -n 80 -v false
TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+TRANSF = $(OCAMLRUN) $(TOOLS)/transf
EXTENSION_FILES = letrecvalues.tex recursivemodules.tex locallyabstract.tex \
firstclassmodules.tex moduletypeof.tex signaturesubstitution.tex \
| class-body-type
;
class-body-type:
- 'object' ['(' typexpr ')'] {class-field-spec} 'end'
- | ['[' typexpr {',' typexpr} ']'] classtype-path
+ 'object' ['(' typexpr ')'] { class-field-spec } 'end'
+ | ['[' typexpr { ',' typexpr } ']'] classtype-path
| 'let' 'open' module-path 'in' class-body-type
;
%\end{syntax} \begin{syntax}
\subsubsection*{sss:clty:body}{Class body type}
The class type expression
-@'object' ['(' typexpr ')'] {class-field-spec} 'end'@
+@'object' ['(' typexpr ')'] { class-field-spec } 'end'@
is the type of a class body. It specifies its instance variables and
methods. In this type, @typexpr@ is matched against the self type, therefore
providing a name for the self type.
\begin{syntax}
class-expr:
class-path
- | '[' typexpr {',' typexpr} ']' class-path
+ | '[' typexpr { ',' typexpr } ']' class-path
| '(' class-expr ')'
| '(' class-expr ':' class-type ')'
- | class-expr {{argument}}
- | 'fun' {{parameter}} '->' class-expr
- | 'let' ['rec'] let-binding {'and' let-binding} 'in' class-expr
+ | class-expr {{ argument }}
+ | 'fun' {{ parameter }} '->' class-expr
+ | 'let' ['rec'] let-binding { 'and' let-binding } 'in' class-expr
| 'object' class-body 'end'
| 'let' 'open' module-path 'in' class-expr
;
| 'val!' ['mutable'] inst-var-name [':' typexpr] '=' expr
| 'val' ['mutable'] 'virtual' inst-var-name ':' typexpr
| 'val' 'virtual' 'mutable' inst-var-name ':' typexpr
- | 'method' ['private'] method-name {parameter} [':' typexpr] '=' expr
- | 'method!' ['private'] method-name {parameter} [':' typexpr] '=' expr
+ | 'method' ['private'] method-name { parameter } [':' typexpr] '=' expr
+ | 'method!' ['private'] method-name { parameter } [':' typexpr] '=' expr
| 'method' ['private'] method-name ':' poly-typexpr '=' expr
| 'method!' ['private'] method-name ':' poly-typexpr '=' expr
| 'method' ['private'] 'virtual' method-name ':' poly-typexpr
explicit declaration may be done in one of three ways: (1) by giving an
explicit polymorphic type in the method definition, immediately after
the method name, {\em i.e.}
-@'method' ['private'] method-name ':' {{"'" ident}} '.' typexpr '='
+@'method' ['private'] method-name ':' {{ "'" ident }} '.' typexpr '='
expr@; (2) by a forward declaration of the explicit polymorphic type
through a virtual method definition; (3) by importing such a
declaration through inheritance and/or constraining the type of {\em
;
class-binding:
['virtual'] ['[' type-parameters ']'] class-name
- {parameter} [':' class-type] \\ '=' class-expr
+ { parameter } [':' class-type] \\ '=' class-expr
;
type-parameters:
"'" ident { "," "'" ident }
| '(' expr ')'
| 'begin' expr 'end'
| '(' expr ':' typexpr ')'
- | expr {{',' expr}}
+ | expr {{ ',' expr }}
| constr expr
| "`"tag-name expr
| expr '::' expr
a certain class of recursive definitions of non-functional values,
as explained in section~\ref{s:letrecvalues}.
+\subsubsection{sss:expr-let-exception}{Local exceptions}
+(Introduced in OCaml 4.04)
+
It is possible to define local exceptions in expressions:
@ "let" exception constr-decl "in" expr @ .
\begin{syntax}
field-decl:
- ['mutable'] field-name ':' poly-typexpr {attribute}
+ ['mutable'] field-name ':' poly-typexpr { attribute }
;
constr-decl:
- (constr-name || '()') [ 'of' constr-args ] {attribute}
+ (constr-name || '()') [ 'of' constr-args ] { attribute }
;
\end{syntax}
\begin{syntax}
infix-symbol:
...
- | "#" {operator-char} "#" {operator-char || "#"}
+ | "#" { operator-char } "#" { operator-char || "#" }
;
prefix-symbol:
...
- | ('?'||'~'||'!') { operator-char } "#" { operator-char || "#"}
+ | ('?' || '~' || '!') { operator-char } "#" { operator-char || "#" }
;
\end{syntax}
\begin{syntax}
float-literal:
...
- | ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
- [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0x"||"0X")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }\\
- ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
- [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- ["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" } ["." { "0"\ldots"9" || "_" }]
+ [("e" || "E") ["+" || "-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }]
+ ["g"\ldots"z" || "G"\ldots"Z"]
+ | ["-"] ("0x" || "0X")
+ ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
+ { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" }\\
+ ["." { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" }]
+ [("p" || "P") ["+" || "-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }]
+ ["g"\ldots"z" || "G"\ldots"Z"]
;
int-literal:
...
- | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }["g"\ldots"z" || "G"\ldots"Z"]
+ | ["-"] ("0x" || "0X") ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
+ { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" }
+ ["g"\ldots"z" || "G"\ldots"Z"]
+ | ["-"] ("0o" || "0O") ("0"\ldots"7") { "0"\ldots"7" || "_" }
+ ["g"\ldots"z" || "G"\ldots"Z"]
+ | ["-"] ("0b" || "0B") ("0"\ldots"1") { "0"\ldots"1" || "_" }
+ ["g"\ldots"z" || "G"\ldots"Z"]
;
\end{syntax}
Int and float literals followed by an one-letter identifier in the
\begin{syntax}
pattern:
...
- | constr '(' "type" {{typeconstr-name}} ')' '(' pattern ')'
+ | constr '(' "type" {{ typeconstr-name }} ')' '(' pattern ')'
;
-\end{syntax}
\ No newline at end of file
+\end{syntax}
| dot-operator-char { operator-char }
;
dot-operator-char:
- '!' || '?' || core-operator-char || '%' || ':'
+ '!' || '?' || core-operator-char || '%' || ':'
;
expr:
...
\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 ]
+ | 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:
...
\begin{syntax}
parameter:
...
- | '(' "type" {{typeconstr-name}} ')'
+ | '(' "type" {{ typeconstr-name }} ')'
\end{syntax}
The expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ introduces a
\begin{syntax}
mod-constraint:
...
- | 'module ' 'type' modtype-path '=' module-type
- | 'module ' 'type' modtype-path ':=' module-type
+ | 'module' 'type' modtype-path '=' module-type
+ | 'module' 'type' modtype-path ':=' module-type
\end{syntax}
Module type substitution essentially behaves like type substitutions.
\subsubsection*{sss:lex:identifiers}{Identifiers}
\begin{syntax}
-ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ;
-capitalized-ident: ("A" \ldots "Z") { letter || "0" \ldots "9" || "_" || "'" } ;
+ident: (letter || "_") { letter || "0"\ldots"9" || "_" || "'" } ;
+capitalized-ident: ("A"\ldots"Z") { letter || "0"\ldots"9" || "_" || "'" } ;
lowercase-ident:
- ("a" \ldots "z" || "_") { letter || "0" \ldots "9" || "_" || "'" } ;
-letter: "A" \ldots "Z" || "a" \ldots "z"
+ ("a"\ldots"z" || "_") { letter || "0"\ldots"9" || "_" || "'" } ;
+letter: "A"\ldots"Z" || "a"\ldots"z"
\end{syntax}
Identifiers are sequences of letters, digits, "_" (the underscore
\begin{syntax}
integer-literal:
["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }
- | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
- | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
- | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
+ | ["-"] ("0x" || "0X") ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
+ { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" }
+ | ["-"] ("0o" || "0O") ("0"\ldots"7") { "0"\ldots"7" || "_" }
+ | ["-"] ("0b" || "0B") ("0"\ldots"1") { "0"\ldots"1" || "_" }
;
int32-literal: integer-literal 'l'
;
\begin{syntax}
float-literal:
- ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
- [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- | ["-"] ("0x"||"0X")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" } \\
- ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
- [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+ ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" } ["." { "0"\ldots"9" || "_" }]
+ [("e" || "E") ["+" || "-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }]
+ | ["-"] ("0x" || "0X")
+ ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
+ { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" } \\
+ ["." { "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" || "_" }]
+ [("p" || "P") ["+" || "-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }]
\end{syntax}
Floating-point decimal literals consist in an integer part, a
| "'" escape-sequence "'"
;
escape-sequence:
- "\" ( "\" || '"' || "'" || "n" || "t" || "b" || "r" || space )
+ "\" ("\" || '"' || "'" || "n" || "t" || "b" || "r" || space)
| "\" ("0"\ldots"9") ("0"\ldots"9") ("0"\ldots"9")
- | "\x" ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ | "\x" ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
+ ("0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f")
| "\o" ("0"\ldots"3") ("0"\ldots"7") ("0"\ldots"7")
\end{syntax}
\begin{syntax}
string-literal:
'"' { string-character } '"'
- | '{' quoted-string-id '|' { any-char } '|' quoted-string-id '}'
+ | '{' quoted-string-id '|' { any-char } '|' quoted-string-id '}'
;
quoted-string-id:
{ 'a'...'z' || '_' }
string-character:
regular-string-char
| escape-sequence
- | "\u{" {{ "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f" }} "}"
+ | "\u{" {{ "0"\ldots"9" || "A"\ldots"F" || "a"\ldots"f" }} "}"
| '\' newline { space || tab }
\end{syntax}
\begin{syntax}
infix-symbol:
- ( core-operator-char || '%' || '<' ) { operator-char }
+ (core-operator-char || '%' || '<') { operator-char }
| "#" {{ operator-char }}
;
prefix-symbol:
\begin{syntax}
linenum-directive:
- '#' {{"0" \ldots "9"}} '"' { string-character } '"'
+ '#' {{ "0"\ldots"9" }} '"' { string-character } '"'
\end{syntax}
Preprocessors that generate OCaml source code can insert line number
particular, a functor may take another functor as argument
(``higher-order'' functor).
+When the result module type is itself a functor,
+\begin{center}
+@'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots '->'
+ 'functor' '(' name_n ':' module-type_n ')' '->' module-type@
+\end{center}
+one may use the abbreviated form
+\begin{center}
+@'functor' '(' name_1 ':' module-type_1 ')' \ldots
+ '(' name_n ':' module-type_n ')' '->' module-type@
+\end{center}
+
\subsection{ss:mty-with}{The "with" operator}
\ikwd{with\@\texttt{with}}
| '(' module-expr ':' module-type ')'
;
module-items:
- {';;'} ( definition || expr ) { {';;'} ( definition || ';;' expr) } {';;'}
+ { ';;' } ( definition || expr ) { { ';;' } ( definition || ';;' expr) } { ';;' }
;
%\end{syntax} \begin{syntax}
definition:
functor argument; in particular, a functor may take another functor as
argument (``higher-order'' functor).
+When the result module expression is itself a functor,
+\begin{center}
+@'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots '->'
+ 'functor' '(' name_n ':' module-type_n ')' '->' module-expr@
+\end{center}
+one may use the abbreviated form
+\begin{center}
+@'functor' '(' name_1 ':' module-type_1 ')' \ldots
+ '(' name_n ':' module-type_n ')' '->' module-expr@
+\end{center}
+
\subsubsection*{sss:mexpr-functor-app}{Functor application}
The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates
equivalent one, where only the order and names of polymorphic
variables may change.
-The type @'<' {method-type ';'} '..' '>'@ is the
+The type @'<' { method-type ';' } '..' '>'@ is the
type of an object whose method names and types are described by
@method-type_1, \ldots, method-type_n@, and possibly some other
methods represented by the ellipsis. This ellipsis actually is
ROOTDIR = ../../..
include $(ROOTDIR)/Makefile.common
-LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+LD_PATH = $(ROOTDIR)/otherlibs/str $(ROOTDIR)/otherlibs/unix
TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
- -repo-root $(ROOTDIR) -n 80 -v false
+CAMLLATEX = $(OCAMLRUN) $(addprefix -I ,$(LD_PATH)) \
+ $(ROOTDIR)/tools/caml-tex -repo-root $(ROOTDIR) -n 80 -v false
TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+TRANSF = $(OCAMLRUN) $(TOOLS)/transf
FILES = coreexamples.tex lablexamples.tex polyvariant.tex objectexamples.tex \
GADT type variable, this variable flows to the type of the recursive
function, and thus escapes its scope. In the above example, this happens
in the branch "App(f,x)" when "eval" is called with "f" as an argument.
-In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in
-"$App_ 'b" denotes an existential type named by the compiler
+In this branch, the type of "f" is "($App_'b -> a) term". The prefix "$" in
+"$App_'b" denotes an existential type named by the compiler
(see~\ref{s:existential-names}). Since the type of "eval" is
"'a term -> 'a", the call "eval f" makes the existential type "$App_'b"
flow to the type variable "'a" and escape its scope. This triggers the
--- /dev/null
+% @configure_input@
+\def\ocamlversion{@OCAML_VERSION_SHORT@}
%\stx@alias{name}{othername}
%will make reference to 'name' point to the definition of non-terminal
%'othername'
-\newif\ifspace
-\def\addspace{\ifspace\;\spacefalse\fi}
\ifhtml
\newcommand{\token}[1]{\textnormal{\@span{class=syntax-token}#1}}
\newstyle{.syntax-token}{color:blue;font-family:monospace}
\def\nt#1{\textnormal{\@span{class=nonterminal}#1}}
\newstyle{.nonterminal}{color:maroon;font-style:oblique}
%%%Link for non-terminal and format
-\def\nonterm#1{\addspace\nt{\@anchor{#1}}\spacetrue}
-\def\brepet{\addspace\{}
+\def\nonterm#1{\nt{\@anchor{#1}}}
+\def\brepet{\{}
\def\erepet{\}}
-\def\boption{\addspace[}
+\def\boption{[}
\def\eoption{]}
-\def\brepets{\addspace\{}
+\def\brepets{\{}
\def\erepets{\}^+}
-\def\bparen{\addspace(}
+\def\bparen{(}
\def\eparen{)}
-\def\orelse{\mid \spacefalse}
-\def\is{ & ::= & \spacefalse }
-\def\alt{ \\ & \mid & \spacefalse }
-\def\sep{ \\ \\ \spacefalse }
+\def\orelse{\mid}
+\def\is{&::=&}
+\def\alt{\\&\mid&}
+\def\sep{\\\\}
\def\cutline{}
\def\emptystring{\epsilon}
-\def\syntax{\@open{div}{class="syntax"}$$\begin{array}{>{\set@name}rcl}\spacefalse}
+\def\syntax{\@open{div}{class="syntax"}$$\begin{array}{>{\set@name}rcl}}
\def\endsyntax{\end{array}$$\@close{div}}
-\def\syntaxleft{\@open{div}{class="syntaxleft"}$\begin{array}{>{\set@name}rcl}\spacefalse}
+\def\syntaxleft{\@open{div}{class="syntaxleft"}$\begin{array}{>{\set@name}rcl}}
\def\endsyntaxleft{\end{array}$\@close{div}}
-\def\synt#1{$\spacefalse#1$}
+\def\synt#1{$#1$}
# check cross-references between the manual and error messages
.PHONY: check-cross-references
check-cross-references: cross-reference-checker
- $(SET_LD_PATH) \
- $(OCAMLRUN) ./cross-reference-checker \
+ $(OCAMLRUN) ./cross-reference-checker \
-auxfile $(MANUAL)/texstuff/manual.aux \
$(ROOTDIR)/utils/warnings.ml \
$(ROOTDIR)/driver/main_args.ml \
exitcode=0
for i in `cat $TMPDIR/stdlib-$$-modules`; do
case $i in
- Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;;
+ Stdlib | Camlinternal* | *Labels | Obj | Pervasives | In_channel | Out_channel) continue;;
esac
grep -q -e '"'$i'" & p\.~\\stdpageref{'$i'} &' $1/manual/src/library/stdlib-blurb.etex || {
echo "Module $i is missing from the module description in library/stdlib-blurb.etex." >&2
transf.ml
texquote2
-htmltransf.ml
transf
htmlgen
htmlquote
ROOTDIR = ../..
-COMPFLAGS = -I $(ROOTDIR)/otherlibs/str -I $(ROOTDIR)/otherlibs/unix
include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
all: texquote2 transf
-transf: transf.cmo htmltransf.cmo transfmain.cmo
+transf: transf.cmo transfmain.cmo
$(OCAMLC) $(COMPFLAGS) -o $@ -g $^
-transfmain.cmo: transf.cmo htmltransf.cmo
+transfmain.cmo: transf.cmo
texquote2: texquote2.ml
$(OCAMLC) $(COMPFLAGS) -o $@ $<
.PHONY: clean
clean:
rm -f *.o *.cm? *.cmx?
- rm -f transf.ml htmltransf.ml
+ rm -f transf.ml
rm -f texquote2 transf
+++ /dev/null
-{
-open Lexing;;
-
-let need_space =
- ref false;;
-
-let addspace () =
- if !need_space then begin print_char ' '; need_space := false end;;
-}
-
-rule main = parse
- "\\begin{syntax}" {
- print_string "\\begin{rawhtml}\n<PRE>\n";
- need_space := false;
- syntax lexbuf;
- print_string "</PRE>\n\\end{rawhtml}\n";
- main lexbuf }
- | "\\@" {
- print_string "@";
- main lexbuf }
- | "@" {
- print_string "%\n\\begin{rawhtml}";
- need_space := false;
- syntax lexbuf;
- print_string "\\end{rawhtml}%\n";
- main lexbuf }
- | _ {
- print_char (lexeme_char lexbuf 0); main lexbuf }
- | eof {
- () }
-
-and syntax = parse
- "\\end{syntax}" { () }
- | "@" { () }
- | '\'' {
- addspace();
- print_string "<font color=\"blue\"><code>";
- inquote lexbuf;
- print_string "</code></font>";
- need_space := true;
- syntax lexbuf }
- | '\"' {
- addspace();
- print_string "<font color=\"blue\"><code>";
- indoublequote lexbuf;
- print_string "</code></font>";
- need_space := true;
- syntax lexbuf }
- | ['a'-'z'] ['a'-'z' '0'-'9' '-'] * {
- addspace();
- print_string "<i>";
- print_string (lexeme lexbuf);
- print_string "</i>";
- need_space := true;
- syntax lexbuf }
- | '\\' ['a'-'z''A'-'Z'] + {
- begin match lexeme lexbuf with
- "\\ldots" -> print_string "..."; need_space := false
- | s -> Printf.eprintf "Warning: %s ignored.\n" s
- end;
- syntax lexbuf }
- | '_' _ {
- print_string "<SUB>";
- print_char(lexeme_char lexbuf 1);
- print_string "</SUB>";
- syntax lexbuf }
- | '^' _ {
- print_string "<SUP>";
- print_char(lexeme_char lexbuf 1);
- print_string "</SUP>";
- syntax lexbuf }
- | ":" {
- print_string ":\n ";
- need_space := false;
- syntax lexbuf }
- | "|" {
- print_string "\n | ";
- need_space := false;
- syntax lexbuf }
- | ";" {
- print_string "\n\n";
- need_space := false;
- syntax lexbuf }
- | [ '{' '[' '('] {
- addspace(); print_string (lexeme lexbuf); syntax lexbuf }
- | [ '}' ']' ')'] {
- print_string (lexeme lexbuf); syntax lexbuf }
- | "{{" {
- addspace(); print_string "{"; syntax lexbuf }
- | "}}" {
- print_string "}+"; syntax lexbuf }
- | "||" {
- print_string " | "; need_space := false; syntax lexbuf }
- | [ ' ' '\n' '\t' '~'] {
- syntax lexbuf }
- | [ ',' ] {
- print_char(lexeme_char lexbuf 0); syntax lexbuf }
- | _ {
- Printf.eprintf "Warning: %s ignored at char %d.\n"
- (lexeme lexbuf) (lexeme_start lexbuf);
- syntax lexbuf }
-
-and inquote = parse
- '\'' { () }
- | '&' { print_string "&"; inquote lexbuf }
- | '<' { print_string "<"; inquote lexbuf }
- | '>' { print_string ">"; inquote lexbuf }
- | _ { print_char (lexeme_char lexbuf 0); inquote lexbuf }
-
-and indoublequote = parse
- '"' { () }
- | '&' { print_string "&"; indoublequote lexbuf }
- | '<' { print_string "<"; indoublequote lexbuf }
- | '>' { print_string ">"; indoublequote lexbuf }
- | _ { print_char (lexeme_char lexbuf 0); indoublequote lexbuf }
-
-
let main() =
let lexbuf = Lexing.from_channel stdin in
- if Array.length Sys.argv >= 2 && Sys.argv.(1) = "-html"
- then Htmltransf.main lexbuf
- else Transf.main lexbuf;
+ Transf.main lexbuf;
exit 0;;
Printexc.print main ();;
body : ulambda;
dbg : Debuginfo.t;
env : Backend_var.t option;
+ poll : poll_attribute;
}
and ulambda_switch =
fun_arity: int; (* Number of arguments *)
mutable fun_closed: bool; (* True if environment not used *)
mutable fun_inline: (Backend_var.With_provenance.t list * ulambda) option;
- mutable fun_float_const_prop: bool (* Can propagate FP consts *)
+ mutable fun_float_const_prop: bool; (* Can propagate FP consts *)
+ fun_poll: poll_attribute; (* Error on poll/alloc/call *)
}
(* Approximation of values *)
body : ulambda;
dbg : Debuginfo.t;
env : Backend_var.t option;
+ poll : poll_attribute;
}
and ulambda_switch =
fun_arity: int; (* Number of arguments *)
mutable fun_closed: bool; (* True if environment not used *)
mutable fun_inline: (Backend_var.With_provenance.t list * ulambda) option;
- mutable fun_float_const_prop: bool (* Can propagate FP consts *)
+ mutable fun_float_const_prop: bool; (* Can propagate FP consts *)
+ fun_poll: poll_attribute; (* Behaviour for polls *)
}
(* Approximation of values *)
| Arbitrary_effects, _ -> false
(* Check if a clambda term is ``pure'',
- that is without side-effects *and* not containing function definitions *)
+ that is without side-effects *and* not containing function definitions
+ (Pure terms may still read mutable state) *)
let rec is_pure = function
Uvar _ -> true
make_const (List.nth l n)
| Pfield n, [ Uprim(P.Pmakeblock _, ul, _) ], [approx]
when n < List.length ul ->
+ (* This case is particularly useful for removing allocations
+ for optional parameters *)
(List.nth ul n, field_approx n approx)
(* Strings *)
| (Pstringlength | Pbyteslength),
[ Value_const(Uconst_ref(_, Some (Uconst_string s))) ] ->
make_const_int (String.length s)
(* Kind test *)
+ | Pisint, [ Uprim(P.Pmakeblock _, _, _) ], _ ->
+ (* This case is particularly useful for removing allocations
+ for optional parameters *)
+ make_const_bool false
| Pisint, _, [a1] ->
begin match a1 with
| Value_const(Uconst_int _) -> make_const_bool true
substitute loc st sb rn u2
else
substitute loc st sb rn u3
- | Uprim(P.Pmakeblock _, _, _) ->
- substitute loc st sb rn u2
| su1 ->
Uifthenelse(su1, substitute loc st sb rn u2,
substitute loc st sb rn u3)
*)
(* Approximates "no effects and no coeffects" *)
-let is_substituable ~mutable_vars = function
+let rec is_substituable ~mutable_vars = function
| Uvar v -> not (V.Set.mem v mutable_vars)
| Uconst _ -> true
+ | Uoffset(arg, _) -> is_substituable ~mutable_vars arg
| _ -> false
(* Approximates "only generative effects" *)
| Uclosure _ -> true
| u -> is_pure u
-let bind_params { backend; mutable_vars; _ } loc fpc params args body =
+let bind_params { backend; mutable_vars; _ } loc fdesc params args funct body =
+ let fpc = fdesc.fun_float_const_prop in
let rec aux subst pl al body =
match (pl, al) with
([], []) -> substitute (Debuginfo.from_location loc) (backend, fpc)
let u1, u2 =
match VP.name p1, a1 with
| "*opt*", Uprim(P.Pmakeblock(0, Immutable, kind), [a], dbg) ->
+ (* This parameter corresponds to an optional parameter,
+ and although it is used twice pushing the expression down
+ actually allows us to remove the allocation as it will
+ appear once under a Pisint primitive and once under a Pfield
+ primitive (see [simplif_prim_pure]) *)
a, Uprim(P.Pmakeblock(0, Immutable, kind),
[Uvar (VP.var p1')], dbg)
| _ ->
in
(* Reverse parameters and arguments to preserve right-to-left
evaluation order (PR#2910). *)
- aux V.Map.empty (List.rev params) (List.rev args) body
-
-(* Check if a lambda term is ``pure'',
- that is without side-effects *and* not containing function definitions *)
+ let params, args = List.rev params, List.rev args in
+ let params, args, body =
+ (* Ensure funct is evaluated after args *)
+ match params with
+ | my_closure :: params when not fdesc.fun_closed ->
+ (params @ [my_closure]), (args @ [funct]), body
+ | _ ->
+ params, args, (if is_pure funct then body else Usequence (funct, body))
+ in
+ aux V.Map.empty params args body
let warning_if_forced_inline ~loc ~attribute warning =
if attribute = Always_inline then
(* Generate a direct application *)
let direct_apply env fundesc ufunct uargs ~loc ~attribute =
- let app_args =
- if fundesc.fun_closed then uargs else uargs @ [ufunct] in
- let app =
- match fundesc.fun_inline, attribute with
- | _, Never_inline | None, _ ->
- let dbg = Debuginfo.from_location loc in
- warning_if_forced_inline ~loc ~attribute
- "Function information unavailable";
- Udirect_apply(fundesc.fun_label, app_args, dbg)
- | Some(params, body), _ ->
- bind_params env loc fundesc.fun_float_const_prop params app_args
- body
- in
- (* If ufunct can contain side-effects or function definitions,
- we must make sure that it is evaluated exactly once.
- If the function is not closed, we evaluate ufunct as part of the
- arguments.
- If the function is closed, we force the evaluation of ufunct first. *)
- if not fundesc.fun_closed || is_pure ufunct
- then app
- else Usequence(ufunct, app)
+ match fundesc.fun_inline, attribute with
+ | _, Never_inline
+ | None, _ ->
+ let dbg = Debuginfo.from_location loc in
+ warning_if_forced_inline ~loc ~attribute
+ "Function information unavailable";
+ if fundesc.fun_closed && is_pure ufunct then
+ Udirect_apply(fundesc.fun_label, uargs, dbg)
+ else if not fundesc.fun_closed &&
+ is_substituable ~mutable_vars:env.mutable_vars ufunct then
+ Udirect_apply(fundesc.fun_label, uargs @ [ufunct], dbg)
+ else begin
+ let args = List.map (fun arg ->
+ if is_substituable ~mutable_vars:env.mutable_vars arg then
+ None, arg
+ else
+ let id = V.create_local "arg" in
+ Some (VP.create id, arg), Uvar id) uargs in
+ let app_args = List.map snd args in
+ List.fold_left (fun app (binding,_) ->
+ match binding with
+ | None -> app
+ | Some (v, e) -> Ulet(Immutable, Pgenval, v, e, app))
+ (if fundesc.fun_closed then
+ Usequence (ufunct, Udirect_apply (fundesc.fun_label, app_args, dbg))
+ else
+ let clos = V.create_local "clos" in
+ Ulet(Immutable, Pgenval, VP.create clos, ufunct,
+ Udirect_apply(fundesc.fun_label, app_args @ [Uvar clos], dbg)))
+ args
+ end
+ | Some(params, body), _ ->
+ bind_params env loc fundesc params uargs ufunct body
(* Add [Value_integer] info to the approximation of an application *)
let funct_var = V.create_local "funct" in
let fenv = V.Map.add funct_var fapprox fenv in
let (new_fun, approx) = close { backend; fenv; cenv; mutable_vars }
- (Lfunction{
- kind = Curried;
- return = Pgenval;
- params = List.map (fun v -> v, Pgenval) final_args;
- body = Lapply{
- ap_loc=loc;
- ap_func=(Lvar funct_var);
- ap_args=internal_args;
- ap_tailcall=Default_tailcall;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise;
- };
- loc;
- attr = default_function_attribute})
+ (lfunction
+ ~kind:Curried
+ ~return:Pgenval
+ ~params:(List.map (fun v -> v, Pgenval) final_args)
+ ~body:(Lapply{
+ ap_loc=loc;
+ ap_func=(Lvar funct_var);
+ ap_args=internal_args;
+ ap_tailcall=Default_tailcall;
+ ap_inlined=Default_inline;
+ ap_specialised=Default_specialise;
+ })
+ ~loc
+ ~attr:default_function_attribute)
in
let new_fun =
iter first_args
let uncurried_defs =
List.map
(function
- (id, Lfunction{kind; params; return; body; loc}) ->
+ (id, Lfunction{kind; params; return; body; loc; attr}) ->
let label = Compilenv.make_symbol (Some (V.unique_name id)) in
let arity = List.length params in
let fundesc =
fun_arity = (if kind = Tupled then -arity else arity);
fun_closed = initially_closed;
fun_inline = None;
- fun_float_const_prop = !Clflags.float_const_prop } in
+ fun_float_const_prop = !Clflags.float_const_prop;
+ fun_poll = attr.poll } in
let dbg = Debuginfo.from_location loc in
(id, params, return, body, fundesc, dbg)
| (_, _) -> fatal_error "Closure.close_functions")
body = ubody;
dbg;
env = Some env_param;
+ poll = fundesc.fun_poll
}
in
(* give more chance of function with default parameters (i.e.
~specialise:Default_specialise
~is_a_functor:false
~closure_origin:function_decl.closure_origin
+ ~poll:Default_poll (* don't propagate attribute to wrappers *)
in
new_fun_var, new_function_decl, rewritten_existing_specialised_args,
benefit
~specialise:function_decl.specialise
~is_a_functor:function_decl.is_a_functor
~closure_origin
+ ~poll:function_decl.poll
in
let funs, direct_call_surrogates =
if for_one_function.make_direct_call_surrogates then
~body ~stub:true ~dbg:Debuginfo.none ~inline:Default_inline
~specialise:Default_specialise ~is_a_functor:false
~closure_origin:(Closure_origin.create (Closure_id.wrap closure_bound_var))
+ ~poll:Default_poll (* don't propogate attribute to wrappers *)
let register_const t (constant:Flambda.constant_defining_value) name
: Flambda.constant_defining_value_block_field * Internal_variable_names.t =
~specialise:(Function_decl.specialise decl)
~is_a_functor:(Function_decl.is_a_functor decl)
~closure_origin
+ ~poll:(Function_decl.poll_attribute decl)
in
match Function_decl.kind decl with
| Curried -> Variable.Map.add closure_bound_var fun_decl map
let specialise t = t.attr.specialise
let is_a_functor t = t.attr.is_a_functor
let stub t = t.attr.stub
+ let poll_attribute t = t.attr.poll
let loc t = t.loc
end
val is_a_functor : t -> bool
val stub : t -> bool
val loc : t -> Lambda.scoped_location
+ val poll_attribute : t -> Lambda.poll_attribute
(* Like [all_free_idents], but for just one function. *)
val free_idents : t -> Ident.Set.t
inline : Lambda.inline_attribute;
specialise : Lambda.specialise_attribute;
is_a_functor : bool;
+ poll: Lambda.poll_attribute;
}
and switch = {
inline = func_decl.inline;
specialise = func_decl.specialise;
is_a_functor = func_decl.is_a_functor;
+ poll = func_decl.poll;
}
let update_function_decl's_params_and_body
inline = func_decl.inline;
specialise = func_decl.specialise;
is_a_functor = func_decl.is_a_functor;
+ poll = func_decl.poll;
}
let create_function_declaration ~params ~body ~stub ~dbg
~(inline : Lambda.inline_attribute)
~(specialise : Lambda.specialise_attribute) ~is_a_functor
- ~closure_origin
+ ~closure_origin ~poll
: function_declaration =
begin match stub, inline with
| true, (Never_inline | Default_inline)
inline;
specialise;
is_a_functor;
+ poll;
}
let update_function_declaration fun_decl ~params ~body =
(** Specialising requirements from the source code. *)
is_a_functor : bool;
(** Whether the function is known definitively to be a functor. *)
+ poll: Lambda.poll_attribute;
+ (** Behaviour for polls *)
}
(** Equivalent to the similar type in [Lambda]. *)
-> specialise:Lambda.specialise_attribute
-> is_a_functor:bool
-> closure_origin:Closure_origin.t
+ -> poll:Lambda.poll_attribute
-> function_declaration
(** Create a function declaration based on another function declaration *)
body = to_clambda t env_body function_decl.body;
dbg = function_decl.dbg;
env = Some env_var;
+ poll = function_decl.poll;
}
in
let funs = List.map to_clambda_function all_functions in
body;
dbg = function_decl.dbg;
env = None;
+ poll = function_decl.poll;
}
in
let ufunct = List.map to_clambda_function functions in
| _ -> assert false
let make_closure_declaration
- ~is_classic_mode ~id ~body ~params ~stub : Flambda.t =
+ ~is_classic_mode ~id ~body ~params : Flambda.t =
let free_variables = Flambda.free_variables body in
let param_set = Parameter.Set.vars params in
if not (Variable.Set.subset param_set free_variables) then begin
let subst_param param = Parameter.map_var subst param in
let function_declaration =
Flambda.create_function_declaration ~params:(List.map subst_param params)
- ~body ~stub ~dbg:Debuginfo.none ~inline:Default_inline
+ ~body ~stub:true ~dbg:Debuginfo.none ~inline:Default_inline
~specialise:Default_specialise ~is_a_functor:false
~closure_origin:(Closure_origin.create (Closure_id.wrap id))
+ ~poll:Default_poll
in
- assert (Variable.Set.equal (Variable.Set.map subst free_variables)
+ begin
+ assert (Variable.Set.equal (Variable.Set.map subst free_variables)
function_declaration.free_variables);
+ end;
let free_vars =
Variable.Map.fold (fun id id' fv' ->
let spec_to : Flambda.specialised_to =
-> id:Variable.t
-> body:Flambda.t
-> params:Parameter.t list
- -> stub:bool
-> Flambda.t
val toplevel_substitution
~inline:func_decl.inline ~specialise:func_decl.specialise
~is_a_functor:func_decl.is_a_functor
~closure_origin:func_decl.closure_origin
+ ~poll:func_decl.poll
in
function_decl, subst
in
~inline:function_decl.inline ~specialise:function_decl.specialise
~is_a_functor:function_decl.is_a_functor
~closure_origin:function_decl.closure_origin
+ ~poll:function_decl.poll
in
let used_params' = Flambda.used_params function_decl in
Variable.Map.add fun_var function_decl funs,
~is_classic_mode:false
~body
~params:remaining_args
- ~stub:true
in
let with_known_args =
Flambda_utils.bind
~inline:function_decl.inline ~specialise:function_decl.specialise
~is_a_functor:function_decl.is_a_functor
~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+ ~poll:function_decl.poll
in
function_decl, specialised_args
List.iter (fun (_, lam) -> lambda_named_size lam) bindings;
lambda_size body
| Switch (_, sw) ->
- let aux = function _::_::_ -> size := !size + 5 | _ -> () in
- aux sw.consts; aux sw.blocks;
+ let cost cases =
+ let size = List.length cases in
+ if size <= 1 then 0
+ else 3 + size
+ in
+ size := !size + cost sw.consts + cost sw.blocks;
List.iter (fun (_, lam) -> lambda_size lam) sw.consts;
List.iter (fun (_, lam) -> lambda_size lam) sw.blocks;
Option.iter lambda_size sw.failaction
~specialise:function_body.specialise
~is_a_functor:function_body.is_a_functor
~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+ ~poll:function_body.poll
in
let new_funs =
Variable.Map.add new_fun_var new_function_decl state.new_funs
Notice that having (f, x) <- (g, a) and (f, x) <- (g, b) does not make
x not unchanging. This is because (g, a) and (g, b) represent necessarily
- different values only if g is the externaly called function. If some
+ different values only if g is the externally called function. If some
value where created during the execution of the function that could
flow to (g, a), then (g, a) <- Top, so (f, x) <- Top.
~stub:fun_decl.stub ~dbg:fun_decl.dbg ~inline:fun_decl.inline
~specialise:fun_decl.specialise ~is_a_functor:fun_decl.is_a_functor
~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
+ ~poll:fun_decl.poll
let make_stub unused var (fun_decl : Flambda.function_declaration)
~specialised_args ~additional_specialised_args =
~stub:true ~dbg:fun_decl.dbg ~inline:Default_inline
~specialise:Default_specialise ~is_a_functor:fun_decl.is_a_functor
~closure_origin:fun_decl.closure_origin
+ ~poll:Default_poll (* don't propagate attribute to wrappers *)
in
function_decl, renamed, additional_specialised_args
specialise : Lambda.specialise_attribute;
is_a_functor : bool;
body : Flambda.t;
+ poll: Lambda.poll_attribute;
}
and function_declaration = {
specialise = fun_decl.specialise;
is_a_functor = fun_decl.is_a_functor;
free_variables = fun_decl.free_variables;
- free_symbols = fun_decl.free_symbols; }
+ free_symbols = fun_decl.free_symbols;
+ poll = fun_decl.poll }
end
in
{ function_body;
specialise : Lambda.specialise_attribute;
is_a_functor : bool;
body : Flambda.t;
+ poll: Lambda.poll_attribute;
}
and function_declaration = private {
| Uclosure (functions, captured_variables) ->
List.iter (loop ~depth) captured_variables;
List.iter (fun (
- { Clambda. label; arity; params; return; body; dbg; env; } as clos) ->
+ { Clambda. label; arity; params; return; body; dbg; env; _ } as clos) ->
(match closure_environment_var clos with
| None -> ()
| Some env_var ->
| Uclosure (functions, captured_variables) ->
ignore_ulambda_list captured_variables;
(* Start a new let stack for speed. *)
- List.iter (fun {Clambda. label; arity; params; return; body; dbg; env} ->
+ List.iter
+ (fun {Clambda. label; arity; params; return; body; dbg; env; _} ->
ignore_function_label label;
ignore_int arity;
ignore_params_with_value_kind params;
opam-version: "2.0"
-version: "4.13.1"
-synopsis: "OCaml 4.13.1"
+version: "4.14.0"
+license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception"
+synopsis: "Official release of OCaml 4.14.0"
depends: [
- "ocaml" {= "4.13.1" & post}
+ "ocaml" {= "4.14.0" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
]
conflict-class: "ocaml-core-compiler"
flags: compiler
-setenv: CAML_LD_LIBRARY_PATH = "%{lib}%/stublibs"
build: [
- ["./configure" "--prefix=%{prefix}%"]
+ ["./configure" "--prefix=%{prefix}%" "--docdir=%{doc}%/ocaml"]
[make "-j%{jobs}%"]
]
install: [make "install"]
odoc_class.cmo \
../parsing/location.cmi \
../typing/ident.cmi \
+ ../typing/btype.cmi \
../parsing/asttypes.cmi \
odoc_ast.cmi
odoc_ast.cmx : \
odoc_class.cmx \
../parsing/location.cmx \
../typing/ident.cmx \
+ ../typing/btype.cmx \
../parsing/asttypes.cmi \
odoc_ast.cmi
odoc_ast.cmi : \
odoc_info.cmx
odoc_env.cmo : \
../typing/types.cmi \
- ../typing/printtyp.cmi \
../typing/predef.cmi \
../typing/path.cmi \
odoc_name.cmi \
odoc_env.cmi
odoc_env.cmx : \
../typing/types.cmx \
- ../typing/printtyp.cmx \
../typing/predef.cmx \
../typing/path.cmx \
odoc_name.cmx \
odoc_types.cmi \
odoc_messages.cmo \
../parsing/longident.cmi \
- ../typing/ctype.cmi \
../typing/btype.cmi \
odoc_misc.cmi
odoc_misc.cmx : \
odoc_types.cmx \
odoc_messages.cmx \
../parsing/longident.cmx \
- ../typing/ctype.cmx \
../typing/btype.cmx \
odoc_misc.cmi
odoc_misc.cmi : \
../parsing/location.cmi
odoc_value.cmo : \
../typing/types.cmi \
- ../typing/printtyp.cmi \
odoc_types.cmi \
odoc_parameter.cmo \
odoc_name.cmi \
../parsing/asttypes.cmi
odoc_value.cmx : \
../typing/types.cmx \
- ../typing/printtyp.cmx \
odoc_types.cmx \
odoc_parameter.cmx \
odoc_name.cmx \
# stdlib non-prefixed :
#######################
-SRC=$(ROOTDIR)
-
.PHONY: autotest_stdlib
autotest_stdlib:
#* *
#**************************************************************************
-OCAMLDOC=$(ROOTDIR)/ocamldoc/ocamldoc$(EXE)
-OCAMLDOC_OPT=$(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE)
+OCAMLDOC = $(ROOTDIR)/ocamldoc/ocamldoc$(EXE)
+OCAMLDOC_OPT = $(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE)
-# 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_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
- else
-# if shared-libraries are not supported, unix.cma and str.cma
-# are compiled with -custom, so ocamldoc also uses -custom,
-# and (ocamlrun ocamldoc) does not work.
- OCAMLDOC_RUN_BYTE=./$(OCAMLDOC)
- endif
+ifeq "$(TARGET)" "$(HOST)"
+ ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
+ OCAMLDOC_RUN_BYTE = $(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) \
+ -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
else
- OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(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 # Windows
- OCAMLDOC_RUN_BYTE = \
- CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC)
+else
+ OCAMLDOC_RUN_BYTE = $(OCAMLRUN) ./$(OCAMLDOC)
endif
-OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT)
+OCAMLDOC_RUN_OPT = ./$(OCAMLDOC_OPT)
-OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE)
+OCAMLDOC_RUN_PLUGINS = $(OCAMLDOC_RUN_BYTE)
ifeq "$(wildcard $(OCAMLDOC_OPT))" ""
- OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE)
+ OCAMLDOC_RUN = $(OCAMLDOC_RUN_BYTE)
else
- OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT)
+ OCAMLDOC_RUN = $(OCAMLDOC_RUN_OPT)
endif
| Typedtree.Tpat_construct (_, cons_desc, _, _) when
(* we give a name to the parameter only if it is unit *)
- (match cons_desc.cstr_res.desc with
- Tconstr (p, _, _) ->
- Path.same p Predef.path_unit
- | _ ->
- false)
+ Path.same (Btype.cstr_type_path cons_desc) Predef.path_unit
->
(* a () argument, it never has description *)
Simple_name { sn_name = "()" ;
with Not_found -> raise (Failure (Odoc_messages.method_type_not_found current_class_name label))
in
let real_type =
- match met_type.Types.desc with
+ match get_desc met_type with
Tarrow (_, _, t, _) ->
t
| _ ->
with Not_found -> raise (Failure (Odoc_messages.method_not_found_in_typedtree complete_name))
in
let real_type =
- match exp.exp_type.desc with
+ match get_desc exp.exp_type with
Tarrow (_, _, t,_) ->
t
| _ ->
let ext_loc_end = tt_ext.ext_loc.Location.loc_end.Lexing.pos_cnum in
let new_xt =
match tt_ext.ext_kind with
- Text_decl(args, ret_type) ->
+ Text_decl(_, args, ret_type) ->
let xt_args =
Sig.get_cstr_args new_env ext_loc_end args in
{
let new_env = Odoc_env.add_extension env complete_name in
let new_ext =
match tt_ext.Typedtree.tyexn_constructor.ext_kind with
- Text_decl(tt_args, tt_ret_type) ->
+ Text_decl(_, tt_args, tt_ret_type) ->
let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
let ex_args =
print_env_types env ;
print_newline ();
*)
- Printtyp.mark_loops t;
let deja_vu = ref [] in
let rec iter t =
if List.memq t !deja_vu then () else begin
deja_vu := t :: !deja_vu;
Btype.iter_type_expr iter t;
- match t.Types.desc with
- | Types.Tconstr (p, [_], _) when Path.same p Predef.path_option ->
+ let open Types in
+ match get_desc t with
+ | Tconstr (p, [_], _) when Path.same p Predef.path_option ->
()
- | Types.Tconstr (p, l, a) ->
+ | Tconstr (p, l, a) ->
let new_p =
Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
- Btype.set_type_desc t (Types.Tconstr (new_p, l, a))
- | Types.Tpackage (p, fl) ->
+ set_type_desc t (Tconstr (new_p, l, a))
+ | Tpackage (p, fl) ->
let new_p =
- Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
- Btype.set_type_desc t (Types.Tpackage (new_p, fl))
- | Types.Tobject (_, ({contents=Some(p,tyl)} as r)) ->
+ Odoc_name.to_path
+ (full_module_type_name env (Odoc_name.from_path p)) in
+ set_type_desc t (Tpackage (new_p, fl))
+ | Tobject (_, ({contents=Some(p,tyl)} as r)) ->
let new_p =
Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
r := Some (new_p, tyl)
- | Types.Tvariant ({Types.row_name=Some(p, tyl)} as row) ->
- let new_p =
- Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
- Btype.set_type_desc t
- (Types.Tvariant {row with Types.row_name=Some(new_p, tyl)})
+ | Tvariant row ->
+ begin match row_name row with
+ | Some (p, tyl) ->
+ let new_p =
+ Odoc_name.to_path (full_type_name env (Odoc_name.from_path p))
+ in
+ set_type_desc t (Tvariant (set_row_name row (Some(new_p, tyl))))
+ | None -> ()
+ end
| _ ->
()
end
let open Types in
match t with
Mty_ident p ->
- let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
+ let new_p =
+ Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p))
+ in
Mty_ident new_p
| Mty_alias _
| Mty_signature _ ->
let subst_class_type env t =
let rec iter t =
+ let open Types in
match t with
- Types.Cty_constr (p,texp_list,ct) ->
- let new_p = Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
+ Cty_constr (p,texp_list,ct) ->
+ let new_p =
+ Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
let new_texp_list = List.map (subst_type env) texp_list in
let new_ct = iter ct in
- Types.Cty_constr (new_p, new_texp_list, new_ct)
- | Types.Cty_signature _ ->
+ Cty_constr (new_p, new_texp_list, new_ct)
+ | Cty_signature _ ->
(* we don't handle vals and methods *)
t
- | Types.Cty_arrow (l, texp, ct) ->
+ | Cty_arrow (l, texp, ct) ->
let new_texp = subst_type env texp in
let new_ct = iter ct in
- Types.Cty_arrow (l, new_texp, new_ct)
+ Cty_arrow (l, new_texp, new_ct)
in
iter t
| Longident.Lapply(l1, l2) ->
string_of_longident l1 ^ "(" ^ string_of_longident l2 ^ ")"
-let get_fields type_expr =
- let (fields, _) = Ctype.flatten_fields (Ctype.object_fields type_expr) in
- List.fold_left
- (fun acc -> fun (label, field_kind, typ) ->
- match field_kind with
- Types.Fabsent ->
- acc
- | _ ->
- if label = "*dummy method*" then
- acc
- else
- acc @ [label, typ]
- )
- []
- fields
-
let rec string_of_text t =
let rec iter t_ele =
match t_ele with
let label_name = Btype.label_name
let remove_option typ =
- let rec iter t =
+ let open Types in
+ let rec trim t =
match t with
- | Types.Tconstr(path, [ty], _) when Path.same path Predef.path_option -> ty.Types.desc
- | Types.Tconstr _
- | Types.Tvar _
- | Types.Tunivar _
- | Types.Tpoly _
- | Types.Tarrow _
- | Types.Ttuple _
- | Types.Tobject _
- | Types.Tfield _
- | Types.Tnil
- | Types.Tvariant _
- | Types.Tpackage _ -> t
- | Types.Tlink t2 -> iter t2.Types.desc
- | Types.Tsubst _ -> assert false
+ | Tconstr(path, [ty], _)
+ when Path.same path Predef.path_option -> get_desc ty
+ | Tconstr _
+ | Tvar _
+ | Tunivar _
+ | Tpoly _
+ | Tarrow _
+ | Ttuple _
+ | Tobject _
+ | Tfield _
+ | Tnil
+ | Tvariant _
+ | Tpackage _ -> t
+ | Tlink t2 -> trim (get_desc t2)
+ | Tsubst _ -> assert false
in
- Types.Private_type_expr.create (iter typ.Types.desc)
- ~level:typ.Types.level ~scope:typ.Types.scope ~id:typ.Types.id
+ Transient_expr.type_expr
+ (Transient_expr.create (trim (get_desc typ))
+ ~level:(get_level typ)
+ ~scope:(get_scope typ)
+ ~id:(get_id typ))
(** This function creates a string from a Longident.t .*)
val string_of_longident : Longident.t -> string
-(** This function returns the list of (label, type_expr) describing
- the methods of a type_expr in a Tobject.*)
-val get_fields : Types.type_expr -> (string * Types.type_expr) list
-
(** get a string from a text *)
val string_of_text : Odoc_types.text -> string
let string_of_type_expr t =
- Printtyp.mark_loops t;
- Printtyp.type_scheme_max ~b_reset_names: false type_fmt t;
+ Printtyp.shared_type_scheme type_fmt t;
flush_type_fmt ()
exception Use_code of string
from the signatures. Used when we don't want to print a too long class type.*)
let simpl_class_type t =
let rec iter t =
+ let open Types in
match t with
- Types.Cty_constr _ -> t
- | Types.Cty_signature cs ->
+ Cty_constr _ -> t
+ | Cty_signature cs ->
(* we delete vals and methods in order to not print them when
displaying the type *)
+ let self_row =
+ Transient_expr.create Tnil
+ ~level:0 ~scope:Btype.lowest_level ~id:0
+ in
let tself =
- let t = cs.Types.csig_self in
- let t' = Types.Private_type_expr.create Types.Tnil
- ~level:0 ~scope:Btype.lowest_level ~id:0 in
- let desc = Types.Tobject (t', ref None) in
- Types.Private_type_expr.create desc
- ~level:t.Types.level ~scope:t.Types.scope ~id:t.Types.id
+ let t = cs.csig_self in
+ let desc = Tobject (Transient_expr.type_expr self_row, ref None) in
+ Transient_expr.create desc
+ ~level:(get_level t) ~scope:(get_scope t) ~id:(get_id t)
in
- Types.Cty_signature { Types.csig_self = tself;
- csig_vars = Types.Vars.empty ;
- csig_concr = Types.Concr.empty ;
- csig_inher = []
- }
+ Types.Cty_signature { csig_self = Transient_expr.type_expr tself;
+ csig_self_row = Transient_expr.type_expr self_row;
+ csig_vars = Vars.empty ;
+ csig_meths = Meths.empty ; }
| Types.Cty_arrow (l, texp, ct) ->
let new_ct = iter ct in
- Types.Cty_arrow (l, texp, new_ct)
+ Cty_arrow (l, texp, new_ct)
in
iter t
type_expr
let search_method_type name class_sig =
- let fields = Odoc_misc.get_fields class_sig.Types.csig_self in
- List.assoc name fields
+ let (_, _, type_expr) = Types.Meths.find name class_sig.Types.csig_meths in
+ type_expr
end
module type Info_retriever =
let manifest_structure env name_comment_list type_expr =
- match type_expr.desc with
+ match get_desc type_expr with
| Tobject (fields, _) ->
let f (field_name, _, type_expr) =
let comment_opt =
else
""
let rec is_arrow_type t =
- match t.Types.desc with
+ match Types.get_desc t with
Types.Tarrow _ -> true
| Types.Tlink t2 -> is_arrow_type t2
| Types.Ttuple _
let buf = Buffer.create 256 in
let fmt = Format.formatter_of_buffer buf in
let rec need_parent t =
- match t.Types.desc with
+ match Types.get_desc t with
Types.Tarrow _ | Types.Ttuple _ -> true
| Types.Tlink t2 -> need_parent t2
| Types.Tconstr _
| Types.Tsubst _ -> assert false
in
let print_one_type variance t =
- Printtyp.mark_loops t;
if need_parent t then
(
Format.fprintf fmt "(%s" variance;
- Printtyp.type_scheme_max ~b_reset_names: false fmt t;
+ Printtyp.shared_type_scheme fmt t;
Format.fprintf fmt ")"
)
else
(
Format.fprintf fmt "%s" variance;
- Printtyp.type_scheme_max ~b_reset_names: false fmt t
+ Printtyp.shared_type_scheme fmt t
)
in
begin match type_list with
[parameter_list_from_arrows t = [ a ; b ]] if t = a -> b -> c.*)
let parameter_list_from_arrows typ =
let rec iter t =
- match t.Types.desc with
+ match Types.get_desc t with
Types.Tarrow (l, t1, t2, _) ->
(l, t1) :: (iter t2)
| Types.Tlink texp
parameter names from the .ml and the type from the .mli file. *)
let dummy_parameter_list typ =
let normal_name = Odoc_misc.label_name in
- Printtyp.mark_loops typ;
let liste_param = parameter_list_from_arrows typ in
let rec iter (label, t) =
- match t.Types.desc with
+ match Types.get_desc t with
| Types.Ttuple l ->
let open Asttypes in
if label = Nolabel then
(** Return true if the value is a function, i.e. has a functional type.*)
let is_function v =
let rec f t =
- match t.Types.desc with
+ match Types.get_desc t with
Types.Tarrow _ ->
true
| Types.Tlink t ->
log_redirection "stdout" stdout_filename;
log_redirection "stderr" stderr_filename;
let systemenv =
- Array.append
+ Environments.append_to_system_env
environment
- (Environments.to_system_env env)
+ env
in
let timeout =
match timeout with
module VariableMap = Map.Make (Variables)
-type t = string VariableMap.t
+type t = string option VariableMap.t
let empty = VariableMap.empty
let to_bindings env =
- let f variable value lst = (variable, value) :: lst in
+ let f variable value lst =
+ Option.fold ~none:lst ~some:(fun value -> (variable, value) :: lst) value
+ in
VariableMap.fold f env []
let expand_aux env value =
let expanded = expand_aux env value in
if expanded=value then value else expand env expanded
-let to_system_env env =
+let expand env = function
+ | None -> raise Not_found
+ | Some value -> expand env value
+
+let append_to_system_env environment env =
+ (* Augment env with any bindings which are only in environment. This must be
+ done here as the Windows C implementation doesn't process multiple values
+ in settings.envp. *)
+ let env =
+ let update env binding =
+ let name, value =
+ match String.index binding '=' with
+ | c ->
+ let name = String.sub binding 0 c in
+ let value =
+ String.sub binding (c + 1) (String.length binding - c - 1) in
+ (name, Some value)
+ | exception Not_found ->
+ (binding, None)
+ in
+ let var = Variables.make (name, "system env var") in
+ if not (VariableMap.mem var env) then
+ VariableMap.add var value env
+ else
+ env
+ in
+ Array.fold_left update env environment
+ in
let system_env = Array.make (VariableMap.cardinal env) "" in
let i = ref 0 in
let store variable value =
+ let some value =
+ Variables.string_of_binding variable (expand env (Some value)) in
system_env.(!i) <-
- Variables.string_of_binding variable (expand env value);
+ Option.fold ~none:(Variables.name_of_variable variable) ~some value;
incr i in
VariableMap.iter store env;
system_env
+let to_system_env env =
+ append_to_system_env [||] env
+
let lookup variable env =
try Some (expand env (VariableMap.find variable env)) with Not_found -> None
let is_variable_defined variable env =
VariableMap.mem variable env
-let add variable value env = VariableMap.add variable value env
+let add variable value env = VariableMap.add variable (Some value) env
let add_if_undefined variable value env =
if VariableMap.mem variable env then env else add variable value env
let append variable appened_value environment =
let previous_value = safe_lookup variable environment in
let new_value = previous_value ^ appened_value in
- VariableMap.add variable new_value environment
+ VariableMap.add variable (Some new_value) environment
let remove = VariableMap.remove
+let unsetenv variable environment =
+ VariableMap.add variable None environment
+
let add_bindings bindings env =
let f env (variable, value) = add variable value env in
List.fold_left f env bindings
let from_bindings bindings = add_bindings bindings empty
-let dump_assignment log (variable, value) =
- Printf.fprintf log "%s = %s\n%!" (Variables.name_of_variable variable) value
+let dump_assignment log = function
+ | (variable, Some value) ->
+ Printf.fprintf log "%s = %s\n%!" (Variables.name_of_variable variable) value
+ | (variable, None) ->
+ Printf.fprintf log "unsetenv %s\n%!" (Variables.name_of_variable variable)
let dump log environment =
List.iter (dump_assignment log) (VariableMap.bindings environment)
val from_bindings : (Variables.t * string) list -> t
val to_bindings : t -> (Variables.t * string) list
val to_system_env : t -> string array
+val append_to_system_env : string array -> t -> string array
val lookup : Variables.t -> t -> string option
val lookup_nonempty : Variables.t -> t -> string option
val add_if_undefined : Variables.t -> string -> t -> t
val add_bindings : (Variables.t * string) list -> t -> t
+val unsetenv : Variables.t -> t -> t
+(** [unsetenv env name] causes [name] to be ignored from the underlying system
+ environment *)
+
val append : Variables.t -> string -> t -> t
val dump : out_channel -> t -> unit
let (msg, children_behavior, summary) = match behavior with
| Skip_all_tests -> "n/a", Skip_all_tests, No_failure
| Run env ->
- let testenv0 = interprete_environment_statements env testenvspec in
+ let testenv0 = interpret_environment_statements env testenvspec in
let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
let (result, newenv) = Tests.run log testenv test in
let msg = Result.string_of_result result in
let rootenv =
Environments.initialize Environments.Pre log initial_environment in
let rootenv =
- interprete_environment_statements
- rootenv rootenv_statements in
+ interpret_environment_statements rootenv rootenv_statements in
let rootenv = Environments.initialize Environments.Post log rootenv in
let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
let initial_status =
program
] in
let systemenv =
- Array.append
+ Environments.append_to_system_env
default_ocaml_env
- (Environments.to_system_env (env_with_lib_unix env))
+ (env_with_lib_unix env)
in
let expected_exit_status = 0 in
let exit_status =
] in
let ocamllib = [| (Printf.sprintf "OCAMLLIB=%s" tools_directory) |] in
let systemenv =
- Array.concat
- [
- default_ocaml_env;
- ocamllib;
- (Environments.to_system_env (env_with_lib_unix env))
- ]
+ Environments.append_to_system_env
+ (Array.concat
+ [
+ default_ocaml_env;
+ ocamllib;
+ ])
+ (env_with_lib_unix env)
in
let expected_exit_status = 0 in
let exit_status =
setup_ocaml_build_env;
ocaml;
check_ocaml_output;
-(*
+ ]
+}
+
+let nattoplevel = {
+ test_name = "toplevel.opt";
+ test_run_by_default = false;
+ test_actions =
+ [
+ shared_libraries;
setup_ocamlnat_build_env;
ocamlnat;
check_ocamlnat_output;
-*)
]
}
bytecode;
native;
toplevel;
+ nattoplevel;
expect;
ocamldoc;
asmgen;
if local_value="" then current_value else
if current_value="" then local_value else
String.concat Filename.path_sep [local_value; current_value] in
- Printf.sprintf "%s=%s" caml_ld_library_path_name new_value
+ (caml_ld_library_path_name, new_value)
let caml_ld_library_path =
make_with_exporter
"Expected exit status of ocamlopt.opt")
let export_ocamlrunparam value =
- Printf.sprintf "%s=%s" "OCAMLRUNPARAM" value
+ ("OCAMLRUNPARAM", value)
let ocamlrunparam =
make_with_exporter
char realpath1[PATH_MAX], realpath2[PATH_MAX];
if (realpath(path1, realpath1) == NULL)
realpath_error(path1);
- if (realpath(path2, realpath2) == NULL)
- {
- if (errno == ENOENT) return 0;
- else realpath_error(path2);
- }
+ if (realpath(path2, realpath2) == NULL)
+ {
+ if (errno == ENOENT) return 0;
+ else realpath_error(path2);
+ }
#endif /* __GLIBC__ */
if (strcmp(realpath1, realpath2) == 0)
same_file = 1;
setenv(name, value, 1); /* 1 means overwrite */
free(name);
free(value);
+ } else {
+ unsetenv(*envp);
}
}
}
/* Compute length of local environment */
localenv_length = 0;
- q = localenv;
- while (*q != NULL) {
+ for (q = localenv; *q != NULL; q++) {
localenv_length += wcslen(*q) + 1;
- q++;
}
/* Build new env that contains both process and local env */
}
r = env;
p = process_env;
+ /* Copy process_env to env only if the given names are not in localenv */
while (*p != L'\0') {
+ wchar_t *pos_eq = wcschr(p, L'=');
+ int copy = 1;
l = wcslen(p) + 1; /* also count terminating '\0' */
- memcpy(r, p, l * sizeof(WCHAR));
+ /* Temporarily change the = to \0 for wcscmp */
+ *pos_eq = L'\0';
+ for (q = localenv; *q != NULL; q++) {
+ wchar_t *pos_eq2 = wcschr(*q, L'=');
+ /* Compare this name in localenv with the current one in processenv */
+ if (pos_eq2) *pos_eq2 = L'\0';
+ if (!wcscmp(*q, p)) copy = 0;
+ if (pos_eq2) *pos_eq2 = L'=';
+ }
+ *pos_eq = L'=';
+ if (copy) {
+ /* This name is not marked for deletion/update in localenv, so copy */
+ memcpy(r, p, l * sizeof(WCHAR));
+ r += l;
+ }
p += l;
- r += l;
}
FreeEnvironmentStrings(process_env);
- q = localenv;
- while (*q != NULL) {
- l = wcslen(*q) + 1;
- memcpy(r, *q, l * sizeof(WCHAR));
- r += l;
- q++;
+ for (q = localenv; *q != NULL; q++) {
+ /* A string in localenv without '=' signals deletion, which has been done */
+ wchar_t *pos_eq = wcschr(*q, L'=');
+ if (pos_eq) {
+ l = wcslen(*q) + 1;
+ memcpy(r, *q, l * sizeof(WCHAR));
+ r += l;
+ }
}
*r = L'\0';
return env;
| Assignment of bool * string located * string located (* variable = value *)
| Append of string located * string located
| Include of string located (* include named environment *)
+ | Unset of string located (* clear environment variable *)
type tsl_item =
| Environment_statement of environment_statement located
| Assignment of bool * string located * string located (* variable = value *)
| Append of string located * string located (* variable += value *)
| Include of string located (* include named environment *)
+ | Unset of string located (* clear environment variable *)
type tsl_item =
| Environment_statement of environment_statement located
match s with
| "include" -> INCLUDE
| "set" -> SET
+ | "unset" -> UNSET
| "with" -> WITH
| _ -> IDENTIFIER s
}
%token <int> TEST_DEPTH
%token EQUAL PLUSEQUAL
/* %token COLON */
-%token INCLUDE SET WITH
+%token INCLUDE SET UNSET WITH
%token <string> IDENTIFIER
%token <string> STRING
{ mkenvstmt (Append ($1, $3)) }
| SET identifier EQUAL string
{ mkenvstmt (Assignment (true, $2, $4)) }
+| UNSET identifier
+ { mkenvstmt (Unset $2) }
| INCLUDE identifier
{ mkenvstmt (Include $2) }
with Variables.No_such_variable name ->
no_such_variable loc name
-let interprete_environment_statement env statement = match statement.node with
+let interpret_environment_statement env statement = match statement.node with
| Assignment (decl, var, value) ->
add_to_env decl statement.loc var.node value.node env
| Append (var, value) ->
append_to_env statement.loc var.node value.node env
| Include modifiers_name ->
apply_modifiers env modifiers_name
-
-let interprete_environment_statements env l =
- List.fold_left interprete_environment_statement env l
+ | Unset var ->
+ let var =
+ match Variables.find_variable var.node with
+ | None -> Variables.make (var.node,"User variable")
+ | Some var -> var
+ in
+ Environments.unsetenv var env
+
+let interpret_environment_statements env l =
+ List.fold_left interpret_environment_statement env l
type test_tree =
| Node of
val apply_modifiers : Environments.t -> string located -> Environments.t
-val interprete_environment_statement :
+val interpret_environment_statement :
Environments.t -> Tsl_ast.environment_statement Tsl_ast.located ->
Environments.t
-val interprete_environment_statements :
+val interpret_environment_statements :
Environments.t -> Tsl_ast.environment_statement Tsl_ast.located list ->
Environments.t
type value = string
-type exporter = value -> string
+type exporter = value -> string * string
type t = {
variable_name : string;
exception No_such_variable of string
-let default_exporter varname value = Printf.sprintf "%s=%s" varname value
+let default_exporter varname value = (varname, value)
let make (name, description) =
if name="" then raise Empty_variable_name else {
with Not_found -> None
let string_of_binding variable value =
- variable.variable_exporter value
+ let (varname, value) = variable.variable_exporter value in
+ Printf.sprintf "%s=%s" varname value
let get_registered_variables () =
let f _variable_name variable variable_list = variable::variable_list in
type value = string
-type exporter = value -> string
+type exporter = value -> string * string
type t
typing/path.ml \
typing/primitive.ml \
typing/type_immediacy.ml \
+ typing/shape.ml \
typing/types.ml \
typing/btype.ml \
typing/subst.ml \
dynlink.cmti dynlink.mli \
"$(INSTALL_LIBDIR)"
endif
- $(INSTALL_PROG) $(extract_crc) "$(INSTALL_LIBDIR)"
installopt:
if $(NATDYNLINK); then \
- [\ ] Quotes special characters. The special characters
are [$^\.*+?[]].
- Note: the argument to [regexp] is usually a string literal. In this
- case, any backslash character in the regular expression must be
- doubled to make it past the OCaml string parser. For example, the
- following expression:
+ In regular expressions you will often use backslash characters; it's
+ easier to use a quoted string literal [{|...|}] to avoid having to
+ escape backslashes.
+
+ For example, the following expression:
+ {[ let r = Str.regexp {|hello \([A-Za-z]+\)|} in
+ Str.replace_first r {|\1|} "hello world" ]}
+ returns the string ["world"].
+
+ If you want a regular expression that matches a literal backslash
+ character, you need to double it: [Str.regexp {|\\|}].
+
+ You can use regular string literals ["..."] too, however you will
+ have to escape backslashes. The example above can be rewritten with a
+ regular string literal as:
{[ let r = Str.regexp "hello \\([A-Za-z]+\\)" in
Str.replace_first r "\\1" "hello world" ]}
- returns the string ["world"].
- In particular, if you want a regular expression that matches a single
- backslash character, you need to quote it in the argument to [regexp]
- (according to the last item of the list above) by adding a second
- backslash. Then you need to quote both backslashes (according to the
- syntax of string constants in OCaml) by doubling them again, so you
- need to write four backslash characters: [Str.regexp "\\\\"].
-*)
+ And the regular expression for matching a backslash becomes a
+ quadruple backslash: [Str.regexp "\\\\"]. *)
val regexp_case_fold : string -> regexp
(** Same as [regexp], but the compiled expression will match text
#define Clear_tag(p) ((value *) ((intnat)(p) & ~1))
#define Tag_is_set(p) ((intnat)(p) & 1)
-#define BACKTRACK_STACK_BLOCK_SIZE 500
+#define BACKTRACK_STACK_BLOCK_SIZE 200
struct backtrack_stack {
struct backtrack_stack * previous;
/* Record positions reached during matching; used to check progress
in repeated matching of a regexp. */
#define NUM_REGISTERS 64
-static unsigned char * re_register[NUM_REGISTERS];
-
-/* The initial backtracking stack */
-static struct backtrack_stack initial_stack = { NULL, };
+typedef unsigned char * progress_registers[NUM_REGISTERS];
/* Free a chained list of backtracking stacks */
static void free_backtrack_stack(struct backtrack_stack * stack)
/* Determine if a character is a word constituent */
/* PR#4874: word constituent = letter, digit, underscore. */
-static unsigned char re_word_letters[32] = {
+static const unsigned char re_word_letters[32] = {
0x00, 0x00, 0x00, 0x00, /* 0x00-0x1F: none */
0x00, 0x00, 0xFF, 0x03, /* 0x20-0x3F: digits 0-9 */
0xFE, 0xFF, 0xFF, 0x87, /* 0x40-0x5F: A to Z, _ */
register unsigned char * endtxt,
int accept_partial_match)
{
+ /* Fields of [re] */
+ value cpool;
+ value normtable;
+ int numgroups;
+ /* Currently-executing instruction */
register value * pc;
intnat instr;
+ unsigned char c;
+ /* Backtracking */
+ struct backtrack_stack initial_stack;
struct backtrack_stack * stack;
union backtrack_point * sp;
- value cpool;
- value normtable;
- unsigned char c;
union backtrack_point back;
+ /* Checking for progress */
+ progress_registers re_register;
+ /* Recording matched groups */
struct re_group default_groups[DEFAULT_NUM_GROUPS];
struct re_group * groups;
- int numgroups = Numgroups(re);
+ /* Final matching info */
value result;
+ numgroups = Numgroups(re);
if (numgroups <= DEFAULT_NUM_GROUPS)
groups = default_groups;
else
}
pc = &Field(Prog(re), 0);
+ initial_stack.previous = NULL;
stack = &initial_stack;
sp = stack->point;
cpool = Cpool(re);
#include "caml/backtrace.h"
#include "caml/callback.h"
#include "caml/custom.h"
+#include "caml/debugger.h"
#include "caml/domain.h"
#include "caml/fail.h"
#include "caml/io.h"
#ifdef NATIVE_CODE
}
#endif
+ caml_stop_stack_overflow_detection();
/* The thread now stops running */
return 0;
}
caml_thread_t th;
st_retcode err;
+#ifndef NATIVE_CODE
+ if (caml_debugger_in_use)
+ caml_fatal_error("ocamldebug does not support multithreaded programs");
+#endif
/* Create a thread info block */
th = caml_thread_new_info();
if (th == NULL) caml_raise_out_of_memory();
let[@inline never] check_memprof_cb () = ref ()
+let default_uncaught_exception_handler = thread_uncaught_exception
+
+let uncaught_exception_handler = ref default_uncaught_exception_handler
+
+let set_uncaught_exception_handler fn = uncaught_exception_handler := fn
+
+exception Exit
+
let create fn arg =
thread_new
(fun () ->
try
fn arg;
ignore (Sys.opaque_identity (check_memprof_cb ()))
- with exn ->
- flush stdout; flush stderr;
- thread_uncaught_exception exn)
+ with
+ | Exit ->
+ ignore (Sys.opaque_identity (check_memprof_cb ()))
+ | exn ->
+ let raw_backtrace = Printexc.get_raw_backtrace () in
+ flush stdout; flush stderr;
+ try
+ !uncaught_exception_handler exn
+ with
+ | Exit -> ()
+ | exn' ->
+ Printf.eprintf
+ "Thread %d killed on uncaught exception %s\n"
+ (id (self ())) (Printexc.to_string exn);
+ Printexc.print_raw_backtrace stderr raw_backtrace;
+ Printf.eprintf
+ "Thread %d uncaught exception handler raised %s\n"
+ (id (self ())) (Printexc.to_string exn');
+ Printexc.print_backtrace stdout;
+ flush stderr)
let exit () =
ignore (Sys.opaque_identity (check_memprof_cb ()));
The application of [Thread.create]
returns the handle of the newly created thread.
The new thread terminates when the application [funct arg]
- returns, either normally or by raising an uncaught exception.
- In the latter case, the exception is printed on standard error,
+ returns, either normally or by raising the {!Thread.Exit} exception
+ or by raising any other uncaught exception.
+ In the last case, the uncaught exception is printed on standard error,
but not propagated back to the parent thread. Similarly, the
result of the application [funct arg] is discarded and not
directly accessible to the parent thread. *)
is an integer that identifies uniquely the thread.
It can be used to build data structures indexed by threads. *)
+exception Exit
+(** Exception that can be raised by user code to initiate termination
+ of the current thread.
+ Compared to calling the {!Thread.exit} function, raising the
+ {!Thread.Exit} exception will trigger {!Fun.finally} finalizers
+ and catch-all exception handlers.
+ It is the recommended way to terminate threads prematurely.
+
+ @since 4.14.0
+*)
+
val exit : unit -> unit
(** Terminate prematurely the currently executing thread. *)
Signal handlers attached to the signals in [sigs] will not
be invoked. The signals [sigs] are expected to be blocked before
calling [wait_signal]. *)
+
+(** {1 Uncaught exceptions} *)
+
+val default_uncaught_exception_handler : exn -> unit
+(** [Thread.default_uncaught_exception_handler] will print the thread's id,
+ exception and backtrace (if available). *)
+
+val set_uncaught_exception_handler : (exn -> unit) -> unit
+(** [Thread.set_uncaught_exception_handler fn] registers [fn] as the handler
+ for uncaught exceptions.
+
+ If the newly set uncaught exception handler raise an exception,
+ {!default_uncaught_exception_handler} will be called. *)
socklen_param_type * adr_len /*out*/)
{
switch(Tag_val(mladr)) {
-#ifndef _WIN32
case 0: /* ADDR_UNIX */
{ value path;
mlsize_t len;
+ len;
break;
}
-#endif
case 1: /* ADDR_INET */
#ifdef HAS_IPV6
if (caml_string_length(Field(mladr, 0)) == 16) {
socklen_param_type adr_len, int close_on_error)
{
value res;
-#ifndef _WIN32
if (adr_len < offsetof(struct sockaddr, sa_data)) {
// Only possible for an unnamed AF_UNIX socket, in
// which case sa_family might be uninitialized.
return alloc_unix_sockaddr(caml_alloc_string(0));
}
-#endif
switch(adr->s_gen.sa_family) {
-#ifndef _WIN32
case AF_UNIX:
{ /* Based on recommendation in section BUGS of Linux unix(7). See
http://man7.org/linux/man-pages/man7/unix.7.html. */
);
break;
}
-#endif
case AF_INET:
{ value a = alloc_inet_addr(&adr->s_inet.sin_addr);
Begin_root (a);
#define CAML_SOCKETADDR_H
#include "caml/misc.h"
-#ifndef _WIN32
+
+#ifdef _WIN32
+
+/* Code duplication with runtime/debugger.c is inevitable, because
+ * pulling winsock2.h creates many naming conflicts. */
+#include <winsock2.h>
+#ifdef HAS_AFUNIX_H
+#include <afunix.h>
+#else
+#define UNIX_PATH_MAX 108
+
+struct sockaddr_un {
+ ADDRESS_FAMILY sun_family;
+ char sun_path[UNIX_PATH_MAX];
+};
+
+#define SIO_AF_UNIX_GETPEERPID _WSAIOR(IOC_VENDOR, 256)
+
+#endif
+
+#else
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
union sock_addr_union {
struct sockaddr s_gen;
-#ifndef _WIN32
struct sockaddr_un s_unix;
-#endif
struct sockaddr_in s_inet;
#ifdef HAS_IPV6
struct sockaddr_in6 s_inet6;
(** Fork a new process. The returned integer is 0 for the child
process, the pid of the child process for the parent process.
- On Windows: not implemented, use {!create_process} or threads. *)
+ @raise Invalid_argument on Windows. Use {!create_process} or threads
+ instead. *)
val wait : unit -> int * process_status
(** Wait until one of the children processes die, and return its pid
and termination status.
- On Windows: not implemented, use {!waitpid}. *)
+ @raise Invalid_argument on Windows. Use {!waitpid} instead. *)
val waitpid : wait_flag list -> int -> int * process_status
(** Same as {!wait}, but waits for the child process whose pid is given.
val getppid : unit -> int
(** Return the pid of the parent process.
- On Windows: not implemented (because it is meaningless). *)
+ @raise Invalid_argument on Windows (because it is
+ meaningless) *)
val nice : int -> int
(** Change the process priority. The integer argument is added to the
``nice'' value. (Higher values of the ``nice'' value mean
lower priorities.) Return the new nice value.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 Basic file input/output} *)
val fchmod : file_descr -> file_perm -> unit
(** Change the permissions of an opened file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val chown : string -> int -> int -> unit
(** Change the owner uid and owner gid of the named file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val fchown : file_descr -> int -> int -> unit
(** Change the owner uid and owner gid of an opened file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val umask : int -> int
(** Set the process's file mode creation mask, and return the previous
mask.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val access : string -> access_permission list -> unit
(** Check that the process has the given permissions over the named file.
val chroot : string -> unit
(** Change the process root directory.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type dir_handle
(** The type of descriptors over opened directories. *)
val mkfifo : string -> file_perm -> unit
(** Create a named pipe with the given permissions (see {!umask}).
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 High-level process and redirection management} *)
concurrently with the current process.
The standard input and outputs of the new process are connected
to the descriptors [stdin], [stdout] and [stderr].
- Passing e.g. [Stdlib.stdout] for [stdout] prevents the redirection
+ Passing e.g. {!Unix.stdout} for [stdout] prevents the redirection
and causes the new process to have the same standard output
as the current process.
The executable file [prog] is searched in the path.
function redirects to [Thread.sigmask]. I.e., [sigprocmask] only
changes the mask of the current thread.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
val sigpending : unit -> int list
(** Return the set of blocked signals that are currently pending.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process
+ signals on Windows) *)
val sigsuspend : int list -> unit
(** [sigsuspend sigs] atomically sets the blocked signals to [sigs]
and waits for a non-ignored, non-blocked signal to be delivered.
On return, the blocked signals are reset to their initial value.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
val pause : unit -> unit
(** Wait until a non-ignored, non-blocked signal is delivered.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
(** {1 Time functions} *)
val alarm : int -> int
(** Schedule a [SIGALRM] signal after the given number of seconds.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val sleep : int -> unit
(** Stop execution for the given number of seconds. *)
val getitimer : interval_timer -> interval_timer_status
(** Return the current status of the given interval timer.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val setitimer :
interval_timer -> interval_timer_status -> interval_timer_status
Setting [s.it_interval] to zero causes the timer to be disabled
after its next expiration.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 User id, group id} *)
val setuid : int -> unit
(** Set the real user id and effective user id for the process.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val getgid : unit -> int
(** Return the group id of the user executing the process.
val setgid : int -> unit
(** Set the real group id and effective group id for the process.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val getgroups : unit -> int array
(** Return the list of groups to which the user executing the process
(** [setgroups groups] sets the supplementary group IDs for the
calling process. Appropriate privileges are required.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val initgroups : string -> int -> unit
(** [initgroups user group] initializes the group access list by
which [user] is a member. The additional group [group] is also
added to the list.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type passwd_entry =
{ pw_name : string;
(** The type of socket domains. Not all platforms support
IPv6 sockets (type [PF_INET6]).
- On Windows: [PF_UNIX] not implemented. *)
+ On Windows: [PF_UNIX] supported since 4.14.0 on Windows 10 1803
+ and later. *)
type socket_type =
SOCK_STREAM (** Stream socket *)
file_descr * file_descr
(** Create a pair of unnamed sockets, connected together.
See {!set_close_on_exec} for documentation on the [cloexec]
- optional argument. *)
+ optional argument.
+
+ @raise Invalid_argument on Windows *)
val accept : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
file_descr -> file_descr * sockaddr
{!Stdlib.close_out} and leave the input channel unclosed,
for reasons explained in {!Unix.in_channel_of_descr}.
- On Windows: not implemented (use threads). *)
+ @raise Invalid_argument on Windows. Use threads instead. *)
(** {1 Host and protocol databases} *)
(** Return the status of the terminal referred to by the given
file descriptor.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type setattr_when =
TCSANOW
the output parameters; [TCSAFLUSH], when changing the input
parameters.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val tcsendbreak : file_descr -> int -> unit
(** Send a break condition on the given file descriptor.
The second argument is the duration of the break, in 0.1s units;
0 means standard duration (0.25s).
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val tcdrain : file_descr -> unit
(** Waits until all output written on the given file descriptor
has been transmitted.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type flush_queue =
TCIFLUSH
[TCOFLUSH] flushes data written but not transmitted, and
[TCIOFLUSH] flushes both.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type flow_action =
TCOOFF
[TCIOFF] transmits a STOP character to suspend input,
and [TCION] transmits a START character to restart input.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val setsid : unit -> int
(** Put the calling process in a new session and detach it from
its controlling terminal.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** Fork a new process. The returned integer is 0 for the child
process, the pid of the child process for the parent process.
- On Windows: not implemented, use {!create_process} or threads. *)
+ @raise Invalid_argument on Windows. Use {!create_process} or threads
+ instead. *)
val wait : unit -> int * process_status
(** Wait until one of the children processes die, and return its pid
and termination status.
- On Windows: not implemented, use {!waitpid}. *)
+ @raise Invalid_argument on Windows. Use {!waitpid} instead. *)
val waitpid : mode:wait_flag list -> int -> int * process_status
(** Same as {!wait}, but waits for the child process whose pid is given.
val getppid : unit -> int
(** Return the pid of the parent process.
- On Windows: not implemented (because it is meaningless). *)
+ @raise Invalid_argument on Windows (because it is
+ meaningless) *)
val nice : int -> int
(** Change the process priority. The integer argument is added to the
``nice'' value. (Higher values of the ``nice'' value mean
lower priorities.) Return the new nice value.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 Basic file input/output} *)
val fchmod : file_descr -> perm:file_perm -> unit
(** Change the permissions of an opened file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val chown : string -> uid:int -> gid:int -> unit
(** Change the owner uid and owner gid of the named file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val fchown : file_descr -> uid:int -> gid:int -> unit
(** Change the owner uid and owner gid of an opened file.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val umask : int -> int
(** Set the process's file mode creation mask, and return the previous
mask.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val access : string -> perm:access_permission list -> unit
(** Check that the process has the given permissions over the named file.
val chroot : string -> unit
(** Change the process root directory.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type dir_handle = Unix.dir_handle
(** The type of descriptors over opened directories. *)
val mkfifo : string -> perm:file_perm -> unit
(** Create a named pipe with the given permissions (see {!umask}).
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 High-level process and redirection management} *)
concurrently with the current process.
The standard input and outputs of the new process are connected
to the descriptors [stdin], [stdout] and [stderr].
- Passing e.g. [Stdlib.stdout] for [stdout] prevents the redirection
+ Passing e.g. {!Unix.stdout} for [stdout] prevents the redirection
and causes the new process to have the same standard output
as the current process.
The executable file [prog] is searched in the path.
function redirects to [Thread.sigmask]. I.e., [sigprocmask] only
changes the mask of the current thread.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
val sigpending : unit -> int list
(** Return the set of blocked signals that are currently pending.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process
+ signals on Windows) *)
val sigsuspend : int list -> unit
(** [sigsuspend sigs] atomically sets the blocked signals to [sigs]
and waits for a non-ignored, non-blocked signal to be delivered.
On return, the blocked signals are reset to their initial value.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
val pause : unit -> unit
(** Wait until a non-ignored, non-blocked signal is delivered.
- On Windows: not implemented (no inter-process signals on Windows). *)
+ @raise Invalid_argument on Windows (no inter-process signals on
+ Windows) *)
(** {1 Time functions} *)
val alarm : int -> int
(** Schedule a [SIGALRM] signal after the given number of seconds.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val sleep : int -> unit
(** Stop execution for the given number of seconds. *)
val getitimer : interval_timer -> interval_timer_status
(** Return the current status of the given interval timer.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val setitimer :
interval_timer -> interval_timer_status -> interval_timer_status
Setting [s.it_interval] to zero causes the timer to be disabled
after its next expiration.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
(** {1 User id, group id} *)
val setuid : int -> unit
(** Set the real user id and effective user id for the process.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val getgid : unit -> int
(** Return the group id of the user executing the process.
val setgid : int -> unit
(** Set the real group id and effective group id for the process.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val getgroups : unit -> int array
(** Return the list of groups to which the user executing the process
(** [setgroups groups] sets the supplementary group IDs for the
calling process. Appropriate privileges are required.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val initgroups : string -> int -> unit
(** [initgroups user group] initializes the group access list by
which [user] is a member. The additional group [group] is also
added to the list.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type passwd_entry = Unix.passwd_entry =
{ pw_name : string;
(** The type of socket domains. Not all platforms support
IPv6 sockets (type [PF_INET6]).
- On Windows: [PF_UNIX] not implemented. *)
+ On Windows: [PF_UNIX] supported since 4.14.0 on Windows 10 1803
+ and later. *)
type socket_type = Unix.socket_type =
SOCK_STREAM (** Stream socket *)
file_descr * file_descr
(** Create a pair of unnamed sockets, connected together.
See {!set_close_on_exec} for documentation on the [cloexec]
- optional argument. *)
+ optional argument.
+
+ @raise Invalid_argument on Windows *)
val accept : ?cloexec: (* thwart tools/sync_stdlib_docs *) bool ->
file_descr -> file_descr * sockaddr
{!Stdlib.close_out} and leave the input channel unclosed,
for reasons explained in {!Unix.in_channel_of_descr}.
- On Windows: not implemented (use threads). *)
+ @raise Invalid_argument on Windows. Use threads instead. *)
(** {1 Host and protocol databases} *)
(** Return the status of the terminal referred to by the given
file descriptor.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type setattr_when = Unix.setattr_when =
TCSANOW
the output parameters; [TCSAFLUSH], when changing the input
parameters.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val tcsendbreak : file_descr -> duration:int -> unit
(** Send a break condition on the given file descriptor.
The second argument is the duration of the break, in 0.1s units;
0 means standard duration (0.25s).
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val tcdrain : file_descr -> unit
(** Waits until all output written on the given file descriptor
has been transmitted.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type flush_queue = Unix.flush_queue =
TCIFLUSH
[TCOFLUSH] flushes data written but not transmitted, and
[TCIOFLUSH] flushes both.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
type flow_action = Unix.flow_action =
TCOOFF
[TCIOFF] transmits a STOP character to suspend input,
and [TCION] transmits a START character to restart input.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
val setsid : unit -> int
(** Put the calling process in a new session and detach it from
its controlling terminal.
- On Windows: not implemented. *)
+ @raise Invalid_argument on Windows *)
caml_unix_check_path(path, "unlink");
p = caml_stat_strdup_to_os(String_val(path));
caml_enter_blocking_section();
- ret = unlink_os(p);
+ ret = caml_unlink(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("unlink", path);
# Files in this directory
WIN_FILES = accept.c bind.c channels.c close.c \
- close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c envir.c \
+ close_on.c connect.c createprocess.c dup.c errmsg.c envir.c \
getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
link.c listen.c lockf.c lseek.c nonblock.c \
mmap.c open.c pipe.c read.c readlink.c rename.c \
realpath.c select.c sendrecv.c \
- shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
+ shutdown.c sleep.c socket.c socketpair.c sockopt.c startup.c stat.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
win32_maperr(err);
uerror("accept", Nothing);
}
- /* This is a best effort, not guaranteed to work, so don't fail on error */
- SetHandleInformation((HANDLE) snew,
- HANDLE_FLAG_INHERIT,
- unix_cloexec_p(cloexec) ? 0 : HANDLE_FLAG_INHERIT);
+ win_set_cloexec((HANDLE) snew, cloexec);
Begin_roots2 (fd, adr)
fd = win_alloc_socket(snew);
adr = alloc_sockaddr(&addr, addr_len, snew);
#include "unixsupport.h"
#include <windows.h>
-int win_set_inherit(value fd, BOOL inherit)
-{
- /* According to the MSDN, SetHandleInformation may not work
- for console handles on WinNT4 and earlier versions. */
- if (! SetHandleInformation(Handle_val(fd),
- HANDLE_FLAG_INHERIT,
- inherit ? HANDLE_FLAG_INHERIT : 0)) {
- win32_maperr(GetLastError());
- return -1;
- }
- return 0;
-}
-
CAMLprim value win_set_close_on_exec(value fd)
{
- if (win_set_inherit(fd, FALSE) == -1) uerror("set_close_on_exec", Nothing);
+ if (win_set_inherit(Handle_val(fd), FALSE) == -1)
+ uerror("set_close_on_exec", Nothing);
return Val_unit;
}
CAMLprim value win_clear_close_on_exec(value fd)
{
- if (win_set_inherit(fd, TRUE) == -1) uerror("clear_close_on_exec", Nothing);
+ if (win_set_inherit(Handle_val(fd), TRUE) == -1)
+ uerror("clear_close_on_exec", Nothing);
return Val_unit;
}
/**************************************************************************/
#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
#include "unixsupport.h"
-CAMLprim value unix_dup(value cloexec, value fd)
+#define _WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+
+static HANDLE duplicate_handle(BOOL inherit, HANDLE oldh)
{
- HANDLE newh;
- value newfd;
- int kind = Descr_kind_val(fd);
- if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
- GetCurrentProcess(), &newh,
+ HANDLE newh, proc = GetCurrentProcess();
+ if (! DuplicateHandle(proc, oldh, proc, &newh,
0L,
- unix_cloexec_p(cloexec) ? FALSE : TRUE,
+ inherit,
DUPLICATE_SAME_ACCESS)) {
win32_maperr(GetLastError());
- return -1;
+ return INVALID_HANDLE_VALUE;
+ }
+ return newh;
+}
+
+static SOCKET duplicate_socket(BOOL inherit, SOCKET oldsock)
+{
+ WSAPROTOCOL_INFO info;
+ SOCKET newsock;
+ if (SOCKET_ERROR == WSADuplicateSocket(oldsock,
+ GetCurrentProcessId(),
+ &info)) {
+ win32_maperr(WSAGetLastError());
+ return INVALID_SOCKET;
+ }
+
+ newsock = WSASocket(info.iAddressFamily, info.iSocketType, info.iProtocol,
+ &info, 0, WSA_FLAG_OVERLAPPED);
+ if (INVALID_SOCKET == newsock)
+ win32_maperr(WSAGetLastError());
+ else
+ win_set_inherit((HANDLE) newsock, inherit);
+ return newsock;
+}
+
+CAMLprim value unix_dup(value cloexec, value fd)
+{
+ CAMLparam2(cloexec, fd);
+ CAMLlocal1(newfd);
+
+ switch (Descr_kind_val(fd)) {
+ case KIND_HANDLE: {
+ HANDLE newh = duplicate_handle(! unix_cloexec_p(cloexec),
+ Handle_val(fd));
+ if (newh == INVALID_HANDLE_VALUE)
+ uerror("dup", Nothing);
+ newfd = win_alloc_handle(newh);
+ CAMLreturn(newfd);
+ }
+ case KIND_SOCKET: {
+ SOCKET newsock = duplicate_socket(! unix_cloexec_p(cloexec),
+ Socket_val(fd));
+ if (newsock == INVALID_SOCKET)
+ uerror("dup", Nothing);
+ newfd = win_alloc_socket(newsock);
+ CAMLreturn(newfd);
+ }
+ default:
+ caml_invalid_argument("Invalid file descriptor type");
+ }
+}
+
+CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
+{
+ CAMLparam3(cloexec, fd1, fd2);
+
+ if (Descr_kind_val(fd1) != Descr_kind_val(fd2))
+ caml_invalid_argument("Expected either two file handles or two sockets");
+
+ switch (Descr_kind_val(fd1)) {
+ case KIND_HANDLE: {
+ HANDLE oldh = Handle_val(fd2),
+ newh = duplicate_handle(! unix_cloexec_p(cloexec),
+ Handle_val(fd1));
+ if (newh == INVALID_HANDLE_VALUE)
+ uerror("dup2", Nothing);
+ Handle_val(fd2) = newh;
+ CloseHandle(oldh);
+ break;
}
- newfd = win_alloc_handle(newh);
- Descr_kind_val(newfd) = kind;
- return newfd;
+ case KIND_SOCKET: {
+ SOCKET oldsock = Socket_val(fd2),
+ newsock = duplicate_socket(! unix_cloexec_p(cloexec),
+ Socket_val(fd1));
+ if (newsock == INVALID_SOCKET)
+ uerror("dup2", Nothing);
+ Socket_val(fd2) = newsock;
+ closesocket(oldsock);
+ break;
+ }
+ default:
+ caml_invalid_argument("Invalid file descriptor type");
+ }
+
+ /* Reflect the dup2 on the CRT fds, if any */
+ if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
+ _dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
+ CAMLreturn(Val_unit);
}
+++ /dev/null
-/**************************************************************************/
-/* */
-/* 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. */
-/* */
-/**************************************************************************/
-
-#include <caml/mlvalues.h>
-#include "unixsupport.h"
-
-CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
-{
- HANDLE oldh, newh;
-
- oldh = Handle_val(fd2);
- if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
- GetCurrentProcess(), &newh,
- 0L,
- unix_cloexec_p(cloexec) ? FALSE : TRUE,
- DUPLICATE_SAME_ACCESS)) {
- win32_maperr(GetLastError());
- return -1;
- }
- Handle_val(fd2) = newh;
- if (Descr_kind_val(fd2) == KIND_SOCKET)
- closesocket((SOCKET) oldh);
- else
- CloseHandle(oldh);
- Descr_kind_val(fd2) = Descr_kind_val(fd1);
- /* Reflect the dup2 on the CRT fds, if any */
- if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
- _dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
- return Val_unit;
-}
#include "unixsupport.h"
#include <errno.h>
#include <winioctl.h>
+#include <caml/winsupport.h>
CAMLprim value unix_readlink(value opath)
{
win32_maperr(WSAGetLastError());
uerror("socket", Nothing);
}
- /* This is a best effort, not guaranteed to work, so don't fail on error */
- SetHandleInformation((HANDLE) s,
- HANDLE_FLAG_INHERIT,
- unix_cloexec_p(cloexec) ? 0 : HANDLE_FLAG_INHERIT);
+ win_set_cloexec((HANDLE) s, cloexec);
return win_alloc_socket(s);
}
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Antonin Decimo, Tarides */
+/* */
+/* Copyright 2021 Tarides */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/misc.h>
+#include <caml/signals.h>
+#include "unixsupport.h"
+#include <errno.h>
+
+#ifdef HAS_SOCKETS
+
+#include "socketaddr.h"
+#include <ws2tcpip.h>
+
+extern int socket_domain_table[]; /* from socket.c */
+extern int socket_type_table[]; /* from socket.c */
+
+#ifdef HAS_SOCKETPAIR
+
+#error "Windows has defined sockepair! win32unix should be updated."
+
+#else
+
+static int socketpair(int domain, int type, int protocol,
+ SOCKET socket_vector[2])
+{
+ wchar_t dirname[MAX_PATH + 1], path[MAX_PATH + 1];
+ union sock_addr_union addr;
+ socklen_param_type socklen;
+
+ /* POSIX states that in case of error, the contents of socket_vector
+ shall be unmodified. */
+ SOCKET listener = INVALID_SOCKET,
+ server = INVALID_SOCKET,
+ client = INVALID_SOCKET;
+
+ fd_set writefds, exceptfds;
+ u_long non_block, peerid = 0UL;
+
+ DWORD drc;
+ int rc;
+
+ if (GetTempPath(MAX_PATH + 1, dirname) == 0) {
+ win32_maperr(GetLastError());
+ goto fail;
+ }
+
+ if (GetTempFileName(dirname, L"osp", 0U, path) == 0) {
+ win32_maperr(GetLastError());
+ goto fail;
+ }
+
+ addr.s_unix.sun_family = PF_UNIX;
+ socklen = sizeof(addr.s_unix);
+
+ /* sun_path needs to be set in UTF-8 */
+ rc = WideCharToMultiByte(CP_UTF8, 0, path, -1, addr.s_unix.sun_path,
+ UNIX_PATH_MAX, NULL, NULL);
+ if (rc == 0) {
+ win32_maperr(GetLastError());
+ goto fail_path;
+ }
+
+ listener = socket(domain, type, protocol);
+ if (listener == INVALID_SOCKET)
+ goto fail_wsa;
+
+ /* The documentation requires removing the file before binding the socket. */
+ if (DeleteFile(path) == 0) {
+ drc = GetLastError();
+ if (drc != ERROR_FILE_NOT_FOUND) {
+ win32_maperr(drc);
+ goto fail_sockets;
+ }
+ }
+
+ rc = bind(listener, (struct sockaddr *) &addr, socklen);
+ if (rc == SOCKET_ERROR)
+ goto fail_wsa;
+
+ rc = listen(listener, 1);
+ if (rc == SOCKET_ERROR)
+ goto fail_wsa;
+
+ client = socket(domain, type, protocol);
+ if (client == INVALID_SOCKET)
+ goto fail_wsa;
+
+ non_block = 1UL;
+ if (ioctlsocket(client, FIONBIO, &non_block) == SOCKET_ERROR)
+ goto fail_wsa;
+
+ rc = connect(client, (struct sockaddr *) &addr, socklen);
+ if (rc != SOCKET_ERROR || WSAGetLastError() != WSAEWOULDBLOCK)
+ goto fail_wsa;
+
+ server = accept(listener, NULL, NULL);
+ if (server == INVALID_SOCKET)
+ goto fail_wsa;
+
+ rc = closesocket(listener);
+ listener = INVALID_SOCKET;
+ if (rc == SOCKET_ERROR)
+ goto fail_wsa;
+
+ FD_ZERO(&writefds);
+ FD_SET(client, &writefds);
+ FD_ZERO(&exceptfds);
+ FD_SET(client, &exceptfds);
+
+ rc = select(0 /* ignored */,
+ NULL, &writefds, &exceptfds,
+ NULL /* blocking */);
+ if (rc == SOCKET_ERROR
+ || FD_ISSET(client, &exceptfds)
+ || !FD_ISSET(client, &writefds)) {
+ /* We're not interested in the socket error status */
+ goto fail_wsa;
+ }
+
+ non_block = 0UL;
+ if (ioctlsocket(client, FIONBIO, &non_block) == SOCKET_ERROR)
+ goto fail_wsa;
+
+ if (DeleteFile(path) == 0) {
+ win32_maperr(GetLastError());
+ goto fail_sockets;
+ }
+
+ rc = WSAIoctl(client, SIO_AF_UNIX_GETPEERPID,
+ NULL, 0U,
+ &peerid, sizeof(peerid), &drc /* Windows bug: always 0 */,
+ NULL, NULL);
+ if (rc == SOCKET_ERROR || peerid != GetCurrentProcessId())
+ goto fail_wsa;
+
+ socket_vector[0] = client;
+ socket_vector[1] = server;
+ return 0;
+
+fail_wsa:
+ win32_maperr(WSAGetLastError());
+
+fail_path:
+ DeleteFile(path);
+
+fail_sockets:
+ if(listener != INVALID_SOCKET)
+ closesocket(listener);
+ if(client != INVALID_SOCKET)
+ closesocket(client);
+ if(server != INVALID_SOCKET)
+ closesocket(server);
+
+fail:
+ return SOCKET_ERROR;
+}
+
+CAMLprim value unix_socketpair(value cloexec, value domain, value type,
+ value protocol)
+{
+ CAMLparam4(cloexec, domain, type, protocol);
+ CAMLlocal1(result);
+ SOCKET sv[2];
+ int rc;
+
+ caml_enter_blocking_section();
+ rc = socketpair(socket_domain_table[Int_val(domain)],
+ socket_type_table[Int_val(type)],
+ Int_val(protocol),
+ sv);
+ caml_leave_blocking_section();
+
+ if (rc == SOCKET_ERROR)
+ uerror("socketpair", Nothing);
+
+ win_set_cloexec((HANDLE) sv[0], cloexec);
+ win_set_cloexec((HANDLE) sv[1], cloexec);
+
+ result = caml_alloc_tuple(2);
+ Store_field(result, 0, win_alloc_socket(sv[0]));
+ Store_field(result, 1, win_alloc_socket(sv[1]));
+ CAMLreturn(result);
+}
+
+#endif /* HAS_SOCKETPAIR */
+
+#endif /* HAS_SOCKETS */
#include <sys/stat.h>
#include <time.h>
#include <winioctl.h>
+#include "caml/winsupport.h"
#ifndef S_IFLNK
/*
* reparse point allows a POSIX-compatible value to be returned in
* st_size
*/
- char buffer[16384];
DWORD read;
- REPARSE_DATA_BUFFER* point;
+ union {
+ char raw[16384];
+ REPARSE_DATA_BUFFER point;
+ } buffer;
caml_enter_blocking_section();
- if (DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, buffer, 16384, &read, NULL)) {
- if (((REPARSE_DATA_BUFFER*)buffer)->ReparseTag == IO_REPARSE_TAG_SYMLINK) {
+ if (DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, &buffer.point, sizeof(buffer.raw), &read, NULL)) {
+ if (buffer.point.ReparseTag == IO_REPARSE_TAG_SYMLINK) {
is_symlink = do_lstat;
- res->st_size = ((REPARSE_DATA_BUFFER*)buffer)->SymbolicLinkReparseBuffer.SubstituteNameLength / 2;
+ res->st_size = buffer.point.SymbolicLinkReparseBuffer.SubstituteNameLength / 2;
}
}
caml_leave_blocking_section();
external socket :
?cloexec: bool -> socket_domain -> socket_type -> int -> file_descr
= "unix_socket"
-let socketpair ?cloexec:_ _dom _ty _proto =
- invalid_arg "Unix.socketpair not implemented"
+external socketpair :
+ ?cloexec: bool -> socket_domain -> socket_type -> int ->
+ file_descr * file_descr
+ = "unix_socketpair"
external accept :
?cloexec: bool -> file_descr -> file_descr * sockaddr = "unix_accept"
external bind : file_descr -> sockaddr -> unit = "unix_bind"
else
return unix_cloexec_default;
}
+
+int win_set_inherit(HANDLE fd, BOOL inherit)
+{
+ /* According to the MSDN, SetHandleInformation may not work
+ for console handles on WinNT4 and earlier versions. */
+ if (! SetHandleInformation(fd,
+ HANDLE_FLAG_INHERIT,
+ inherit ? HANDLE_FLAG_INHERIT : 0)) {
+ win32_maperr(GetLastError());
+ return -1;
+ }
+ return 0;
+}
extern int unix_cloexec_default;
extern int unix_cloexec_p(value cloexec);
+extern int win_set_inherit(HANDLE fd, BOOL inherit);
+/* This is a best effort, not guaranteed to work, so don't fail on error */
+#define win_set_cloexec(fd, cloexec) \
+ win_set_inherit((fd), ! unix_cloexec_p((cloexec)))
/* Information stored in flags_fd, describing more precisely the socket
* and its status. The whole flags_fd is initialized to 0.
}
#endif
-/*
- * This structure is defined inconsistently. mingw64 has it in ntdef.h (which
- * doesn't look like a primary header) and technically it's part of ntifs.h in
- * the WDK. Requiring the WDK is a bit extreme, so the definition is taken from
- * ntdef.h. Both ntdef.h and ntifs.h define REPARSE_DATA_BUFFER_HEADER_SIZE
- */
-#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
-typedef struct _REPARSE_DATA_BUFFER
-{
- ULONG ReparseTag;
- USHORT ReparseDataLength;
- USHORT Reserved;
- union
- {
- struct
- {
- USHORT SubstituteNameOffset;
- USHORT SubstituteNameLength;
- USHORT PrintNameOffset;
- USHORT PrintNameLength;
- ULONG Flags;
- WCHAR PathBuffer[1];
- } SymbolicLinkReparseBuffer;
- struct
- {
- USHORT SubstituteNameOffset;
- USHORT SubstituteNameLength;
- USHORT PrintNameOffset;
- USHORT PrintNameLength;
- WCHAR PathBuffer[1];
- } MountPointReparseBuffer;
- struct
- {
- UCHAR DataBuffer[1];
- } GenericReparseBuffer;
- };
-} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;
-#endif
-
#define EXECV_CAST (const char_os * const *)
#endif /* CAML_UNIXSUPPORT_H */
}
let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
- ?(args = Pcstr_tuple []) ?res name =
+ ?(vars = []) ?(args = Pcstr_tuple []) ?res name =
{
pcd_name = name;
+ pcd_vars = vars;
pcd_args = args;
pcd_res = res;
pcd_loc = loc;
}
let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
- ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name =
+ ?(info = empty_info) ?(vars = []) ?(args = Pcstr_tuple []) ?res name =
{
pext_name = name;
- pext_kind = Pext_decl(args, res);
+ pext_kind = Pext_decl(vars, args, res);
pext_loc = loc;
pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}
type_declaration
val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info ->
- ?args:constructor_arguments -> ?res:core_type -> str ->
+ ?vars:str list -> ?args:constructor_arguments -> ?res:core_type ->
+ str ->
constructor_declaration
val field: ?loc:loc -> ?attrs:attrs -> ?info:info ->
?mut:mutable_flag -> str -> core_type -> label_declaration
str -> extension_constructor_kind -> extension_constructor
val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
- ?args:constructor_arguments -> ?res:core_type -> str ->
+ ?vars:str list -> ?args:constructor_arguments -> ?res:core_type ->
+ str ->
extension_constructor
val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
str -> lid -> extension_constructor
sub.attributes sub ptyexn_attributes
let iter_extension_constructor_kind sub = function
- Pext_decl(ctl, cto) ->
- iter_constructor_arguments sub ctl; iter_opt (sub.typ sub) cto
+ Pext_decl(vars, ctl, cto) ->
+ List.iter (iter_loc sub) vars;
+ iter_constructor_arguments sub ctl;
+ iter_opt (sub.typ sub) cto
| Pext_rebind li ->
iter_loc sub li
constructor_declaration =
- (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
+ (fun this {pcd_name; pcd_vars; pcd_args;
+ pcd_res; pcd_loc; pcd_attributes} ->
iter_loc this pcd_name;
+ List.iter (iter_loc this) pcd_vars;
T.iter_constructor_arguments this pcd_args;
iter_opt (this.typ this) pcd_res;
this.location this pcd_loc;
(* *)
(**************************************************************************)
-(** {!iterator} enables AST inspection using open recursion. A
- typical mapper would be based on {!default_iterator}, a trivial iterator,
- and will fall back on it for handling the syntax it does not modify.
+(** {!Ast_iterator.iterator} enables AST inspection using open recursion. A
+ typical mapper would be based on {!Ast_iterator.default_iterator}, a
+ trivial iterator, and will fall back on it for handling the syntax it does
+ not modify.
{b Warning:} this module is unstable and part of
{{!Compiler_libs}compiler-libs}.
(sub.extension_constructor sub ptyexn_constructor)
let map_extension_constructor_kind sub = function
- Pext_decl(ctl, cto) ->
- Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto)
+ Pext_decl(vars, ctl, cto) ->
+ Pext_decl(List.map (map_loc sub) vars,
+ map_constructor_arguments sub ctl,
+ map_opt (sub.typ sub) cto)
| Pext_rebind li ->
Pext_rebind (map_loc sub li)
constructor_declaration =
- (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
+ (fun this {pcd_name; pcd_vars; pcd_args;
+ pcd_res; pcd_loc; pcd_attributes} ->
Type.constructor
(map_loc this pcd_name)
+ ~vars:(List.map (map_loc this) pcd_vars)
~args:(T.map_constructor_arguments this pcd_args)
?res:(map_opt (this.typ this) pcd_res)
~loc:(this.location this pcd_loc)
type arg_label =
Nolabel
- | Labelled of string (* label:T -> ... *)
- | Optional of string (* ?label:T -> ... *)
+ | Labelled of string (** [label:T -> ...] *)
+ | Optional of string (** [?label:T -> ...] *)
type 'a loc = 'a Location.loc = {
txt : 'a;
let add_extension_constructor bv ext =
match ext.pext_kind with
- Pext_decl(args, rty) ->
+ Pext_decl(_, args, rty) ->
add_constructor_arguments bv args;
Option.iter (add_type bv) rty
| Pext_rebind lid -> add bv lid
(* Single-line error *)
Format.fprintf ppf "%s | %s@," line_nb line;
Format.fprintf ppf "%*s " (String.length line_nb) "";
- for pos = line_start_cnum to rightmost.pos_cnum - 1 do
+ String.iteri (fun i c ->
+ let pos = line_start_cnum + i in
if ISet.is_start iset ~pos <> None then
Format.fprintf ppf "@{<%s>" highlight_tag;
if ISet.mem iset ~pos then Format.pp_print_char ppf '^'
- else Format.pp_print_char ppf ' ';
+ else if pos < rightmost.pos_cnum then begin
+ (* For alignment purposes, align using a tab for each tab in the
+ source code *)
+ if c = '\t' then Format.pp_print_char ppf '\t'
+ else Format.pp_print_char ppf ' '
+ end;
if ISet.is_end iset ~pos <> None then
Format.fprintf ppf "@}"
- done;
+ ) line;
Format.fprintf ppf "@}@,"
| _ ->
(* Multi-line error *)
and core_type = wrap Parser.parse_core_type
and expression = wrap Parser.parse_expression
and pattern = wrap Parser.parse_pattern
+let module_type = wrap Parser.parse_module_type
+let module_expr = wrap Parser.parse_module_expr
let longident = wrap Parser.parse_any_longident
let val_ident = wrap Parser.parse_val_longident
val core_type : Lexing.lexbuf -> Parsetree.core_type
val expression : Lexing.lexbuf -> Parsetree.expression
val pattern : Lexing.lexbuf -> Parsetree.pattern
+val module_type : Lexing.lexbuf -> Parsetree.module_type
+val module_expr : Lexing.lexbuf -> Parsetree.module_expr
(** The functions below can be used to parse Longident safely. *)
let mkexp_constraint ~loc e (t1, t2) =
match t1, t2 with
- | Some t, None -> ghexp ~loc (Pexp_constraint(e, t))
- | _, Some t -> ghexp ~loc (Pexp_coerce(e, t1, t))
+ | Some t, None -> mkexp ~loc (Pexp_constraint(e, t))
+ | _, Some t -> mkexp ~loc (Pexp_coerce(e, t1, t))
| None, None -> assert false
let mkexp_opt_constraint ~loc e = function
let mkpat_opt_constraint ~loc p = function
| None -> p
- | Some typ -> ghpat ~loc (Ppat_constraint(p, typ))
+ | Some typ -> mkpat ~loc (Ppat_constraint(p, typ))
let syntax_error () =
raise Syntaxerr.Escape_error
let loc_lident (id : string Location.loc) : Longident.t Location.loc =
loc_map (fun x -> Lident x) id
-let exp_of_longident ~loc lid =
- let lid = make_ghost (loc_map (fun id -> Lident (Longident.last id)) lid) in
- ghexp ~loc (Pexp_ident lid)
+let exp_of_longident lid =
+ let lid = loc_map (fun id -> Lident (Longident.last id)) lid in
+ Exp.mk ~loc:lid.loc (Pexp_ident lid)
-let exp_of_label ~loc lbl =
- mkexp ~loc (Pexp_ident (loc_lident lbl))
+let exp_of_label lbl =
+ Exp.mk ~loc:lbl.loc (Pexp_ident (loc_lident lbl))
let pat_of_label lbl =
Pat.mk ~loc:lbl.loc (Ppat_var (loc_last lbl))
%nonassoc below_DOT
%nonassoc DOT DOTOP
/* Finally, the first tokens of simple_expr are above everything else. */
-%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT
+%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT OBJECT
LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
NEW PREFIXOP STRING TRUE UIDENT
LBRACKETPERCENT QUOTED_STRING_EXPR
%start use_file /* for the #use directive */
%type <Parsetree.toplevel_phrase list> use_file
/* BEGIN AVOID */
+%start parse_module_type
+%type <Parsetree.module_type> parse_module_type
+%start parse_module_expr
+%type <Parsetree.module_expr> parse_module_expr
%start parse_core_type
%type <Parsetree.core_type> parse_core_type
%start parse_expression
;
/* BEGIN AVOID */
+parse_module_type:
+ module_type EOF
+ { $1 }
+;
+
+parse_module_expr:
+ module_expr EOF
+ { $1 }
+;
+
parse_core_type:
core_type EOF
{ $1 }
{ Pexp_assert $3, $2 }
| LAZY ext_attributes simple_expr %prec below_HASH
{ Pexp_lazy $3, $2 }
- | OBJECT ext_attributes class_structure END
- { Pexp_object $3, $2 }
- | OBJECT ext_attributes class_structure error
- { unclosed "object" $loc($1) "end" $loc($4) }
;
%inline expr_:
| simple_expr nonempty_llist(labeled_simple_expr)
{ Pexp_constraint (ghexp ~loc:$sloc (Pexp_pack $4), $6), $3 }
| LPAREN MODULE ext_attributes module_expr COLON error
{ unclosed "(" $loc($1) ")" $loc($6) }
+ | OBJECT ext_attributes class_structure END
+ { Pexp_object $3, $2 }
+ | OBJECT ext_attributes class_structure error
+ { unclosed "object" $loc($1) "end" $loc($4) }
;
%inline simple_expr_:
| mkrhs(val_longident)
| TILDE label = LIDENT
{ let loc = $loc(label) in
(Labelled label, mkexpvar ~loc label) }
+ | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN
+ { (Labelled label, mkexp_constraint ~loc:($startpos($2), $endpos)
+ (mkexpvar ~loc:$loc(label) label) ty) }
| QUESTION label = LIDENT
{ let loc = $loc(label) in
(Optional label, mkexpvar ~loc label) }
let patloc = ($startpos($1), $endpos($2)) in
(ghpat ~loc:patloc (Ppat_constraint(v, typ)),
mkexp_constraint ~loc:$sloc $4 $2) }
- | let_ident COLON typevar_list DOT core_type EQUAL seq_expr
- (* TODO: could replace [typevar_list DOT core_type]
- with [mktyp(poly(core_type))]
- and simplify the semantic action? *)
- { let typloc = ($startpos($3), $endpos($5)) in
- let patloc = ($startpos($1), $endpos($5)) in
+ | let_ident COLON poly(core_type) EQUAL seq_expr
+ { let patloc = ($startpos($1), $endpos($3)) in
(ghpat ~loc:patloc
- (Ppat_constraint($1, ghtyp ~loc:typloc (Ptyp_poly($3,$5)))),
- $7) }
+ (Ppat_constraint($1, ghtyp ~loc:($loc($3)) $3)),
+ $5) }
| let_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
{ let exp, poly =
wrap_type_annotation ~loc:$sloc $4 $6 $8 in
| label = mkrhs(label_longident)
c = type_constraint?
eo = preceded(EQUAL, expr)?
- { let e =
+ { let constraint_loc, label, e =
match eo with
| None ->
(* No pattern; this is a pun. Desugar it. *)
- exp_of_longident ~loc:$sloc label
+ $sloc, make_ghost label, exp_of_longident label
| Some e ->
- e
+ ($startpos(c), $endpos), label, e
in
- label, mkexp_opt_constraint ~loc:$sloc e c }
+ label, mkexp_opt_constraint ~loc:constraint_loc e c }
;
%inline object_expr_content:
xs = separated_or_terminated_nonempty_list(SEMI, object_expr_field)
%inline object_expr_field:
label = mkrhs(label)
oe = preceded(EQUAL, expr)?
- { let e =
+ { let label, e =
match oe with
| None ->
(* No expression; this is a pun. Desugar it. *)
- exp_of_label ~loc:$sloc label
+ make_ghost label, exp_of_label label
| Some e ->
- e
+ label, e
in
label, e }
;
label = mkrhs(label_longident)
octy = preceded(COLON, core_type)?
opat = preceded(EQUAL, pattern)?
- { let label, pat =
+ { let constraint_loc, label, pat =
match opat with
| None ->
(* No pattern; this is a pun. Desugar it.
But that the pattern was there and the label reconstructed (which
piece of AST is marked as ghost is important for warning
emission). *)
- make_ghost label, pat_of_label label
+ $sloc, make_ghost label, pat_of_label label
| Some pat ->
- label, pat
+ ($startpos(octy), $endpos), label, pat
in
- label, mkpat_opt_constraint ~loc:$sloc pat octy
+ label, mkpat_opt_constraint ~loc:constraint_loc pat octy
}
;
attrs1 = attributes
id = mkrhs(val_ident)
COLON
- ty = core_type
+ ty = possibly_poly(core_type)
attrs2 = post_item_attributes
{ let attrs = attrs1 @ attrs2 in
let loc = make_loc $sloc in
attrs1 = attributes
id = mkrhs(val_ident)
COLON
- ty = core_type
+ ty = possibly_poly(core_type)
EQUAL
prim = raw_string+
attrs2 = post_item_attributes
generic_constructor_declaration(opening):
opening
cid = mkrhs(constr_ident)
- args_res = generalized_constructor_arguments
+ vars_args_res = generalized_constructor_arguments
attrs = attributes
{
- let args, res = args_res in
+ let vars, args, res = vars_args_res in
let info = symbol_info $endpos in
let loc = make_loc $sloc in
- cid, args, res, attrs, loc, info
+ cid, vars, args, res, attrs, loc, info
}
;
%inline constructor_declaration(opening):
d = generic_constructor_declaration(opening)
{
- let cid, args, res, attrs, loc, info = d in
- Type.constructor cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
}
;
str_exception_declaration:
ext = ext
attrs1 = attributes
id = mkrhs(constr_ident)
- args_res = generalized_constructor_arguments
+ vars_args_res = generalized_constructor_arguments
attrs2 = attributes
attrs = post_item_attributes
- { let args, res = args_res in
+ { let vars, args, res = vars_args_res in
let loc = make_loc ($startpos, $endpos(attrs2)) in
let docs = symbol_docs $sloc in
Te.mk_exception ~attrs
- (Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
+ (Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext }
;
%inline let_exception_declaration:
mkrhs(constr_ident) generalized_constructor_arguments attributes
- { let args, res = $2 in
- Te.decl $1 ~args ?res ~attrs:$3 ~loc:(make_loc $sloc) }
+ { let vars, args, res = $2 in
+ Te.decl $1 ~vars ~args ?res ~attrs:$3 ~loc:(make_loc $sloc) }
;
generalized_constructor_arguments:
- /*empty*/ { (Pcstr_tuple [],None) }
- | OF constructor_arguments { ($2,None) }
+ /*empty*/ { ([],Pcstr_tuple [],None) }
+ | OF constructor_arguments { ([],$2,None) }
| COLON constructor_arguments MINUSGREATER atomic_type %prec below_HASH
- { ($2,Some $4) }
+ { ([],$2,Some $4) }
+ | COLON typevar_list DOT constructor_arguments MINUSGREATER atomic_type
+ %prec below_HASH
+ { ($2,$4,Some $6) }
| COLON atomic_type %prec below_HASH
- { (Pcstr_tuple [],Some $2) }
+ { ([],Pcstr_tuple [],Some $2) }
+ | COLON typevar_list DOT atomic_type %prec below_HASH
+ { ($2,Pcstr_tuple [],Some $4) }
;
constructor_arguments:
%inline extension_constructor_declaration(opening):
d = generic_constructor_declaration(opening)
{
- let cid, args, res, attrs, loc, info = d in
- Te.decl cid ~args ?res ~attrs ~loc ~info
+ let cid, vars, args, res, attrs, loc, info = d in
+ Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
}
;
extension_constructor_rebind(opening):
open Asttypes
type constant =
- Pconst_integer of string * char option
- (* 3 3l 3L 3n
+ | Pconst_integer of string * char option
+ (** Integer constants such as [3] [3l] [3L] [3n].
- Suffixes [g-z][G-Z] are accepted by the parser.
- Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
+ Suffixes [[g-z][G-Z]] are accepted by the parser.
+ Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker
*)
- | Pconst_char of char
- (* 'c' *)
+ | Pconst_char of char (** Character such as ['c']. *)
| Pconst_string of string * Location.t * string option
- (* "constant"
- {delim|other constant|delim}
+ (** Constant string such as ["constant"] or
+ [{delim|other constant|delim}].
The location span the content of the string, without the delimiters.
*)
| Pconst_float of string * char option
- (* 3.4 2e5 1.4e-4
+ (** Float constant such as [3.4], [2e5] or [1.4e-4].
Suffixes [g-z][G-Z] are accepted by the parser.
Suffixes are rejected by the typechecker.
attr_payload : payload;
attr_loc : Location.t;
}
- (* [@id ARG]
- [@@id ARG]
+(** Attributes such as [[\@id ARG]] and [[\@\@id ARG]].
Metadata containers passed around within the AST.
The compiler ignores unknown attributes.
*)
and extension = string loc * payload
- (* [%id ARG]
- [%%id ARG]
+(** Extension points such as [[%id ARG] and [%%id ARG]].
Sub-language placeholder -- rejected by the typechecker.
*)
and payload =
| PStr of structure
- | PSig of signature (* : SIG *)
- | PTyp of core_type (* : T *)
- | PPat of pattern * expression option (* ? P or ? P when E *)
+ | PSig of signature (** [: SIG] in an attribute or an extension point *)
+ | PTyp of core_type (** [: T] in an attribute or an extension point *)
+ | PPat of pattern * expression option
+ (** [? P] or [? P when E], in an attribute or an extension point *)
(** {1 Core language} *)
-
-(* Type expressions *)
+(** {2 Type expressions} *)
and core_type =
{
ptyp_desc: core_type_desc;
ptyp_loc: Location.t;
ptyp_loc_stack: location_stack;
- ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
+ ptyp_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and core_type_desc =
- | Ptyp_any
- (* _ *)
- | Ptyp_var of string
- (* 'a *)
+ | Ptyp_any (** [_] *)
+ | Ptyp_var of string (** A type variable such as ['a] *)
| Ptyp_arrow of arg_label * core_type * core_type
- (* T1 -> T2 Simple
- ~l:T1 -> T2 Labelled
- ?l:T1 -> T2 Optional
+ (** [Ptyp_arrow(lbl, T1, T2)] represents:
+ - [T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Nolabel}[Nolabel]},
+ - [~l:T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Labelled}[Labelled]},
+ - [?l:T1 -> T2] when [lbl] is
+ {{!Asttypes.arg_label.Optional}[Optional]}.
*)
| Ptyp_tuple of core_type list
- (* T1 * ... * Tn
+ (** [Ptyp_tuple([T1 ; ... ; Tn])]
+ represents a product type [T1 * ... * Tn].
- Invariant: n >= 2
+ Invariant: [n >= 2].
*)
| Ptyp_constr of Longident.t loc * core_type list
- (* tconstr
- T tconstr
- (T1, ..., Tn) tconstr
+ (** [Ptyp_constr(lident, l)] represents:
+ - [tconstr] when [l=[]],
+ - [T tconstr] when [l=[T]],
+ - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]].
*)
| Ptyp_object of object_field list * closed_flag
- (* < l1:T1; ...; ln:Tn > (flag = Closed)
- < l1:T1; ...; ln:Tn; .. > (flag = Open)
+ (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents:
+ - [< l1:T1; ...; ln:Tn >] when [flag] is
+ {{!Asttypes.closed_flag.Closed}[Closed]},
+ - [< l1:T1; ...; ln:Tn; .. >] when [flag] is
+ {{!Asttypes.closed_flag.Open}[Open]}.
*)
| Ptyp_class of Longident.t loc * core_type list
- (* #tconstr
- T #tconstr
- (T1, ..., Tn) #tconstr
+ (** [Ptyp_class(tconstr, l)] represents:
+ - [#tconstr] when [l=[]],
+ - [T #tconstr] when [l=[T]],
+ - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]].
*)
- | Ptyp_alias of core_type * string
- (* T as 'a *)
+ | Ptyp_alias of core_type * string (** [T as 'a]. *)
| Ptyp_variant of row_field list * closed_flag * label list option
- (* [ `A|`B ] (flag = Closed; labels = None)
- [> `A|`B ] (flag = Open; labels = None)
- [< `A|`B ] (flag = Closed; labels = Some [])
- [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"])
+ (** [Ptyp_variant([`A;`B], flag, labels)] represents:
+ - [[ `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [None],
+ - [[> `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Open}[Open]},
+ and [labels] is [None],
+ - [[< `A|`B ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [Some []],
+ - [[< `A|`B > `X `Y ]]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]},
+ and [labels] is [Some ["X";"Y"]].
*)
| Ptyp_poly of string loc list * core_type
- (* 'a1 ... 'an. T
+ (** ['a1 ... 'an. T]
Can only appear in the following context:
- - As the core_type of a Ppat_constraint node corresponding
- to a constraint on a let-binding: let x : 'a1 ... 'an. T
- = e ...
+ - As the {!core_type} of a
+ {{!pattern_desc.Ppat_constraint}[Ppat_constraint]} node corresponding
+ to a constraint on a let-binding:
+ {[let x : 'a1 ... 'an. T = e ...]}
- - Under Cfk_virtual for methods (not values).
+ - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods
+ (not values).
- - As the core_type of a Pctf_method node.
+ - As the {!core_type} of a
+ {{!class_type_field_desc.Pctf_method}[Pctf_method]} node.
- - As the core_type of a Pexp_poly node.
+ - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]}
+ node.
- - As the pld_type field of a label_declaration.
+ - As the {{!label_declaration.pld_type}[pld_type]} field of a
+ {!label_declaration}.
- - As a core_type of a Ptyp_object node.
- *)
+ - As a {!core_type} of a {{!core_type_desc.Ptyp_object}[Ptyp_object]}
+ node.
- | Ptyp_package of package_type
- (* (module S) *)
- | Ptyp_extension of extension
- (* [%id] *)
+ - As the {{!value_description.pval_type}[pval_type]} field of a
+ {!value_description}.
+ *)
+ | Ptyp_package of package_type (** [(module S)]. *)
+ | Ptyp_extension of extension (** [[%id]]. *)
and package_type = Longident.t loc * (Longident.t loc * core_type) list
- (*
- (module S)
- (module S with type t1 = T1 and ... and tn = Tn)
+(** As {!package_type} typed values:
+ - [(S, [])] represents [(module S)],
+ - [(S, [(t1, T1) ; ... ; (tn, Tn)])]
+ represents [(module S with type t1 = T1 and ... and tn = Tn)].
*)
and row_field = {
and row_field_desc =
| Rtag of label loc * bool * core_type list
- (* [`A] ( true, [] )
- [`A of T] ( false, [T] )
- [`A of T1 & .. & Tn] ( false, [T1;...Tn] )
- [`A of & T1 & .. & Tn] ( true, [T1;...Tn] )
+ (** [Rtag(`A, b, l)] represents:
+ - [`A] when [b] is [true] and [l] is [[]],
+ - [`A of T] when [b] is [false] and [l] is [[T]],
+ - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]],
+ - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[T1;...Tn]].
- - The 'bool' field is true if the tag contains a
+ - The [bool] field is true if the tag contains a
constant (empty) constructor.
- - '&' occurs when several types are used for the same constructor
+ - [&] occurs when several types are used for the same constructor
(see 4.2 in the manual)
*)
- | Rinherit of core_type
- (* [ | t ] *)
+ | Rinherit of core_type (** [[ | t ]] *)
and object_field = {
pof_desc : object_field_desc;
| Otag of label loc * core_type
| Oinherit of core_type
-(* Patterns *)
+(** {2 Patterns} *)
and pattern =
{
ppat_desc: pattern_desc;
ppat_loc: Location.t;
ppat_loc_stack: location_stack;
- ppat_attributes: attributes; (* ... [@id1] [@id2] *)
+ ppat_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and pattern_desc =
- | Ppat_any
- (* _ *)
- | Ppat_var of string loc
- (* x *)
+ | Ppat_any (** The pattern [_]. *)
+ | Ppat_var of string loc (** A variable pattern such as [x] *)
| Ppat_alias of pattern * string loc
- (* P as 'a *)
+ (** An alias pattern such as [P as 'a] *)
| Ppat_constant of constant
- (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *)
| Ppat_interval of constant * constant
- (* 'a'..'z'
+ (** Patterns such as ['a'..'z'].
Other forms of interval are recognized by the parser
but rejected by the type-checker. *)
| Ppat_tuple of pattern list
- (* (P1, ..., Pn)
+ (** Patterns [(P1, ..., Pn)].
- Invariant: n >= 2
+ Invariant: [n >= 2]
*)
- | Ppat_construct of
- Longident.t loc * (string loc list * pattern) option
- (* C None
- C P Some ([], P)
- C (P1, ..., Pn) Some ([], Ppat_tuple [P1; ...; Pn])
- C (type a b) P Some ([a; b], P)
+ | Ppat_construct of Longident.t loc * (string loc list * pattern) option
+ (** [Ppat_construct(C, args)] represents:
+ - [C] when [args] is [None],
+ - [C P] when [args] is [Some ([], P)]
+ - [C (P1, ..., Pn)] when [args] is
+ [Some ([], Ppat_tuple [P1; ...; Pn])]
+ - [C (type a b) P] when [args] is [Some ([a; b], P)]
*)
| Ppat_variant of label * pattern option
- (* `A (None)
- `A P (Some P)
+ (** [Ppat_variant(`A, pat)] represents:
+ - [`A] when [pat] is [None],
+ - [`A P] when [pat] is [Some P]
*)
| Ppat_record of (Longident.t loc * pattern) list * closed_flag
- (* { l1=P1; ...; ln=Pn } (flag = Closed)
- { l1=P1; ...; ln=Pn; _} (flag = Open)
+ (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents:
+ - [{ l1=P1; ...; ln=Pn }]
+ when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}
+ - [{ l1=P1; ...; ln=Pn; _}]
+ when [flag] is {{!Asttypes.closed_flag.Open}[Open]}
- Invariant: n > 0
+ Invariant: [n > 0]
*)
- | Ppat_array of pattern list
- (* [| P1; ...; Pn |] *)
- | Ppat_or of pattern * pattern
- (* P1 | P2 *)
- | Ppat_constraint of pattern * core_type
- (* (P : T) *)
- | Ppat_type of Longident.t loc
- (* #tconst *)
- | Ppat_lazy of pattern
- (* lazy P *)
+ | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *)
+ | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *)
+ | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *)
+ | Ppat_type of Longident.t loc (** Pattern [#tconst] *)
+ | Ppat_lazy of pattern (** Pattern [lazy P] *)
| Ppat_unpack of string option loc
- (* (module P) Some "P"
- (module _) None
+ (** [Ppat_unpack(s)] represents:
+ - [(module P)] when [s] is [Some "P"]
+ - [(module _)] when [s] is [None]
- Note: (module P : S) is represented as
- Ppat_constraint(Ppat_unpack, Ptyp_package)
+ Note: [(module P : S)] is represented as
+ [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)]
*)
- | Ppat_exception of pattern
- (* exception P *)
- | Ppat_extension of extension
- (* [%id] *)
- | Ppat_open of Longident.t loc * pattern
- (* M.(P) *)
+ | Ppat_exception of pattern (** Pattern [exception P] *)
+ | Ppat_extension of extension (** Pattern [[%id]] *)
+ | Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *)
-(* Value expressions *)
+(** {2 Value expressions} *)
and expression =
{
pexp_desc: expression_desc;
pexp_loc: Location.t;
pexp_loc_stack: location_stack;
- pexp_attributes: attributes; (* ... [@id1] [@id2] *)
+ pexp_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and expression_desc =
| Pexp_ident of Longident.t loc
- (* x
- M.x
+ (** Identifiers such as [x] and [M.x]
*)
| Pexp_constant of constant
- (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l],
+ [1L], [1n] *)
| Pexp_let of rec_flag * value_binding list * expression
- (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive)
- let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive)
+ (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents:
+ - [let P1 = E1 and ... and Pn = EN in E]
+ when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN in E]
+ when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
*)
- | Pexp_function of case list
- (* function P1 -> E1 | ... | Pn -> En *)
+ | Pexp_function of case list (** [function P1 -> E1 | ... | Pn -> En] *)
| Pexp_fun of arg_label * expression option * pattern * expression
- (* fun P -> E1 (Simple, None)
- fun ~l:P -> E1 (Labelled l, None)
- fun ?l:P -> E1 (Optional l, None)
- fun ?l:(P = E0) -> E1 (Optional l, Some E0)
+ (** [Pexp_fun(lbl, exp0, P, E1)] represents:
+ - [fun P -> E1]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
+ and [exp0] is [None]
+ - [fun ~l:P -> E1]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
+ and [exp0] is [None]
+ - [fun ?l:P -> E1]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [None]
+ - [fun ?l:(P = E0) -> E1]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [Some E0]
Notes:
- - If E0 is provided, only Optional is allowed.
- - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
- - "let f P = E" is represented using Pexp_fun.
+ - If [E0] is provided, only
+ {{!Asttypes.arg_label.Optional}[Optional]} is allowed.
+ - [fun P1 P2 .. Pn -> E1] is represented as nested
+ {{!expression_desc.Pexp_fun}[Pexp_fun]}.
+ - [let f P = E] is represented using
+ {{!expression_desc.Pexp_fun}[Pexp_fun]}.
*)
| Pexp_apply of expression * (arg_label * expression) list
- (* E0 ~l1:E1 ... ~ln:En
- li can be empty (non labeled argument) or start with '?'
- (optional argument).
+ (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
+ represents [E0 ~l1:E1 ... ~ln:En]
+
+ [li] can be
+ {{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument),
+ {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or
+ {{!Asttypes.arg_label.Optional}[Optional]} (optional argument).
- Invariant: n > 0
+ Invariant: [n > 0]
*)
| Pexp_match of expression * case list
- (* match E0 with P1 -> E1 | ... | Pn -> En *)
+ (** [match E0 with P1 -> E1 | ... | Pn -> En] *)
| Pexp_try of expression * case list
- (* try E0 with P1 -> E1 | ... | Pn -> En *)
+ (** [try E0 with P1 -> E1 | ... | Pn -> En] *)
| Pexp_tuple of expression list
- (* (E1, ..., En)
+ (** Expressions [(E1, ..., En)]
- Invariant: n >= 2
+ Invariant: [n >= 2]
*)
| Pexp_construct of Longident.t loc * expression option
- (* C None
- C E Some E
- C (E1, ..., En) Some (Pexp_tuple[E1;...;En])
+ (** [Pexp_construct(C, exp)] represents:
+ - [C] when [exp] is [None],
+ - [C E] when [exp] is [Some E],
+ - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])]
*)
| Pexp_variant of label * expression option
- (* `A (None)
- `A E (Some E)
+ (** [Pexp_variant(`A, exp)] represents
+ - [`A] when [exp] is [None]
+ - [`A E] when [exp] is [Some E]
*)
| Pexp_record of (Longident.t loc * expression) list * expression option
- (* { l1=P1; ...; ln=Pn } (None)
- { E0 with l1=P1; ...; ln=Pn } (Some E0)
+ (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents
+ - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None]
+ - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0]
- Invariant: n > 0
+ Invariant: [n > 0]
*)
- | Pexp_field of expression * Longident.t loc
- (* E.l *)
+ | Pexp_field of expression * Longident.t loc (** [E.l] *)
| Pexp_setfield of expression * Longident.t loc * expression
- (* E1.l <- E2 *)
- | Pexp_array of expression list
- (* [| E1; ...; En |] *)
+ (** [E1.l <- E2] *)
+ | Pexp_array of expression list (** [[| E1; ...; En |]] *)
| Pexp_ifthenelse of expression * expression * expression option
- (* if E1 then E2 else E3 *)
- | Pexp_sequence of expression * expression
- (* E1; E2 *)
- | Pexp_while of expression * expression
- (* while E1 do E2 done *)
- | Pexp_for of
- pattern * expression * expression * direction_flag * expression
- (* for i = E1 to E2 do E3 done (flag = Upto)
- for i = E1 downto E2 do E3 done (flag = Downto)
+ (** [if E1 then E2 else E3] *)
+ | Pexp_sequence of expression * expression (** [E1; E2] *)
+ | Pexp_while of expression * expression (** [while E1 do E2 done] *)
+ | Pexp_for of pattern * expression * expression * direction_flag * expression
+ (** [Pexp_for(i, E1, E2, direction, E3)] represents:
+ - [for i = E1 to E2 do E3 done]
+ when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]}
+ - [for i = E1 downto E2 do E3 done]
+ when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]}
*)
- | Pexp_constraint of expression * core_type
- (* (E : T) *)
+ | Pexp_constraint of expression * core_type (** [(E : T)] *)
| Pexp_coerce of expression * core_type option * core_type
- (* (E :> T) (None, T)
- (E : T0 :> T) (Some T0, T)
+ (** [Pexp_coerce(E, from, T)] represents
+ - [(E :> T)] when [from] is [None],
+ - [(E : T0 :> T)] when [from] is [Some T0].
*)
- | Pexp_send of expression * label loc
- (* E # m *)
- | Pexp_new of Longident.t loc
- (* new M.c *)
- | Pexp_setinstvar of label loc * expression
- (* x <- 2 *)
+ | Pexp_send of expression * label loc (** [E # m] *)
+ | Pexp_new of Longident.t loc (** [new M.c] *)
+ | Pexp_setinstvar of label loc * expression (** [x <- 2] *)
| Pexp_override of (label loc * expression) list
- (* {< x1 = E1; ...; Xn = En >} *)
+ (** [{< x1 = E1; ...; xn = En >}] *)
| Pexp_letmodule of string option loc * module_expr * expression
- (* let module M = ME in E *)
+ (** [let module M = ME in E] *)
| Pexp_letexception of extension_constructor * expression
- (* let exception C in E *)
+ (** [let exception C in E] *)
| Pexp_assert of expression
- (* assert E
- Note: "assert false" is treated in a special way by the
+ (** [assert E].
+
+ Note: [assert false] is treated in a special way by the
type-checker. *)
- | Pexp_lazy of expression
- (* lazy E *)
+ | Pexp_lazy of expression (** [lazy E] *)
| Pexp_poly of expression * core_type option
- (* Used for method bodies.
-
- Can only be used as the expression under Cfk_concrete
- for methods (not values). *)
- | Pexp_object of class_structure
- (* object ... end *)
- | Pexp_newtype of string loc * expression
- (* fun (type t) -> E *)
+ (** Used for method bodies.
+
+ Can only be used as the expression under
+ {{!class_field_kind.Cfk_concrete}[Cfk_concrete]} for methods (not
+ values). *)
+ | Pexp_object of class_structure (** [object ... end] *)
+ | Pexp_newtype of string loc * expression (** [fun (type t) -> E] *)
| Pexp_pack of module_expr
- (* (module ME)
+ (** [(module ME)].
- (module ME : S) is represented as
- Pexp_constraint(Pexp_pack, Ptyp_package S) *)
+ [(module ME : S)] is represented as
+ [Pexp_constraint(Pexp_pack ME, Ptyp_package S)] *)
| Pexp_open of open_declaration * expression
- (* M.(E)
- let open M in E
- let! open M in E *)
+ (** - [M.(E)]
+ - [let open M in E]
+ - [let open! M in E] *)
| Pexp_letop of letop
- (* let* P = E in E
- let* P = E and* P = E in E *)
- | Pexp_extension of extension
- (* [%id] *)
- | Pexp_unreachable
- (* . *)
-
-and case = (* (P -> E) or (P when E0 -> E) *)
+ (** - [let* P = E0 in E1]
+ - [let* P0 = E00 and* P1 = E01 in E1] *)
+ | Pexp_extension of extension (** [[%id]] *)
+ | Pexp_unreachable (** [.] *)
+
+and case =
{
pc_lhs: pattern;
pc_guard: expression option;
pc_rhs: expression;
}
+(** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *)
and letop =
{
pbop_loc : Location.t;
}
-(* Value descriptions *)
+(** {2 Value descriptions} *)
and value_description =
{
pval_name: string loc;
pval_type: core_type;
pval_prim: string list;
- pval_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pval_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
pval_loc: Location.t;
}
-
-(*
- val x: T (prim = [])
- external x: T = "s1" ... "sn" (prim = ["s1";..."sn"])
+(** Values of type {!value_description} represents:
+ - [val x: T],
+ when {{!value_description.pval_prim}[pval_prim]} is [[]]
+ - [external x: T = "s1" ... "sn"]
+ when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]]
*)
-(* Type declarations *)
+(** {2 Type declarations} *)
and type_declaration =
{
ptype_name: string loc;
ptype_params: (core_type * (variance * injectivity)) list;
- (* ('a1,...'an) t; None represents _*)
+ (** [('a1,...'an) t] *)
ptype_cstrs: (core_type * core_type * Location.t) list;
- (* ... constraint T1=T1' ... constraint Tn=Tn' *)
+ (** [... constraint T1=T1' ... constraint Tn=Tn'] *)
ptype_kind: type_kind;
- ptype_private: private_flag; (* = private ... *)
- ptype_manifest: core_type option; (* = T *)
- ptype_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ ptype_private: private_flag; (** for [= private ...] *)
+ ptype_manifest: core_type option; (** represents [= T] *)
+ ptype_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
ptype_loc: Location.t;
}
-
-(*
- type t (abstract, no manifest)
- type t = T0 (abstract, manifest=T0)
- type t = C of T | ... (variant, no manifest)
- type t = T0 = C of T | ... (variant, manifest=T0)
- type t = {l: T; ...} (record, no manifest)
- type t = T0 = {l : T; ...} (record, manifest=T0)
- type t = .. (open, no manifest)
+(**
+ Here are type declarations and their representation,
+ for various {{!type_declaration.ptype_kind}[ptype_kind]}
+ and {{!type_declaration.ptype_manifest}[ptype_manifest]} values:
+ - [type t] when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
+ and [manifest] is [None],
+ - [type t = T0]
+ when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
+ and [manifest] is [Some T0],
+ - [type t = C of T | ...]
+ when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
+ and [manifest] is [None],
+ - [type t = T0 = C of T | ...]
+ when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
+ and [manifest] is [Some T0],
+ - [type t = {l: T; ...}]
+ when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
+ and [manifest] is [None],
+ - [type t = T0 = {l : T; ...}]
+ when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
+ and [manifest] is [Some T0],
+ - [type t = ..]
+ when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]},
+ and [manifest] is [None].
*)
and type_kind =
| Ptype_abstract
| Ptype_variant of constructor_declaration list
- | Ptype_record of label_declaration list
- (* Invariant: non-empty list *)
+ | Ptype_record of label_declaration list (** Invariant: non-empty list *)
| Ptype_open
and label_declaration =
pld_mutable: mutable_flag;
pld_type: core_type;
pld_loc: Location.t;
- pld_attributes: attributes; (* l : T [@id1] [@id2] *)
+ pld_attributes: attributes; (** [l : T [\@id1] [\@id2]] *)
}
-
-(* { ...; l: T; ... } (mutable=Immutable)
- { ...; mutable l: T; ... } (mutable=Mutable)
-
- Note: T can be a Ptyp_poly.
+(**
+ - [{ ...; l: T; ... }]
+ when {{!label_declaration.pld_mutable}[pld_mutable]}
+ is {{!Asttypes.mutable_flag.Immutable}[Immutable]},
+ - [{ ...; mutable l: T; ... }]
+ when {{!label_declaration.pld_mutable}[pld_mutable]}
+ is {{!Asttypes.mutable_flag.Mutable}[Mutable]}.
+
+ Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}.
*)
and constructor_declaration =
{
pcd_name: string loc;
+ pcd_vars: string loc list;
pcd_args: constructor_arguments;
pcd_res: core_type option;
pcd_loc: Location.t;
- pcd_attributes: attributes; (* C of ... [@id1] [@id2] *)
+ pcd_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *)
}
and constructor_arguments =
| Pcstr_tuple of core_type list
| Pcstr_record of label_declaration list
-
-(*
- | C of T1 * ... * Tn (res = None, args = Pcstr_tuple [])
- | C: T0 (res = Some T0, args = [])
- | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple)
- | C of {...} (res = None, args = Pcstr_record)
- | C: {...} -> T0 (res = Some T0, args = Pcstr_record)
- | C of {...} as t (res = None, args = Pcstr_record)
+ (** Values of type {!constructor_declaration}
+ represents the constructor arguments of:
+ - [C of T1 * ... * Tn] when [res = None],
+ and [args = Pcstr_tuple [T1; ... ; Tn]],
+ - [C: T0] when [res = Some T0],
+ and [args = Pcstr_tuple []],
+ - [C: T1 * ... * Tn -> T0] when [res = Some T0],
+ and [args = Pcstr_tuple [T1; ... ; Tn]],
+ - [C of {...}] when [res = None],
+ and [args = Pcstr_record [...]],
+ - [C: {...} -> T0] when [res = Some T0],
+ and [args = Pcstr_record [...]].
*)
and type_extension =
ptyext_constructors: extension_constructor list;
ptyext_private: private_flag;
ptyext_loc: Location.t;
- ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ ptyext_attributes: attributes; (** ... [\@\@id1] [\@\@id2] *)
}
-(*
- type t += ...
+(**
+ Definition of new extensions constructors for the extensive sum type [t]
+ ([type t += ...]).
*)
and extension_constructor =
{
pext_name: string loc;
- pext_kind : extension_constructor_kind;
- pext_loc : Location.t;
- pext_attributes: attributes; (* C of ... [@id1] [@id2] *)
+ pext_kind: extension_constructor_kind;
+ pext_loc: Location.t;
+ pext_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *)
}
-(* exception E *)
and type_exception =
{
- ptyexn_constructor: extension_constructor;
- ptyexn_loc: Location.t;
- ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ ptyexn_constructor : extension_constructor;
+ ptyexn_loc : Location.t;
+ ptyexn_attributes : attributes; (** [... [\@\@id1] [\@\@id2]] *)
}
+(** Definition of a new exception ([exception E]). *)
and extension_constructor_kind =
- Pext_decl of constructor_arguments * core_type option
- (*
- | C of T1 * ... * Tn ([T1; ...; Tn], None)
- | C: T0 ([], Some T0)
- | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0)
+ | Pext_decl of string loc list * constructor_arguments * core_type option
+ (** [Pext_decl(existentials, c_args, t_opt)]
+ describes a new extension constructor. It can be:
+ - [C of T1 * ... * Tn] when:
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[T1; ...; Tn]],}
+ {- [t_opt] is [None]}.}
+ - [C: T0] when
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[]],}
+ {- [t_opt] is [Some T0].}}
+ - [C: T1 * ... * Tn -> T0] when
+ {ul {- [existentials] is [[]],}
+ {- [c_args] is [[T1; ...; Tn]],}
+ {- [t_opt] is [Some T0].}}
+ - [C: 'a... . T1 * ... * Tn -> T0] when
+ {ul {- [existentials] is [['a;...]],}
+ {- [c_args] is [[T1; ... ; Tn]],}
+ {- [t_opt] is [Some T0].}}
*)
| Pext_rebind of Longident.t loc
- (*
- | C = D
- *)
+ (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *)
(** {1 Class language} *)
-
-(* Type expressions for the class language *)
+(** {2 Type expressions for the class language} *)
and class_type =
{
pcty_desc: class_type_desc;
pcty_loc: Location.t;
- pcty_attributes: attributes; (* ... [@id1] [@id2] *)
+ pcty_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and class_type_desc =
| Pcty_constr of Longident.t loc * core_type list
- (* c
- ['a1, ..., 'an] c *)
- | Pcty_signature of class_signature
- (* object ... end *)
+ (** - [c]
+ - [['a1, ..., 'an] c] *)
+ | Pcty_signature of class_signature (** [object ... end] *)
| Pcty_arrow of arg_label * core_type * class_type
- (* T -> CT Simple
- ~l:T -> CT Labelled l
- ?l:T -> CT Optional l
+ (** [Pcty_arrow(lbl, T, CT)] represents:
+ - [T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]},
+ - [~l:T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]},
+ - [?l:T -> CT]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}.
*)
- | Pcty_extension of extension
- (* [%id] *)
- | Pcty_open of open_description * class_type
- (* let open M in CT *)
+ | Pcty_extension of extension (** [%id] *)
+ | Pcty_open of open_description * class_type (** [let open M in CT] *)
and class_signature =
{
pcsig_self: core_type;
pcsig_fields: class_type_field list;
}
-(* object('selfpat) ... end
- object ... end (self = Ptyp_any)
- *)
+(** Values of type [class_signature] represents:
+ - [object('selfpat) ... end]
+ - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]}
+ is {{!core_type_desc.Ptyp_any}[Ptyp_any]}
+*)
and class_type_field =
{
pctf_desc: class_type_field_desc;
pctf_loc: Location.t;
- pctf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pctf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
}
and class_type_field_desc =
- | Pctf_inherit of class_type
- (* inherit CT *)
+ | Pctf_inherit of class_type (** [inherit CT] *)
| Pctf_val of (label loc * mutable_flag * virtual_flag * core_type)
- (* val x: T *)
- | Pctf_method of (label loc * private_flag * virtual_flag * core_type)
- (* method x: T
+ (** [val x: T] *)
+ | Pctf_method of (label loc * private_flag * virtual_flag * core_type)
+ (** [method x: T]
- Note: T can be a Ptyp_poly.
- *)
- | Pctf_constraint of (core_type * core_type)
- (* constraint T1 = T2 *)
- | Pctf_attribute of attribute
- (* [@@@id] *)
- | Pctf_extension of extension
- (* [%%id] *)
+ Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}.
+ *)
+ | Pctf_constraint of (core_type * core_type) (** [constraint T1 = T2] *)
+ | Pctf_attribute of attribute (** [[\@\@\@id]] *)
+ | Pctf_extension of extension (** [[%%id]] *)
and 'a class_infos =
{
pci_name: string loc;
pci_expr: 'a;
pci_loc: Location.t;
- pci_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pci_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
}
-(* class c = ...
- class ['a1,...,'an] c = ...
- class virtual c = ...
+(** Values of type [class_expr class_infos] represents:
+ - [class c = ...]
+ - [class ['a1,...,'an] c = ...]
+ - [class virtual c = ...]
- Also used for "class type" declaration.
+ They are also used for "class type" declaration.
*)
and class_description = class_type class_infos
and class_type_declaration = class_type class_infos
-(* Value expressions for the class language *)
+(** {2 Value expressions for the class language} *)
and class_expr =
{
pcl_desc: class_expr_desc;
pcl_loc: Location.t;
- pcl_attributes: attributes; (* ... [@id1] [@id2] *)
+ pcl_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and class_expr_desc =
| Pcl_constr of Longident.t loc * core_type list
- (* c
- ['a1, ..., 'an] c *)
- | Pcl_structure of class_structure
- (* object ... end *)
+ (** [c] and [['a1, ..., 'an] c] *)
+ | Pcl_structure of class_structure (** [object ... end] *)
| Pcl_fun of arg_label * expression option * pattern * class_expr
- (* fun P -> CE (Simple, None)
- fun ~l:P -> CE (Labelled l, None)
- fun ?l:P -> CE (Optional l, None)
- fun ?l:(P = E0) -> CE (Optional l, Some E0)
- *)
+ (** [Pcl_fun(lbl, exp0, P, CE)] represents:
+ - [fun P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
+ and [exp0] is [None],
+ - [fun ~l:P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
+ and [exp0] is [None],
+ - [fun ?l:P -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [None],
+ - [fun ?l:(P = E0) -> CE]
+ when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
+ and [exp0] is [Some E0].
+ *)
| Pcl_apply of class_expr * (arg_label * expression) list
- (* CE ~l1:E1 ... ~ln:En
- li can be empty (non labeled argument) or start with '?'
- (optional argument).
+ (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])]
+ represents [CE ~l1:E1 ... ~ln:En].
+ [li] can be empty (non labeled argument) or start with [?]
+ (optional argument).
- Invariant: n > 0
- *)
+ Invariant: [n > 0]
+ *)
| Pcl_let of rec_flag * value_binding list * class_expr
- (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive)
- let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive)
- *)
- | Pcl_constraint of class_expr * class_type
- (* (CE : CT) *)
- | Pcl_extension of extension
- (* [%id] *)
- | Pcl_open of open_description * class_expr
- (* let open M in CE *)
-
+ (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents:
+ - [let P1 = E1 and ... and Pn = EN in CE]
+ when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN in CE]
+ when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
+ *)
+ | Pcl_constraint of class_expr * class_type (** [(CE : CT)] *)
+ | Pcl_extension of extension (** [[%id]] *)
+ | Pcl_open of open_description * class_expr (** [let open M in CE] *)
and class_structure =
{
pcstr_self: pattern;
pcstr_fields: class_field list;
}
-(* object(selfpat) ... end
- object ... end (self = Ppat_any)
- *)
+(** Values of type {!class_structure} represents:
+ - [object(selfpat) ... end]
+ - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]}
+ is {{!pattern_desc.Ppat_any}[Ppat_any]}
+*)
and class_field =
{
pcf_desc: class_field_desc;
pcf_loc: Location.t;
- pcf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pcf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
}
and class_field_desc =
| Pcf_inherit of override_flag * class_expr * string loc option
- (* inherit CE
- inherit CE as x
- inherit! CE
- inherit! CE as x
- *)
+ (** [Pcf_inherit(flag, CE, s)] represents:
+ - [inherit CE]
+ when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
+ and [s] is [None],
+ - [inherit CE as x]
+ when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
+ and [s] is [Some x],
+ - [inherit! CE]
+ when [flag] is {{!Asttypes.override_flag.Override}[Override]}
+ and [s] is [None],
+ - [inherit! CE as x]
+ when [flag] is {{!Asttypes.override_flag.Override}[Override]}
+ and [s] is [Some x]
+ *)
| Pcf_val of (label loc * mutable_flag * class_field_kind)
- (* val x = E
- val virtual x: T
- *)
+ (** [Pcf_val(x,flag, kind)] represents:
+ - [val x = E]
+ when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
+ and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
+ - [val virtual x: T]
+ when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
+ and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
+ - [val mutable x = E]
+ when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
+ and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
+ - [val mutable virtual x: T]
+ when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
+ and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
+ *)
| Pcf_method of (label loc * private_flag * class_field_kind)
- (* method x = E (E can be a Pexp_poly)
- method virtual x: T (T can be a Ptyp_poly)
- *)
- | Pcf_constraint of (core_type * core_type)
- (* constraint T1 = T2 *)
- | Pcf_initializer of expression
- (* initializer E *)
- | Pcf_attribute of attribute
- (* [@@@id] *)
- | Pcf_extension of extension
- (* [%%id] *)
+ (** - [method x = E]
+ ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]})
+ - [method virtual x: T]
+ ([T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]})
+ *)
+ | Pcf_constraint of (core_type * core_type) (** [constraint T1 = T2] *)
+ | Pcf_initializer of expression (** [initializer E] *)
+ | Pcf_attribute of attribute (** [[\@\@\@id]] *)
+ | Pcf_extension of extension (** [[%%id]] *)
and class_field_kind =
| Cfk_virtual of core_type
and class_declaration = class_expr class_infos
(** {1 Module language} *)
-
-(* Type expressions for the module language *)
+(** {2 Type expressions for the module language} *)
and module_type =
{
pmty_desc: module_type_desc;
pmty_loc: Location.t;
- pmty_attributes: attributes; (* ... [@id1] [@id2] *)
+ pmty_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and module_type_desc =
- | Pmty_ident of Longident.t loc
- (* S *)
- | Pmty_signature of signature
- (* sig ... end *)
+ | Pmty_ident of Longident.t loc (** [Pmty_ident(S)] represents [S] *)
+ | Pmty_signature of signature (** [sig ... end] *)
| Pmty_functor of functor_parameter * module_type
- (* functor(X : MT1) -> MT2 *)
- | Pmty_with of module_type * with_constraint list
- (* MT with ... *)
- | Pmty_typeof of module_expr
- (* module type of ME *)
- | Pmty_extension of extension
- (* [%id] *)
- | Pmty_alias of Longident.t loc
- (* (module M) *)
+ (** [functor(X : MT1) -> MT2] *)
+ | Pmty_with of module_type * with_constraint list (** [MT with ...] *)
+ | Pmty_typeof of module_expr (** [module type of ME] *)
+ | Pmty_extension of extension (** [[%id]] *)
+ | Pmty_alias of Longident.t loc (** [(module M)] *)
and functor_parameter =
- | Unit
- (* () *)
+ | Unit (** [()] *)
| Named of string option loc * module_type
- (* (X : MT) Some X, MT
- (_ : MT) None, MT *)
+ (** [Named(name, MT)] represents:
+ - [(X : MT)] when [name] is [Some X],
+ - [(_ : MT)] when [name] is [None] *)
and signature = signature_item list
and signature_item_desc =
| Psig_value of value_description
- (*
- val x: T
- external x: T = "s1" ... "sn"
+ (** - [val x: T]
+ - [external x: T = "s1" ... "sn"]
*)
| Psig_type of rec_flag * type_declaration list
- (* type t1 = ... and ... and tn = ... *)
+ (** [type t1 = ... and ... and tn = ...] *)
| Psig_typesubst of type_declaration list
- (* type t1 := ... and ... and tn := ... *)
- | Psig_typext of type_extension
- (* type t1 += ... *)
- | Psig_exception of type_exception
- (* exception C of T *)
- | Psig_module of module_declaration
- (* module X = M
- module X : MT *)
- | Psig_modsubst of module_substitution
- (* module X := M *)
+ (** [type t1 := ... and ... and tn := ...] *)
+ | Psig_typext of type_extension (** [type t1 += ...] *)
+ | Psig_exception of type_exception (** [exception C of T] *)
+ | Psig_module of module_declaration (** [module X = M] and [module X : MT] *)
+ | Psig_modsubst of module_substitution (** [module X := M] *)
| Psig_recmodule of module_declaration list
- (* module rec X1 : MT1 and ... and Xn : MTn *)
+ (** [module rec X1 : MT1 and ... and Xn : MTn] *)
| Psig_modtype of module_type_declaration
- (* module type S = MT
- module type S *)
+ (** [module type S = MT] and [module type S] *)
| Psig_modtypesubst of module_type_declaration
- (* module type S := ... *)
- | Psig_open of open_description
- (* open X *)
- | Psig_include of include_description
- (* include MT *)
+ (** [module type S := ...] *)
+ | Psig_open of open_description (** [open X] *)
+ | Psig_include of include_description (** [include MT] *)
| Psig_class of class_description list
- (* class c1 : ... and ... and cn : ... *)
+ (** [class c1 : ... and ... and cn : ...] *)
| Psig_class_type of class_type_declaration list
- (* class type ct1 = ... and ... and ctn = ... *)
- | Psig_attribute of attribute
- (* [@@@id] *)
- | Psig_extension of extension * attributes
- (* [%%id] *)
+ (** [class type ct1 = ... and ... and ctn = ...] *)
+ | Psig_attribute of attribute (** [[\@\@\@id]] *)
+ | Psig_extension of extension * attributes (** [[%%id]] *)
and module_declaration =
{
pmd_name: string option loc;
pmd_type: module_type;
- pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pmd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
pmd_loc: Location.t;
}
-(* S : MT *)
+(** Values of type [module_declaration] represents [S : MT] *)
and module_substitution =
{
pms_name: string loc;
pms_manifest: Longident.t loc;
- pms_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pms_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
pms_loc: Location.t;
}
+(** Values of type [module_substitution] represents [S := M] *)
and module_type_declaration =
{
pmtd_name: string loc;
pmtd_type: module_type option;
- pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pmtd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *)
pmtd_loc: Location.t;
}
-(* S = MT
- S (abstract module type declaration, pmtd_type = None)
+(** Values of type [module_type_declaration] represents:
+ - [S = MT],
+ - [S] for abstract module type declaration,
+ when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None].
*)
and 'a open_infos =
popen_loc: Location.t;
popen_attributes: attributes;
}
-(* open! X - popen_override = Override (silences the 'used identifier
- shadowing' warning)
- open X - popen_override = Fresh
- *)
+(** Values of type ['a open_infos] represents:
+ - [open! X] when {{!open_infos.popen_override}[popen_override]}
+ is {{!Asttypes.override_flag.Override}[Override]}
+ (silences the "used identifier shadowing" warning)
+ - [open X] when {{!open_infos.popen_override}[popen_override]}
+ is {{!Asttypes.override_flag.Fresh}[Fresh]}
+*)
and open_description = Longident.t loc open_infos
-(* open M.N
- open M(N).O *)
+(** Values of type [open_description] represents:
+ - [open M.N]
+ - [open M(N).O] *)
and open_declaration = module_expr open_infos
-(* open M.N
- open M(N).O
- open struct ... end *)
+(** Values of type [open_declaration] represents:
+ - [open M.N]
+ - [open M(N).O]
+ - [open struct ... end] *)
and 'a include_infos =
{
}
and include_description = module_type include_infos
-(* include MT *)
+(** Values of type [include_description] represents [include MT] *)
and include_declaration = module_expr include_infos
-(* include ME *)
+(** Values of type [include_declaration] represents [include ME] *)
and with_constraint =
| Pwith_type of Longident.t loc * type_declaration
- (* with type X.t = ...
+ (** [with type X.t = ...]
- Note: the last component of the longident must match
- the name of the type_declaration. *)
+ Note: the last component of the longident must match
+ the name of the type_declaration. *)
| Pwith_module of Longident.t loc * Longident.t loc
- (* with module X.Y = Z *)
+ (** [with module X.Y = Z] *)
| Pwith_modtype of Longident.t loc * module_type
- (* with module type X.Y = Z *)
+ (** [with module type X.Y = Z] *)
| Pwith_modtypesubst of Longident.t loc * module_type
- (* with module type X.Y := sig end *)
+ (** [with module type X.Y := sig end] *)
| Pwith_typesubst of Longident.t loc * type_declaration
- (* with type X.t := ..., same format as [Pwith_type] *)
+ (** [with type X.t := ..., same format as [Pwith_type]] *)
| Pwith_modsubst of Longident.t loc * Longident.t loc
- (* with module X.Y := Z *)
+ (** [with module X.Y := Z] *)
-(* Value expressions for the module language *)
+(** {2 Value expressions for the module language} *)
and module_expr =
{
pmod_desc: module_expr_desc;
pmod_loc: Location.t;
- pmod_attributes: attributes; (* ... [@id1] [@id2] *)
+ pmod_attributes: attributes; (** [... [\@id1] [\@id2]] *)
}
and module_expr_desc =
- | Pmod_ident of Longident.t loc
- (* X *)
- | Pmod_structure of structure
- (* struct ... end *)
+ | Pmod_ident of Longident.t loc (** [X] *)
+ | Pmod_structure of structure (** [struct ... end] *)
| Pmod_functor of functor_parameter * module_expr
- (* functor(X : MT1) -> ME *)
- | Pmod_apply of module_expr * module_expr
- (* ME1(ME2) *)
- | Pmod_constraint of module_expr * module_type
- (* (ME : MT) *)
- | Pmod_unpack of expression
- (* (val E) *)
- | Pmod_extension of extension
- (* [%id] *)
+ (** [functor(X : MT1) -> ME] *)
+ | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *)
+ | Pmod_constraint of module_expr * module_type (** [(ME : MT)] *)
+ | Pmod_unpack of expression (** [(val E)] *)
+ | Pmod_extension of extension (** [[%id]] *)
and structure = structure_item list
}
and structure_item_desc =
- | Pstr_eval of expression * attributes
- (* E *)
+ | Pstr_eval of expression * attributes (** [E] *)
| Pstr_value of rec_flag * value_binding list
- (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive)
- let rec P1 = E1 and ... and Pn = EN (flag = Recursive)
- *)
+ (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents:
+ - [let P1 = E1 and ... and Pn = EN]
+ when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
+ - [let rec P1 = E1 and ... and Pn = EN ]
+ when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
+ *)
| Pstr_primitive of value_description
- (* val x: T
- external x: T = "s1" ... "sn" *)
+ (** - [val x: T]
+ - [external x: T = "s1" ... "sn" ]*)
| Pstr_type of rec_flag * type_declaration list
- (* type t1 = ... and ... and tn = ... *)
- | Pstr_typext of type_extension
- (* type t1 += ... *)
+ (** [type t1 = ... and ... and tn = ...] *)
+ | Pstr_typext of type_extension (** [type t1 += ...] *)
| Pstr_exception of type_exception
- (* exception C of T
- exception C = M.X *)
- | Pstr_module of module_binding
- (* module X = ME *)
+ (** - [exception C of T]
+ - [exception C = M.X] *)
+ | Pstr_module of module_binding (** [module X = ME] *)
| Pstr_recmodule of module_binding list
- (* module rec X1 = ME1 and ... and Xn = MEn *)
- | Pstr_modtype of module_type_declaration
- (* module type S = MT *)
- | Pstr_open of open_declaration
- (* open X *)
+ (** [module rec X1 = ME1 and ... and Xn = MEn] *)
+ | Pstr_modtype of module_type_declaration (** [module type S = MT] *)
+ | Pstr_open of open_declaration (** [open X] *)
| Pstr_class of class_declaration list
- (* class c1 = ... and ... and cn = ... *)
+ (** [class c1 = ... and ... and cn = ...] *)
| Pstr_class_type of class_type_declaration list
- (* class type ct1 = ... and ... and ctn = ... *)
- | Pstr_include of include_declaration
- (* include ME *)
- | Pstr_attribute of attribute
- (* [@@@id] *)
- | Pstr_extension of extension * attributes
- (* [%%id] *)
+ (** [class type ct1 = ... and ... and ctn = ...] *)
+ | Pstr_include of include_declaration (** [include ME] *)
+ | Pstr_attribute of attribute (** [[\@\@\@id]] *)
+ | Pstr_extension of extension * attributes (** [[%%id]] *)
and value_binding =
{
pmb_attributes: attributes;
pmb_loc: Location.t;
}
-(* X = ME *)
+(** Values of type [module_binding] represents [module X = ME] *)
(** {1 Toplevel} *)
-(* Toplevel phrases *)
+(** {2 Toplevel phrases} *)
type toplevel_phrase =
| Ptop_def of structure
- | Ptop_dir of toplevel_directive
- (* #use, #load ... *)
+ | Ptop_dir of toplevel_directive (** [#use], [#load] ... *)
and toplevel_directive =
{
- pdir_name : string loc;
- pdir_arg : directive_argument option;
- pdir_loc : Location.t;
+ pdir_name: string loc;
+ pdir_arg: directive_argument option;
+ pdir_loc: Location.t;
}
and directive_argument =
{
- pdira_desc : directive_argument_desc;
- pdira_loc : Location.t;
+ pdira_desc: directive_argument_desc;
+ pdira_loc: Location.t;
}
and directive_argument_desc =
(extension_constructor ctxt) x.ptyexn_constructor
(item_attributes ctxt) x.ptyexn_attributes
+and class_type_field ctxt f x =
+ match x.pctf_desc with
+ | Pctf_inherit (ct) ->
+ pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_val (s, mf, vf, ct) ->
+ pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
+ mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_method (s, pf, vf, ct) ->
+ pp f "@[<2>method %a %a%s :@;%a@]%a"
+ private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_constraint (ct1, ct2) ->
+ pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+ (core_type ctxt) ct1 (core_type ctxt) ct2
+ (item_attributes ctxt) x.pctf_attributes
+ | Pctf_attribute a -> floating_attribute ctxt f a
+ | Pctf_extension e ->
+ item_extension ctxt f e;
+ item_attributes ctxt f x.pctf_attributes
+
and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
- let class_type_field f x =
- match x.pctf_desc with
- | Pctf_inherit (ct) ->
- pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
- (item_attributes ctxt) x.pctf_attributes
- | Pctf_val (s, mf, vf, ct) ->
- pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
- mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
- (item_attributes ctxt) x.pctf_attributes
- | Pctf_method (s, pf, vf, ct) ->
- pp f "@[<2>method %a %a%s :@;%a@]%a"
- private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
- (item_attributes ctxt) x.pctf_attributes
- | Pctf_constraint (ct1, ct2) ->
- pp f "@[<2>constraint@ %a@ =@ %a@]%a"
- (core_type ctxt) ct1 (core_type ctxt) ct2
- (item_attributes ctxt) x.pctf_attributes
- | Pctf_attribute a -> floating_attribute ctxt f a
- | Pctf_extension e ->
- item_extension ctxt f e;
- item_attributes ctxt f x.pctf_attributes
- in
pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
(fun f -> function
{ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
| ct -> pp f " (%a)" (core_type ctxt) ct) ct
- (list class_type_field ~sep:"@;") l
+ (list (class_type_field ctxt) ~sep:"@;") l
(* call [class_signature] called by [class_signature] *)
and class_type ctxt f x =
let constructor_declaration f pcd =
pp f "|@;";
constructor_declaration ctxt f
- (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+ (pcd.pcd_name.txt, pcd.pcd_vars,
+ pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
in
let repr f =
let intro f =
x.ptyext_constructors
(item_attributes ctxt) x.ptyext_attributes
-and constructor_declaration ctxt f (name, args, res, attrs) =
+and constructor_declaration ctxt f (name, vars, args, res, attrs) =
let name =
match name with
| "::" -> "(::)"
| s -> s in
+ let pp_vars f vs =
+ match vs with
+ | [] -> ()
+ | vs -> pp f "%a@;.@;" (list tyvar_loc ~sep:"@;") vs in
match res with
| None ->
pp f "%s%a@;%a" name
) args
(attributes ctxt) attrs
| Some r ->
- pp f "%s:@;%a@;%a" name
+ pp f "%s:@;%a%a@;%a" name
+ pp_vars vars
(fun f -> function
| Pcstr_tuple [] -> core_type1 ctxt f r
| Pcstr_tuple l -> pp f "%a@;->@;%a"
and extension_constructor ctxt f x =
(* Cf: #7200 *)
match x.pext_kind with
- | Pext_decl(l, r) ->
- constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
+ | Pext_decl(v, l, r) ->
+ constructor_declaration ctxt f
+ (x.pext_name.txt, v, l, r, x.pext_attributes)
| Pext_rebind li ->
pp f "%s@;=@;%a%a" x.pext_name.txt
longident_loc li
let signature = signature reset_ctxt
let structure = structure reset_ctxt
let module_expr = module_expr reset_ctxt
+let module_type = module_type reset_ctxt
+let class_field = class_field reset_ctxt
+let class_type_field = class_type_field reset_ctxt
+let class_expr = class_expr reset_ctxt
+let class_type = class_type reset_ctxt
+let structure_item = structure_item reset_ctxt
+let signature_item = signature_item reset_ctxt
+let binding = binding reset_ctxt
+let payload = payload reset_ctxt
val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
+val class_field: Format.formatter -> Parsetree.class_field -> unit
+val class_type_field: Format.formatter -> Parsetree.class_type_field -> unit
+val class_expr: Format.formatter -> Parsetree.class_expr -> unit
+val class_type: Format.formatter -> Parsetree.class_type -> unit
+val module_type: Format.formatter -> Parsetree.module_type -> unit
+val structure_item: Format.formatter -> Parsetree.structure_item -> unit
+val signature_item: Format.formatter -> Parsetree.signature_item -> unit
+val binding: Format.formatter -> Parsetree.value_binding -> unit
+val payload: Format.formatter -> Parsetree.payload -> unit
val tyvar: Format.formatter -> string -> unit
(** Print a type variable name, taking care of the special treatment
| Labelled s -> line i ppf "Labelled \"%s\"\n" s
;;
+let typevars ppf vs =
+ List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt) vs
+
let rec core_type i ppf x =
line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
attributes i ppf x.ptyp_attributes;
line i ppf "Ptyp_alias \"%s\"\n" s;
core_type i ppf ct;
| Ptyp_poly (sl, ct) ->
- line i ppf "Ptyp_poly%a\n"
- (fun ppf ->
- List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt)
- )
- sl;
+ line i ppf "Ptyp_poly%a\n" typevars sl;
core_type i ppf ct;
| Ptyp_package (s, l) ->
line i ppf "Ptyp_package %a\n" fmt_longident_loc s;
and extension_constructor_kind i ppf x =
match x with
- Pext_decl(a, r) ->
+ Pext_decl(v, a, r) ->
line i ppf "Pext_decl\n";
+ if v <> [] then line (i+1) ppf "vars%a\n" typevars v;
constructor_arguments (i+1) ppf a;
option (i+1) core_type ppf r;
| Pext_rebind li ->
core_type (i+1) ppf ct2;
and constructor_decl i ppf
- {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
+ {pcd_name; pcd_vars; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
line i ppf "%a\n" fmt_location pcd_loc;
line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
+ if pcd_vars <> [] then line (i+1) ppf "pcd_vars =%a\n" typevars pcd_vars;
attributes i ppf pcd_attributes;
constructor_arguments (i+1) ppf pcd_args;
option (i+1) core_type ppf pcd_res
cat >/tmp/env-$USER.sh <<EOF
# Update the data below
export MAJOR=4
-export MINOR=13
+export MINOR=12
export BUGFIX=0
-export PLUSEXT=~alpha1
+export PLUSEXT=
# names for the release announce
-export HUMAN=Florian Angeletti
+export HUMAN=
# do we need to use tar or gtar?
export TAR=tar
git checkout -b OCaml_$VERSION
```
-Create ocaml-variants packages for the new version, copying the particular
-switch configuration choices from the previous version.
+The following opam packages are needed for all releases:
+
+- `ocaml-base-compiler.$VERSION`
+- `ocaml-variants.$VERSION+options`
+
+For production release, the following packages need to be updated:
+
+- `ocaml-system.$VERSION`
+- `ocaml-src.$VERSION`
+- `ocaml-src.$MAJOR.$MINOR.dev`
+- `ocaml-manual.$VERSION`
+- `ocaml.$NEXTVERSION`
+
+Note that the `ocaml` virtual package needs to be updated to the next version.
+
+Similarly, the `ocurrent/ocaml-version` library should be updated.
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
dynlink clambda_checks afl bigarray \
memprof domain skiplist codefrag)
-GENERATED_HEADERS := caml/opnames.h caml/version.h caml/jumptbl.h build_config.h
-CONFIG_HEADERS := caml/m.h caml/s.h
+# Header files generated by configure
+CONFIGURED_HEADERS := caml/m.h caml/s.h caml/version.h
+
+# Header files generated by make
+BUILT_HEADERS := caml/opnames.h caml/jumptbl.h build_config.h
ifeq "$(TOOLCHAIN)" "msvc"
ASM_EXT := asm
rm -f *.o *.obj *.a *.lib *.so *.dll ld.conf
rm -f ocamlrun ocamlrund ocamlruni ocamlruns sak
rm -f ocamlrun.exe ocamlrund.exe ocamlruni.exe ocamlruns.exe sak.exe
- rm -f primitives primitives.new prims.c $(GENERATED_HEADERS)
+ rm -f primitives primitives.new prims.c $(BUILT_HEADERS)
rm -f domain_state*.inc
rm -rf $(DEPDIR)
.PHONY: distclean
distclean: clean
+ rm -f $(CONFIGURED_HEADERS)
# Generated non-object files
tr -d '\r' < $< | \
sed -n -e '/^ /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
-e '/^}/q' > $@
-
-caml/version.h : $(ROOTDIR)/tools/make-version-header.sh $(ROOTDIR)/VERSION
- $^ > $@
-
# These are provided as a temporary shim to allow cross-compilation systems
# to supply a host C compiler and different flags and a linking macro.
SAK_CC ?= $(CC)
ifneq "$(COMPUTE_DEPS)" "false"
ifneq "$(1)" "%"
# -MG would ensure that the dependencies are generated even if the files listed
-# in $$(GENERATED_HEADERS) haven't been assembled yet. However, this goes subtly
+# in $$(BUILT_HEADERS) haven't been assembled yet. However, this goes subtly
# wrong if the user has the headers installed, as gcc will pick up a dependency
# on those instead and the local ones will not be generated. For this reason, we
-# don't use -MG and instead include $(GENERATED_HEADERS) in the order only
+# don't use -MG and instead include $(BUILT_HEADERS) in the order only
# dependencies to ensure that they exist before dependencies are computed.
-$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS)
+$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(BUILT_HEADERS)
$$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT \
'$$*$(subst %,,$(1)).$(O)' -MF $$@
endif # ifneq "$(1)" "%"
$(1).$(O): $(2).c
else
-$(1).$(O): $(2).c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
+$(1).$(O): $(2).c $(CONFIGURED_HEADERS) $(BUILT_HEADERS) $(RUNTIME_HEADERS)
endif # ifneq "$(COMPUTE_DEPS)" "false"
$$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
$$(OUTPUTOBJ)$$@ $$<
{
intnat idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
- Modify(&Field(array, idx), newval);
+ caml_modify(&Field(array, idx), newval);
return Val_unit;
}
static value caml_array_unsafe_set_addr(value array, value index,value newval)
{
intnat idx = Long_val(index);
- Modify(&Field(array, idx), newval);
+ caml_modify(&Field(array, idx), newval);
return Val_unit;
}
are within the bounds and return the offset of the corresponding
array element in the data part of the array. */
-static long caml_ba_offset(struct caml_ba_array * b, intnat * index)
+static intnat caml_ba_offset(struct caml_ba_array * b, intnat * index)
{
intnat offset;
int i;
/* **** alloc.c */
-#define alloc caml_alloc /*SP*/
-#define alloc_small caml_alloc_small
-#define alloc_tuple caml_alloc_tuple
-#define alloc_string caml_alloc_string
-#define alloc_final caml_alloc_final
-#define copy_string caml_copy_string
-#define alloc_array caml_alloc_array
-#define copy_string_array caml_copy_string_array
-#define convert_flag_list caml_convert_flag_list
+#define alloc CAML_DEPRECATED("alloc", "caml_alloc") caml_alloc /*SP*/
+#define alloc_small CAML_DEPRECATED("alloc_small", "caml_alloc_small") caml_alloc_small
+#define alloc_tuple CAML_DEPRECATED("alloc_tuple", "caml_alloc_tuple") caml_alloc_tuple
+#define alloc_string CAML_DEPRECATED("alloc_string", "caml_alloc_string") caml_alloc_string
+#define alloc_final CAML_DEPRECATED("alloc_final", "caml_alloc_final") caml_alloc_final
+#define copy_string CAML_DEPRECATED("copy_string", "caml_copy_string") caml_copy_string
+#define alloc_array CAML_DEPRECATED("alloc_array", "caml_alloc_array") caml_alloc_array
+#define copy_string_array CAML_DEPRECATED("copy_string_array", "caml_copy_string_array") caml_copy_string_array
+#define convert_flag_list CAML_DEPRECATED("convert_flag_list", "caml_convert_flag_list") caml_convert_flag_list
/* **** array.c */
/* **** backtrace.c */
-#define backtrace_active caml_backtrace_active
-#define backtrace_pos caml_backtrace_pos
-#define backtrace_buffer caml_backtrace_buffer
-#define backtrace_last_exn caml_backtrace_last_exn
-#define print_exception_backtrace caml_print_exception_backtrace
+#define backtrace_active CAML_DEPRECATED("backtrace_active", "caml_backtrace_active") caml_backtrace_active
+#define backtrace_pos CAML_DEPRECATED("backtrace_pos", "caml_backtrace_pos") caml_backtrace_pos
+#define backtrace_buffer CAML_DEPRECATED("backtrace_buffer", "caml_backtrace_buffer") caml_backtrace_buffer
+#define backtrace_last_exn CAML_DEPRECATED("backtrace_last_exn", "caml_backtrace_last_exn") caml_backtrace_last_exn
+#define print_exception_backtrace CAML_DEPRECATED("print_exception_backtrace", "caml_print_exception_backtrace") caml_print_exception_backtrace
/* **** callback.c */
-#define callback_depth caml_callback_depth
-#define callbackN_exn caml_callbackN_exn
-#define callback_exn caml_callback_exn
-#define callback2_exn caml_callback2_exn
-#define callback3_exn caml_callback3_exn
-#define callback caml_callback
-#define callback2 caml_callback2
-#define callback3 caml_callback3
-#define callbackN caml_callbackN
+#define callback_depth CAML_DEPRECATED("callback_depth", "caml_callback_depth") caml_callback_depth
+#define callbackN_exn CAML_DEPRECATED("callbackN_exn", "caml_callbackN_exn") caml_callbackN_exn
+#define callback_exn CAML_DEPRECATED("callback_exn", "caml_callback_exn") caml_callback_exn
+#define callback2_exn CAML_DEPRECATED("callback2_exn", "caml_callback2_exn") caml_callback2_exn
+#define callback3_exn CAML_DEPRECATED("callback3_exn", "caml_callback3_exn") caml_callback3_exn
+#define callback CAML_DEPRECATED("callback", "caml_callback") caml_callback
+#define callback2 CAML_DEPRECATED("callback2", "caml_callback2") caml_callback2
+#define callback3 CAML_DEPRECATED("callback3", "caml_callback3") caml_callback3
+#define callbackN CAML_DEPRECATED("callbackN", "caml_callbackN") caml_callbackN
/* **** compact.c */
/* **** compare.c */
-#define compare_unordered caml_compare_unordered
+#define compare_unordered CAML_DEPRECATED("compare_unordered", "caml_compare_unordered") caml_compare_unordered
/* **** custom.c */
-#define alloc_custom caml_alloc_custom
-#define register_custom_operations caml_register_custom_operations
+#define alloc_custom CAML_DEPRECATED("alloc_custom", "caml_alloc_custom") caml_alloc_custom
+#define register_custom_operations CAML_DEPRECATED("register_custom_operations", "caml_register_custom_operations") caml_register_custom_operations
/* **** debugger.c */
/* **** dynlink.c */
/* **** extern.c */
-#define output_val caml_output_val
-#define output_value_to_malloc caml_output_value_to_malloc
-#define output_value_to_block caml_output_value_to_block
-#define serialize_int_1 caml_serialize_int_1
-#define serialize_int_2 caml_serialize_int_2
-#define serialize_int_4 caml_serialize_int_4
-#define serialize_int_8 caml_serialize_int_8
-#define serialize_float_4 caml_serialize_float_4
-#define serialize_float_8 caml_serialize_float_8
-#define serialize_block_1 caml_serialize_block_1
-#define serialize_block_2 caml_serialize_block_2
-#define serialize_block_4 caml_serialize_block_4
-#define serialize_block_8 caml_serialize_block_8
-#define serialize_block_float_8 caml_serialize_block_float_8
+#define output_val CAML_DEPRECATED("output_val", "caml_output_val") caml_output_val
+#define output_value_to_malloc CAML_DEPRECATED("output_value_to_malloc", "caml_output_value_to_malloc") caml_output_value_to_malloc
+#define output_value_to_block CAML_DEPRECATED("output_value_to_block", "caml_output_value_to_block") caml_output_value_to_block
+#define serialize_int_1 CAML_DEPRECATED("serialize_int_1", "caml_serialize_int_1") caml_serialize_int_1
+#define serialize_int_2 CAML_DEPRECATED("serialize_int_2", "caml_serialize_int_2") caml_serialize_int_2
+#define serialize_int_4 CAML_DEPRECATED("serialize_int_4", "caml_serialize_int_4") caml_serialize_int_4
+#define serialize_int_8 CAML_DEPRECATED("serialize_int_8", "caml_serialize_int_8") caml_serialize_int_8
+#define serialize_float_4 CAML_DEPRECATED("serialize_float_4", "caml_serialize_float_4") caml_serialize_float_4
+#define serialize_float_8 CAML_DEPRECATED("serialize_float_8", "caml_serialize_float_8") caml_serialize_float_8
+#define serialize_block_1 CAML_DEPRECATED("serialize_block_1", "caml_serialize_block_1") caml_serialize_block_1
+#define serialize_block_2 CAML_DEPRECATED("serialize_block_2", "caml_serialize_block_2") caml_serialize_block_2
+#define serialize_block_4 CAML_DEPRECATED("serialize_block_4", "caml_serialize_block_4") caml_serialize_block_4
+#define serialize_block_8 CAML_DEPRECATED("serialize_block_8", "caml_serialize_block_8") caml_serialize_block_8
+#define serialize_block_float_8 CAML_DEPRECATED("serialize_block_float_8", "caml_serialize_block_float_8") caml_serialize_block_float_8
/* **** fail.c */
-#define external_raise caml_external_raise
-#define mlraise caml_raise /*SP*/
-#define raise_constant caml_raise_constant
-#define raise_with_arg caml_raise_with_arg
-#define raise_with_string caml_raise_with_string
-#define failwith caml_failwith
-#define invalid_argument caml_invalid_argument
-#define array_bound_error caml_array_bound_error /*SP*/
-#define raise_out_of_memory caml_raise_out_of_memory
-#define raise_stack_overflow caml_raise_stack_overflow
-#define raise_sys_error caml_raise_sys_error
-#define raise_end_of_file caml_raise_end_of_file
-#define raise_zero_divide caml_raise_zero_divide
-#define raise_not_found caml_raise_not_found
-#define raise_sys_blocked_io caml_raise_sys_blocked_io
+#define external_raise CAML_DEPRECATED("external_raise", "caml_external_raise") caml_external_raise
+#define mlraise CAML_DEPRECATED("mlraise", "caml_raise") caml_raise /*SP*/
+#define raise_constant CAML_DEPRECATED("raise_constant", "caml_raise_constant") caml_raise_constant
+#define raise_with_arg CAML_DEPRECATED("raise_with_arg", "caml_raise_with_arg") caml_raise_with_arg
+#define raise_with_string CAML_DEPRECATED("raise_with_string", "caml_raise_with_string") caml_raise_with_string
+#define failwith CAML_DEPRECATED("failwith", "caml_failwith") caml_failwith
+#define invalid_argument CAML_DEPRECATED("invalid_argument", "caml_invalid_argument") caml_invalid_argument
+#define array_bound_error CAML_DEPRECATED("array_bound_error", "caml_array_bound_error") caml_array_bound_error /*SP*/
+#define raise_out_of_memory CAML_DEPRECATED("raise_out_of_memory", "caml_raise_out_of_memory") caml_raise_out_of_memory
+#define raise_stack_overflow CAML_DEPRECATED("raise_stack_overflow", "caml_raise_stack_overflow") caml_raise_stack_overflow
+#define raise_sys_error CAML_DEPRECATED("raise_sys_error", "caml_raise_sys_error") caml_raise_sys_error
+#define raise_end_of_file CAML_DEPRECATED("raise_end_of_file", "caml_raise_end_of_file") caml_raise_end_of_file
+#define raise_zero_divide CAML_DEPRECATED("raise_zero_divide", "caml_raise_zero_divide") caml_raise_zero_divide
+#define raise_not_found CAML_DEPRECATED("raise_not_found", "caml_raise_not_found") caml_raise_not_found
+#define raise_sys_blocked_io CAML_DEPRECATED("raise_sys_blocked_io", "caml_raise_sys_blocked_io") caml_raise_sys_blocked_io
/* **** runtime/fail_nat.c */
/* **** runtime/<arch>.s */
/* **** floats.c */
/*#define Double_val caml_Double_val done in mlvalues.h as needed */
/*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */
-#define copy_double caml_copy_double
+#define copy_double CAML_DEPRECATED("copy_double", "caml_copy_double") caml_copy_double
/* **** freelist.c */
/* **** gc_ctrl.c */
/* **** globroots.c */
-#define register_global_root caml_register_global_root
-#define remove_global_root caml_remove_global_root
+#define register_global_root CAML_DEPRECATED("register_global_root", "caml_register_global_root") caml_register_global_root
+#define remove_global_root CAML_DEPRECATED("remove_global_root", "caml_remove_global_root") caml_remove_global_root
/* **** hash.c */
-#define hash_variant caml_hash_variant
+#define hash_variant CAML_DEPRECATED("hash_variant", "caml_hash_variant") caml_hash_variant
/* **** instrtrace.c */
/* **** intern.c */
-#define input_val caml_input_val
-#define input_val_from_string caml_input_val_from_string
-#define input_value_from_malloc caml_input_value_from_malloc
-#define input_value_from_block caml_input_value_from_block
-#define deserialize_uint_1 caml_deserialize_uint_1
-#define deserialize_sint_1 caml_deserialize_sint_1
-#define deserialize_uint_2 caml_deserialize_uint_2
-#define deserialize_sint_2 caml_deserialize_sint_2
-#define deserialize_uint_4 caml_deserialize_uint_4
-#define deserialize_sint_4 caml_deserialize_sint_4
-#define deserialize_uint_8 caml_deserialize_uint_8
-#define deserialize_sint_8 caml_deserialize_sint_8
-#define deserialize_float_4 caml_deserialize_float_4
-#define deserialize_float_8 caml_deserialize_float_8
-#define deserialize_block_1 caml_deserialize_block_1
-#define deserialize_block_2 caml_deserialize_block_2
-#define deserialize_block_4 caml_deserialize_block_4
-#define deserialize_block_8 caml_deserialize_block_8
-#define deserialize_block_float_8 caml_deserialize_block_float_8
-#define deserialize_error caml_deserialize_error
+#define input_val CAML_DEPRECATED("input_val", "caml_input_val") caml_input_val
+#define input_val_from_string CAML_DEPRECATED("input_val_from_string", "caml_input_val_from_string") caml_input_val_from_string
+#define input_value_from_malloc CAML_DEPRECATED("input_value_from_malloc", "caml_input_value_from_malloc") caml_input_value_from_malloc
+#define input_value_from_block CAML_DEPRECATED("input_value_from_block", "caml_input_value_from_block") caml_input_value_from_block
+#define deserialize_uint_1 CAML_DEPRECATED("deserialize_uint_1", "caml_deserialize_uint_1") caml_deserialize_uint_1
+#define deserialize_sint_1 CAML_DEPRECATED("deserialize_sint_1", "caml_deserialize_sint_1") caml_deserialize_sint_1
+#define deserialize_uint_2 CAML_DEPRECATED("deserialize_uint_2", "caml_deserialize_uint_2") caml_deserialize_uint_2
+#define deserialize_sint_2 CAML_DEPRECATED("deserialize_sint_2", "caml_deserialize_sint_2") caml_deserialize_sint_2
+#define deserialize_uint_4 CAML_DEPRECATED("deserialize_uint_4", "caml_deserialize_uint_4") caml_deserialize_uint_4
+#define deserialize_sint_4 CAML_DEPRECATED("deserialize_sint_4", "caml_deserialize_sint_4") caml_deserialize_sint_4
+#define deserialize_uint_8 CAML_DEPRECATED("deserialize_uint_8", "caml_deserialize_uint_8") caml_deserialize_uint_8
+#define deserialize_sint_8 CAML_DEPRECATED("deserialize_sint_8", "caml_deserialize_sint_8") caml_deserialize_sint_8
+#define deserialize_float_4 CAML_DEPRECATED("deserialize_float_4", "caml_deserialize_float_4") caml_deserialize_float_4
+#define deserialize_float_8 CAML_DEPRECATED("deserialize_float_8", "caml_deserialize_float_8") caml_deserialize_float_8
+#define deserialize_block_1 CAML_DEPRECATED("deserialize_block_1", "caml_deserialize_block_1") caml_deserialize_block_1
+#define deserialize_block_2 CAML_DEPRECATED("deserialize_block_2", "caml_deserialize_block_2") caml_deserialize_block_2
+#define deserialize_block_4 CAML_DEPRECATED("deserialize_block_4", "caml_deserialize_block_4") caml_deserialize_block_4
+#define deserialize_block_8 CAML_DEPRECATED("deserialize_block_8", "caml_deserialize_block_8") caml_deserialize_block_8
+#define deserialize_block_float_8 CAML_DEPRECATED("deserialize_block_float_8", "caml_deserialize_block_float_8") caml_deserialize_block_float_8
+#define deserialize_error CAML_DEPRECATED("deserialize_error", "caml_deserialize_error") caml_deserialize_error
/* **** interp.c */
/* **** ints.c */
-#define int32_ops caml_int32_ops
-#define copy_int32 caml_copy_int32
+#define int32_ops CAML_DEPRECATED("int32_ops", "caml_int32_ops") caml_int32_ops
+#define copy_int32 CAML_DEPRECATED("copy_int32", "caml_copy_int32") caml_copy_int32
/*#define Int64_val caml_Int64_val *** done in mlvalues.h as needed */
-#define int64_ops caml_int64_ops
-#define copy_int64 caml_copy_int64
-#define nativeint_ops caml_nativeint_ops
-#define copy_nativeint caml_copy_nativeint
+#define int64_ops CAML_DEPRECATED("int64_ops", "caml_int64_ops") caml_int64_ops
+#define copy_int64 CAML_DEPRECATED("copy_int64", "caml_copy_int64") caml_copy_int64
+#define nativeint_ops CAML_DEPRECATED("nativeint_ops", "caml_nativeint_ops") caml_nativeint_ops
+#define copy_nativeint CAML_DEPRECATED("copy_nativeint", "caml_copy_nativeint") caml_copy_nativeint
/* **** io.c */
-#define channel_mutex_free caml_channel_mutex_free
-#define channel_mutex_lock caml_channel_mutex_lock
-#define channel_mutex_unlock caml_channel_mutex_unlock
-#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn
-#define all_opened_channels caml_all_opened_channels
-#define open_descriptor_in caml_open_descriptor_in /*SP*/
-#define open_descriptor_out caml_open_descriptor_out /*SP*/
-#define close_channel caml_close_channel /*SP*/
-#define channel_size caml_channel_size /*SP*/
-#define channel_binary_mode caml_channel_binary_mode
-#define flush_partial caml_flush_partial /*SP*/
-#define flush caml_flush /*SP*/
-#define putword caml_putword
-#define putblock caml_putblock
-#define really_putblock caml_really_putblock
-#define seek_out caml_seek_out /*SP*/
-#define pos_out caml_pos_out /*SP*/
-#define do_read caml_do_read
-#define refill caml_refill
-#define getword caml_getword
-#define getblock caml_getblock
-#define really_getblock caml_really_getblock
-#define seek_in caml_seek_in /*SP*/
-#define pos_in caml_pos_in /*SP*/
-#define input_scan_line caml_input_scan_line /*SP*/
-#define finalize_channel caml_finalize_channel
-#define alloc_channel caml_alloc_channel
+#define channel_mutex_free CAML_DEPRECATED("channel_mutex_free", "caml_channel_mutex_free") caml_channel_mutex_free
+#define channel_mutex_lock CAML_DEPRECATED("channel_mutex_lock", "caml_channel_mutex_lock") caml_channel_mutex_lock
+#define channel_mutex_unlock CAML_DEPRECATED("channel_mutex_unlock", "caml_channel_mutex_unlock") caml_channel_mutex_unlock
+#define channel_mutex_unlock_exn CAML_DEPRECATED("channel_mutex_unlock_exn", "caml_channel_mutex_unlock_exn") caml_channel_mutex_unlock_exn
+#define all_opened_channels CAML_DEPRECATED("all_opened_channels", "caml_all_opened_channels") caml_all_opened_channels
+#define open_descriptor_in CAML_DEPRECATED("open_descriptor_in", "caml_open_descriptor_in") caml_open_descriptor_in /*SP*/
+#define open_descriptor_out CAML_DEPRECATED("open_descriptor_out", "caml_open_descriptor_out") caml_open_descriptor_out /*SP*/
+#define close_channel CAML_DEPRECATED("close_channel", "caml_close_channel") caml_close_channel /*SP*/
+#define channel_size CAML_DEPRECATED("channel_size", "caml_channel_size") caml_channel_size /*SP*/
+#define channel_binary_mode CAML_DEPRECATED("channel_binary_mode", "caml_channel_binary_mode") caml_channel_binary_mode
+#define flush_partial CAML_DEPRECATED("flush_partial", "caml_flush_partial") caml_flush_partial /*SP*/
+#define flush CAML_DEPRECATED("flush", "caml_flush") caml_flush /*SP*/
+#define putword CAML_DEPRECATED("putword", "caml_putword") caml_putword
+#define putblock CAML_DEPRECATED("putblock", "caml_putblock") caml_putblock
+#define really_putblock CAML_DEPRECATED("really_putblock", "caml_really_putblock") caml_really_putblock
+#define seek_out CAML_DEPRECATED("seek_out", "caml_seek_out") caml_seek_out /*SP*/
+#define pos_out CAML_DEPRECATED("pos_out", "caml_pos_out") caml_pos_out /*SP*/
+#define do_read CAML_DEPRECATED("do_read", "caml_do_read") caml_do_read
+#define refill CAML_DEPRECATED("refill", "caml_refill") caml_refill
+#define getword CAML_DEPRECATED("getword", "caml_getword") caml_getword
+#define getblock CAML_DEPRECATED("getblock", "caml_getblock") caml_getblock
+#define really_getblock CAML_DEPRECATED("really_getblock", "caml_really_getblock") caml_really_getblock
+#define seek_in CAML_DEPRECATED("seek_in", "caml_seek_in") caml_seek_in /*SP*/
+#define pos_in CAML_DEPRECATED("pos_in", "caml_pos_in") caml_pos_in /*SP*/
+#define input_scan_line CAML_DEPRECATED("input_scan_line", "caml_input_scan_line") caml_input_scan_line /*SP*/
+#define finalize_channel CAML_DEPRECATED("finalize_channel", "caml_finalize_channel") caml_finalize_channel
+#define alloc_channel CAML_DEPRECATED("alloc_channel", "caml_alloc_channel") caml_alloc_channel
/*#define Val_file_offset caml_Val_file_offset *** done in io.h as needed */
/*#define File_offset_val caml_File_offset_val *** done in io.h as needed */
/* *** no change */
/* **** major_gc.c */
-#define heap_start caml_heap_start
-#define page_table caml_page_table
+#define heap_start CAML_DEPRECATED("heap_start", "caml_heap_start") caml_heap_start
+#define page_table CAML_DEPRECATED("page_table", "caml_page_table") caml_page_table
/* **** md5.c */
-#define MD5Init caml_MD5Init
-#define MD5Update caml_MD5Update
-#define MD5Final caml_MD5Final
-#define MD5Transform caml_MD5Transform
+#define md5_string CAML_DEPRECATED("md5_string", "caml_md5_string") caml_md5_string
+#define md5_chan CAML_DEPRECATED("md5_chan", "caml_md5_chan") caml_md5_chan
+#define MD5Init CAML_DEPRECATED("MD5Init", "caml_MD5Init") caml_MD5Init
+#define MD5Update CAML_DEPRECATED("MD5Update", "caml_MD5Update") caml_MD5Update
+#define MD5Final CAML_DEPRECATED("MD5Final", "caml_MD5Final") caml_MD5Final
+#define MD5Transform CAML_DEPRECATED("MD5Transform", "caml_MD5Transform") caml_MD5Transform
/* **** memory.c */
-#define alloc_shr caml_alloc_shr
-#define initialize caml_initialize
-#define modify caml_modify
-#define stat_alloc caml_stat_alloc
-#define stat_free caml_stat_free
-#define stat_resize caml_stat_resize
+#define alloc_shr CAML_DEPRECATED("alloc_shr", "caml_alloc_shr") caml_alloc_shr
+#define initialize CAML_DEPRECATED("initialize", "caml_initialize") caml_initialize
+#define modify CAML_DEPRECATED("modify", "caml_modify") caml_modify
+#define stat_alloc CAML_DEPRECATED("stat_alloc", "caml_stat_alloc") caml_stat_alloc
+#define stat_free CAML_DEPRECATED("stat_free", "caml_stat_free") caml_stat_free
+#define stat_resize CAML_DEPRECATED("stat_resize", "caml_stat_resize") caml_stat_resize
/* **** meta.c */
/* **** minor_gc.c */
-#define young_start caml_young_start
-#define young_end caml_young_end
-#define young_ptr caml_young_ptr
-#define young_limit caml_young_limit
-#define ref_table caml_ref_table
-#define minor_collection caml_minor_collection
-#define check_urgent_gc caml_check_urgent_gc
+#define young_start CAML_DEPRECATED("young_start", "caml_young_start") caml_young_start
+#define young_end CAML_DEPRECATED("young_end", "caml_young_end") caml_young_end
+#define young_ptr CAML_DEPRECATED("young_ptr", "caml_young_ptr") caml_young_ptr
+#define young_limit CAML_DEPRECATED("young_limit", "caml_young_limit") caml_young_limit
+#define ref_table CAML_DEPRECATED("ref_table", "caml_ref_table") caml_ref_table
+#define minor_collection CAML_DEPRECATED("minor_collection", "caml_minor_collection") caml_minor_collection
+#define check_urgent_gc CAML_DEPRECATED("check_urgent_gc", "caml_check_urgent_gc") caml_check_urgent_gc
/* **** misc.c */
/* **** prims.c */
/* **** printexc.c */
-#define format_caml_exception caml_format_exception /*SP*/
+#define format_caml_exception CAML_DEPRECATED("format_caml_exception", "caml_format_exception") caml_format_exception /*SP*/
/* **** roots.c */
-#define local_roots caml_local_roots
-#define scan_roots_hook caml_scan_roots_hook
-#define do_local_roots caml_do_local_roots
+#define local_roots CAML_DEPRECATED("local_roots", "caml_local_roots") caml_local_roots
+#define scan_roots_hook CAML_DEPRECATED("scan_roots_hook", "caml_scan_roots_hook") caml_scan_roots_hook
+#define do_local_roots CAML_DEPRECATED("do_local_roots", "caml_do_local_roots") caml_do_local_roots
/* **** signals.c */
-#define pending_signals caml_pending_signals
-#define something_to_do caml_something_to_do
-#define enter_blocking_section_hook caml_enter_blocking_section_hook
-#define leave_blocking_section_hook caml_leave_blocking_section_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
+#define pending_signals CAML_DEPRECATED("pending_signals", "caml_pending_signals") caml_pending_signals
+#define something_to_do CAML_DEPRECATED("something_to_do", "caml_something_to_do") caml_something_to_do
+#define enter_blocking_section_hook CAML_DEPRECATED("enter_blocking_section_hook", "caml_enter_blocking_section_hook") caml_enter_blocking_section_hook
+#define leave_blocking_section_hook CAML_DEPRECATED("leave_blocking_section_hook", "caml_leave_blocking_section_hook") caml_leave_blocking_section_hook
+#define enter_blocking_section CAML_DEPRECATED("enter_blocking_section", "caml_enter_blocking_section") caml_enter_blocking_section
+#define leave_blocking_section CAML_DEPRECATED("leave_blocking_section", "caml_leave_blocking_section") caml_leave_blocking_section
+#define convert_signal_number CAML_DEPRECATED("convert_signal_number", "caml_convert_signal_number") caml_convert_signal_number
+
/* **** runtime/signals.c */
-#define garbage_collection caml_garbage_collection
+#define garbage_collection CAML_DEPRECATED("garbage_collection", "caml_garbage_collection") caml_garbage_collection
/* **** stacks.c */
-#define stack_low caml_stack_low
-#define stack_high caml_stack_high
-#define stack_threshold caml_stack_threshold
-#define extern_sp caml_extern_sp
-#define trapsp caml_trapsp
-#define trap_barrier caml_trap_barrier
+#define stack_low CAML_DEPRECATED("stack_low", "caml_stack_low") caml_stack_low
+#define stack_high CAML_DEPRECATED("stack_high", "caml_stack_high") caml_stack_high
+#define stack_threshold CAML_DEPRECATED("stack_threshold", "caml_stack_threshold") caml_stack_threshold
+#define extern_sp CAML_DEPRECATED("extern_sp", "caml_extern_sp") caml_extern_sp
+#define trapsp CAML_DEPRECATED("trapsp", "caml_trapsp") caml_trapsp
+#define trap_barrier CAML_DEPRECATED("trap_barrier", "caml_trap_barrier") caml_trap_barrier
/* **** startup.c */
-#define atom_table caml_atom_table
+#define atom_table CAML_DEPRECATED("atom_table", "caml_atom_table") caml_atom_table
/* **** runtime/startup_nat.c */
-#define static_data_start caml_static_data_start
-#define static_data_end caml_static_data_end
+#define static_data_start CAML_DEPRECATED("static_data_start", "caml_static_data_start") caml_static_data_start
+#define static_data_end CAML_DEPRECATED("static_data_end", "caml_static_data_end") caml_static_data_end
/* **** str.c */
-#define string_length caml_string_length
+#define string_length CAML_DEPRECATED("string_length", "caml_string_length") caml_string_length
/* **** sys.c */
-#define sys_error caml_sys_error
+#define sys_error CAML_DEPRECATED("sys_error", "caml_sys_error") caml_sys_error
/* **** terminfo.c */
/* **** unix.c & win32.c */
-#define search_exe_in_path caml_search_exe_in_path
+#define search_exe_in_path CAML_DEPRECATED("search_exe_in_path", "caml_search_exe_in_path") caml_search_exe_in_path
/* **** weak.c */
#define uint8 caml_ba_uint8
#define int16 caml_ba_int16
#define uint16 caml_ba_uint16
-#define MAX_NUM_DIMS CAML_BA_MAX_NUM_DIMS
-#define caml_bigarray_kind caml_ba_kind
-#define BIGARRAY_FLOAT32 CAML_BA_FLOAT32
-#define BIGARRAY_FLOAT64 CAML_BA_FLOAT64
-#define BIGARRAY_SINT8 CAML_BA_SINT8
-#define BIGARRAY_UINT8 CAML_BA_UINT8
-#define BIGARRAY_SINT16 CAML_BA_SINT16
-#define BIGARRAY_UINT16 CAML_BA_UINT16
-#define BIGARRAY_INT32 CAML_BA_INT32
-#define BIGARRAY_INT64 CAML_BA_INT64
-#define BIGARRAY_CAML_INT CAML_BA_CAML_INT
-#define BIGARRAY_NATIVE_INT CAML_BA_NATIVE_INT
-#define BIGARRAY_COMPLEX32 CAML_BA_COMPLEX32
-#define BIGARRAY_COMPLEX64 CAML_BA_COMPLEX64
-#define BIGARRAY_KIND_MASK CAML_BA_KIND_MASK
-#define caml_bigarray_layout caml_ba_layout
-#define BIGARRAY_C_LAYOUT CAML_BA_C_LAYOUT
-#define BIGARRAY_FORTRAN_LAYOUT CAML_BA_FORTRAN_LAYOUT
-#define BIGARRAY_LAYOUT_MASK CAML_BA_LAYOUT_MASK
-#define caml_bigarray_managed caml_ba_managed
-#define BIGARRAY_EXTERNAL CAML_BA_EXTERNAL
-#define BIGARRAY_MANAGED CAML_BA_MANAGED
-#define BIGARRAY_MAPPED_FILE CAML_BA_MAPPED_FILE
-#define BIGARRAY_MANAGED_MASK CAML_BA_MANAGED_MASK
-#define caml_bigarray_proxy caml_ba_proxy
-#define caml_bigarray caml_ba_array
-#define Bigarray_val Caml_ba_array_val
-#define Data_bigarray_val Caml_ba_data_val
-#define alloc_bigarray caml_ba_alloc
-#define alloc_bigarray_dims caml_ba_alloc_dims
-#define bigarray_map_file caml_ba_map_file
-#define bigarray_unmap_file caml_ba_unmap_file
-#define bigarray_element_size caml_ba_element_size
-#define bigarray_byte_size caml_ba_byte_size
-#define bigarray_deserialize caml_ba_deserialize
-#define MAX_BIGARRAY_MEMORY CAML_BA_MAX_MEMORY
-#define bigarray_create caml_ba_create
-#define bigarray_get_N caml_ba_get_N
-#define bigarray_get_1 caml_ba_get_1
-#define bigarray_get_2 caml_ba_get_2
-#define bigarray_get_3 caml_ba_get_3
-#define bigarray_get_generic caml_ba_get_generic
-#define bigarray_set_1 caml_ba_set_1
-#define bigarray_set_2 caml_ba_set_2
-#define bigarray_set_3 caml_ba_set_3
-#define bigarray_set_N caml_ba_set_N
-#define bigarray_set_generic caml_ba_set_generic
-#define bigarray_num_dims caml_ba_num_dims
-#define bigarray_dim caml_ba_dim
-#define bigarray_kind caml_ba_kind
-#define bigarray_layout caml_ba_layout
-#define bigarray_slice caml_ba_slice
-#define bigarray_sub caml_ba_sub
-#define bigarray_blit caml_ba_blit
-#define bigarray_fill caml_ba_fill
-#define bigarray_reshape caml_ba_reshape
-#define bigarray_init caml_ba_init
+#define MAX_NUM_DIMS CAML_DEPRECATED("MAX_NUM_DIMS", "CAML_BA_MAX_NUM_DIMS") CAML_BA_MAX_NUM_DIMS
+#define caml_bigarray_kind CAML_DEPRECATED("caml_bigarray_kind", "caml_ba_kind") caml_ba_kind
+#define BIGARRAY_FLOAT32 CAML_DEPRECATED("BIGARRAY_FLOAT32", "CAML_BA_FLOAT32") CAML_BA_FLOAT32
+#define BIGARRAY_FLOAT64 CAML_DEPRECATED("BIGARRAY_FLOAT64", "CAML_BA_FLOAT64") CAML_BA_FLOAT64
+#define BIGARRAY_SINT8 CAML_DEPRECATED("BIGARRAY_SINT8", "CAML_BA_SINT8") CAML_BA_SINT8
+#define BIGARRAY_UINT8 CAML_DEPRECATED("BIGARRAY_UINT8", "CAML_BA_UINT8") CAML_BA_UINT8
+#define BIGARRAY_SINT16 CAML_DEPRECATED("BIGARRAY_SINT16", "CAML_BA_SINT16") CAML_BA_SINT16
+#define BIGARRAY_UINT16 CAML_DEPRECATED("BIGARRAY_UINT16", "CAML_BA_UINT16") CAML_BA_UINT16
+#define BIGARRAY_INT32 CAML_DEPRECATED("BIGARRAY_INT32", "CAML_BA_INT32") CAML_BA_INT32
+#define BIGARRAY_INT64 CAML_DEPRECATED("BIGARRAY_INT64", "CAML_BA_INT64") CAML_BA_INT64
+#define BIGARRAY_CAML_INT CAML_DEPRECATED("BIGARRAY_CAML_INT", "CAML_BA_CAML_INT") CAML_BA_CAML_INT
+#define BIGARRAY_NATIVE_INT CAML_DEPRECATED("BIGARRAY_NATIVE_INT", "CAML_BA_NATIVE_INT") CAML_BA_NATIVE_INT
+#define BIGARRAY_COMPLEX32 CAML_DEPRECATED("BIGARRAY_COMPLEX32", "CAML_BA_COMPLEX32") CAML_BA_COMPLEX32
+#define BIGARRAY_COMPLEX64 CAML_DEPRECATED("BIGARRAY_COMPLEX64", "CAML_BA_COMPLEX64") CAML_BA_COMPLEX64
+#define BIGARRAY_KIND_MASK CAML_DEPRECATED("BIGARRAY_KIND_MASK", "CAML_BA_KIND_MASK") CAML_BA_KIND_MASK
+#define caml_bigarray_layout CAML_DEPRECATED("caml_bigarray_layout", "caml_ba_layout") caml_ba_layout
+#define BIGARRAY_C_LAYOUT CAML_DEPRECATED("BIGARRAY_C_LAYOUT", "CAML_BA_C_LAYOUT") CAML_BA_C_LAYOUT
+#define BIGARRAY_FORTRAN_LAYOUT CAML_DEPRECATED("BIGARRAY_FORTRAN_LAYOUT", "CAML_BA_FORTRAN_LAYOUT") CAML_BA_FORTRAN_LAYOUT
+#define BIGARRAY_LAYOUT_MASK CAML_DEPRECATED("BIGARRAY_LAYOUT_MASK", "CAML_BA_LAYOUT_MASK") CAML_BA_LAYOUT_MASK
+#define caml_bigarray_managed CAML_DEPRECATED("caml_bigarray_managed", "caml_ba_managed") caml_ba_managed
+#define BIGARRAY_EXTERNAL CAML_DEPRECATED("BIGARRAY_EXTERNAL", "CAML_BA_EXTERNAL") CAML_BA_EXTERNAL
+#define BIGARRAY_MANAGED CAML_DEPRECATED("BIGARRAY_MANAGED", "CAML_BA_MANAGED") CAML_BA_MANAGED
+#define BIGARRAY_MAPPED_FILE CAML_DEPRECATED("BIGARRAY_MAPPED_FILE", "CAML_BA_MAPPED_FILE") CAML_BA_MAPPED_FILE
+#define BIGARRAY_MANAGED_MASK CAML_DEPRECATED("BIGARRAY_MANAGED_MASK", "CAML_BA_MANAGED_MASK") CAML_BA_MANAGED_MASK
+#define caml_bigarray_proxy CAML_DEPRECATED("caml_bigarray_proxy", "caml_ba_proxy") caml_ba_proxy
+#define caml_bigarray CAML_DEPRECATED("caml_bigarray", "caml_ba_array") caml_ba_array
+#define Bigarray_val CAML_DEPRECATED("Bigarray_val", "Caml_ba_array_val") Caml_ba_array_val
+#define Data_bigarray_val CAML_DEPRECATED("Data_bigarray_val", "Caml_ba_data_val") Caml_ba_data_val
+#define alloc_bigarray CAML_DEPRECATED("alloc_bigarray", "caml_ba_alloc") caml_ba_alloc
+#define alloc_bigarray_dims CAML_DEPRECATED("alloc_bigarray_dims", "caml_ba_alloc_dims") caml_ba_alloc_dims
+#define bigarray_map_file CAML_DEPRECATED("bigarray_map_file", "caml_ba_map_file") caml_ba_map_file
+#define bigarray_unmap_file CAML_DEPRECATED("bigarray_unmap_file", "caml_ba_unmap_file") caml_ba_unmap_file
+#define bigarray_element_size CAML_DEPRECATED("bigarray_element_size", "caml_ba_element_size") caml_ba_element_size
+#define bigarray_byte_size CAML_DEPRECATED("bigarray_byte_size", "caml_ba_byte_size") caml_ba_byte_size
+#define bigarray_deserialize CAML_DEPRECATED("bigarray_deserialize", "caml_ba_deserialize") caml_ba_deserialize
+#define MAX_BIGARRAY_MEMORY CAML_DEPRECATED("MAX_BIGARRAY_MEMORY", "CAML_BA_MAX_MEMORY") CAML_BA_MAX_MEMORY
+#define bigarray_create CAML_DEPRECATED("bigarray_create", "caml_ba_create") caml_ba_create
+#define bigarray_get_N CAML_DEPRECATED("bigarray_get_N", "caml_ba_get_N") caml_ba_get_N
+#define bigarray_get_1 CAML_DEPRECATED("bigarray_get_1", "caml_ba_get_1") caml_ba_get_1
+#define bigarray_get_2 CAML_DEPRECATED("bigarray_get_2", "caml_ba_get_2") caml_ba_get_2
+#define bigarray_get_3 CAML_DEPRECATED("bigarray_get_3", "caml_ba_get_3") caml_ba_get_3
+#define bigarray_get_generic CAML_DEPRECATED("bigarray_get_generic", "caml_ba_get_generic") caml_ba_get_generic
+#define bigarray_set_1 CAML_DEPRECATED("bigarray_set_1", "caml_ba_set_1") caml_ba_set_1
+#define bigarray_set_2 CAML_DEPRECATED("bigarray_set_2", "caml_ba_set_2") caml_ba_set_2
+#define bigarray_set_3 CAML_DEPRECATED("bigarray_set_3", "caml_ba_set_3") caml_ba_set_3
+#define bigarray_set_N CAML_DEPRECATED("bigarray_set_N", "caml_ba_set_N") caml_ba_set_N
+#define bigarray_set_generic CAML_DEPRECATED("bigarray_set_generic", "caml_ba_set_generic") caml_ba_set_generic
+#define bigarray_num_dims CAML_DEPRECATED("bigarray_num_dims", "caml_ba_num_dims") caml_ba_num_dims
+#define bigarray_dim CAML_DEPRECATED("bigarray_dim", "caml_ba_dim") caml_ba_dim
+#define bigarray_kind CAML_DEPRECATED("bigarray_kind", "caml_ba_kind") caml_ba_kind
+#define bigarray_layout CAML_DEPRECATED("bigarray_layout", "caml_ba_layout") caml_ba_layout
+#define bigarray_slice CAML_DEPRECATED("bigarray_slice", "caml_ba_slice") caml_ba_slice
+#define bigarray_sub CAML_DEPRECATED("bigarray_sub", "caml_ba_sub") caml_ba_sub
+#define bigarray_blit CAML_DEPRECATED("bigarray_blit", "caml_ba_blit") caml_ba_blit
+#define bigarray_fill CAML_DEPRECATED("bigarray_fill", "caml_ba_fill") caml_ba_fill
+#define bigarray_reshape CAML_DEPRECATED("bigarray_reshape", "caml_ba_reshape") caml_ba_reshape
+#define bigarray_init CAML_DEPRECATED("bigarray_init", "caml_ba_init") caml_ba_init
#endif /* CAML_NAME_SPACE */
#endif /* CAML_COMPATIBILITY_H */
#include "misc.h"
#include "mlvalues.h"
+#define NUM_EXTRA_PARAMS 64
+typedef value extra_params_area[NUM_EXTRA_PARAMS];
+
/* This structure sits in the TLS area and is also accessed efficiently
* via native code, which is why the indices are important */
#endif
#include "domain_state.tbl"
#undef DOMAIN_STATE
- CAMLalign(8) char end_of_domain_state;
} caml_domain_state;
enum {
#undef DOMAIN_STATE
};
+#ifdef CAML_NAME_SPACE
+#define LAST_DOMAIN_STATE_MEMBER extra_params
+#else
+#define LAST_DOMAIN_STATE_MEMBER _extra_params
+#endif
+
/* Check that the structure was laid out without padding,
since the runtime assumes this in computing offsets */
CAML_STATIC_ASSERT(
- offsetof(caml_domain_state, end_of_domain_state) ==
- Domain_state_num_fields * 8);
+ offsetof(caml_domain_state, LAST_DOMAIN_STATE_MEMBER) ==
+ (Domain_state_num_fields - 1) * 8);
CAMLextern caml_domain_state* Caml_state;
#ifdef CAML_NAME_SPACE
DOMAIN_STATE(void*, checking_pointer_pc)
/* See major_gc.c */
#endif
+
+DOMAIN_STATE(extra_params_area, extra_params)
+/* This member must occur last, because it is an array, not a scalar */
/* Magic number for this release */
-#define EXEC_MAGIC "Caml1999X030"
+#define EXEC_MAGIC "Caml1999X031"
#endif /* CAML_INTERNALS */
CHANNEL_FLAG_FROM_SOCKET = 1, /* For Windows */
CHANNEL_FLAG_MANAGED_BY_GC = 4, /* Free and close using GC finalization */
CHANNEL_TEXT_MODE = 8, /* "Text mode" for Windows and Cygwin */
+ CHANNEL_FLAG_UNBUFFERED = 16 /* Unbuffered (for output channels only) */
};
/* For an output channel:
if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
#define Unlock_exn() \
if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
+#define Flush_if_unbuffered(channel) \
+ if (channel->flags & CHANNEL_FLAG_UNBUFFERED) caml_flush(channel)
/* Conversion between file_offset and int64_t */
#include "freelist.h"
#include "misc.h"
+/* An interval of a single object to be scanned.
+ The end pointer must always be one-past-the-end of a heap block,
+ but the start pointer is not necessarily the start of the block */
+typedef struct {
+ value* start;
+ value* end;
+} mark_entry;
+
typedef struct {
void *block; /* address of the malloced block this chunk lives in */
- asize_t alloc; /* in bytes, used for compaction */
+ asize_t allocated; /* in bytes, used for compaction */
asize_t size; /* in bytes */
char *next;
- value* redarken_start; /* first block in chunk to redarken */
- value* redarken_end; /* last block in chunk that needs redarkening */
+ mark_entry redarken_first; /* first block in chunk to redarken */
+ value* redarken_end; /* one-past-end of last block for redarkening */
} heap_chunk_head;
-#define Chunk_size(c) (((heap_chunk_head *) (c)) [-1]).size
-#define Chunk_alloc(c) (((heap_chunk_head *) (c)) [-1]).alloc
-#define Chunk_next(c) (((heap_chunk_head *) (c)) [-1]).next
-#define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block
-#define Chunk_redarken_start(c) (((heap_chunk_head *) (c)) [-1]).redarken_start
-#define Chunk_redarken_end(c) (((heap_chunk_head *) (c)) [-1]).redarken_end
+#define Chunk_head(c) (((heap_chunk_head *) (c)) - 1)
+#define Chunk_size(c) Chunk_head(c)->size
+#define Chunk_alloc(c) Chunk_head(c)->allocated
+#define Chunk_next(c) Chunk_head(c)->next
+#define Chunk_block(c) Chunk_head(c)->block
extern int caml_gc_phase;
extern int caml_gc_subphase;
extern double caml_extra_heap_resources;
extern uintnat caml_dependent_size, caml_dependent_allocated;
extern uintnat caml_fl_wsz_at_phase_change;
+extern int caml_ephe_list_pure;
#define Phase_mark 0
#define Phase_clean 1
/* Deprecated alias for [caml_modify] */
-#define Modify(fp,val) caml_modify((fp), (val))
+#define Modify(fp,val) \
+ CAML_DEPRECATED("Modify", "caml_modify") \
+ caml_modify((fp), (val))
#endif /* CAML_INTERNALS */
#include <stdlib.h>
#include <stdarg.h>
-/* Basic types and constants */
-
-typedef size_t asize_t;
+/* Deprecation warnings */
#if defined(__GNUC__) || defined(__clang__)
/* Supported since at least GCC 3.1 */
#define CAMLdeprecated_typedef(name, type) typedef type name
#endif
+#if defined(__GNUC__) && __STDC_VERSION__ >= 199901L || _MSC_VER >= 1925
+
+#define CAML_STRINGIFY(x) #x
+#ifdef _MSC_VER
+#define CAML_MAKEWARNING1(x) CAML_STRINGIFY(message(x))
+#else
+#define CAML_MAKEWARNING1(x) CAML_STRINGIFY(GCC warning x)
+#endif
+#define CAML_MAKEWARNING2(y) CAML_MAKEWARNING1(#y)
+#define CAML_PREPROWARNING(x) _Pragma(CAML_MAKEWARNING2(x))
+#define CAML_DEPRECATED(name1,name2) \
+ CAML_PREPROWARNING(name1 is deprecated: use name2 instead)
+
+#else
+
+#define CAML_PREPROWARNING(msg)
+#define CAML_DEPRECATED(name1,name2)
+
+#endif
+
+/* Basic types and constants */
+
+typedef size_t asize_t;
+
+#ifndef NULL
+#define NULL 0
+#endif
+
#ifdef CAML_INTERNALS
CAMLdeprecated_typedef(addr, char *);
#endif /* CAML_INTERNALS */
#define Noreturn
#endif
+/* Manually preventing inlining */
+#if defined(__GNUC__)
+ #define Caml_noinline __attribute__ ((noinline))
+#elif defined(_MSC_VER)
+ #define Caml_noinline __declspec(noinline)
+#else
+ #define Caml_noinline
+#endif
+
/* Export control (to mark primitives and to handle Windows DLL) */
#ifndef CAMLDLLIMPORT
#ifdef CAML_INTERNALS
#define T(x) L ## x
+
+#define main_os wmain
#endif
#define access_os _waccess
#ifdef CAML_INTERNALS
#define T(x) x
+
+#define main_os main
#endif
#define access_os access
#endif /* _WIN32 */
+/* Wrapper for Windows unlink */
+#ifdef _WIN32
+#define caml_unlink caml_win32_unlink
+#else
+#define caml_unlink unlink_os
+#endif
+
/* Data structures */
struct ext_table * contents);
/* Deprecated aliases */
-#define caml_aligned_malloc caml_stat_alloc_aligned_noexc
-#define caml_strdup caml_stat_strdup
-#define caml_strconcat caml_stat_strconcat
+#define caml_aligned_malloc \
+ CAML_DEPRECATED("caml_aligned_malloc", "caml_stat_alloc_aligned_noexc") \
+ caml_stat_alloc_aligned_noexc
+#define caml_strdup \
+ CAML_DEPRECATED("caml_strdup", "caml_stat_strdup") \
+ caml_stat_strdup
+#define caml_strconcat \
+ CAML_DEPRECATED("caml_strconcat", "caml_stat_strconcat") \
+ caml_stat_strconcat
#ifdef CAML_INTERNALS
#ifdef _WIN32
extern int caml_win32_rename(const wchar_t *, const wchar_t *);
+CAMLextern int caml_win32_unlink(const wchar_t *);
extern void caml_probe_win32_version(void);
extern void caml_setup_win32_terminal(void);
/* Define HAS_SOCKETS if you have BSD sockets. */
+#undef HAS_SOCKETPAIR
+
+/* Define HAS_SOCKETPAIR if you have the socketpair function. Only
+ relevant on Windows. */
+
#undef HAS_SOCKLEN_T
/* Define HAS_SOCKLEN_T if the type socklen_t is defined in
/usr/include/sys/socket.h. */
+#undef HAS_AFUNIX_H
+
+/* Define HAS_AFUNIX_H if you have <afunix.h>. */
+
#undef HAS_INET_ATON
#undef HAS_IPV6
value caml_process_pending_actions_with_root_exn (value extra_root);
int caml_set_signal_action(int signo, int action);
CAMLextern int caml_setup_stack_overflow_detection(void);
-
+CAMLextern int caml_stop_stack_overflow_detection(void);
+CAMLextern void caml_init_signals(void);
+CAMLextern void caml_terminate_signals(void);
CAMLextern void (*caml_enter_blocking_section_hook)(void);
CAMLextern void (*caml_leave_blocking_section_hook)(void);
#ifdef POSIX_SIGNALS
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Sebastien Hinderer, projet Cambium, INRIA Paris */
+/* */
+/* Copyright 2021 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+/* Macros defining the current version of OCaml */
+
+#undef OCAML_VERSION_MAJOR
+#undef OCAML_VERSION_MINOR
+#undef OCAML_VERSION_PATCHLEVEL
+#undef OCAML_VERSION_ADDITIONAL
+#undef OCAML_VERSION_EXTRA
+#undef OCAML_VERSION
+#undef OCAML_VERSION_STRING
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* David Allsopp, MetaStack Solutions Ltd. */
+/* */
+/* Copyright 2015 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. */
+/* */
+/**************************************************************************/
+
+/* Operating system - Windows specific stuff */
+
+#ifndef CAML_WINSUPPORT_H
+#define CAML_WINSUPPORT_H
+
+#if defined(_WIN32) && defined(CAML_INTERNALS)
+
+#include <windef.h>
+
+/*
+ * This structure is defined inconsistently. mingw64 has it in ntdef.h (which
+ * doesn't look like a primary header) and technically it's part of ntifs.h in
+ * the WDK. Requiring the WDK is a bit extreme, so the definition is taken from
+ * ntdef.h. Both ntdef.h and ntifs.h define REPARSE_DATA_BUFFER_HEADER_SIZE
+ */
+#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
+typedef struct _REPARSE_DATA_BUFFER
+{
+ ULONG ReparseTag;
+ USHORT ReparseDataLength;
+ USHORT Reserved;
+ union
+ {
+ struct
+ {
+ USHORT SubstituteNameOffset;
+ USHORT SubstituteNameLength;
+ USHORT PrintNameOffset;
+ USHORT PrintNameLength;
+ ULONG Flags;
+ WCHAR PathBuffer[1];
+ } SymbolicLinkReparseBuffer;
+ struct
+ {
+ USHORT SubstituteNameOffset;
+ USHORT SubstituteNameLength;
+ USHORT PrintNameOffset;
+ USHORT PrintNameLength;
+ WCHAR PathBuffer[1];
+ } MountPointReparseBuffer;
+ struct
+ {
+ UCHAR DataBuffer[1];
+ } GenericReparseBuffer;
+ };
+} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;
+#endif
+
+#endif
+
+#endif /* CAML_WINSUPPORT_H */
#define ATOM ATOM_WS
#include <winsock2.h>
#undef ATOM
+/* Code duplication with otherlibs/unix/socketaddr.h is inevitable
+ * because pulling winsock2.h creates many naming conflicts. */
+#ifdef HAS_AFUNIX_H
+#include <afunix.h>
+#else
+struct sockaddr_un {
+ ADDRESS_FAMILY sun_family;
+ char sun_path[108];
+};
+#endif /* HAS_AFUNIX_H */
#include <process.h>
-#endif
+#endif /* _WIN32 */
#include "caml/fail.h"
#include "caml/fix_code.h"
static int sock_domain; /* Socket domain for the debugger */
static union { /* Socket address for the debugger */
struct sockaddr s_gen;
-#ifndef _WIN32
struct sockaddr_un s_unix;
-#endif
struct sockaddr_in s_inet;
} sock_addr;
static int sock_addr_len; /* Length of sock_addr */
dbg_in = caml_open_descriptor_in(dbg_socket);
dbg_out = caml_open_descriptor_out(dbg_socket);
/* The code in this file does not bracket channel I/O operations with
- Lock and Unlock, so fail if those are not no-ops. */
- if (caml_channel_mutex_lock != NULL ||
- caml_channel_mutex_unlock != NULL ||
- caml_channel_mutex_unlock_exn != NULL)
- caml_fatal_error("debugger does not support channel locks");
+ Lock and Unlock, but this is safe because the debugger only works
+ with single-threaded programs. The program being debugged
+ will abort when it creates a thread. */
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
#ifdef _WIN32
caml_putword(dbg_out, _getpid());
{
char * address;
char_os * a;
- size_t a_len;
char * port, * p;
struct hostent * host;
int n;
if (*p == ':') { *p = 0; port = p+1; break; }
}
if (port == NULL) {
-#ifndef _WIN32
+ size_t a_len;
/* Unix domain */
sock_domain = PF_UNIX;
sock_addr.s_unix.sun_family = AF_UNIX;
sock_addr_len =
((char *)&(sock_addr.s_unix.sun_path) - (char *)&(sock_addr.s_unix))
+ a_len;
-#else
- caml_fatal_error("unix sockets not supported");
-#endif
} else {
/* Internet domain */
sock_domain = PF_INET;
caml_stat_free(blk);
blk = nextblk;
}
+ Flush_if_unbuffered(chan);
}
CAMLprim value caml_output_value(value vchan, value v, value flags)
uintnat h = 0;
uintnat pos;
+ obj_counter = 0;
+ extern_flags = 0;
extern_init_position_table();
sp = extern_stack;
size = 0;
#include "caml/stack.h"
#include "caml/roots.h"
#include "caml/callback.h"
+#include "caml/signals.h"
/* The globals holding predefined exceptions */
if (Is_exception_result(v))
v = Extract_exception(v);
- if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
+ if (Caml_state->exception_pointer == NULL) {
+ caml_terminate_signals();
+ caml_fatal_uncaught_exception(v);
+ }
while (Caml_state->local_roots != NULL &&
(char *) Caml_state->local_roots < Caml_state->exception_pointer) {
.globl G(caml_extra_params)
G(caml_extra_params):
#ifndef SYS_solaris
- .space 64
+ .space 256
#else
- .zero 64
+ .zero 256
#endif
#if defined(SYS_linux_elf)
PUBLIC _caml_extra_params
_caml_extra_params LABEL DWORD
- BYTE 64 DUP (?)
+ BYTE 256 DUP (?)
END
const value * function_placeholder =
caml_named_value ("Debugger.function_placeholder");
if (function_placeholder != NULL) {
- v = *function_placeholder;
+ /* Use the code pointer from the "placeholder" function */
+ v = (value) Code_val(*function_placeholder);
} else {
intern_cleanup();
intern_bad_code_pointer(digest);
CAMLreturn (Val_unit);
}
+CAMLprim value caml_ml_set_buffered(value vchannel, value mode)
+{
+ struct channel * channel = Channel(vchannel);
+ if (Bool_val(mode)) {
+ channel->flags &= ~CHANNEL_FLAG_UNBUFFERED;
+ } else {
+ channel->flags |= CHANNEL_FLAG_UNBUFFERED;
+ caml_ml_flush(vchannel);
+ }
+ return Val_unit;
+}
+
+CAMLprim value caml_ml_is_buffered(value vchannel)
+{
+ struct channel * channel = Channel(vchannel);
+ return Val_bool( ! (channel->flags & CHANNEL_FLAG_UNBUFFERED));
+}
+
CAMLprim value caml_ml_output_char(value vchannel, value ch)
{
CAMLparam2 (vchannel, ch);
Lock(channel);
Putch(channel, Long_val(ch));
+ Flush_if_unbuffered(channel);
Unlock(channel);
CAMLreturn (Val_unit);
}
Lock(channel);
caml_putword(channel, (uint32_t) Long_val(w));
+ Flush_if_unbuffered(channel);
Unlock(channel);
CAMLreturn (Val_unit);
}
pos += written;
len -= written;
}
+ Flush_if_unbuffered(channel);
Unlock(channel);
CAMLreturn (Val_unit);
}
#include <windows.h>
#endif
-#ifdef _WIN32
-int wmain(int argc, wchar_t **argv)
-#else
-int main(int argc, char **argv)
-#endif
+int main_os(int argc, char_os **argv)
{
#ifdef _WIN32
/* Expand wildcards and diversions in command line */
#define MARK_STACK_INIT_SIZE 2048
-typedef struct {
- value block;
- uintnat offset;
-} mark_entry;
-
struct mark_stack {
mark_entry* stack;
uintnat count;
At the start of mark phase, (1) and (2) are empty.
In mark phase:
- - the ephemerons in (1) have a data alive or none
- (nb: new ephemerons are added in this part by weak.c)
- - the ephemerons in (2) have at least a white key or are white
- if ephe_list_pure is true, otherwise they are in an unknown state and
- must be checked again.
+ - An ephemeron in (1) have a data alive (grey/black if in the heap)
+ or none (nb: new ephemerons are added in this part by weak.c)
+ - An ephemeron in (2):
+ - is in any state if caml_ephe_list_pure is false
+ - otherwise has at least a white key or is white or its data is
+ black or none.
+ The third case can happen only using a set_* of weak.c
- the ephemerons in (3) are in an unknown state and must be checked
- At the end of mark phase, (3) is empty and ephe_list_pure is true.
+ At the end of mark phase, (3) is empty and caml_ephe_list_pure is true.
The ephemeron in (1) and (2) will be cleaned (white keys and data
replaced by none or the ephemeron is removed from the list if it is white)
in clean phase.
- the ephemerons in (3) should be cleaned or removed if white.
*/
-static int ephe_list_pure;
+int caml_ephe_list_pure;
/** The ephemerons is pure if since the start of its iteration
no value have been darkened. */
static value *ephes_checked_if_pure;
for( entry = 0; entry < mark_stack_count ; entry++ ) {
mark_entry me = mark_stack[entry];
- value* block_op = Op_val(me.block);
uintnat chunk_addr = 0, chunk_addr_below = 0;
- if( caml_skiplist_find_below(&chunk_sklist, (uintnat)me.block,
+ if( caml_skiplist_find_below(&chunk_sklist, (uintnat)me.start,
&chunk_addr, &chunk_addr_below)
- && me.block < chunk_addr_below ) {
-
- if( Chunk_redarken_start(chunk_addr) > block_op ) {
- Chunk_redarken_start(chunk_addr) = block_op;
- }
+ && (uintnat)me.start < chunk_addr_below ) {
+ heap_chunk_head* ch = Chunk_head(chunk_addr);
+ if (ch->redarken_first.start > me.start)
+ ch->redarken_first = me;
- if( Chunk_redarken_end(chunk_addr) < block_op ) {
- Chunk_redarken_end(chunk_addr) = block_op;
- }
+ if (ch->redarken_end < me.end)
+ ch->redarken_end = me.end;
if( redarken_first_chunk == NULL
|| redarken_first_chunk > (char*)chunk_addr ) {
me = &stk->stack[stk->count++];
- me->block = block;
- me->offset = offset;
+ me->start = Op_val(block) + offset;
+ me->end = Op_val(block) + Wosize_val(block);
}
#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
#endif
CAMLassert (!Is_blue_hd (h));
if (Is_white_hd (h)){
- ephe_list_pure = 0;
+ caml_ephe_list_pure = 0;
Hd_val (v) = Blackhd_hd (h);
marked_words += Whsize_hd (h);
if (t < No_scan_tag){
wasteful. Subsequent calls will continue progress.
*/
static int redarken_chunk(char* heap_chunk, struct mark_stack* stk) {
- value* p = Chunk_redarken_start(heap_chunk);
- value* end = Chunk_redarken_end(heap_chunk);
-
- while (p <= end) {
- header_t hd = Hd_op(p);
+ heap_chunk_head* chunk = Chunk_head(heap_chunk);
+ mark_entry me = chunk->redarken_first;
+ header_t* end = (header_t*)chunk->redarken_end;
+ if (chunk->redarken_end <= me.start) return 1;
+
+ while (1) {
+ header_t* hp;
+ /* Skip a prefix of fields that need no marking */
+ CAMLassert(me.start <= me.end && (header_t*)me.end <= end);
+ while (me.start < me.end &&
+ (!Is_block(*me.start) || Is_young(*me.start))) {
+ me.start++;
+ }
- if( Is_black_hd(hd) && Tag_hd(hd) < No_scan_tag ) {
- if( stk->count < stk->size/4 ) {
- mark_stack_push(stk, Val_op(p), 0, NULL);
+ /* Push to the mark stack (if anything's left) */
+ if (me.start < me.end) {
+ if (stk->count < stk->size/4) {
+ stk->stack[stk->count++] = me;
} else {
/* Only fill up a quarter of the mark stack, we can resume later
for more if we need to */
- Chunk_redarken_start(heap_chunk) = p;
+ chunk->redarken_first = me;
return 0;
}
}
- p += Whsize_hp(Hp_op(p));
+ /* Find the next block that needs to be re-marked */
+ hp = (header_t*)me.end;
+ CAMLassert(hp <= end);
+ while (hp < end) {
+ value v = Val_hp(hp);
+ if (Tag_val(v) < No_scan_tag && Is_black_val(v))
+ break;
+ hp = (header_t*)(Op_val(v) + Wosize_val(v));
+ }
+ if (hp == end)
+ break;
+
+ /* Found a block */
+ me.start = Op_hp(hp);
+ me.end = me.start + Wosize_hp(hp);
+ if (Tag_hp(hp) == Closure_tag) {
+ me.start += Start_env_closinfo(Closinfo_val(Val_hp(hp)));
+ }
}
- Chunk_redarken_start(heap_chunk) =
+ chunk->redarken_first.start =
(value*)(heap_chunk + Chunk_size(heap_chunk));
+ chunk->redarken_first.end = chunk->redarken_first.start;
+ chunk->redarken_end = (value*)heap_chunk;
- Chunk_redarken_end(heap_chunk) = 0;
return 1;
}
caml_gc_phase = Phase_mark;
heap_wsz_at_cycle_start = Caml_state->stat_heap_wsz;
caml_gc_subphase = Subphase_mark_roots;
- ephe_list_pure = 1;
+ caml_ephe_list_pure = 1;
ephes_checked_if_pure = &caml_ephe_list_head;
ephes_to_check = &caml_ephe_list_head;
#ifdef DEBUG
if (caml_major_gc_hook) (*caml_major_gc_hook)();
}
-/* auxiliary function of mark_slice */
-Caml_inline void mark_slice_darken(struct mark_stack* stk, value v, mlsize_t i,
+/* auxiliary function of mark_ephe_aux */
+Caml_inline void mark_ephe_darken(struct mark_stack* stk, value v, mlsize_t i,
int in_ephemeron, int *slice_pointers,
intnat *work)
{
CAMLassert (Is_in_heap (child) || Is_black_hd (chd));
#endif
if (Is_white_hd (chd)){
- ephe_list_pure = 0;
+ caml_ephe_list_pure = 0;
Hd_val (child) = Blackhd_hd (chd);
if( Tag_hd(chd) < No_scan_tag ) {
mark_stack_push(stk, child, 0, work);
*work -= Whsize_wosize(i);
if (alive_data){
- mark_slice_darken(stk, v, CAML_EPHE_DATA_OFFSET, /*in_ephemeron=*/1,
+ mark_ephe_darken(stk, v, CAML_EPHE_DATA_OFFSET, /*in_ephemeron=*/1,
slice_pointers, work);
} else { /* not triggered move to the next one */
ephes_to_check = &Field(v,CAML_EPHE_LINK_OFFSET);
return;
}
- } else { /* a simily weak pointer or an already alive data */
+ } else { /* a similarly weak pointer or an already alive data */
*work -= 1;
}
}
}
+
+#define Pb_size (1 << 8)
+#define Pb_min 64
+#define Pb_mask (Pb_size - 1)
+
+Caml_inline void prefetch_block(value v)
+{
+ /* Prefetch a block so that scanning it later avoids cache misses.
+ We will access at least the header, but we don't yet know how
+ many of the fields we will access - the block might be already
+ marked, not scannable, or very short. The compromise here is to
+ prefetch the header and the first few fields.
+
+ We issue two prefetches, with the second being a few words ahead
+ of the first. Most of the time, these will land in the same
+ cacheline, be coalesced by hardware, and so not cost any more
+ than a single prefetch. Two memory operations are issued only
+ when the two prefetches land in different cachelines.
+
+ In the case where the block is not already in cache, and yet is
+ already marked, not markable, or extremely short, then we waste
+ somewhere between 1/8-1/2 of a prefetch operation (in expectation,
+ depending on alignment, word size, and cache line size), which is
+ cheap enough to make this worthwhile. */
+ caml_prefetch(Hp_val(v));
+ caml_prefetch(&Field(v, 3));
+}
+
+Caml_inline uintnat rotate1(uintnat x)
+{
+ return (x << ((sizeof x)*8 - 1)) | (x >> 1);
+}
+
+Caml_noinline static intnat do_some_marking
+#ifndef CAML_INSTR
+ (intnat work)
+#else
+ (intnat work, int* pslice_fields, int* pslice_pointers)
+#endif
+{
+ uintnat pb_enqueued = 0, pb_dequeued = 0;
+ int darkened_anything = 0;
+ value pb[Pb_size];
+ uintnat min_pb = Pb_min; /* keep pb at least this full */
+ /* These global values are cached in locals,
+ so that they can be stored in registers */
+ struct mark_stack stk = *Caml_state->mark_stack;
+ uintnat young_start = (uintnat)Val_hp(Caml_state->young_start);
+ uintnat half_young_len =
+ ((uintnat)Caml_state->young_end - (uintnat)Caml_state->young_start) >> 1;
+#define Is_block_and_not_young(v) \
+ (((intnat)rotate1((uintnat)v - young_start)) >= (intnat)half_young_len)
+#ifdef NO_NAKED_POINTERS
+ #define Is_major_block(v) Is_block_and_not_young(v)
+#else
+ #define Is_major_block(v) (Is_block_and_not_young(v) && Is_in_heap(v))
+#endif
+
+#ifdef CAML_INSTR
+ int slice_fields = 0, slice_pointers = 0;
+#endif
+
+ while (1) {
+ value *scan, *obj_end, *scan_end;
+ intnat scan_len;
+
+ if (pb_enqueued > pb_dequeued + min_pb) {
+ /* Dequeue from prefetch buffer */
+ value block = pb[(pb_dequeued++) & Pb_mask];
+ header_t hd = Hd_val(block);
+
+ if (Tag_hd(hd) == Infix_tag) {
+ block -= Infix_offset_val(block);
+ hd = Hd_val(block);
+ }
+
+#ifdef NO_NAKED_POINTERS
+ /* See [caml_darken] for a description of this assertion. */
+ CAMLassert (Is_in_heap (block) || Is_black_hd (hd));
+#endif
+ CAMLassert(Is_white_hd(hd) || Is_black_hd(hd));
+ if (!Is_white_hd (hd)) {
+ /* Already black, nothing to do */
+ continue;
+ }
+ hd = Blackhd_hd (hd);
+ Hd_val (block) = hd;
+ darkened_anything = 1;
+ work--; /* header word */
+ if (Tag_hd (hd) >= No_scan_tag) {
+ /* Nothing to scan here */
+ work -= Wosize_hd (hd);
+ continue;
+ }
+ scan = Op_val(block);
+ obj_end = scan + Wosize_hd(hd);
+
+ if (Tag_hd (hd) == Closure_tag) {
+ uintnat env_offset = Start_env_closinfo(Closinfo_val(block));
+ work -= env_offset;
+ scan += env_offset;
+ }
+ } else if (work <= 0 || stk.count == 0) {
+ if (min_pb > 0) {
+ /* Dequeue from pb even when close to empty, because
+ we have nothing else to do */
+ min_pb = 0;
+ continue;
+ } else {
+ /* Couldn't find work with min_pb == 0, so there's nothing to do */
+ break;
+ }
+ } else {
+ mark_entry m = stk.stack[--stk.count];
+ scan = m.start;
+ obj_end = m.end;
+ }
+
+ scan_len = obj_end - scan;
+ if (work < scan_len) {
+ scan_len = work;
+ if (scan_len < 0) scan_len = 0;
+ }
+ work -= scan_len;
+ scan_end = scan + scan_len;
+
+ for (; scan < scan_end; scan++) {
+ value v = *scan;
+#ifdef CAML_INSTR
+ slice_fields ++;
+#endif
+ if (Is_major_block(v)) {
+#ifdef CAML_INSTR
+ slice_pointers ++;
+#endif
+ if (pb_enqueued == pb_dequeued + Pb_size) {
+ /* Prefetch buffer is full */
+ work += scan_end - scan; /* scanning work not done */
+ break;
+ }
+ prefetch_block(v);
+ pb[(pb_enqueued++) & Pb_mask] = v;
+ }
+#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
+ else if (Is_block_and_not_young (v) && !Is_in_heap (v)){
+ is_naked_pointer_safe (v, scan);
+ }
+#endif
+ }
+
+ if (scan < obj_end) {
+ /* Didn't finish scanning this object, either because work <= 0,
+ or the prefetch buffer filled up. Leave the rest on the stack. */
+ mark_entry m = { scan, obj_end };
+ caml_prefetch(scan+1);
+ if (stk.count == stk.size) {
+ *Caml_state->mark_stack = stk;
+ realloc_mark_stack(Caml_state->mark_stack);
+ stk = *Caml_state->mark_stack;
+ }
+ CAML_EVENTLOG_DO({
+ if (work <= 0 && pb_enqueued == pb_dequeued) {
+ CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_REMAIN, obj_end - scan);
+ }
+ });
+ stk.stack[stk.count++] = m;
+ /* We may have just discovered more work when we were about to run out.
+ Reset min_pb so that we try to refill the buffer again. */
+ min_pb = Pb_min;
+ }
+ }
+ CAMLassert(pb_enqueued == pb_dequeued);
+ *Caml_state->mark_stack = stk;
+ if (darkened_anything)
+ caml_ephe_list_pure = 0;
+#ifdef CAML_INSTR
+ *pslice_fields += slice_fields;
+ *pslice_pointers += slice_pointers;
+#endif
+ return work;
+}
+
static void mark_slice (intnat work)
{
- mark_entry me = {0, 0};
- mlsize_t me_end = 0;
#ifdef CAML_INSTR
int slice_fields = 0; /** eventlog counters */
#endif /*CAML_INSTR*/
marked_words += work;
while (1){
- int can_mark = 0;
-
- if (me.offset == me_end) {
- if (stk->count > 0)
- {
- me = stk->stack[--stk->count];
- me_end = Wosize_val(me.block);
- can_mark = 1;
- }
- } else {
- can_mark = 1;
- }
+#ifndef CAML_INSTR
+ work = do_some_marking(work);
+#else
+ work = do_some_marking(work, &slice_fields, &slice_pointers);
+#endif
- if (work <= 0) {
- if( can_mark ) {
- mark_stack_push(stk, me.block, me.offset, NULL);
- CAML_EVENTLOG_DO({
- CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_REMAIN, me_end - me.offset);
- });
- }
+ if (work <= 0)
break;
- }
-
- if( can_mark ) {
- CAMLassert(Is_block(me.block) &&
- Is_black_val (me.block) &&
- Tag_val(me.block) < No_scan_tag);
- mark_slice_darken(stk, me.block, me.offset++, /*in_ephemeron=*/ 0,
- &slice_pointers, &work);
+ CAMLassert (stk->count == 0);
- work--;
-
- CAML_EVENTLOG_DO({
- slice_fields++;
- });
-
- if( me.offset == me_end ) {
- work--; /* Include header word */
- }
- } else if( redarken_first_chunk != NULL ) {
+ if( redarken_first_chunk != NULL ) {
/* There are chunks that need to be redarkened because we
overflowed our mark stack */
if( redarken_chunk(redarken_first_chunk, stk) ) {
} else if (*ephes_to_check != (value) NULL) {
/* Continue to scan the list of ephe */
mark_ephe_aux(stk,&work,&slice_pointers);
- } else if (!ephe_list_pure){
+ } else if (!caml_ephe_list_pure){
/* We must scan again the list because some value have been darken */
- ephe_list_pure = 1;
+ caml_ephe_list_pure = 1;
ephes_to_check = ephes_checked_if_pure;
}else{
switch (caml_gc_subphase){
*/
char *caml_alloc_for_heap (asize_t request)
{
+ char *mem;
if (caml_use_huge_pages){
-#ifdef HAS_HUGE_PAGES
+#ifndef HAS_HUGE_PAGES
+ return NULL;
+#else
uintnat size = Round_mmap_size (sizeof (heap_chunk_head) + request);
void *block;
- char *mem;
block = mmap (NULL, size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB, -1, 0);
if (block == MAP_FAILED) return NULL;
mem = (char *) block + sizeof (heap_chunk_head);
Chunk_size (mem) = size - sizeof (heap_chunk_head);
Chunk_block (mem) = block;
- Chunk_redarken_start(mem) = (value*)(mem + Chunk_size(mem));
- Chunk_redarken_end(mem) = (value*)mem;
- return mem;
-#else
- return NULL;
#endif
}else{
- char *mem;
void *block;
request = ((request + Page_size - 1) >> Page_log) << Page_log;
mem += sizeof (heap_chunk_head);
Chunk_size (mem) = request;
Chunk_block (mem) = block;
- Chunk_redarken_start(mem) = (value*)(mem + Chunk_size(mem));
- Chunk_redarken_end(mem) = (value*)mem;
- return mem;
}
+ Chunk_head (mem)->redarken_first.start = (value*)(mem + Chunk_size(mem));
+ Chunk_head (mem)->redarken_first.end = (value*)(mem + Chunk_size(mem));
+ Chunk_head (mem)->redarken_end = (value*)mem;
+ return mem;
}
/* Use this function to free a block allocated with [caml_alloc_for_heap]
/* Asm part of the runtime system, RISC-V processor, 64-bit mode */
/* Must be preprocessed by cpp */
+#include "caml/m.h"
+
#define ARG_DOMAIN_STATE_PTR t0
#define DOMAIN_STATE_PTR s11
#define TRAP_PTR s1
#define STORE sd
#define LOAD ld
+#if defined(ASM_CFI_SUPPORTED)
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#define CFI_REGISTER(r1,r2) .cfi_register r1,r2
+#define CFI_OFFSET(r,n) .cfi_offset r,n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#define CFI_REGISTER(r1,r2)
+#define CFI_OFFSET(r,n)
+#endif
+
.set domain_curr_field, 0
#define DOMAIN_STATE(c_type, name) \
.equ domain_field_caml_##name, domain_curr_field ; \
.align 2; \
.globl name; \
.type name, @function; \
-name:
+name:; \
+ CFI_STARTPROC
+
+#define END_FUNCTION(name) \
+ CFI_ENDPROC; \
+ .size name, .-name
#if defined(__PIC__)
.option pic
20 caller-save float regs) * 8 */
/* + 1 for alignment */
addi sp, sp, -0x170
+ CFI_ADJUST(0x170)
STORE ra, 0x8(sp)
+ CFI_OFFSET(ra, -0x170+8)
/* Save allocatable integer registers on the stack,
in the order given in proc.ml */
STORE a0, 0x10(sp)
/* Free stack space and return to caller */
LOAD ra, 0x8(sp)
addi sp, sp, 0x170
+ CFI_ADJUST(-0x170)
ret
- .size caml_call_gc, .-caml_call_gc
+END_FUNCTION(caml_call_gc)
/* Call a C function from OCaml */
/* Function to call is in ARG */
FUNCTION(caml_c_call)
/* Preserve return address in callee-save register s2 */
mv s2, ra
+ CFI_REGISTER(ra, s2)
/* Record lowest stack address and return address */
STORE ra, Caml_state(last_return_address)
STORE sp, Caml_state(bottom_of_stack)
LOAD ALLOC_PTR, Caml_state(young_ptr)
/* Return */
jr s2
- .size caml_c_call, .-caml_c_call
+END_FUNCTION(caml_c_call)
/* Raise an exception from OCaml */
FUNCTION(caml_raise_exn)
LOAD TMP, 8(sp)
LOAD TRAP_PTR, 0(sp)
addi sp, sp, 16
+ CFI_ADJUST(-16)
jr TMP
2: /* Preserve exception bucket in callee-save register s2 */
mv s2, a0
/* Restore exception bucket and raise */
mv a0, s2
j 1b
- .size caml_raise_exn, .-caml_raise_exn
+END_FUNCTION(caml_raise_exn)
.globl caml_reraise_exn
.type caml_reraise_exn, @function
LOAD TMP, 8(sp)
LOAD TRAP_PTR, 0(sp)
addi sp, sp, 16
+ CFI_ADJUST(-16)
jr TMP
2: /* Preserve exception bucket in callee-save register s2 */
mv s2, a0
call PLT(caml_stash_backtrace)
mv a0, s2
j 1b
- .size caml_raise_exception, .-caml_raise_exception
+END_FUNCTION(caml_raise_exception)
/* Start the OCaml program */
.Ljump_to_caml:
/* Set up stack frame and save callee-save registers */
addi sp, sp, -0xd0
+ CFI_ADJUST(0xd0)
STORE ra, 0xc0(sp)
+ CFI_OFFSET(ra, -0xd0+0xc0)
STORE s0, 0x0(sp)
STORE s1, 0x8(sp)
STORE s2, 0x10(sp)
fsd fs10, 0xb0(sp)
fsd fs11, 0xb8(sp)
addi sp, sp, -32
+ CFI_ADJUST(32)
/* Load domain state pointer from argument */
mv DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
/* Setup a callback link on the stack */
STORE TMP, 16(sp)
/* set up a trap frame */
addi sp, sp, -16
+ CFI_ADJUST(16)
LOAD TMP, Caml_state(exception_pointer)
STORE TMP, 0(sp)
lla TMP, .Ltrap_handler
LOAD TMP, 0(sp)
STORE TMP, Caml_state(exception_pointer)
addi sp, sp, 16
+ CFI_ADJUST(-16)
.Lreturn_result: /* pop callback link, restoring global variables */
LOAD TMP, 0(sp)
STORE TMP, Caml_state(bottom_of_stack)
LOAD TMP, 16(sp)
STORE TMP, Caml_state(gc_regs)
addi sp, sp, 32
+ CFI_ADJUST(-32)
/* Update allocation pointer */
STORE ALLOC_PTR, Caml_state(young_ptr)
/* reload callee-save registers and return */
fld fs10, 0xb0(sp)
fld fs11, 0xb8(sp)
addi sp, sp, 0xd0
+ CFI_ADJUST(-0xd0)
ret
.type .Lcaml_retaddr, @function
.size .Lcaml_retaddr, .-.Lcaml_retaddr
- .size caml_start_program, .-caml_start_program
+END_FUNCTION(caml_start_program)
.align 2
.Ltrap_handler:
+ CFI_STARTPROC
STORE TRAP_PTR, Caml_state(exception_pointer)
ori a0, a0, 2
j .Lreturn_result
.type .Ltrap_handler, @function
- .size .Ltrap_handler, .-.Ltrap_handler
+END_FUNCTION(.Ltrap_handler)
/* Callback from C to OCaml */
/* a1 = closure environment */
LOAD ARG, 0(a1) /* code pointer */
j .Ljump_to_caml
- .size caml_callback_asm, .-caml_callback_asm
+END_FUNCTION(caml_callback_asm)
FUNCTION(caml_callback2_asm)
/* Initial shuffling of arguments */
mv a2, TMP
la ARG, caml_apply2
j .Ljump_to_caml
- .size caml_callback2_asm, .-caml_callback2_asm
+END_FUNCTION(caml_callback2_asm)
FUNCTION(caml_callback3_asm)
/* Initial shuffling of arguments */
LOAD a2, 16(a2)
la ARG, caml_apply3
j .Ljump_to_caml
- .size caml_callback3_asm, .-caml_callback3_asm
+END_FUNCTION(caml_callback3_asm)
FUNCTION(caml_ml_array_bound_error)
/* Load address of [caml_array_bound_error] in ARG */
la ARG, caml_array_bound_error
/* Call that function */
tail caml_c_call
- .size caml_ml_array_bound_error, .-caml_ml_array_bound_error
+END_FUNCTION(caml_ml_array_bound_error)
.globl caml_system__code_end
caml_system__code_end:
}
}
-#ifdef _WIN32
-int wmain(int argc, wchar_t **argv)
-#else
-int main(int argc, char **argv)
-#endif
+int main_os(int argc, char_os **argv)
{
if (argc == 3 && !strcmp_os(argv[1], T("encode-C-literal"))) {
encode_C_literal(argv[2]);
}
CAMLexport int caml_setup_stack_overflow_detection(void) { return 0; }
+CAMLexport int caml_stop_stack_overflow_detection(void) { return 0; }
+CAMLexport void caml_init_signals(void) { }
+CAMLexport void caml_terminate_signals(void) { }
#endif
#else
/* Raise a Stack_overflow exception straight from this signal handler */
-#if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER)
- Caml_state->exception_pointer == (char *) CONTEXT_EXCEPTION_POINTER;
+#if defined(CONTEXT_YOUNG_PTR)
Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
+#endif
+#if defined(CONTEXT_EXCEPTION_POINTER)
+ Caml_state->exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
#endif
caml_raise_stack_overflow();
#endif
#endif
}
+/* Termination of signal stuff */
+
+#if defined(TARGET_power) || defined(TARGET_s390x) \
+ || defined(HAS_STACK_OVERFLOW_DETECTION)
+static void set_signal_default(int signum)
+{
+ struct sigaction act;
+ sigemptyset(&act.sa_mask);
+ act.sa_handler = SIG_DFL;
+ act.sa_flags = 0;
+ sigaction(signum, &act, NULL);
+}
+#endif
+
+void caml_terminate_signals(void)
+{
+#if defined(TARGET_power)
+ set_signal_default(SIGTRAP);
+#endif
+
+#if defined(TARGET_s390x)
+ set_signal_default(SIGFPE);
+#endif
+
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+ set_signal_default(SIGSEGV);
+ caml_stop_stack_overflow_detection();
+#endif
+}
+
/* Allocate and select an alternate stack for handling signals,
especially SIGSEGV signals.
Each thread needs its own alternate stack.
if (stk.ss_sp == NULL) return -1;
stk.ss_size = SIGSTKSZ;
stk.ss_flags = 0;
- return sigaltstack(&stk, NULL);
+ if (sigaltstack(&stk, NULL) == -1) {
+ free(stk.ss_sp);
+ return -1;
+ }
+#endif
+ /* Success (or stack overflow detection not available) */
+ return 0;
+}
+
+CAMLexport int caml_stop_stack_overflow_detection(void)
+{
+#ifdef HAS_STACK_OVERFLOW_DETECTION
+ stack_t oldstk, stk;
+ stk.ss_flags = SS_DISABLE;
+ if (sigaltstack(&stk, &oldstk) == -1) return -1;
+ /* If caml_setup_stack_overflow_detection failed, we are not using
+ an alternate signal stack. SS_DISABLE will be set in oldstk,
+ and there is nothing to free in this case. */
+ if (! (oldstk.ss_flags & SS_DISABLE)) free(oldstk.ss_sp);
+ return 0;
#else
return 0;
#endif
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_EXCEPTION_PTR (context->uc_mcontext.arm_r8)
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.arm_r10)
#define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
/****************** ARM64, Linux */
#define CONTEXT_PC (context->uc_mcontext.pc)
#define CONTEXT_SP (context->uc_mcontext.sp)
#define CONTEXT_C_ARG_1 (context->uc_mcontext.regs[0])
+ #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)
#define CONTEXT_PC (CONTEXT_STATE.__pc)
#define CONTEXT_SP (CONTEXT_STATE.__sp)
#define CONTEXT_C_ARG_1 (CONTEXT_STATE.__x[0])
+ #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.__x[26])
#define CONTEXT_YOUNG_PTR (CONTEXT_STATE.__x[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
#include "caml/mlvalues.h"
#include "caml/osdeps.h"
#include "caml/printexc.h"
+#include "caml/signals.h"
#include "caml/stack.h"
#include "caml/startup_aux.h"
#include "caml/sys.h"
void (*caml_termination_hook)(void *) = NULL;
extern value caml_start_program (caml_domain_state*);
-extern void caml_init_signals (void);
#ifdef _WIN32
extern void caml_win32_overflow_detection (void);
#endif
value caml_startup_common(char_os **argv, int pooling)
{
char_os * exe_name, * proc_self_exe;
+ value res;
char tos;
/* Initialize the domain */
exe_name = caml_search_exe_in_path(exe_name);
caml_sys_init(exe_name, argv);
if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
+ caml_terminate_signals();
if (caml_termination_hook != NULL) caml_termination_hook(NULL);
return Val_unit;
}
- return caml_start_program(Caml_state);
+ res = caml_start_program(Caml_state);
+ caml_terminate_signals();
+ return res;
}
value caml_startup_exn(char_os **argv)
#ifdef _WIN32
caml_restore_win32_terminal();
#endif
+ caml_terminate_signals();
#ifdef NAKED_POINTERS_CHECKER
if (retcode == 0 && caml_naked_pointers_detected) {
fprintf (stderr, "\nOut-of-heap pointers were detected by the runtime.\n"
caml_sys_check_path(name);
p = caml_stat_strdup_to_os(String_val(name));
caml_enter_blocking_section();
- ret = unlink_os(p);
+ ret = caml_unlink(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) caml_sys_error(name);
#ifdef _WIN32
extern int caml_win32_random_seed (intnat data[16]);
-#endif
-
-CAMLprim value caml_sys_random_seed (value unit)
-{
- intnat data[16];
- int n, i;
- value res;
-#ifdef _WIN32
- n = caml_win32_random_seed(data);
#else
+int caml_unix_random_seed(intnat data[16])
+{
int fd;
- n = 0;
+ int n = 0;
+
/* Try /dev/urandom first */
fd = open("/dev/urandom", O_RDONLY, 0);
if (fd != -1) {
while (nread > 0) data[n++] = buffer[--nread];
}
/* If the read from /dev/urandom fully succeeded, we now have 96 bits
- of good random data and can stop here. Otherwise, complement
- whatever we got (probably nothing) with some not-very-random data. */
- if (n < 12) {
+ of good random data and can stop here. */
+ if (n >= 12) return n;
+ /* Otherwise, complement whatever we got (probably nothing)
+ with some not-very-random data. */
+ {
#ifdef HAS_GETTIMEOFDAY
struct timeval tv;
gettimeofday(&tv, NULL);
- data[n++] = tv.tv_usec;
- data[n++] = tv.tv_sec;
+ if (n < 16) data[n++] = tv.tv_usec;
+ if (n < 16) data[n++] = tv.tv_sec;
#else
- data[n++] = time(NULL);
+ if (n < 16) data[n++] = time(NULL);
#endif
#ifdef HAS_UNISTD
- data[n++] = getpid();
- data[n++] = getppid();
+ if (n < 16) data[n++] = getpid();
+ if (n < 16) data[n++] = getppid();
#endif
+ return n;
}
+}
+#endif
+
+CAMLprim value caml_sys_random_seed (value unit)
+{
+ intnat data[16];
+ int n, i;
+ value res;
+#ifdef _WIN32
+ n = caml_win32_random_seed(data);
+#else
+ n = caml_unix_random_seed(data);
#endif
/* Convert to an OCaml array of ints */
res = caml_alloc_small(n, 0);
return Wosize_val (eph) - CAML_EPHE_FIRST_KEY;
}
-/** The minor heap is considered alive. */
-
-/** Outside minor and major heap, x must be black. */
-Caml_inline int Is_Dead_during_clean(value x)
-{
+/* The minor heap is considered alive. Outside minor and major heap it is
+ considered alive (out of reach of the GC). */
+Caml_inline int Test_if_its_white(value x){
CAMLassert (x != caml_ephe_none);
- CAMLassert (caml_gc_phase == Phase_clean);
#ifdef NO_NAKED_POINTERS
if (!Is_block(x) || Is_young (x)) return 0;
#else
if (Tag_val(x) == Infix_tag) x -= Infix_offset_val(x);
return Is_white_val(x);
}
+
+/* If it is not white during clean phase it is dead, i.e it will be swept */
+Caml_inline int Is_Dead_during_clean(value x)
+{
+ CAMLassert (caml_gc_phase == Phase_clean);
+ return Test_if_its_white(x);
+}
+
+/** caml_ephe_none is considered as not white */
+Caml_inline int Is_White_During_Mark(value x)
+{
+ CAMLassert (caml_gc_phase == Phase_mark);
+ if (x == caml_ephe_none ) return 0;
+ return Test_if_its_white(x);
+}
+
/** The minor heap doesn't have to be marked, outside they should
- already be black
+ already be black. Remains the value in the heap to mark.
*/
Caml_inline int Must_be_Marked_during_mark(value x)
{
*/
static void do_check_key_clean(value ar, mlsize_t offset)
{
+ value elt;
CAMLassert (offset >= CAML_EPHE_FIRST_KEY);
- if (caml_gc_phase == Phase_clean){
- value elt = Field (ar, offset);
- if (elt != caml_ephe_none && Is_Dead_during_clean(elt)){
- Field(ar, offset) = caml_ephe_none;
- Field(ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none;
- };
+ CAMLassert (caml_gc_phase == Phase_clean);
+ elt = Field (ar, offset);
+ if (elt != caml_ephe_none && Is_Dead_during_clean(elt)){
+ Field(ar, offset) = caml_ephe_none;
+ Field(ar, CAML_EPHE_DATA_OFFSET) = caml_ephe_none;
};
}
CAMLassert (Is_in_heap (ar));
offset += CAML_EPHE_FIRST_KEY;
- do_check_key_clean(ar, offset);
+
+ if( caml_gc_phase == Phase_mark
+ && caml_ephe_list_pure
+ && Field(ar, CAML_EPHE_DATA_OFFSET) != caml_ephe_none
+ && !Is_white_val(ar)
+ && Is_White_During_Mark(Field(ar, offset))
+ && !Is_White_During_Mark(k)){
+ /* the ephemeron could be in the set (2) only because of a white key and not
+ have one anymore after set */
+ caml_darken(Field(ar, CAML_EPHE_DATA_OFFSET), NULL);
+ };
+ if(caml_gc_phase == Phase_clean) do_check_key_clean(ar, offset);
do_set (ar, offset, k);
}
offset += CAML_EPHE_FIRST_KEY;
- do_check_key_clean(ar, offset);
+ if( caml_gc_phase == Phase_mark
+ && caml_ephe_list_pure
+ && Field(ar, CAML_EPHE_DATA_OFFSET) != caml_ephe_none
+ && !Is_white_val(ar)
+ && Is_White_During_Mark(Field(ar, offset)) ){
+ /* the ephemeron could be in the set (2) only because of this white key and
+ not have one anymore after unsetting it */
+ caml_darken(Field(ar, CAML_EPHE_DATA_OFFSET), NULL);
+ };
+
+ if(caml_gc_phase == Phase_clean) do_check_key_clean(ar, offset);
Field (ar, offset) = caml_ephe_none;
}
CAMLexport void caml_ephemeron_set_data (value ar, value el)
{
+ value old_data;
CAMLassert_valid_ephemeron(ar);
+ old_data = Field (ar, CAML_EPHE_DATA_OFFSET);
+ if (caml_gc_phase == Phase_mark && !Is_White_During_Mark(old_data))
+ caml_darken (el, NULL);
if (caml_gc_phase == Phase_clean){
/* During this phase since we don't know which ephemerons have been
cleaned we always need to check it. */
mlsize_t length)
{
intnat i; /** intnat because the second for-loop stops with i == -1 */
+ int dest_has_white_value;
if (length == 0) return;
CAMLassert_valid_offset(ars, offset_s);
CAMLassert_valid_offset(ard, offset_d);
offset_s += CAML_EPHE_FIRST_KEY;
offset_d += CAML_EPHE_FIRST_KEY;
+ if ( caml_gc_phase == Phase_mark
+ && caml_ephe_list_pure
+ && Field(ard, CAML_EPHE_DATA_OFFSET) != caml_ephe_none
+ && !Is_white_val(ard)
+ && !Is_White_During_Mark(Field(ard, CAML_EPHE_DATA_OFFSET))
+ ){
+ /* We check here if darkening of the data of the destination is needed
+ because the destination could be in (2). Indeed a white key could
+ disappear from the destination after blitting and being in (2) requires
+ if the ephemeron is alive without white key to have a black or none
+ data. */
+
+ dest_has_white_value = 0;
+
+ for(i = 0; i < length; i++){
+ dest_has_white_value |= Is_White_During_Mark(Field(ard, offset_d + i));
+ };
+ /* test if the destination can't be in set (2) because of the keys that are
+ going to be set */
+ if(!dest_has_white_value) goto No_darkening;
+ for(i = 0; i < length; i++){
+ /* test if the source is going to bring a white key to replace the one
+ set */
+ if(Is_White_During_Mark(Field(ars, offset_s + i))) goto No_darkening;
+ };
+ /* the destination ephemeron could be in the set (2) because of a white key
+ replaced and not have one anymore after. */
+ caml_darken(Field(ard, CAML_EPHE_DATA_OFFSET),NULL);
+ }
+ No_darkening:
+
if (caml_gc_phase == Phase_clean){
caml_ephe_clean_partial(ars, offset_s, offset_s + length);
/* We don't need to clean the keys that are about to be overwritten,
- except where cleaning them could result in releasing the data,
+ except when cleaning them could result in releasing the data,
which can't happen if data is already released. */
if (Field (ard, CAML_EPHE_DATA_OFFSET) != caml_ephe_none)
caml_ephe_clean_partial(ard, offset_d, offset_d + length);
CAMLexport void caml_ephemeron_blit_data (value ars, value ard)
{
+ value data, old_data;
CAMLassert_valid_ephemeron(ars);
CAMLassert_valid_ephemeron(ard);
caml_ephe_clean(ars);
caml_ephe_clean(ard);
};
- do_set (ard, CAML_EPHE_DATA_OFFSET, Field (ars, CAML_EPHE_DATA_OFFSET));
+
+ data = Field (ars, CAML_EPHE_DATA_OFFSET);
+ old_data = Field (ard, CAML_EPHE_DATA_OFFSET);
+ if (caml_gc_phase == Phase_mark &&
+ data != caml_ephe_none &&
+ !Is_White_During_Mark(old_data))
+ caml_darken (data, NULL);
+
+ do_set (ard, CAML_EPHE_DATA_OFFSET, data);
}
CAMLprim value caml_ephe_blit_data (value ars, value ard)
#include <wtypes.h>
#include <winbase.h>
#include <winsock2.h>
+#include <winioctl.h>
+#include <direct.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include "caml/osdeps.h"
#include "caml/signals.h"
#include "caml/sys.h"
+#include "caml/winsupport.h"
#include "caml/config.h"
return -1;
}
+int caml_win32_unlink(const wchar_t * path) {
+ int ret;
+
+ ret = _wunlink(path);
+ /* On Windows, trying to unlink a symlink to a directory will return
+ * EACCES, but the symlink can be deleted with rmdir. */
+ if (ret == -1 && errno == EACCES) {
+ HANDLE h;
+ DWORD attrs, dummy;
+ union {
+ char raw[16384];
+ REPARSE_DATA_BUFFER point;
+ } buffer;
+
+ attrs = GetFileAttributes(path);
+ if (attrs == INVALID_FILE_ATTRIBUTES ||
+ !(attrs & (FILE_ATTRIBUTE_DIRECTORY | FILE_ATTRIBUTE_REPARSE_POINT)))
+ return -1;
+
+ h = CreateFile(path,
+ FILE_READ_ATTRIBUTES,
+ FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE,
+ NULL,
+ OPEN_EXISTING,
+ FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT,
+ NULL);
+ if (h == INVALID_HANDLE_VALUE)
+ return -1;
+
+ ret = DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, &buffer.point,
+ sizeof(buffer.raw), &dummy, NULL);
+ CloseHandle(h);
+ if (!ret || buffer.point.ReparseTag != IO_REPARSE_TAG_SYMLINK)
+ return -1;
+
+ ret = _wrmdir(path);
+ if (ret == -1)
+ errno = EACCES;
+ }
+ return ret;
+}
+
/* Windows Unicode support */
static uintnat windows_unicode_enabled = WINDOWS_UNICODE;
stdlib__Bool.cmi
stdlib__Bool.cmi : bool.mli
stdlib__Buffer.cmo : buffer.ml \
- stdlib__Uchar.cmi \
stdlib__Sys.cmi \
stdlib__String.cmi \
stdlib__Seq.cmi \
- stdlib__Char.cmi \
stdlib__Bytes.cmi \
stdlib__Buffer.cmi
stdlib__Buffer.cmx : buffer.ml \
- stdlib__Uchar.cmx \
stdlib__Sys.cmx \
stdlib__String.cmx \
stdlib__Seq.cmx \
- stdlib__Char.cmx \
stdlib__Bytes.cmx \
stdlib__Buffer.cmi
stdlib__Buffer.cmi : buffer.mli \
stdlib__Uchar.cmi \
stdlib__Seq.cmi
stdlib__Bytes.cmo : bytes.ml \
+ stdlib__Uchar.cmi \
stdlib__Sys.cmi \
stdlib.cmi \
stdlib__Seq.cmi \
stdlib__Char.cmi \
stdlib__Bytes.cmi
stdlib__Bytes.cmx : bytes.ml \
+ stdlib__Uchar.cmx \
stdlib__Sys.cmx \
stdlib.cmx \
stdlib__Seq.cmx \
stdlib__Char.cmx \
stdlib__Bytes.cmi
stdlib__Bytes.cmi : bytes.mli \
+ stdlib__Uchar.cmi \
stdlib__Seq.cmi
stdlib__BytesLabels.cmo : bytesLabels.ml \
stdlib__Bytes.cmi \
stdlib__Bytes.cmx \
stdlib__BytesLabels.cmi
stdlib__BytesLabels.cmi : bytesLabels.mli \
+ stdlib__Uchar.cmi \
stdlib__Seq.cmi
stdlib__Callback.cmo : callback.ml \
stdlib__Obj.cmi \
stdlib__Seq.cmi \
stdlib__Random.cmi \
stdlib__Obj.cmi \
+ stdlib__List.cmi \
stdlib__Lazy.cmi \
stdlib__Int.cmi \
stdlib__Hashtbl.cmi \
stdlib__Seq.cmx \
stdlib__Random.cmx \
stdlib__Obj.cmx \
+ stdlib__List.cmx \
stdlib__Lazy.cmx \
stdlib__Int.cmx \
stdlib__Hashtbl.cmx \
stdlib__Array.cmx \
stdlib__Ephemeron.cmi
stdlib__Ephemeron.cmi : ephemeron.mli \
+ stdlib__Seq.cmi \
stdlib__Hashtbl.cmi
stdlib__Filename.cmo : filename.ml \
stdlib__Sys.cmi \
stdlib__Hashtbl.cmi
stdlib__Hashtbl.cmi : hashtbl.mli \
stdlib__Seq.cmi
+stdlib__In_channel.cmo : in_channel.ml \
+ stdlib__Sys.cmi \
+ stdlib.cmi \
+ stdlib__Fun.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__In_channel.cmi
+stdlib__In_channel.cmx : in_channel.ml \
+ stdlib__Sys.cmx \
+ stdlib.cmx \
+ stdlib__Fun.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__In_channel.cmi
+stdlib__In_channel.cmi : in_channel.mli \
+ stdlib.cmi
stdlib__Int.cmo : int.ml \
stdlib.cmi \
stdlib__Int.cmi
stdlib__Obj.cmo : obj.ml \
stdlib__Sys.cmi \
stdlib__Nativeint.cmi \
- stdlib__Marshal.cmi \
stdlib__Int32.cmi \
stdlib__Obj.cmi
stdlib__Obj.cmx : obj.ml \
stdlib__Sys.cmx \
stdlib__Nativeint.cmx \
- stdlib__Marshal.cmx \
stdlib__Int32.cmx \
stdlib__Obj.cmi
stdlib__Obj.cmi : obj.mli \
stdlib__Option.cmi
stdlib__Option.cmi : option.mli \
stdlib__Seq.cmi
+stdlib__Out_channel.cmo : out_channel.ml \
+ stdlib.cmi \
+ stdlib__Fun.cmi \
+ stdlib__Out_channel.cmi
+stdlib__Out_channel.cmx : out_channel.ml \
+ stdlib.cmx \
+ stdlib__Fun.cmx \
+ stdlib__Out_channel.cmi
+stdlib__Out_channel.cmi : out_channel.mli \
+ stdlib.cmi
stdlib__Parsing.cmo : parsing.ml \
stdlib__Obj.cmi \
stdlib__Lexing.cmi \
stdlib__Scanf.cmi : scanf.mli \
stdlib.cmi
stdlib__Seq.cmo : seq.ml \
+ stdlib__Lazy.cmi \
+ stdlib__Either.cmi \
+ camlinternalAtomic.cmi \
stdlib__Seq.cmi
stdlib__Seq.cmx : seq.ml \
+ stdlib__Lazy.cmx \
+ stdlib__Either.cmx \
+ camlinternalAtomic.cmx \
stdlib__Seq.cmi
-stdlib__Seq.cmi : seq.mli
+stdlib__Seq.cmi : seq.mli \
+ stdlib__Either.cmi
stdlib__Set.cmo : set.ml \
stdlib__Seq.cmi \
stdlib__List.cmi \
stdlib__Bytes.cmx \
stdlib__String.cmi
stdlib__String.cmi : string.mli \
+ stdlib__Uchar.cmi \
stdlib__Seq.cmi
stdlib__StringLabels.cmo : stringLabels.ml \
stdlib__String.cmi \
stdlib__String.cmx \
stdlib__StringLabels.cmi
stdlib__StringLabels.cmi : stringLabels.mli \
+ stdlib__Uchar.cmi \
stdlib__Seq.cmi
stdlib__Sys.cmo : sys.ml \
stdlib__Sys.cmi
stdlib.cmxa: $(OBJS:.cmo=.cmx)
$(CAMLOPT) -a -o $@ $^
-sys.ml: $(ROOTDIR)/VERSION sys.mlp
- sed -e "s|%%VERSION%%|`sed -e 1q $< | tr -d '\r'`|" sys.mlp > $@
-
-.PHONY: clean
-clean::
+.PHONY: distclean
+distclean: clean
rm -f sys.ml
+.PHONY: clean
clean::
rm -f $(CAMLHEADERS)
# with lowercase first letters). These must be listed in dependency order.
STDLIB_MODULE_BASENAMES = \
camlinternalFormatBasics camlinternalAtomic \
- stdlib pervasives seq option either result bool char uchar \
- sys list int bytes string unit marshal obj array float int32 int64 nativeint \
- lexing parsing set map stack queue camlinternalLazy lazy stream buffer \
+ stdlib pervasives either \
+ sys obj camlinternalLazy lazy \
+ seq option result bool char uchar \
+ list int bytes string unit marshal array float int32 int64 nativeint \
+ lexing parsing set map stack queue stream buffer \
camlinternalFormat printf arg atomic \
printexc fun gc digest random hashtbl weak \
format scanf callback camlinternalOO oo camlinternalMod genlex ephemeron \
filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \
- stdLabels bigarray
+ stdLabels bigarray in_channel out_channel
STDLIB_PREFIXED_MODULES = \
$(filter-out stdlib camlinternal%, $(STDLIB_MODULE_BASENAMES))
compatibility: when people will start writing code to run on
Multicore, it would be nice if their use of Atomic was
backward-compatible with older versions of OCaml without having to
- import additional compatibility layers. *)
+ import additional compatibility layers.
+
+ @since 4.12
+*)
(** An atomic (mutable) reference to a value of type ['a]. *)
type !'a t
(** {1 Array layouts} *)
type c_layout = C_layout_typ (**)
-(** See {!Bigarray.fortran_layout}.*)
+(** See {!type:Bigarray.fortran_layout}.*)
type fortran_layout = Fortran_layout_typ (**)
(** To facilitate interoperability with existing C and Fortran code,
and [(x+1, y)] are adjacent in memory.
Each layout style is identified at the type level by the
- phantom types {!Bigarray.c_layout} and {!Bigarray.fortran_layout}
+ phantom types {!type:Bigarray.c_layout} and {!type:Bigarray.fortran_layout}
respectively. *)
-(** {7 Supported layouts}
+(** {2 Supported layouts}
The GADT type ['a layout] represents one of the two supported
memory layouts: C-style or Fortran-style. Its constructors are
external genarray_of_array0 :
('a, 'b, 'c) Array0.t -> ('a, 'b, 'c) Genarray.t = "%identity"
(** Return the generic Bigarray corresponding to the given zero-dimensional
- Bigarray. @since 4.05.0 *)
+ Bigarray.
+ @since 4.05.0 *)
external genarray_of_array1 :
('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Genarray.t = "%identity"
Bytes.unsafe_set b.buffer pos c;
b.position <- pos + 1
- let add_utf_8_uchar b u = match Uchar.to_int u with
- | u when u < 0 -> assert false
- | u when u <= 0x007F ->
- add_char b (Char.unsafe_chr u)
- | u when u <= 0x07FF ->
- let pos = b.position in
- if pos + 2 > b.length then resize b 2;
- Bytes.unsafe_set b.buffer (pos )
- (Char.unsafe_chr (0xC0 lor (u lsr 6)));
- Bytes.unsafe_set b.buffer (pos + 1)
- (Char.unsafe_chr (0x80 lor (u land 0x3F)));
- b.position <- pos + 2
- | u when u <= 0xFFFF ->
- let pos = b.position in
- if pos + 3 > b.length then resize b 3;
- Bytes.unsafe_set b.buffer (pos )
- (Char.unsafe_chr (0xE0 lor (u lsr 12)));
- Bytes.unsafe_set b.buffer (pos + 1)
- (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
- Bytes.unsafe_set b.buffer (pos + 2)
- (Char.unsafe_chr (0x80 lor (u land 0x3F)));
- b.position <- pos + 3
- | u when u <= 0x10FFFF ->
- let pos = b.position in
- if pos + 4 > b.length then resize b 4;
- Bytes.unsafe_set b.buffer (pos )
- (Char.unsafe_chr (0xF0 lor (u lsr 18)));
- Bytes.unsafe_set b.buffer (pos + 1)
- (Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F)));
- Bytes.unsafe_set b.buffer (pos + 2)
- (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
- Bytes.unsafe_set b.buffer (pos + 3)
- (Char.unsafe_chr (0x80 lor (u land 0x3F)));
- b.position <- pos + 4
- | _ -> assert false
-
- let add_utf_16be_uchar b u = match Uchar.to_int u with
- | u when u < 0 -> assert false
- | u when u <= 0xFFFF ->
- let pos = b.position in
- if pos + 2 > b.length then resize b 2;
- Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (u lsr 8));
- Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u land 0xFF));
- b.position <- pos + 2
- | u when u <= 0x10FFFF ->
- let u' = u - 0x10000 in
- let hi = 0xD800 lor (u' lsr 10) in
- let lo = 0xDC00 lor (u' land 0x3FF) in
- let pos = b.position in
- if pos + 4 > b.length then resize b 4;
- Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (hi lsr 8));
- Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi land 0xFF));
- Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo lsr 8));
- Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo land 0xFF));
- b.position <- pos + 4
- | _ -> assert false
-
- let add_utf_16le_uchar b u = match Uchar.to_int u with
- | u when u < 0 -> assert false
- | u when u <= 0xFFFF ->
- let pos = b.position in
- if pos + 2 > b.length then resize b 2;
- Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (u land 0xFF));
- Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u lsr 8));
- b.position <- pos + 2
- | u when u <= 0x10FFFF ->
- let u' = u - 0x10000 in
- let hi = 0xD800 lor (u' lsr 10) in
- let lo = 0xDC00 lor (u' land 0x3FF) in
- let pos = b.position in
- if pos + 4 > b.length then resize b 4;
- Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (hi land 0xFF));
- Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi lsr 8));
- Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo land 0xFF));
- Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo lsr 8));
- b.position <- pos + 4
- | _ -> assert false
+let uchar_utf_8_byte_length_max = 4
+let uchar_utf_16_byte_length_max = 4
+
+let rec add_utf_8_uchar b u =
+ let pos = b.position in
+ if pos >= b.length then resize b uchar_utf_8_byte_length_max;
+ let n = Bytes.set_utf_8_uchar b.buffer pos u in
+ if n = 0
+ then (resize b uchar_utf_8_byte_length_max; add_utf_8_uchar b u)
+ else (b.position <- pos + n)
+
+let rec add_utf_16be_uchar b u =
+ let pos = b.position in
+ if pos >= b.length then resize b uchar_utf_16_byte_length_max;
+ let n = Bytes.set_utf_16be_uchar b.buffer pos u in
+ if n = 0
+ then (resize b uchar_utf_16_byte_length_max; add_utf_16be_uchar b u)
+ else (b.position <- pos + n)
+
+let rec add_utf_16le_uchar b u =
+ let pos = b.position in
+ if pos >= b.length then resize b uchar_utf_16_byte_length_max;
+ let n = Bytes.set_utf_16le_uchar b.buffer pos u in
+ if n = 0
+ then (resize b uchar_utf_16_byte_length_max; add_utf_16le_uchar b u)
+ else (b.position <- pos + n)
let add_substring b s offset len =
if offset < 0 || len < 0 || offset > String.length s - len
This module implements buffers that automatically expand
as necessary. It provides accumulative concatenation of strings
- in quasi-linear time (instead of quadratic time when strings are
+ in linear time (instead of quadratic time when strings are
concatenated pairwise). For example:
{[
val to_seq : t -> char Seq.t
(** Iterate on the buffer, in increasing order.
- Modification of the buffer during iteration is undefined behavior.
+
+ The behavior is not specified if the buffer is modified during iteration.
@since 4.07 *)
val to_seqi : t -> (int * char) Seq.t
(** Iterate on the buffer, in increasing order, yielding indices along chars.
- Modification of the buffer during iteration is undefined behavior.
+
+ The behavior is not specified if the buffer is modified during iteration.
@since 4.07 *)
val add_seq : t -> char Seq.t -> unit
(* The get_ functions are all duplicated in string.ml *)
+external unsafe_get_uint8 : bytes -> int -> int = "%bytes_unsafe_get"
+external unsafe_get_uint16_ne : bytes -> int -> int = "%caml_bytes_get16u"
external get_uint8 : bytes -> int -> int = "%bytes_safe_get"
external get_uint16_ne : bytes -> int -> int = "%caml_bytes_get16"
external get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32"
external get_int64_ne : bytes -> int -> int64 = "%caml_bytes_get64"
+
+external unsafe_set_uint8 : bytes -> int -> int -> unit = "%bytes_unsafe_set"
+external unsafe_set_uint16_ne : bytes -> int -> int -> unit
+ = "%caml_bytes_set16u"
external set_int8 : bytes -> int -> int -> unit = "%bytes_safe_set"
external set_int16_ne : bytes -> int -> int -> unit = "%caml_bytes_set16"
external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_bytes_set32"
external swap32 : int32 -> int32 = "%bswap_int32"
external swap64 : int64 -> int64 = "%bswap_int64"
+let unsafe_get_uint16_le b i =
+ if Sys.big_endian
+ then swap16 (unsafe_get_uint16_ne b i)
+ else unsafe_get_uint16_ne b i
+
+let unsafe_get_uint16_be b i =
+ if Sys.big_endian
+ then unsafe_get_uint16_ne b i
+ else swap16 (unsafe_get_uint16_ne b i)
+
let get_int8 b i =
((get_uint8 b i) lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
if not Sys.big_endian then swap64 (get_int64_ne b i)
else get_int64_ne b i
+let unsafe_set_uint16_le b i x =
+ if Sys.big_endian
+ then unsafe_set_uint16_ne b i (swap16 x)
+ else unsafe_set_uint16_ne b i x
+
+let unsafe_set_uint16_be b i x =
+ if Sys.big_endian
+ then unsafe_set_uint16_ne b i x else
+ unsafe_set_uint16_ne b i (swap16 x)
+
let set_int16_le b i x =
if Sys.big_endian then set_int16_ne b i (swap16 x)
else set_int16_ne b i x
let set_uint16_ne = set_int16_ne
let set_uint16_be = set_int16_be
let set_uint16_le = set_int16_le
+
+(* UTF codecs and validations *)
+
+let dec_invalid = Uchar.utf_decode_invalid
+let[@inline] dec_ret n u = Uchar.utf_decode n (Uchar.unsafe_of_int u)
+
+(* In case of decoding error, if we error on the first byte, we
+ consume the byte, otherwise we consume the [n] bytes preceeding
+ the erroring byte.
+
+ This means that if a client uses decodes without caring about
+ validity it naturally replace bogus data with Uchar.rep according
+ to the WHATWG Encoding standard. Other schemes are possible by
+ consulting the number of used bytes on invalid decodes. For more
+ details see https://hsivonen.fi/broken-utf-8/
+
+ For this reason in [get_utf_8_uchar] we gradually check the next
+ byte is available rather than doing it immediately after the
+ first byte. Contrast with [is_valid_utf_8]. *)
+
+(* UTF-8 *)
+
+let[@inline] not_in_x80_to_xBF b = b lsr 6 <> 0b10
+let[@inline] not_in_xA0_to_xBF b = b lsr 5 <> 0b101
+let[@inline] not_in_x80_to_x9F b = b lsr 5 <> 0b100
+let[@inline] not_in_x90_to_xBF b = b < 0x90 || 0xBF < b
+let[@inline] not_in_x80_to_x8F b = b lsr 4 <> 0x8
+
+let[@inline] utf_8_uchar_2 b0 b1 =
+ ((b0 land 0x1F) lsl 6) lor
+ ((b1 land 0x3F))
+
+let[@inline] utf_8_uchar_3 b0 b1 b2 =
+ ((b0 land 0x0F) lsl 12) lor
+ ((b1 land 0x3F) lsl 6) lor
+ ((b2 land 0x3F))
+
+let[@inline] utf_8_uchar_4 b0 b1 b2 b3 =
+ ((b0 land 0x07) lsl 18) lor
+ ((b1 land 0x3F) lsl 12) lor
+ ((b2 land 0x3F) lsl 6) lor
+ ((b3 land 0x3F))
+
+let get_utf_8_uchar b i =
+ let b0 = get_uint8 b i in (* raises if [i] is not a valid index. *)
+ let get = unsafe_get_uint8 in
+ let max = length b - 1 in
+ match Char.unsafe_chr b0 with (* See The Unicode Standard, Table 3.7 *)
+ | '\x00' .. '\x7F' -> dec_ret 1 b0
+ | '\xC2' .. '\xDF' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x80_to_xBF b1 then dec_invalid 1 else
+ dec_ret 2 (utf_8_uchar_2 b0 b1)
+ | '\xE0' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_xA0_to_xBF b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ dec_ret 3 (utf_8_uchar_3 b0 b1 b2)
+ | '\xE1' .. '\xEC' | '\xEE' .. '\xEF' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x80_to_xBF b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ dec_ret 3 (utf_8_uchar_3 b0 b1 b2)
+ | '\xED' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x80_to_x9F b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ dec_ret 3 (utf_8_uchar_3 b0 b1 b2)
+ | '\xF0' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x90_to_xBF b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ let i = i + 1 in if i > max then dec_invalid 3 else
+ let b3 = get b i in if not_in_x80_to_xBF b3 then dec_invalid 3 else
+ dec_ret 4 (utf_8_uchar_4 b0 b1 b2 b3)
+ | '\xF1' .. '\xF3' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x80_to_xBF b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ let i = i + 1 in if i > max then dec_invalid 3 else
+ let b3 = get b i in if not_in_x80_to_xBF b3 then dec_invalid 3 else
+ dec_ret 4 (utf_8_uchar_4 b0 b1 b2 b3)
+ | '\xF4' ->
+ let i = i + 1 in if i > max then dec_invalid 1 else
+ let b1 = get b i in if not_in_x80_to_x8F b1 then dec_invalid 1 else
+ let i = i + 1 in if i > max then dec_invalid 2 else
+ let b2 = get b i in if not_in_x80_to_xBF b2 then dec_invalid 2 else
+ let i = i + 1 in if i > max then dec_invalid 3 else
+ let b3 = get b i in if not_in_x80_to_xBF b3 then dec_invalid 3 else
+ dec_ret 4 (utf_8_uchar_4 b0 b1 b2 b3)
+ | _ -> dec_invalid 1
+
+let set_utf_8_uchar b i u =
+ let set = unsafe_set_uint8 in
+ let max = length b - 1 in
+ match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0x007F ->
+ set_uint8 b i u;
+ 1
+ | u when u <= 0x07FF ->
+ let last = i + 1 in
+ if last > max then 0 else
+ (set_uint8 b i (0xC0 lor (u lsr 6));
+ set b last (0x80 lor (u land 0x3F));
+ 2)
+ | u when u <= 0xFFFF ->
+ let last = i + 2 in
+ if last > max then 0 else
+ (set_uint8 b i (0xE0 lor (u lsr 12));
+ set b (i + 1) (0x80 lor ((u lsr 6) land 0x3F));
+ set b last (0x80 lor (u land 0x3F));
+ 3)
+ | u when u <= 0x10FFFF ->
+ let last = i + 3 in
+ if last > max then 0 else
+ (set_uint8 b i (0xF0 lor (u lsr 18));
+ set b (i + 1) (0x80 lor ((u lsr 12) land 0x3F));
+ set b (i + 2) (0x80 lor ((u lsr 6) land 0x3F));
+ set b last (0x80 lor (u land 0x3F));
+ 4)
+ | _ -> assert false
+
+let is_valid_utf_8 b =
+ let rec loop max b i =
+ if i > max then true else
+ let get = unsafe_get_uint8 in
+ match Char.unsafe_chr (get b i) with
+ | '\x00' .. '\x7F' -> loop max b (i + 1)
+ | '\xC2' .. '\xDF' ->
+ let last = i + 1 in
+ if last > max
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xE0' ->
+ let last = i + 2 in
+ if last > max
+ || not_in_xA0_to_xBF (get b (i + 1))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xE1' .. '\xEC' | '\xEE' .. '\xEF' ->
+ let last = i + 2 in
+ if last > max
+ || not_in_x80_to_xBF (get b (i + 1))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xED' ->
+ let last = i + 2 in
+ if last > max
+ || not_in_x80_to_x9F (get b (i + 1))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xF0' ->
+ let last = i + 3 in
+ if last > max
+ || not_in_x90_to_xBF (get b (i + 1))
+ || not_in_x80_to_xBF (get b (i + 2))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xF1' .. '\xF3' ->
+ let last = i + 3 in
+ if last > max
+ || not_in_x80_to_xBF (get b (i + 1))
+ || not_in_x80_to_xBF (get b (i + 2))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | '\xF4' ->
+ let last = i + 3 in
+ if last > max
+ || not_in_x80_to_x8F (get b (i + 1))
+ || not_in_x80_to_xBF (get b (i + 2))
+ || not_in_x80_to_xBF (get b last)
+ then false
+ else loop max b (last + 1)
+ | _ -> false
+ in
+ loop (length b - 1) b 0
+
+(* UTF-16BE *)
+
+let get_utf_16be_uchar b i =
+ let get = unsafe_get_uint16_be in
+ let max = length b - 1 in
+ if i < 0 || i > max then invalid_arg "index out of bounds" else
+ if i = max then dec_invalid 1 else
+ match get b i with
+ | u when u < 0xD800 || u > 0xDFFF -> dec_ret 2 u
+ | u when u > 0xDBFF -> dec_invalid 2
+ | hi -> (* combine [hi] with a low surrogate *)
+ let last = i + 3 in
+ if last > max then dec_invalid (max - i + 1) else
+ match get b (i + 2) with
+ | u when u < 0xDC00 || u > 0xDFFF -> dec_invalid 2 (* retry here *)
+ | lo ->
+ let u = (((hi land 0x3FF) lsl 10) lor (lo land 0x3FF)) + 0x10000 in
+ dec_ret 4 u
+
+let set_utf_16be_uchar b i u =
+ let set = unsafe_set_uint16_be in
+ let max = length b - 1 in
+ if i < 0 || i > max then invalid_arg "index out of bounds" else
+ match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+ let last = i + 1 in
+ if last > max then 0 else (set b i u; 2)
+ | u when u <= 0x10FFFF ->
+ let last = i + 3 in
+ if last > max then 0 else
+ let u' = u - 0x10000 in
+ let hi = (0xD800 lor (u' lsr 10)) in
+ let lo = (0xDC00 lor (u' land 0x3FF)) in
+ set b i hi; set b (i + 2) lo; 4
+ | _ -> assert false
+
+let is_valid_utf_16be b =
+ let rec loop max b i =
+ let get = unsafe_get_uint16_be in
+ if i > max then true else
+ if i = max then false else
+ match get b i with
+ | u when u < 0xD800 || u > 0xDFFF -> loop max b (i + 2)
+ | u when u > 0xDBFF -> false
+ | _hi ->
+ let last = i + 3 in
+ if last > max then false else
+ match get b (i + 2) with
+ | u when u < 0xDC00 || u > 0xDFFF -> false
+ | _lo -> loop max b (i + 4)
+ in
+ loop (length b - 1) b 0
+
+(* UTF-16LE *)
+
+let get_utf_16le_uchar b i =
+ let get = unsafe_get_uint16_le in
+ let max = length b - 1 in
+ if i < 0 || i > max then invalid_arg "index out of bounds" else
+ if i = max then dec_invalid 1 else
+ match get b i with
+ | u when u < 0xD800 || u > 0xDFFF -> dec_ret 2 u
+ | u when u > 0xDBFF -> dec_invalid 2
+ | hi -> (* combine [hi] with a low surrogate *)
+ let last = i + 3 in
+ if last > max then dec_invalid (max - i + 1) else
+ match get b (i + 2) with
+ | u when u < 0xDC00 || u > 0xDFFF -> dec_invalid 2 (* retry here *)
+ | lo ->
+ let u = (((hi land 0x3FF) lsl 10) lor (lo land 0x3FF)) + 0x10000 in
+ dec_ret 4 u
+
+let set_utf_16le_uchar b i u =
+ let set = unsafe_set_uint16_le in
+ let max = length b - 1 in
+ if i < 0 || i > max then invalid_arg "index out of bounds" else
+ match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+ let last = i + 1 in
+ if last > max then 0 else (set b i u; 2)
+ | u when u <= 0x10FFFF ->
+ let last = i + 3 in
+ if last > max then 0 else
+ let u' = u - 0x10000 in
+ let hi = (0xD800 lor (u' lsr 10)) in
+ let lo = (0xDC00 lor (u' land 0x3FF)) in
+ set b i hi; set b (i + 2) lo; 4
+ | _ -> assert false
+
+let is_valid_utf_16le b =
+ let rec loop max b i =
+ let get = unsafe_get_uint16_le in
+ if i > max then true else
+ if i = max then false else
+ match get b i with
+ | u when u < 0xD800 || u > 0xDFFF -> loop max b (i + 2)
+ | u when u > 0xDBFF -> false
+ | _hi ->
+ let last = i + 3 in
+ if last > max then false else
+ match get b (i + 2) with
+ | u when u < 0xDC00 || u > 0xDFFF -> false
+ | _lo -> loop max b (i + 4)
+ in
+ loop (length b - 1) b 0
(** Create a string from the generator
@since 4.07 *)
+(** {1:utf UTF codecs and validations}
+
+ @since 4.14 *)
+
+(** {2:utf_8 UTF-8} *)
+
+val get_utf_8_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_8_uchar b i] decodes an UTF-8 character at index [i] in
+ [b]. *)
+
+val set_utf_8_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_8_uchar b i u] UTF-8 encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_8 : t -> bool
+(** [is_valid_utf_8 b] is [true] if and only if [b] contains valid
+ UTF-8 data. *)
+
+(** {2:utf_16be UTF-16BE} *)
+
+val get_utf_16be_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16be_uchar b i] decodes an UTF-16BE character at index
+ [i] in [b]. *)
+
+val set_utf_16be_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_16be_uchar b i u] UTF-16BE encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_16be : t -> bool
+(** [is_valid_utf_16be b] is [true] if and only if [b] contains valid
+ UTF-16BE data. *)
+
+(** {2:utf_16le UTF-16LE} *)
+
+val get_utf_16le_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16le_uchar b i] decodes an UTF-16LE character at index
+ [i] in [b]. *)
+
+val set_utf_16le_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_16le_uchar b i u] UTF-16LE encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_16le : t -> bool
+(** [is_valid_utf_16le b] is [true] if and only if [b] contains valid
+ UTF-16LE data. *)
+
(** {1 Binary encoding/decoding of integers} *)
(** The functions in this section binary encode and decode integers to
8-bit and 16-bit integers are represented by the [int] type,
which has more bits than the binary encoding. These extra bits
- are handled as follows: {ul
+ are handled as follows:
+ {ul
{- Functions that decode signed (resp. unsigned) 8-bit or 16-bit
- integers represented by [int] values sign-extend
- (resp. zero-extend) their result.}
+ integers represented by [int] values sign-extend
+ (resp. zero-extend) their result.}
{- Functions that encode 8-bit or 16-bit integers represented by
- [int] values truncate their input to their least significant
- bytes.}}
+ [int] values truncate their input to their least significant
+ bytes.}}
*)
val get_uint8 : bytes -> int -> int
(** Create a string from the generator
@since 4.07 *)
+(** {1:utf UTF codecs and validations}
+
+ @since 4.14 *)
+
+(** {2:utf_8 UTF-8} *)
+
+val get_utf_8_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_8_uchar b i] decodes an UTF-8 character at index [i] in
+ [b]. *)
+
+val set_utf_8_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_8_uchar b i u] UTF-8 encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_8 : t -> bool
+(** [is_valid_utf_8 b] is [true] if and only if [b] contains valid
+ UTF-8 data. *)
+
+(** {2:utf_16be UTF-16BE} *)
+
+val get_utf_16be_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16be_uchar b i] decodes an UTF-16BE character at index
+ [i] in [b]. *)
+
+val set_utf_16be_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_16be_uchar b i u] UTF-16BE encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_16be : t -> bool
+(** [is_valid_utf_16be b] is [true] if and only if [b] contains valid
+ UTF-16BE data. *)
+
+(** {2:utf_16le UTF-16LE} *)
+
+val get_utf_16le_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16le_uchar b i] decodes an UTF-16LE character at index
+ [i] in [b]. *)
+
+val set_utf_16le_uchar : t -> int -> Uchar.t -> int
+(** [set_utf_16le_uchar b i u] UTF-16LE encodes [u] at index [i] in [b]
+ and returns the number of bytes [n] that were written starting
+ at [i]. If [n] is [0] there was not enough space to encode [u]
+ at [i] and [b] was left untouched. Otherwise a new character can
+ be encoded at [i + n]. *)
+
+val is_valid_utf_16le : t -> bool
+(** [is_valid_utf_16le b] is [true] if and only if [b] contains valid
+ UTF-16LE data. *)
+
(** {1 Binary encoding/decoding of integers} *)
(** The functions in this section binary encode and decode integers to
8-bit and 16-bit integers are represented by the [int] type,
which has more bits than the binary encoding. These extra bits
- are handled as follows: {ul
+ are handled as follows:
+ {ul
{- Functions that decode signed (resp. unsigned) 8-bit or 16-bit
- integers represented by [int] values sign-extend
- (resp. zero-extend) their result.}
+ integers represented by [int] values sign-extend
+ (resp. zero-extend) their result.}
{- Functions that encode 8-bit or 16-bit integers represented by
- [int] values truncate their input to their least significant
- bytes.}}
+ [int] values truncate their input to their least significant
+ bytes.}}
*)
val get_uint8 : bytes -> int -> int
(run awk -f %{dep:expand_module_aliases.awk} %{input-file}))
stdlib)
)))
-
-(rule
- (targets sys.ml)
- (deps (:version ../VERSION) (:p sys.mlp))
- (action
- (with-stdout-to %{targets}
- (bash
- "sed -e \"s|%%VERSION%%|`sed -e 1q %{version} | tr -d '\r'`|\" %{p}"))))
(* *)
(**************************************************************************)
+[@@@ocaml.warning "-32"]
+
module type SeededS = sig
- include Hashtbl.SeededS
+
+ type key
+ type !'a t
+ val create : ?random (*thwart tools/sync_stdlib_docs*) : bool -> int -> 'a t
+ val clear : 'a t -> unit
+ val reset : 'a t -> unit
+ val copy : 'a t -> 'a t
+ val add : 'a t -> key -> 'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key -> 'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val length : 'a t -> int
+ val stats : 'a t -> Hashtbl.statistics
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_keys : _ t -> key Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_values : 'a t -> 'a Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val of_seq : (key * 'a) Seq.t -> 'a t
val clean: 'a t -> unit
val stats_alive: 'a t -> Hashtbl.statistics
(** same as {!stats} but only count the alive bindings *)
end
module type S = sig
- include Hashtbl.S
+
+ type key
+ type !'a t
+ val create : int -> 'a t
+ val clear : 'a t -> unit
+ val reset : 'a t -> unit
+ val copy : 'a t -> 'a t
+ val add : 'a t -> key -> 'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key -> 'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val length : 'a t -> int
+ val stats : 'a t -> Hashtbl.statistics
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_keys : _ t -> key Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_values : 'a t -> 'a Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val of_seq : (key * 'a) Seq.t -> 'a t
val clean: 'a t -> unit
val stats_alive: 'a t -> Hashtbl.statistics
(** same as {!stats} but only count the alive bindings *)
let check_data (t:('k,'d) t) : bool = ObjEph.check_data t
let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2
+ let make key data =
+ let eph = create () in
+ set_data eph data;
+ set_key eph key;
+ eph
+
+ let query eph key =
+ match get_key eph with
+ | None -> None
+ | Some k when k == key -> get_data eph
+ | Some _ -> None
+
module MakeSeeded (H:Hashtbl.SeededHashedType) =
GenHashTable.MakeSeeded(struct
type 'a container = (H.t,'a) t
tbl
end
+ module Bucket = struct
+
+ type nonrec ('k, 'd) t = ('k, 'd) t list ref
+ let k1_make = make
+ let make () = ref []
+ let add b k d = b := k1_make k d :: !b
+
+ let test_key k e =
+ match get_key e with
+ | Some x when x == k -> true
+ | _ -> false
+
+ let remove b k =
+ let rec loop l acc =
+ match l with
+ | [] -> ()
+ | h :: t when test_key k h -> b := List.rev_append acc t
+ | h :: t -> loop t (h :: acc)
+ in
+ loop !b []
+
+ let find b k =
+ match List.find_opt (test_key k) !b with
+ | Some e -> get_data e
+ | None -> None
+
+ let length b = List.length !b
+ let clear b = b := []
+
+ end
+
end
module K2 = struct
let check_data (t:('k1,'k2,'d) t) : bool = ObjEph.check_data t
let blit_data (t1:(_,_,'d) t) (t2:(_,_,'d) t) : unit = ObjEph.blit_data t1 t2
+ let make key1 key2 data =
+ let eph = create () in
+ set_data eph data;
+ set_key1 eph key1;
+ set_key2 eph key2;
+ ignore (Sys.opaque_identity key1);
+ eph
+
+ let query eph key1 key2 =
+ match get_key1 eph with
+ | None -> None
+ | Some k when k == key1 ->
+ begin match get_key2 eph with
+ | None -> None
+ | Some k when k == key2 -> get_data eph
+ | Some _ -> None
+ end
+ | Some _ -> None
+
module MakeSeeded
(H1:Hashtbl.SeededHashedType)
(H2:Hashtbl.SeededHashedType) =
tbl
end
+ module Bucket = struct
+
+ type nonrec ('k1, 'k2, 'd) t = ('k1, 'k2, 'd) t list ref
+ let k2_make = make
+ let make () = ref []
+ let add b k1 k2 d = b := k2_make k1 k2 d :: !b
+
+ let test_keys k1 k2 e =
+ match get_key1 e, get_key2 e with
+ | Some x1, Some x2 when x1 == k1 && x2 == k2 -> true
+ | _ -> false
+
+ let remove b k1 k2 =
+ let rec loop l acc =
+ match l with
+ | [] -> ()
+ | h :: t when test_keys k1 k2 h -> b := List.rev_append acc t
+ | h :: t -> loop t (h :: acc)
+ in
+ loop !b []
+
+ let find b k1 k2 =
+ match List.find_opt (test_keys k1 k2) !b with
+ | Some e -> get_data e
+ | None -> None
+
+ let length b = List.length !b
+ let clear b = b := []
+
+ end
+
end
module Kn = struct
let check_data (t:('k,'d) t) : bool = ObjEph.check_data t
let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2
+ let make keys data =
+ let l = Array.length keys in
+ let eph = create l in
+ set_data eph data;
+ for i = 0 to l - 1 do set_key eph i keys.(i) done;
+ eph
+
+ let query eph keys =
+ let l = length eph in
+ try
+ if l <> Array.length keys then raise Exit;
+ for i = 0 to l - 1 do
+ match get_key eph i with
+ | None -> raise Exit
+ | Some k when k == keys.(i) -> ()
+ | Some _ -> raise Exit
+ done;
+ get_data eph
+ with Exit -> None
+
module MakeSeeded (H:Hashtbl.SeededHashedType) =
GenHashTable.MakeSeeded(struct
type 'a container = (H.t,'a) t
replace_seq tbl i;
tbl
end
+
+ module Bucket = struct
+
+ type nonrec ('k, 'd) t = ('k, 'd) t list ref
+ let kn_make = make
+ let make () = ref []
+ let add b k d = b := kn_make k d :: !b
+
+ let test_keys k e =
+ try
+ if length e <> Array.length k then raise Exit;
+ for i = 0 to Array.length k - 1 do
+ match get_key e i with
+ | Some x when x == k.(i) -> ()
+ | _ -> raise Exit
+ done;
+ true
+ with Exit -> false
+
+ let remove b k =
+ let rec loop l acc =
+ match l with
+ | [] -> ()
+ | h :: t when test_keys k h -> b := List.rev_append acc t
+ | h :: t -> loop t (h :: acc)
+ in
+ loop !b []
+
+ let find b k =
+ match List.find_opt (test_keys k) !b with
+ | Some e -> get_data e
+ | None -> None
+
+ let length b = List.length !b
+ let clear b = b := []
+
+ end
+
end
Use [filter_map_inplace] in this case.
*)
- include Hashtbl.S
+ type key
+ type !'a t
+ val create : int -> 'a t
+ val clear : 'a t -> unit
+ val reset : 'a t -> unit
+ val copy : 'a t -> 'a t
+ val add : 'a t -> key -> 'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key -> 'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val length : 'a t -> int
+ val stats : 'a t -> Hashtbl.statistics
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_keys : _ t -> key Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_values : 'a t -> 'a Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val of_seq : (key * 'a) Seq.t -> 'a t
val clean: 'a t -> unit
(** remove all dead bindings. Done automatically during automatic resizing. *)
val stats_alive: 'a t -> Hashtbl.statistics
(** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
end
-(** The output signature of the functor {!K1.Make} and {!K2.Make}.
+(** The output signature of the functors {!K1.Make} and {!K2.Make}.
These hash tables are weak in the keys. If all the keys of a binding are
alive the binding is kept, but if one of the keys of the binding
is dead then the binding is removed.
*)
module type SeededS = sig
- include Hashtbl.SeededS
+
+ type key
+ type !'a t
+ val create : ?random (*thwart tools/sync_stdlib_docs*) : bool -> int -> 'a t
+ val clear : 'a t -> unit
+ val reset : 'a t -> unit
+ val copy : 'a t -> 'a t
+ val add : 'a t -> key -> 'a -> unit
+ val remove : 'a t -> key -> unit
+ val find : 'a t -> key -> 'a
+ val find_opt : 'a t -> key -> 'a option
+ val find_all : 'a t -> key -> 'a list
+ val replace : 'a t -> key -> 'a -> unit
+ val mem : 'a t -> key -> bool
+ val iter : (key -> 'a -> unit) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val length : 'a t -> int
+ val stats : 'a t -> Hashtbl.statistics
+ val to_seq : 'a t -> (key * 'a) Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_keys : _ t -> key Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val to_seq_values : 'a t -> 'a Seq.t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
+ val add_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val replace_seq : 'a t -> (key * 'a) Seq.t -> unit
+ val of_seq : (key * 'a) Seq.t -> 'a t
+
val clean: 'a t -> unit
(** remove all dead bindings. Done automatically during automatic resizing. *)
val stats_alive: 'a t -> Hashtbl.statistics
(** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
end
-(** The output signature of the functor {!K1.MakeSeeded} and {!K2.MakeSeeded}.
+(** The output signature of the functors {!K1.MakeSeeded} and {!K2.MakeSeeded}.
*)
module K1 : sig
type ('k,'d) t (** an ephemeron with one key *)
val create: unit -> ('k,'d) t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.create ()] creates an ephemeron with one key. The
data and the key are empty *)
val get_key: ('k,'d) t -> 'k option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.get_key eph] returns [None] if the key of [eph] is
empty, [Some x] (where [x] is the key) if it is full. *)
val get_key_copy: ('k,'d) t -> 'k option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.get_key_copy eph] returns [None] if the key of [eph] is
empty, [Some x] (where [x] is a (shallow) copy of the key) if
it is full. This function has the same GC friendliness as {!Weak.get_copy}
*)
val set_key: ('k,'d) t -> 'k -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.set_key eph el] sets the key of [eph] to be a
(full) key to [el]
*)
val unset_key: ('k,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.unset_key eph el] sets the key of [eph] to be an
empty key. Since there is only one key, the ephemeron starts
behaving like a reference on the data. *)
val check_key: ('k,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.check_key eph] returns [true] if the key of the [eph]
is full, [false] if it is empty. Note that even if
[Ephemeron.K1.check_key eph] returns [true], a subsequent
val blit_key : ('k,_) t -> ('k,_) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.blit_key eph1 eph2] sets the key of [eph2] with
the key of [eph1]. Contrary to using {!Ephemeron.K1.get_key}
followed by {!Ephemeron.K1.set_key} or {!Ephemeron.K1.unset_key}
the value in its current cycle. *)
val get_data: ('k,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.get_data eph] returns [None] if the data of [eph] is
empty, [Some x] (where [x] is the data) if it is full. *)
val get_data_copy: ('k,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.get_data_copy eph] returns [None] if the data of [eph] is
empty, [Some x] (where [x] is a (shallow) copy of the data) if
it is full. This function has the same GC friendliness as {!Weak.get_copy}
*)
val set_data: ('k,'d) t -> 'd -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.set_data eph el] sets the data of [eph] to be a
(full) data to [el]
*)
val unset_data: ('k,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.unset_data eph el] sets the key of [eph] to be an
empty key. The ephemeron starts behaving like a weak pointer.
*)
val check_data: ('k,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.check_data eph] returns [true] if the data of the [eph]
is full, [false] if it is empty. Note that even if
[Ephemeron.K1.check_data eph] returns [true], a subsequent
*)
val blit_data : (_,'d) t -> (_,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** [Ephemeron.K1.blit_data eph1 eph2] sets the data of [eph2] with
the data of [eph1]. Contrary to using {!Ephemeron.K1.get_data}
followed by {!Ephemeron.K1.set_data} or {!Ephemeron.K1.unset_data}
this function does not prevent the incremental GC from erasing
the value in its current cycle. *)
+ val make : 'k -> 'd -> ('k,'d) t
+ (** [Ephemeron.K1.make k d] creates an ephemeron with key [k] and data [d]. *)
+
+ val query : ('k,'d) t -> 'k -> 'd option
+ (** [Ephemeron.K1.query eph key] returns [Some x] (where [x] is the
+ ephemeron's data) if [key] is physically equal to [eph]'s key, and
+ [None] if [eph] is empty or [key] is not equal to [eph]'s key. *)
+
module Make (H:Hashtbl.HashedType) : S with type key = H.t
(** Functor building an implementation of a weak hash table *)
(** Functor building an implementation of a weak hash table.
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+ module Bucket : sig
+
+ type ('k, 'd) t
+ (** A bucket is a mutable "list" of ephemerons. *)
+
+ val make : unit -> ('k, 'd) t
+ (** Create a new bucket. *)
+
+ val add : ('k, 'd) t -> 'k -> 'd -> unit
+ (** Add an ephemeron to the bucket. *)
+
+ val remove : ('k, 'd) t -> 'k -> unit
+ (** [remove b k] removes from [b] the most-recently added
+ ephemeron with key [k], or does nothing if there is no such
+ ephemeron. *)
+
+ val find : ('k, 'd) t -> 'k -> 'd option
+ (** Returns the data of the most-recently added ephemeron with the
+ given key, or [None] if there is no such ephemeron. *)
+
+ val length : ('k, 'd) t -> int
+ (** Returns an upper bound on the length of the bucket. *)
+
+ val clear : ('k, 'd) t -> unit
+ (** Remove all ephemerons from the bucket. *)
+
+ end
+
end
(** Ephemerons with one key. *)
type ('k1,'k2,'d) t (** an ephemeron with two keys *)
val create: unit -> ('k1,'k2,'d) t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.create} *)
val get_key1: ('k1,'k2,'d) t -> 'k1 option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key} *)
val get_key1_copy: ('k1,'k2,'d) t -> 'k1 option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key_copy} *)
val set_key1: ('k1,'k2,'d) t -> 'k1 -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.set_key} *)
val unset_key1: ('k1,'k2,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.unset_key} *)
val check_key1: ('k1,'k2,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.check_key} *)
val get_key2: ('k1,'k2,'d) t -> 'k2 option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key} *)
val get_key2_copy: ('k1,'k2,'d) t -> 'k2 option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key_copy} *)
val set_key2: ('k1,'k2,'d) t -> 'k2 -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.set_key} *)
val unset_key2: ('k1,'k2,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.unset_key} *)
val check_key2: ('k1,'k2,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.check_key} *)
val blit_key1: ('k1,_,_) t -> ('k1,_,_) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_key} *)
val blit_key2: (_,'k2,_) t -> (_,'k2,_) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_key} *)
val blit_key12: ('k1,'k2,_) t -> ('k1,'k2,_) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_key} *)
val get_data: ('k1,'k2,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_data} *)
val get_data_copy: ('k1,'k2,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_data_copy} *)
val set_data: ('k1,'k2,'d) t -> 'd -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.set_data} *)
val unset_data: ('k1,'k2,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.unset_data} *)
val check_data: ('k1,'k2,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.check_data} *)
val blit_data: ('k1,'k2,'d) t -> ('k1,'k2,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_data} *)
+ val make : 'k1 -> 'k2 -> 'd -> ('k1,'k2,'d) t
+ (** Same as {!Ephemeron.K1.make} *)
+
+ val query : ('k1,'k2,'d) t -> 'k1 -> 'k2 -> 'd option
+ (** Same as {!Ephemeron.K1.query} *)
+
module Make
(H1:Hashtbl.HashedType)
(H2:Hashtbl.HashedType) :
(** Functor building an implementation of a weak hash table.
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+ module Bucket : sig
+
+ type ('k1, 'k2, 'd) t
+ (** A bucket is a mutable "list" of ephemerons. *)
+
+ val make : unit -> ('k1, 'k2, 'd) t
+ (** Create a new bucket. *)
+
+ val add : ('k1, 'k2, 'd) t -> 'k1 -> 'k2 -> 'd -> unit
+ (** Add an ephemeron to the bucket. *)
+
+ val remove : ('k1, 'k2, 'd) t -> 'k1 -> 'k2 -> unit
+ (** [remove b k1 k2] removes from [b] the most-recently added
+ ephemeron with keys [k1] and [k2], or does nothing if there
+ is no such ephemeron. *)
+
+ val find : ('k1, 'k2, 'd) t -> 'k1 -> 'k2 -> 'd option
+ (** Returns the data of the most-recently added ephemeron with the
+ given keys, or [None] if there is no such ephemeron. *)
+
+ val length : ('k1, 'k2, 'd) t -> int
+ (** Returns an upper bound on the length of the bucket. *)
+
+ val clear : ('k1, 'k2, 'd) t -> unit
+ (** Remove all ephemerons from the bucket. *)
+
+ end
+
end
-(** Emphemerons with two keys. *)
+(** Ephemerons with two keys. *)
module Kn : sig
type ('k,'d) t (** an ephemeron with an arbitrary number of keys
of the same type *)
val create: int -> ('k,'d) t
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.create} *)
val get_key: ('k,'d) t -> int -> 'k option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key} *)
val get_key_copy: ('k,'d) t -> int -> 'k option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_key_copy} *)
val set_key: ('k,'d) t -> int -> 'k -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.set_key} *)
val unset_key: ('k,'d) t -> int -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.unset_key} *)
val check_key: ('k,'d) t -> int -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.check_key} *)
val blit_key: ('k,_) t -> int -> ('k,_) t -> int -> int -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_key} *)
val get_data: ('k,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_data} *)
val get_data_copy: ('k,'d) t -> 'd option
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.get_data_copy} *)
val set_data: ('k,'d) t -> 'd -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.set_data} *)
val unset_data: ('k,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.unset_data} *)
val check_data: ('k,'d) t -> bool
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.check_data} *)
val blit_data: ('k,'d) t -> ('k,'d) t -> unit
+ [@@alert old_ephemeron_api "This function won't be available in 5.0"]
(** Same as {!Ephemeron.K1.blit_data} *)
+ val make : 'k array -> 'd -> ('k,'d) t
+ (** Same as {!Ephemeron.K1.make} *)
+
+ val query : ('k,'d) t -> 'k array -> 'd option
+ (** Same as {!Ephemeron.K1.query} *)
+
module Make
(H:Hashtbl.HashedType) :
S with type key = H.t array
(** Functor building an implementation of a weak hash table.
The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
+ module Bucket : sig
+
+ type ('k, 'd) t
+ (** A bucket is a mutable "list" of ephemerons. *)
+
+ val make : unit -> ('k, 'd) t
+ (** Create a new bucket. *)
+
+ val add : ('k, 'd) t -> 'k array -> 'd -> unit
+ (** Add an ephemeron to the bucket. *)
+
+ val remove : ('k, 'd) t -> 'k array -> unit
+ (** [remove b k] removes from [b] the most-recently added
+ ephemeron with keys [k], or does nothing if there is no such
+ ephemeron. *)
+
+ val find : ('k, 'd) t -> 'k array -> 'd option
+ (** Returns the data of the most-recently added ephemeron with the
+ given keys, or [None] if there is no such ephemeron. *)
+
+ val length : ('k, 'd) t -> int
+ (** Returns an upper bound on the length of the bucket. *)
+
+ val clear : ('k, 'd) t -> unit
+ (** Remove all ephemerons from the bucket. *)
+
+ end
+
end
-(** Emphemerons with arbitrary number of keys of the same type. *)
+(** Ephemerons with arbitrary number of keys of the same type. *)
module GenHashTable: sig
(** Define a hash table on generic containers which have a notion of
"death" and aliveness. If a binding is dead the hash table can
automatically remove it. *)
+ [@@@alert old_ephemeron_api "This module won't be available in 5.0"]
+
type equal =
| ETrue
| EFalse
else if (state==1)
state=2;
else if ($1 == "module")
- { if (ocamldoc!="true") printf("\n(** @canonical %s *)", $2);
+ { if (ocamldoc!="true") printf("\n(** @canonical Stdlib.%s *)", $2);
printf("\nmodule %s = Stdlib__%s\n", $2, $4);
}
else
else dirname ^ dir_sep ^ filename
let chop_suffix name suff =
- let n = String.length name - String.length suff in
- if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
+ if check_suffix name suff
+ then String.sub name 0 (String.length name - String.length suff)
+ else invalid_arg "Filename.chop_suffix"
let extension_len name =
let rec check i0 i =
(e.g. [..] in Unix). *)
val dir_sep : string
-(** The directory separator (e.g. [/] in Unix). @since 3.11.2 *)
+(** The directory separator (e.g. [/] in Unix).
+
+ @since 3.11.2 *)
val concat : string -> string -> string
(** [concat dir file] returns a file name that designates file
val chop_suffix : string -> string -> string
(** [chop_suffix name suff] removes the suffix [suff] from
- the filename [name]. The behavior is undefined if [name] does not
- end with the suffix [suff]. [chop_suffix_opt] is thus recommended
- instead.
+ the filename [name].
+ @raise Invalid_argument if [name] does not end with the suffix [suff].
*)
val chop_suffix_opt: suffix:string -> string -> string option
The custom break is useful if you want to change which visible
(non-whitespace) characters are printed in case of break or no break. For
- example, when printing a list {[ [a; b; c] ]}, you might want to add a
+ example, when printing a list [ [a; b; c] ], you might want to add a
trailing semicolon when it is printed vertically:
{[
(** [make_formatter out flush] returns a new formatter that outputs with
function [out], and flushes with function [flush].
- For instance, {[
+ For instance,
+ {[
make_formatter
(Stdlib.output oc)
- (fun () -> Stdlib.flush oc) ]}
+ (fun () -> Stdlib.flush oc)
+ ]}
returns a formatter to the {!Stdlib.out_channel} [oc].
*)
live_words : int;
(** Number of words of live data in the major heap, including the header
- words. *)
+ words.
+
+ Note that "live" words refers to every word in the major heap that isn't
+ currently known to be collectable, which includes words that have become
+ unreachable by the program after the start of the previous gc cycle.
+ It is typically much simpler and more predictable to call
+ {!Gc.full_major} (or {!Gc.compact}) then computing gc stats, as then
+ "live" words has the simple meaning of "reachable by the program". One
+ caveat is that a single call to {!Gc.full_major} will not reclaim values
+ that have a finaliser from {!Gc.finalise} (this does not apply to
+ {!Gc.finalise_last}). If this caveat matters, simply call
+ {!Gc.full_major} twice instead of once.
+ *)
live_blocks : int;
- (** Number of live blocks in the major heap. *)
+ (** Number of live blocks in the major heap.
+
+ See [live_words] for a caveat about what "live" means. *)
free_words : int;
(** Number of words in the free list. *)
(** Maximum size reached by the major heap, in words. *)
stack_size: int;
- (** Current size of the stack, in words. @since 3.12.0 *)
+ (** Current size of the stack, in words.
+ @since 3.12.0 *)
forced_major_collections: int;
(** Number of forced full major collections completed since the program
- was started. @since 4.12.0 *)
+ was started.
+ @since 4.12.0 *)
}
(** The memory management counters are returned in a [stat] record.
(** The size of the window used by the major GC for smoothing
out variations in its workload. This is an integer between
1 and 50.
- Default: 1. @since 4.03.0 *)
+ Default: 1.
+ @since 4.03.0 *)
custom_major_ratio : int;
(** Target ratio of floating garbage to major heap size for
The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
- {!Array.make}, and {!Stdlib.ref} are guaranteed to be
+ {!Array.make}, and {!val:Stdlib.ref} are guaranteed to be
heap-allocated and non-constant except when the length argument is [0].
*)
(* *)
(**************************************************************************)
+[@@@ocaml.warning "-3"] (* ignore deprecation warning about module Stream *)
+
type token =
Kwd of string
| Ident of string
["-pp"] command-line switch of the compilers.
*)
+[@@@ocaml.warning "-3"] (* ignore deprecation warning about module Stream *)
+
(** The type of tokens. The lexical classes are: [Int] and [Float]
for integer and floating-point numbers; [String] for
string literals, enclosed in double quotes; [Char] for
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
several bindings for the same key, they appear in reversed order of
introduction, that is, the most recent binding appears first.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
during the iteration.
@since 4.07 *)
(** A seeded hashing function on keys. The first argument is
the seed. It must be the case that if [equal x y] is true,
then [hash seed x = hash seed y] for any value of [seed].
- A suitable choice for [hash] is the function {!seeded_hash}
- below. *)
+ A suitable choice for [hash] is the function
+ {!Stdlib.Hashtbl.seeded_hash} below. *)
end
(** The input signature of the functor {!MakeSeeded}.
@since 4.00.0 *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type t = in_channel
+
+type open_flag = Stdlib.open_flag =
+ | Open_rdonly
+ | Open_wronly
+ | Open_append
+ | Open_creat
+ | Open_trunc
+ | Open_excl
+ | Open_binary
+ | Open_text
+ | Open_nonblock
+
+let stdin = Stdlib.stdin
+let open_bin = Stdlib.open_in_bin
+let open_text = Stdlib.open_in
+let open_gen = Stdlib.open_in_gen
+
+let with_open openfun s f =
+ let ic = openfun s in
+ Fun.protect ~finally:(fun () -> Stdlib.close_in_noerr ic)
+ (fun () -> f ic)
+
+let with_open_bin s f =
+ with_open Stdlib.open_in_bin s f
+
+let with_open_text s f =
+ with_open Stdlib.open_in s f
+
+let with_open_gen flags perm s f =
+ with_open (Stdlib.open_in_gen flags perm) s f
+
+let seek = Stdlib.LargeFile.seek_in
+let pos = Stdlib.LargeFile.pos_in
+let length = Stdlib.LargeFile.in_channel_length
+let close = Stdlib.close_in
+let close_noerr = Stdlib.close_in_noerr
+
+let input_char ic =
+ match Stdlib.input_char ic with
+ | c -> Some c
+ | exception End_of_file -> None
+
+let input_byte ic =
+ match Stdlib.input_byte ic with
+ | n -> Some n
+ | exception End_of_file -> None
+
+let input_line ic =
+ match Stdlib.input_line ic with
+ | s -> Some s
+ | exception End_of_file -> None
+
+let input = Stdlib.input
+
+let really_input ic buf pos len =
+ match Stdlib.really_input ic buf pos len with
+ | () -> Some ()
+ | exception End_of_file -> None
+
+let really_input_string ic len =
+ match Stdlib.really_input_string ic len with
+ | s -> Some s
+ | exception End_of_file -> None
+
+(* Read up to [len] bytes into [buf], starting at [ofs]. Return total bytes
+ read. *)
+let read_upto ic buf ofs len =
+ let rec loop ofs len =
+ if len = 0 then ofs
+ else begin
+ let r = Stdlib.input ic buf ofs len in
+ if r = 0 then
+ ofs
+ else
+ loop (ofs + r) (len - r)
+ end
+ in
+ loop ofs len - ofs
+
+(* Best effort attempt to return a buffer with >= (ofs + n) bytes of storage,
+ and such that it coincides with [buf] at indices < [ofs].
+
+ The returned buffer is equal to [buf] itself if it already has sufficient
+ free space.
+
+ The returned buffer may have *fewer* than [ofs + n] bytes of storage if this
+ number is > [Sys.max_string_length]. However the returned buffer will
+ *always* have > [ofs] bytes of storage. In the limiting case when [ofs = len
+ = Sys.max_string_length] (so that it is not possible to resize the buffer at
+ all), an exception is raised. *)
+
+let ensure buf ofs n =
+ let len = Bytes.length buf in
+ if len >= ofs + n then buf
+ else begin
+ let new_len = ref len in
+ while !new_len < ofs + n do
+ new_len := 2 * !new_len + 1
+ done;
+ let new_len = !new_len in
+ let new_len =
+ if new_len <= Sys.max_string_length then
+ new_len
+ else if ofs < Sys.max_string_length then
+ Sys.max_string_length
+ else
+ failwith "In_channel.input_all: channel content \
+ is larger than maximum string length"
+ in
+ let new_buf = Bytes.create new_len in
+ Bytes.blit buf 0 new_buf 0 ofs;
+ new_buf
+ end
+
+let input_all ic =
+ let chunk_size = 65536 in (* IO_BUFFER_SIZE *)
+ let initial_size =
+ try
+ Stdlib.in_channel_length ic - Stdlib.pos_in ic
+ with Sys_error _ ->
+ -1
+ in
+ let initial_size = if initial_size < 0 then chunk_size else initial_size in
+ let initial_size =
+ if initial_size <= Sys.max_string_length then
+ initial_size
+ else
+ Sys.max_string_length
+ in
+ let buf = Bytes.create initial_size in
+ let nread = read_upto ic buf 0 initial_size in
+ if nread < initial_size then (* EOF reached, buffer partially filled *)
+ Bytes.sub_string buf 0 nread
+ else begin (* nread = initial_size, maybe EOF reached *)
+ match Stdlib.input_char ic with
+ | exception End_of_file ->
+ (* EOF reached, buffer is completely filled *)
+ Bytes.unsafe_to_string buf
+ | c ->
+ (* EOF not reached *)
+ let rec loop buf ofs =
+ let buf = ensure buf ofs chunk_size in
+ let rem = Bytes.length buf - ofs in
+ (* [rem] can be < [chunk_size] if buffer size close to
+ [Sys.max_string_length] *)
+ let r = read_upto ic buf ofs rem in
+ if r < rem then (* EOF reached *)
+ Bytes.sub_string buf 0 (ofs + r)
+ else (* r = rem *)
+ loop buf (ofs + rem)
+ in
+ let buf = ensure buf nread (chunk_size + 1) in
+ Bytes.set buf nread c;
+ loop buf (nread + 1)
+ end
+
+let set_binary_mode = Stdlib.set_binary_mode_in
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Input channels.
+
+ @since 4.14.0 *)
+
+type t = in_channel
+(** The type of input channel. *)
+
+type open_flag = Stdlib.open_flag =
+ | Open_rdonly (** open for reading. *)
+ | Open_wronly (** open for writing. *)
+ | Open_append (** open for appending: always write at end of file. *)
+ | Open_creat (** create the file if it does not exist. *)
+ | Open_trunc (** empty the file if it already exists. *)
+ | Open_excl (** fail if Open_creat and the file already exists. *)
+ | Open_binary (** open in binary mode (no conversion). *)
+ | Open_text (** open in text mode (may perform conversions). *)
+ | Open_nonblock (** open in non-blocking mode. *)
+(** Opening modes for {!open_gen}. *)
+
+val stdin : t
+(** The standard input for the process. *)
+
+val open_bin : string -> t
+(** Open the named file for reading, and return a new input channel on that
+ file, positioned at the beginning of the file. *)
+
+val open_text : string -> t
+(** Same as {!open_bin}, but the file is opened in text mode, so that newline
+ translation takes place during reads. On operating systems that do not
+ distinguish between text mode and binary mode, this function behaves like
+ {!open_bin}. *)
+
+val open_gen : open_flag list -> int -> string -> t
+(** [open_gen mode perm filename] opens the named file for reading, as described
+ above. The extra arguments [mode] and [perm] specify the opening mode and
+ file permissions. {!open_text} and {!open_bin} are special cases of this
+ function. *)
+
+val with_open_bin : string -> (t -> 'a) -> 'a
+(** [with_open_bin fn f] opens a channel [ic] on file [fn] and returns [f
+ ic]. After [f] returns, either with a value or by raising an exception, [ic]
+ is guaranteed to be closed. *)
+
+val with_open_text : string -> (t -> 'a) -> 'a
+(** Like {!with_open_bin}, but the channel is opened in text mode (see
+ {!open_text}). *)
+
+val with_open_gen : open_flag list -> int -> string -> (t -> 'a) -> 'a
+(** Like {!with_open_bin}, but can specify the opening mode and file permission,
+ in case the file must be created (see {!open_gen}). *)
+
+val seek : t -> int64 -> unit
+(** [seek chan pos] sets the current reading position to [pos] for channel
+ [chan]. This works only for regular files. On files of other kinds, the
+ behavior is unspecified. *)
+
+val pos : t -> int64
+(** Return the current reading position for the given channel. For files opened
+ in text mode under Windows, the returned position is approximate (owing to
+ end-of-line conversion); in particular, saving the current position with
+ {!pos}, then going back to this position using {!seek} will not work. For
+ this programming idiom to work reliably and portably, the file must be
+ opened in binary mode. *)
+
+val length : t -> int64
+(** Return the size (number of characters) of the regular file on which the
+ given channel is opened. If the channel is opened on a file that is not a
+ regular file, the result is meaningless. The returned size does not take
+ into account the end-of-line translations that can be performed when reading
+ from a channel opened in text mode. *)
+
+val close : t -> unit
+(** Close the given channel. Input functions raise a [Sys_error] exception when
+ they are applied to a closed input channel, except {!close}, which does
+ nothing when applied to an already closed channel. *)
+
+val close_noerr : t -> unit
+(** Same as {!close}, but ignore all errors. *)
+
+val input_char : t -> char option
+(** Read one character from the given input channel. Returns [None] if there
+ are no more characters to read. *)
+
+val input_byte : t -> int option
+(** Same as {!input_char}, but return the 8-bit integer representing the
+ character. Returns [None] if the end of file was reached. *)
+
+val input_line : t -> string option
+(** [input_line ic] reads characters from [ic] until a newline or the end of
+ file is reached. Returns the string of all characters read, without the
+ newline (if any). Returns [None] if the end of the file has been reached.
+ In particular, this will be the case if the last line of input is empty.
+
+ A newline is the character [\n] unless the file is open in text mode and
+ {!Sys.win32} is [true] in which case it is the sequence of characters
+ [\r\n]. *)
+
+val input : t -> bytes -> int -> int -> int
+(** [input ic buf pos len] reads up to [len] characters from the given channel
+ [ic], storing them in byte sequence [buf], starting at character number
+ [pos]. It returns the actual number of characters read, between 0 and [len]
+ (inclusive). A return value of 0 means that the end of file was reached.
+
+ Use {!really_input} to read exactly [len] characters.
+
+ @raise Invalid_argument if [pos] and [len] do not designate a valid range of
+ [buf]. *)
+
+val really_input : t -> bytes -> int -> int -> unit option
+(** [really_input ic buf pos len] reads [len] characters from channel [ic],
+ storing them in byte sequence [buf], starting at character number [pos].
+
+ Returns [None] if the end of file is reached before [len] characters have
+ been read.
+
+ @raise Invalid_argument if [pos] and [len] do not designate a valid range of
+ [buf]. *)
+
+val really_input_string : t -> int -> string option
+(** [really_input_string ic len] reads [len] characters from channel [ic] and
+ returns them in a new string. Returns [None] if the end of file is reached
+ before [len] characters have been read. *)
+
+val input_all : t -> string
+(** [input_all ic] reads all remaining data from [ic]. *)
+
+val set_binary_mode : t -> bool -> unit
+(** [set_binary_mode ic true] sets the channel [ic] to binary mode: no
+ translations take place during input.
+
+ [set_binary_mode ic false] sets the channel [ic] to text mode: depending
+ on the operating system, some translations may take place during input. For
+ instance, under Windows, end-of-lines will be translated from [\r\n] to
+ [\n].
+
+ This function has no effect under operating systems that do not distinguish
+ between text mode and binary mode. *)
[@@unboxed] [@@noalloc]
(** Convert the given floating-point number to a 32-bit integer,
discarding the fractional part (truncate towards 0).
- The result of the conversion is undefined if, after truncation,
- the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. *)
+ If the truncated floating-point number is outside the range
+ \[{!Int32.min_int}, {!Int32.max_int}\], no exception is raised, and
+ an unspecified, platform-dependent integer is returned. *)
external to_float : int32 -> float
= "caml_int32_to_float" "caml_int32_to_float_unboxed"
(** {1 Deprecated functions} *)
external format : string -> int32 -> string = "caml_int32_format"
+[@@ocaml.deprecated "Use Printf.sprintf with a [%l...] format instead."]
(** Do not use this deprecated function. Instead,
used {!Printf.sprintf} with a [%l...] format. *)
[@@unboxed] [@@noalloc]
(** Convert the given floating-point number to a 64-bit integer,
discarding the fractional part (truncate towards 0).
- The result of the conversion is undefined if, after truncation,
- the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. *)
+ If the truncated floating-point number is outside the range
+ \[{!Int64.min_int}, {!Int64.max_int}\], no exception is raised, and
+ an unspecified, platform-dependent integer is returned. *)
external to_float : int64 -> float
= "caml_int64_to_float" "caml_int64_to_float_unboxed"
(** {1 Deprecated functions} *)
external format : string -> int64 -> string = "caml_int64_format"
+[@@ocaml.deprecated "Use Printf.sprintf with a [%L...] format instead."]
(** Do not use this deprecated function. Instead,
used {!Printf.sprintf} with a [%L...] format. *)
(**/**)
-(** {1 } *)
-
(** The following definitions are used by the generated scanners only.
They are not intended to be used directly by user programs. *)
(** Return the list of all bindings of the given map.
The returned list is sorted in increasing order of keys with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}.
+ given to {!Stdlib.Map.Make}.
@since 3.12.0
*)
*)
val max_binding: 'a t -> (key * 'a)
- (** Same as {!S.min_binding}, but returns the binding with
+ (** Same as {!min_binding}, but returns the binding with
the largest key in the given map.
@since 3.12.0
*)
val max_binding_opt: 'a t -> (key * 'a) option
- (** Same as {!S.min_binding_opt}, but returns the binding with
+ (** Same as {!min_binding_opt}, but returns the binding with
the largest key in the given map.
@since 4.05
*)
with respect to the ordering over the type of the keys. *)
val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
- (** Same as {!S.map}, but the function receives as arguments both the
+ (** Same as {!map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
(** {1 Maps and Sequences} *)
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
several bindings for the same key, they appear in reversed order of
introduction, that is, the most recent binding appears first.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
during the iteration.
@since 4.07 *)
(** A seeded hashing function on keys. The first argument is
the seed. It must be the case that if [equal x y] is true,
then [hash seed x = hash seed y] for any value of [seed].
- A suitable choice for [hash] is the function {!seeded_hash}
- below. *)
+ A suitable choice for [hash] is the function
+ {!Stdlib.Hashtbl.seeded_hash} below. *)
end
(** The input signature of the functor {!MakeSeeded}.
@since 4.00.0 *)
(** Return the list of all bindings of the given map.
The returned list is sorted in increasing order of keys with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}.
+ given to {!Stdlib.Map.Make}.
@since 3.12.0
*)
*)
val max_binding: 'a t -> (key * 'a)
- (** Same as {!S.min_binding}, but returns the binding with
+ (** Same as {!min_binding}, but returns the binding with
the largest key in the given map.
@since 3.12.0
*)
val max_binding_opt: 'a t -> (key * 'a) option
- (** Same as {!S.min_binding_opt}, but returns the binding with
+ (** Same as {!min_binding_opt}, but returns the binding with
the largest key in the given map.
@since 4.05
*)
with respect to the ordering over the type of the keys. *)
val mapi: f:(key -> 'a -> 'b) -> 'a t -> 'b t
- (** Same as {!S.map}, but the function receives as arguments both the
+ (** Same as {!map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
(** {1 Maps and Sequences} *)
(** Return the list of all elements of the given set.
The returned list is sorted in increasing order with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}. *)
+ given to {!Stdlib.Set.Make}. *)
val min_elt: t -> elt
(** Return the smallest element of the given set
*)
val max_elt: t -> elt
- (** Same as {!S.min_elt}, but returns the largest element of the
+ (** Same as {!min_elt}, but returns the largest element of the
given set. *)
val max_elt_opt: t -> elt option
- (** Same as {!S.min_elt_opt}, but returns the largest element of the
+ (** Same as {!min_elt_opt}, but returns the largest element of the
given set.
@since 4.05
*)
[@@unboxed] [@@noalloc]
(** Convert the given floating-point number to a native integer,
discarding the fractional part (truncate towards 0).
- The result of the conversion is undefined if, after truncation,
- the number is outside the range
- \[{!Nativeint.min_int}, {!Nativeint.max_int}\]. *)
+ If the truncated floating-point number is outside the range
+ \[{!Nativeint.min_int}, {!Nativeint.max_int}\], no exception is raised,
+ and an unspecified, platform-dependent integer is returned. *)
external to_float : nativeint -> float
= "caml_nativeint_to_float" "caml_nativeint_to_float_unboxed"
(** {1 Deprecated functions} *)
external format : string -> nativeint -> string = "caml_nativeint_format"
+[@@ocaml.deprecated "Use Printf.sprintf with a [%n...] format instead."]
(** [Nativeint.format fmt n] return the string representation of the
native integer [n] in the format specified by [fmt].
[fmt] is a [Printf]-style format consisting of exactly
external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
external with_tag : int -> t -> t = "caml_obj_with_tag"
-let marshal (obj : t) =
- Marshal.to_bytes obj []
-let unmarshal str pos =
- (Marshal.from_bytes str pos, pos + Marshal.total_size str pos)
-
let first_non_constant_constructor_tag = 0
let last_non_constant_constructor_tag = 245
allocated blocks are excluded, unless the runtime system
was configured with [--disable-naked-pointers].
- @Since 4.04
+ @since 4.04
*)
external field : t -> int -> t = "%obj_field"
val [@inline always] extension_id : extension_constructor -> int
[@@ocaml.deprecated "use Obj.Extension_constructor.id"]
-(** The following two functions are deprecated. Use module {!Marshal}
- instead. *)
-
-val marshal : t -> bytes
- [@@ocaml.deprecated "Use Marshal.to_bytes instead."]
-val unmarshal : bytes -> int -> t * int
- [@@ocaml.deprecated "Use Marshal.from_bytes and Marshal.total_size instead."]
-
module Ephemeron: sig
(** Ephemeron with arbitrary arity and untyped *)
(** return the number of keys *)
val get_key: t -> int -> obj_t option
- (** Same as {!Ephemeron.K1.get_key} *)
+ (** Same as {!Stdlib.Ephemeron.K1.get_key} *)
val get_key_copy: t -> int -> obj_t option
- (** Same as {!Ephemeron.K1.get_key_copy} *)
+ (** Same as {!Stdlib.Ephemeron.K1.get_key_copy} *)
val set_key: t -> int -> obj_t -> unit
- (** Same as {!Ephemeron.K1.set_key} *)
+ (** Same as {!Stdlib.Ephemeron.K1.set_key} *)
val unset_key: t -> int -> unit
- (** Same as {!Ephemeron.K1.unset_key} *)
+ (** Same as {!Stdlib.Ephemeron.K1.unset_key} *)
val check_key: t -> int -> bool
- (** Same as {!Ephemeron.K1.check_key} *)
+ (** Same as {!Stdlib.Ephemeron.K1.check_key} *)
val blit_key : t -> int -> t -> int -> int -> unit
- (** Same as {!Ephemeron.K1.blit_key} *)
+ (** Same as {!Stdlib.Ephemeron.K1.blit_key} *)
val get_data: t -> obj_t option
- (** Same as {!Ephemeron.K1.get_data} *)
+ (** Same as {!Stdlib.Ephemeron.K1.get_data} *)
val get_data_copy: t -> obj_t option
- (** Same as {!Ephemeron.K1.get_data_copy} *)
+ (** Same as {!Stdlib.Ephemeron.K1.get_data_copy} *)
val set_data: t -> obj_t -> unit
- (** Same as {!Ephemeron.K1.set_data} *)
+ (** Same as {!Stdlib.Ephemeron.K1.set_data} *)
val unset_data: t -> unit
- (** Same as {!Ephemeron.K1.unset_data} *)
+ (** Same as {!Stdlib.Ephemeron.K1.unset_data} *)
val check_data: t -> bool
- (** Same as {!Ephemeron.K1.check_data} *)
+ (** Same as {!Stdlib.Ephemeron.K1.check_data} *)
val blit_data : t -> t -> unit
- (** Same as {!Ephemeron.K1.blit_data} *)
+ (** Same as {!Stdlib.Ephemeron.K1.blit_data} *)
val max_ephe_length: int
(** Maximum length of an ephemeron, ie the maximum number of keys an
(** [value o ~default] is [v] if [o] is [Some v] and [default] otherwise. *)
val get : 'a option -> 'a
-(** [get o] is [v] if [o] is [Some v] and @raise Invalid_argument otherwise. *)
+(** [get o] is [v] if [o] is [Some v] and raise otherwise.
+
+ @raise Invalid_argument if [o] is [None]. *)
val bind : 'a option -> ('a -> 'b option) -> 'b option
(** [bind o f] is [f v] if [o] is [Some v] and [None] if [o] is [None]. *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type t = out_channel
+
+type open_flag = Stdlib.open_flag =
+ | Open_rdonly
+ | Open_wronly
+ | Open_append
+ | Open_creat
+ | Open_trunc
+ | Open_excl
+ | Open_binary
+ | Open_text
+ | Open_nonblock
+
+let stdout = Stdlib.stdout
+let stderr = Stdlib.stderr
+let open_bin = Stdlib.open_out_bin
+let open_text = Stdlib.open_out
+let open_gen = Stdlib.open_out_gen
+
+let with_open openfun s f =
+ let oc = openfun s in
+ Fun.protect ~finally:(fun () -> Stdlib.close_out_noerr oc)
+ (fun () -> f oc)
+
+let with_open_bin s f =
+ with_open Stdlib.open_out_bin s f
+
+let with_open_text s f =
+ with_open Stdlib.open_out s f
+
+let with_open_gen flags perm s f =
+ with_open (Stdlib.open_out_gen flags perm) s f
+
+let seek = Stdlib.LargeFile.seek_out
+let pos = Stdlib.LargeFile.pos_out
+let length = Stdlib.LargeFile.out_channel_length
+let close = Stdlib.close_out
+let close_noerr = Stdlib.close_out_noerr
+let flush = Stdlib.flush
+let flush_all = Stdlib.flush_all
+let output_char = Stdlib.output_char
+let output_byte = Stdlib.output_byte
+let output_string = Stdlib.output_string
+let output_bytes = Stdlib.output_bytes
+let output = Stdlib.output
+let output_substring = Stdlib.output_substring
+let set_binary_mode = Stdlib.set_binary_mode_out
+
+external set_buffered : t -> bool -> unit = "caml_ml_set_buffered"
+
+external is_buffered : t -> bool = "caml_ml_is_buffered"
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Output channels.
+
+ @since 4.14.0 *)
+
+type t = out_channel
+(** The type of output channel. *)
+
+type open_flag = Stdlib.open_flag =
+ | Open_rdonly (** open for reading. *)
+ | Open_wronly (** open for writing. *)
+ | Open_append (** open for appending: always write at end of file. *)
+ | Open_creat (** create the file if it does not exist. *)
+ | Open_trunc (** empty the file if it already exists. *)
+ | Open_excl (** fail if Open_creat and the file already exists. *)
+ | Open_binary (** open in binary mode (no conversion). *)
+ | Open_text (** open in text mode (may perform conversions). *)
+ | Open_nonblock (** open in non-blocking mode. *)
+(** Opening modes for {!open_gen}. *)
+
+val stdout : t
+(** The standard output for the process. *)
+
+val stderr : t
+(** The standard error output for the process. *)
+
+val open_bin : string -> t
+(** Open the named file for writing, and return a new output channel on that
+ file, positioned at the beginning of the file. The file is truncated to zero
+ length if it already exists. It is created if it does not already exists. *)
+
+val open_text : string -> t
+(** Same as {!open_bin}, but the file is opened in text mode, so that newline
+ translation takes place during writes. On operating systems that do not
+ distinguish between text mode and binary mode, this function behaves like
+ {!open_bin}. *)
+
+val open_gen : open_flag list -> int -> string -> t
+(** [open_gen mode perm filename] opens the named file for writing, as described
+ above. The extra argument [mode] specifies the opening mode. The extra
+ argument [perm] specifies the file permissions, in case the file must be
+ created. {!open_text} and {!open_bin} are special cases of this
+ function. *)
+
+val with_open_bin : string -> (t -> 'a) -> 'a
+(** [with_open_bin fn f] opens a channel [oc] on file [fn] and returns [f
+ oc]. After [f] returns, either with a value or by raising an exception, [oc]
+ is guaranteed to be closed. *)
+
+val with_open_text : string -> (t -> 'a) -> 'a
+(** Like {!with_open_bin}, but the channel is opened in text mode (see
+ {!open_text}). *)
+
+val with_open_gen : open_flag list -> int -> string -> (t -> 'a) -> 'a
+(** Like {!with_open_bin}, but can specify the opening mode and file permission,
+ in case the file must be created (see {!open_gen}). *)
+
+val seek : t -> int64 -> unit
+(** [seek chan pos] sets the current writing position to [pos] for channel
+ [chan]. This works only for regular files. On files of other kinds (such as
+ terminals, pipes and sockets), the behavior is unspecified. *)
+
+val pos : t -> int64
+(** Return the current writing position for the given channel. Does not work on
+ channels opened with the [Open_append] flag (returns unspecified results).
+
+ For files opened in text mode under Windows, the returned position is
+ approximate (owing to end-of-line conversion); in particular, saving the
+ current position with {!pos}, then going back to this position using {!seek}
+ will not work. For this programming idiom to work reliably and portably,
+ the file must be opened in binary mode. *)
+
+val length : t -> int64
+(** Return the size (number of characters) of the regular file on which the
+ given channel is opened. If the channel is opened on a file that is not a
+ regular file, the result is meaningless. *)
+
+val close : t -> unit
+(** Close the given channel, flushing all buffered write operations. Output
+ functions raise a [Sys_error] exception when they are applied to a closed
+ output channel, except {!close} and {!flush}, which do nothing when applied
+ to an already closed channel. Note that {!close} may raise [Sys_error] if
+ the operating system signals an error when flushing or closing. *)
+
+val close_noerr : t -> unit
+(** Same as {!close}, but ignore all errors. *)
+
+val flush : t -> unit
+(** Flush the buffer associated with the given output channel, performing all
+ pending writes on that channel. Interactive programs must be careful about
+ flushing standard output and standard error at the right time. *)
+
+val flush_all : unit -> unit
+(** Flush all open output channels; ignore errors. *)
+
+val output_char : t -> char -> unit
+(** Write the character on the given output channel. *)
+
+val output_byte : t -> int -> unit
+(** Write one 8-bit integer (as the single character with that code) on the
+ given output channel. The given integer is taken modulo 256. *)
+
+val output_string : t -> string -> unit
+(** Write the string on the given output channel. *)
+
+val output_bytes : t -> bytes -> unit
+(** Write the byte sequence on the given output channel. *)
+
+val output : t -> bytes -> int -> int -> unit
+(** [output oc buf pos len] writes [len] characters from byte sequence [buf],
+ starting at offset [pos], to the given output channel [oc].
+
+ @raise Invalid_argument if [pos] and [len] do not designate a valid range of
+ [buf]. *)
+
+val output_substring : t -> string -> int -> int -> unit
+(** Same as {!output} but take a string as argument instead of a byte
+ sequence. *)
+
+val set_binary_mode : t -> bool -> unit
+(** [set_binary_mode oc true] sets the channel [oc] to binary mode: no
+ translations take place during output.
+
+ [set_binary_mode oc false] sets the channel [oc] to text mode: depending on
+ the operating system, some translations may take place during output. For
+ instance, under Windows, end-of-lines will be translated from [\n] to
+ [\r\n].
+
+ This function has no effect under operating systems that do not distinguish
+ between text mode and binary mode. *)
+
+val set_buffered : t -> bool -> unit
+(** [set_buffered oc true] sets the channel [oc] to {e buffered} mode. In this
+ mode, data output on [oc] will be buffered until either the internal buffer
+ is full or the function {!flush} or {!flush_all} is called, at which point
+ it will be sent to the output device.
+
+ [set_buffered oc false] sets the channel [oc] to {e unbuffered} mode. In
+ this mode, data output on [oc] will be sent to the output device
+ immediately.
+
+ All channels are open in {e buffered} mode by default. *)
+
+val is_buffered : t -> bool
+(** [is_buffered oc] returns whether the channel [oc] is buffered (see
+ {!set_buffered}). *)
(**/**)
-(** {1 } *)
-
(** The following definitions are used by the generated parsers only.
They are not intended to be used directly by user programs. *)
val to_seq : 'a t -> 'a Seq.t
(** Iterate on the queue, in front-to-back order.
- The behavior is not defined if the queue is modified
+ The behavior is not specified if the queue is modified
during the iteration.
@since 4.07 *)
let bool s = (bits s land 1 = 0)
+ let bits32 s =
+ let b1 = Int32.(shift_right_logical (of_int (bits s)) 14) in (* 16 bits *)
+ let b2 = Int32.(shift_right_logical (of_int (bits s)) 14) in (* 16 bits *)
+ Int32.(logor b1 (shift_left b2 16))
+
+ let bits64 s =
+ let b1 = Int64.(shift_right_logical (of_int (bits s)) 9) in (* 21 bits *)
+ let b2 = Int64.(shift_right_logical (of_int (bits s)) 9) in (* 21 bits *)
+ let b3 = Int64.(shift_right_logical (of_int (bits s)) 8) in (* 22 bits *)
+ Int64.(logor b1 (logor (shift_left b2 21) (shift_left b3 42)))
+
+ let nativebits =
+ if Nativeint.size = 32
+ then fun s -> Nativeint.of_int32 (bits32 s)
+ else fun s -> Int64.to_nativeint (bits64 s)
+
end
(* This is the state you get with [init 27182818] and then applying
let int64 bound = State.int64 default bound
let float scale = State.float default scale
let bool () = State.bool default
+let bits32 () = State.bits32 default
+let bits64 () = State.bits64 default
+let nativebits () = State.nativebits default
let full_init seed = State.full_init default seed
let init seed = State.full_init default [| seed |]
val bool : unit -> bool
(** [Random.bool ()] returns [true] or [false] with probability 0.5 each. *)
+val bits32 : unit -> Int32.t
+(** [Random.bits32 ()] returns 32 random bits as an integer between
+ {!Int32.min_int} and {!Int32.max_int}.
+ @since 4.14.0 *)
+
+val bits64 : unit -> Int64.t
+(** [Random.bits64 ()] returns 64 random bits as an integer between
+ {!Int64.min_int} and {!Int64.max_int}.
+ @since 4.14.0 *)
+
+val nativebits : unit -> Nativeint.t
+(** [Random.nativebits ()] returns 32 or 64 random bits (depending on
+ the bit width of the platform) as an integer between
+ {!Nativeint.min_int} and {!Nativeint.max_int}.
+ @since 4.14.0 *)
(** {1 Advanced functions} *)
val int64 : t -> Int64.t -> Int64.t
val float : t -> float -> float
val bool : t -> bool
+ val bits32 : t -> Int32.t
+ val bits64 : t -> Int64.t
+ val nativebits : t -> Nativeint.t
(** These functions are the same as the basic functions, except that they
use (and update) the given PRNG state instead of the default one.
*)
(** [value r ~default] is [v] if [r] is [Ok v] and [default] otherwise. *)
val get_ok : ('a, 'e) result -> 'a
-(** [get_ok r] is [v] if [r] is [Ok v] and @raise Invalid_argument
- otherwise. *)
+(** [get_ok r] is [v] if [r] is [Ok v] and raise otherwise.
+
+ @raise Invalid_argument if [r] is [Error _]. *)
val get_error : ('a, 'e) result -> 'e
-(** [get_error r] is [e] if [r] is [Error e] and @raise Invalid_argument
- otherwise. *)
+(** [get_error r] is [e] if [r] is [Error e] and raise otherwise.
+
+ @raise Invalid_argument if [r] is [Ok _]. *)
val bind : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result
(** [bind r f] is [f v] if [r] is [Ok v] and [r] if [r] is [Error _]. *)
- [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-fA-F]+]).
- [o]: reads an unsigned octal integer ([[0-7]+]).
- [s]: reads a string argument that spreads as much as possible, until the
- following bounding condition holds: {ul
+ following bounding condition holds:
+ {ul
{- a whitespace has been found (see {!Scanf.space}),}
{- a scanning indication (see scanning {!Scanf.indication}) has been
encountered,}
let concat_map = flat_map
-let fold_left f acc seq =
- let rec aux f acc seq = match seq () with
+let rec fold_left f acc seq =
+ match seq () with
| Nil -> acc
| Cons (x, next) ->
let acc = f acc x in
- aux f acc next
- in
- aux f acc seq
+ fold_left f acc next
-let iter f seq =
- let rec aux seq = match seq () with
+let rec iter f seq =
+ match seq () with
| Nil -> ()
| Cons (x, next) ->
f x;
- aux next
- in
- aux seq
+ iter f next
let rec unfold f u () =
match f u with
| None -> Nil
| Some (x, u') -> Cons (x, unfold f u')
+
+let is_empty xs =
+ match xs() with
+ | Nil ->
+ true
+ | Cons (_, _) ->
+ false
+
+let uncons xs =
+ match xs() with
+ | Cons (x, xs) ->
+ Some (x, xs)
+ | Nil ->
+ None
+
+
+
+let rec length_aux accu xs =
+ match xs() with
+ | Nil ->
+ accu
+ | Cons (_, xs) ->
+ length_aux (accu + 1) xs
+
+let[@inline] length xs =
+ length_aux 0 xs
+
+let rec iteri_aux f i xs =
+ match xs() with
+ | Nil ->
+ ()
+ | Cons (x, xs) ->
+ f i x;
+ iteri_aux f (i+1) xs
+
+let[@inline] iteri f xs =
+ iteri_aux f 0 xs
+
+let rec fold_lefti_aux f accu i xs =
+ match xs() with
+ | Nil ->
+ accu
+ | Cons (x, xs) ->
+ let accu = f accu i x in
+ fold_lefti_aux f accu (i+1) xs
+
+let[@inline] fold_lefti f accu xs =
+ fold_lefti_aux f accu 0 xs
+
+let rec for_all p xs =
+ match xs() with
+ | Nil ->
+ true
+ | Cons (x, xs) ->
+ p x && for_all p xs
+
+let rec exists p xs =
+ match xs() with
+ | Nil ->
+ false
+ | Cons (x, xs) ->
+ p x || exists p xs
+
+let rec find p xs =
+ match xs() with
+ | Nil ->
+ None
+ | Cons (x, xs) ->
+ if p x then Some x else find p xs
+
+let rec find_map f xs =
+ match xs() with
+ | Nil ->
+ None
+ | Cons (x, xs) ->
+ match f x with
+ | None ->
+ find_map f xs
+ | Some _ as result ->
+ result
+
+(* [iter2], [fold_left2], [for_all2], [exists2], [map2], [zip] work also in
+ the case where the two sequences have different lengths. They stop as soon
+ as one sequence is exhausted. Their behavior is slightly asymmetric: when
+ [xs] is empty, they do not force [ys]; however, when [ys] is empty, [xs] is
+ forced, even though the result of the function application [xs()] turns out
+ to be useless. *)
+
+let rec iter2 f xs ys =
+ match xs() with
+ | Nil ->
+ ()
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ ()
+ | Cons (y, ys) ->
+ f x y;
+ iter2 f xs ys
+
+let rec fold_left2 f accu xs ys =
+ match xs() with
+ | Nil ->
+ accu
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ accu
+ | Cons (y, ys) ->
+ let accu = f accu x y in
+ fold_left2 f accu xs ys
+
+let rec for_all2 f xs ys =
+ match xs() with
+ | Nil ->
+ true
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ true
+ | Cons (y, ys) ->
+ f x y && for_all2 f xs ys
+
+let rec exists2 f xs ys =
+ match xs() with
+ | Nil ->
+ false
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ false
+ | Cons (y, ys) ->
+ f x y || exists2 f xs ys
+
+let rec equal eq xs ys =
+ match xs(), ys() with
+ | Nil, Nil ->
+ true
+ | Cons (x, xs), Cons (y, ys) ->
+ eq x y && equal eq xs ys
+ | Nil, Cons (_, _)
+ | Cons (_, _), Nil ->
+ false
+
+let rec compare cmp xs ys =
+ match xs(), ys() with
+ | Nil, Nil ->
+ 0
+ | Cons (x, xs), Cons (y, ys) ->
+ let c = cmp x y in
+ if c <> 0 then c else compare cmp xs ys
+ | Nil, Cons (_, _) ->
+ -1
+ | Cons (_, _), Nil ->
+ +1
+
+
+
+(* [init_aux f i j] is the sequence [f i, ..., f (j-1)]. *)
+
+let rec init_aux f i j () =
+ if i < j then begin
+ Cons (f i, init_aux f (i + 1) j)
+ end
+ else
+ Nil
+
+let init n f =
+ if n < 0 then
+ invalid_arg "Seq.init"
+ else
+ init_aux f 0 n
+
+let rec repeat x () =
+ Cons (x, repeat x)
+
+let rec forever f () =
+ Cons (f(), forever f)
+
+(* This preliminary definition of [cycle] requires the sequence [xs]
+ to be nonempty. Applying it to an empty sequence would produce a
+ sequence that diverges when it is forced. *)
+
+let rec cycle_nonempty xs () =
+ append xs (cycle_nonempty xs) ()
+
+(* [cycle xs] checks whether [xs] is empty and, if so, returns an empty
+ sequence. Otherwise, [cycle xs] produces one copy of [xs] followed
+ with the infinite sequence [cycle_nonempty xs]. Thus, the nonemptiness
+ check is performed just once. *)
+
+let cycle xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs') ->
+ Cons (x, append xs' (cycle_nonempty xs))
+
+(* [iterate1 f x] is the sequence [f x, f (f x), ...].
+ It is equivalent to [tail (iterate f x)].
+ [iterate1] is used as a building block in the definition of [iterate]. *)
+
+let rec iterate1 f x () =
+ let y = f x in
+ Cons (y, iterate1 f y)
+
+(* [iterate f x] is the sequence [x, f x, ...]. *)
+
+(* The reason why we give this slightly indirect definition of [iterate],
+ as opposed to the more naive definition that may come to mind, is that
+ we are careful to avoid evaluating [f x] until this function call is
+ actually necessary. The naive definition (not shown here) computes the
+ second argument of the sequence, [f x], when the first argument is
+ requested by the user. *)
+
+let iterate f x =
+ cons x (iterate1 f x)
+
+
+
+let rec mapi_aux f i xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ Cons (f i x, mapi_aux f (i+1) xs)
+
+let[@inline] mapi f xs =
+ mapi_aux f 0 xs
+
+(* [tail_scan f s xs] is equivalent to [tail (scan f s xs)].
+ [tail_scan] is used as a building block in the definition of [scan]. *)
+
+(* This slightly indirect definition of [scan] is meant to avoid computing
+ elements too early; see the above comment about [iterate1] and [iterate]. *)
+
+let rec tail_scan f s xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ let s = f s x in
+ Cons (s, tail_scan f s xs)
+
+let scan f s xs =
+ cons s (tail_scan f s xs)
+
+(* [take] is defined in such a way that [take 0 xs] returns [empty]
+ immediately, without allocating any memory. *)
+
+let rec take_aux n xs =
+ if n = 0 then
+ empty
+ else
+ fun () ->
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ Cons (x, take_aux (n-1) xs)
+
+let take n xs =
+ if n < 0 then invalid_arg "Seq.take";
+ take_aux n xs
+
+(* [force_drop n xs] is equivalent to [drop n xs ()].
+ [force_drop n xs] requires [n > 0].
+ [force_drop] is used as a building block in the definition of [drop]. *)
+
+let rec force_drop n xs =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (_, xs) ->
+ let n = n - 1 in
+ if n = 0 then
+ xs()
+ else
+ force_drop n xs
+
+(* [drop] is defined in such a way that [drop 0 xs] returns [xs] immediately,
+ without allocating any memory. *)
+
+let drop n xs =
+ if n < 0 then invalid_arg "Seq.drop"
+ else if n = 0 then
+ xs
+ else
+ fun () ->
+ force_drop n xs
+
+let rec take_while p xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ if p x then Cons (x, take_while p xs) else Nil
+
+let rec drop_while p xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) as node ->
+ if p x then drop_while p xs () else node
+
+let rec group eq xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ Cons (cons x (take_while (eq x) xs), group eq (drop_while (eq x) xs))
+
+exception Forced_twice
+
+module Suspension = struct
+
+ type 'a suspension =
+ unit -> 'a
+
+ (* Conversions. *)
+
+ let to_lazy : 'a suspension -> 'a Lazy.t =
+ Lazy.from_fun
+ (* fun s -> lazy (s()) *)
+
+ let from_lazy (s : 'a Lazy.t) : 'a suspension =
+ fun () -> Lazy.force s
+
+ (* [memoize] turns an arbitrary suspension into a persistent suspension. *)
+
+ let memoize (s : 'a suspension) : 'a suspension =
+ from_lazy (to_lazy s)
+
+ (* [failure] is a suspension that fails when forced. *)
+
+ let failure : _ suspension =
+ fun () ->
+ (* A suspension created by [once] has been forced twice. *)
+ raise Forced_twice
+
+ (* If [f] is a suspension, then [once f] is a suspension that can be forced
+ at most once. If it is forced more than once, then [Forced_twice] is
+ raised. *)
+
+ let once (f : 'a suspension) : 'a suspension =
+ let action = CamlinternalAtomic.make f in
+ fun () ->
+ (* Get the function currently stored in [action], and write the
+ function [failure] in its place, so the next access will result
+ in a call to [failure()]. *)
+ let f = CamlinternalAtomic.exchange action failure in
+ f()
+
+end (* Suspension *)
+
+let rec memoize xs =
+ Suspension.memoize (fun () ->
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ Cons (x, memoize xs)
+ )
+
+let rec once xs =
+ Suspension.once (fun () ->
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ Cons (x, once xs)
+ )
+
+
+let rec zip xs ys () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ Nil
+ | Cons (y, ys) ->
+ Cons ((x, y), zip xs ys)
+
+let rec map2 f xs ys () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ match ys() with
+ | Nil ->
+ Nil
+ | Cons (y, ys) ->
+ Cons (f x y, map2 f xs ys)
+
+let rec interleave xs ys () =
+ match xs() with
+ | Nil ->
+ ys()
+ | Cons (x, xs) ->
+ Cons (x, interleave ys xs)
+
+(* [sorted_merge1l cmp x xs ys] is equivalent to
+ [sorted_merge cmp (cons x xs) ys].
+
+ [sorted_merge1r cmp xs y ys] is equivalent to
+ [sorted_merge cmp xs (cons y ys)].
+
+ [sorted_merge1 cmp x xs y ys] is equivalent to
+ [sorted_merge cmp (cons x xs) (cons y ys)].
+
+ These three functions are used as building blocks in the definition
+ of [sorted_merge]. *)
+
+let rec sorted_merge1l cmp x xs ys () =
+ match ys() with
+ | Nil ->
+ Cons (x, xs)
+ | Cons (y, ys) ->
+ sorted_merge1 cmp x xs y ys
+
+and sorted_merge1r cmp xs y ys () =
+ match xs() with
+ | Nil ->
+ Cons (y, ys)
+ | Cons (x, xs) ->
+ sorted_merge1 cmp x xs y ys
+
+and sorted_merge1 cmp x xs y ys =
+ if cmp x y <= 0 then
+ Cons (x, sorted_merge1r cmp xs y ys)
+ else
+ Cons (y, sorted_merge1l cmp x xs ys)
+
+let sorted_merge cmp xs ys () =
+ match xs(), ys() with
+ | Nil, Nil ->
+ Nil
+ | Nil, c
+ | c, Nil ->
+ c
+ | Cons (x, xs), Cons (y, ys) ->
+ sorted_merge1 cmp x xs y ys
+
+
+let rec map_fst xys () =
+ match xys() with
+ | Nil ->
+ Nil
+ | Cons ((x, _), xys) ->
+ Cons (x, map_fst xys)
+
+let rec map_snd xys () =
+ match xys() with
+ | Nil ->
+ Nil
+ | Cons ((_, y), xys) ->
+ Cons (y, map_snd xys)
+
+let unzip xys =
+ map_fst xys, map_snd xys
+
+let split =
+ unzip
+
+(* [filter_map_find_left_map f xs] is equivalent to
+ [filter_map Either.find_left (map f xs)]. *)
+
+let rec filter_map_find_left_map f xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ match f x with
+ | Either.Left y ->
+ Cons (y, filter_map_find_left_map f xs)
+ | Either.Right _ ->
+ filter_map_find_left_map f xs ()
+
+let rec filter_map_find_right_map f xs () =
+ match xs() with
+ | Nil ->
+ Nil
+ | Cons (x, xs) ->
+ match f x with
+ | Either.Left _ ->
+ filter_map_find_right_map f xs ()
+ | Either.Right z ->
+ Cons (z, filter_map_find_right_map f xs)
+
+let partition_map f xs =
+ filter_map_find_left_map f xs,
+ filter_map_find_right_map f xs
+
+let partition p xs =
+ filter p xs, filter (fun x -> not (p x)) xs
+
+(* If [xss] is a matrix (a sequence of rows), then [peel xss] is a pair of
+ the first column (a sequence of elements) and of the remainder of the
+ matrix (a sequence of shorter rows). These two sequences have the same
+ length. The rows of the matrix [xss] are not required to have the same
+ length. An empty row is ignored. *)
+
+(* Because [peel] uses [unzip], its argument must be persistent. The same
+ remark applies to [transpose], [diagonals], [product], etc. *)
+
+let peel xss =
+ unzip (filter_map uncons xss)
+
+let rec transpose xss () =
+ let heads, tails = peel xss in
+ if is_empty heads then begin
+ assert (is_empty tails);
+ Nil
+ end
+ else
+ Cons (heads, transpose tails)
+
+(* The internal function [diagonals] takes an extra argument, [remainders],
+ which contains the remainders of the rows that have already been
+ discovered. *)
+
+let rec diagonals remainders xss () =
+ match xss() with
+ | Cons (xs, xss) ->
+ begin match xs() with
+ | Cons (x, xs) ->
+ (* We discover a new nonempty row [x :: xs]. Thus, the next diagonal
+ is [x :: heads]: this diagonal begins with [x] and continues with
+ the first element of every row in [remainders]. In the recursive
+ call, the argument [remainders] is instantiated with [xs ::
+ tails], which means that we have one more remaining row, [xs],
+ and that we keep the tails of the pre-existing remaining rows. *)
+ let heads, tails = peel remainders in
+ Cons (cons x heads, diagonals (cons xs tails) xss)
+ | Nil ->
+ (* We discover a new empty row. In this case, the new diagonal is
+ just [heads], and [remainders] is instantiated with just [tails],
+ as we do not have one more remaining row. *)
+ let heads, tails = peel remainders in
+ Cons (heads, diagonals tails xss)
+ end
+ | Nil ->
+ (* There are no more rows to be discovered. There remains to exhaust
+ the remaining rows. *)
+ transpose remainders ()
+
+(* If [xss] is a matrix (a sequence of rows), then [diagonals xss] is
+ the sequence of its diagonals.
+
+ The first diagonal contains just the first element of the
+ first row. The second diagonal contains the first element of the
+ second row and the second element of the first row; and so on.
+ This kind of diagonal is in fact sometimes known as an antidiagonal.
+
+ - Every diagonal is a finite sequence.
+ - The rows of the matrix [xss] are not required to have the same length.
+ - The matrix [xss] is not required to be finite (in either direction).
+ - The matrix [xss] must be persistent. *)
+
+let diagonals xss =
+ diagonals empty xss
+
+let map_product f xs ys =
+ concat (diagonals (
+ map (fun x ->
+ map (fun y ->
+ f x y
+ ) ys
+ ) xs
+ ))
+
+let product xs ys =
+ map_product (fun x y -> (x, y)) xs ys
+
+let of_dispenser it =
+ let rec c () =
+ match it() with
+ | None ->
+ Nil
+ | Some x ->
+ Cons (x, c)
+ in
+ c
+
+let to_dispenser xs =
+ let s = ref xs in
+ fun () ->
+ match (!s)() with
+ | Nil ->
+ None
+ | Cons (x, xs) ->
+ s := xs;
+ Some x
+
+
+
+let rec ints i () =
+ Cons (i, ints (i + 1))
(* *)
(**************************************************************************)
-(** Sequences (functional iterators).
+(** Sequences.
- The type ['a Seq.t] is a {b delayed list}, i.e. a list where some
- evaluation is needed to access the next element. This makes it possible
- to build infinite sequences, to build sequences as we traverse them, and
- to transform them in a lazy fashion rather than upfront.
+ A sequence of type ['a Seq.t] can be thought of as a {b delayed list},
+ that is, a list whose elements are computed only when they are demanded
+ by a consumer. This allows sequences to be produced and transformed
+ lazily (one element at a time) rather than eagerly (all elements at
+ once). This also allows constructing conceptually infinite sequences.
- @since 4.07
-*)
+ The type ['a Seq.t] is defined as a synonym for [unit -> 'a Seq.node].
+ This is a function type: therefore, it is opaque. The consumer can {b
+ query} a sequence in order to request the next element (if there is
+ one), but cannot otherwise inspect the sequence in any way.
+
+ Because it is opaque, the type ['a Seq.t] does {i not} reveal whether
+ a sequence is:
+ - {b persistent},
+ which means that the sequence can be used as many times as desired,
+ producing the same elements every time,
+ just like an immutable list; or
+ - {b ephemeral},
+ which means that the sequence is not persistent.
+ Querying an ephemeral sequence might have an observable side effect,
+ such as incrementing a mutable counter.
+ As a common special case, an ephemeral sequence can be {b affine},
+ which means that it must be queried at most once.
+
+ It also does {i not} reveal whether the elements of the sequence are:
+
+ - {b pre-computed and stored} in memory,
+ which means that querying the sequence is cheap;
+ - {b computed when first demanded and then stored} in memory,
+ which means that querying the sequence once can be expensive,
+ but querying the same sequence again is cheap; or
+ - {b re-computed every time they are demanded},
+ which may or may not be cheap.
+
+ It is up to the programmer to keep these distinctions in mind
+ so as to understand the time and space requirements of sequences.
+
+ For the sake of simplicity, most of the documentation that follows
+ is written under the implicit assumption that the sequences at hand
+ are persistent.
+ We normally do not point out {i when} or {i how many times}
+ each function is invoked, because that would be too verbose.
+ For instance, in the description of [map], we write:
+ "if [xs] is the sequence [x0; x1; ...]
+ then [map f xs] is the sequence [f x0; f x1; ...]".
+ If we wished to be more explicit,
+ we could point out that the transformation takes place on demand:
+ that is, the elements of [map f xs] are computed only when they
+ are demanded. In other words,
+ the definition [let ys = map f xs] terminates immediately and
+ does not invoke [f]. The function call [f x0] takes place only when the
+ first element of [ys] is demanded, via the function call [ys()].
+ Furthermore, calling [ys()] twice causes [f x0] to be called twice
+ as well. If one wishes for [f] to be applied at most once to each
+ element of [xs], even in scenarios where [ys] is queried more than once,
+ then one should use [let ys = memoize (map f xs)].
+
+ As a general rule, the functions that build sequences, such as [map],
+ [filter], [scan], [take], etc., produce sequences whose elements are
+ computed only on demand. The functions that eagerly consume sequences,
+ such as [is_empty], [find], [length], [iter], [fold_left],
+ etc., are the functions that force computation to take place.
+
+ When possible, we recommend using sequences rather than dispensers
+ (functions of type [unit -> 'a option] that produce elements upon
+ demand). Whereas sequences can be persistent or ephemeral, dispensers
+ are always ephemeral, and are typically more difficult to work with
+ than sequences. Two conversion functions, {!to_dispenser} and
+ {!of_dispenser}, are provided.
+
+ @since 4.07 *)
type 'a t = unit -> 'a node
-(** The type of delayed lists containing elements of type ['a].
- Note that the concrete list node ['a node] is delayed under a closure,
- not a [lazy] block, which means it might be recomputed every time
- we access it. *)
+(** A sequence [xs] of type ['a t] is a delayed list of elements of
+ type ['a]. Such a sequence is queried by performing a function
+ application [xs()]. This function application returns a node,
+ allowing the caller to determine whether the sequence is empty
+ or nonempty, and in the latter case, to obtain its head and tail. *)
and +'a node =
| Nil
| Cons of 'a * 'a t (**)
-(** A fully-evaluated list node, either empty or containing an element
- and a delayed tail. *)
+(** A node is either [Nil], which means that the sequence is empty,
+ or [Cons (x, xs)], which means that [x] is the first element
+ of the sequence and that [xs] is the remainder of the sequence. *)
+
+(** {1 Consuming sequences} *)
+
+(**
+
+ The functions in this section consume their argument, a sequence, either
+ partially or completely:
+ - [is_empty] and [uncons] consume the sequence down to depth 1.
+ That is, they demand the first argument of the sequence, if there is one.
+ - [iter], [fold_left], [length], etc., consume the sequence all the way to
+ its end. They terminate only if the sequence is finite.
+ - [for_all], [exists], [find], etc. consume the sequence down to a certain
+ depth, which is a priori unpredictable.
+
+ Similarly, among the functions that consume two sequences,
+ one can distinguish two groups:
+ - [iter2] and [fold_left2] consume both sequences all the way
+ to the end, provided the sequences have the same length.
+ - [for_all2], [exists2], [equal], [compare] consume the sequences down
+ to a certain depth, which is a priori unpredictable.
+
+ The functions that consume two sequences can be applied to two sequences
+ of distinct lengths: in that case, the excess elements in the longer
+ sequence are ignored. (It may be the case that one excess element is
+ demanded, even though this element is not used.)
+
+ None of the functions in this section is lazy. These functions
+ are consumers: they force some computation to take place. *)
+
+val is_empty : 'a t -> bool
+(** [is_empty xs] determines whether the sequence [xs] is empty.
+
+ It is recommended that the sequence [xs] be persistent.
+ Indeed, [is_empty xs] demands the head of the sequence [xs],
+ so, if [xs] is ephemeral, it may be the case that [xs] cannot
+ be used any more after this call has taken place.
+
+ @since 4.14 *)
+
+val uncons : 'a t -> ('a * 'a t) option
+(** If [xs] is empty, then [uncons xs] is [None].
+
+ If [xs] is nonempty, then [uncons xs] is
+ [Some (head xs, tail xs)],
+ that is, a pair of the head and tail of the sequence [xs].
+
+ This equivalence holds if [xs] is persistent.
+ If [xs] is ephemeral, then [uncons] must be preferred
+ over separate calls to [head] and [tail],
+ which would cause [xs] to be queried twice.
+
+ @since 4.14 *)
+
+val length : 'a t -> int
+(** [length xs] is the length of the sequence [xs].
+
+ The sequence [xs] must be finite.
+
+ @since 4.14 *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [iter f xs] invokes [f x] successively
+ for every element [x] of the sequence [xs],
+ from left to right.
+
+ It terminates only if the sequence [xs] is finite. *)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+(** [fold_left f _ xs] invokes [f _ x] successively
+ for every element [x] of the sequence [xs],
+ from left to right.
+
+ An accumulator of type ['a] is threaded through the calls to [f].
+
+ It terminates only if the sequence [xs] is finite. *)
+
+val iteri : (int -> 'a -> unit) -> 'a t -> unit
+(** [iteri f xs] invokes [f i x] successively
+ for every element [x] located at index [i] in the sequence [xs].
+
+ It terminates only if the sequence [xs] is finite.
+
+ [iteri f xs] is equivalent to
+ [iter (fun (i, x) -> f i x) (zip (ints 0) xs)].
+
+ @since 4.14 *)
+
+val fold_lefti : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
+(** [fold_lefti f _ xs] invokes [f _ i x] successively
+ for every element [x] located at index [i] of the sequence [xs].
+
+ An accumulator of type ['b] is threaded through the calls to [f].
+
+ It terminates only if the sequence [xs] is finite.
+
+ [fold_lefti f accu xs] is equivalent to
+ [fold_left (fun accu (i, x) -> f accu i x) accu (zip (ints 0) xs)].
+
+ @since 4.14 *)
+
+val for_all : ('a -> bool) -> 'a t -> bool
+(** [for_all p xs] determines whether all elements [x] of the sequence [xs]
+ satisfy [p x].
+
+ The sequence [xs] must be finite.
+
+ @since 4.14 *)
+
+val exists : ('a -> bool) -> 'a t -> bool
+(** [exists xs p] determines whether at least one element [x]
+ of the sequence [xs] satisfies [p x].
+
+ The sequence [xs] must be finite.
+
+ @since 4.14 *)
+
+val find : ('a -> bool) -> 'a t -> 'a option
+(** [find p xs] returns [Some x], where [x] is the first element of the
+ sequence [xs] that satisfies [p x], if there is such an element.
+
+ It returns [None] if there is no such element.
+
+ The sequence [xs] must be finite.
+
+ @since 4.14 *)
+
+val find_map : ('a -> 'b option) -> 'a t -> 'b option
+(** [find_map f xs] returns [Some y], where [x] is the first element of the
+ sequence [xs] such that [f x = Some _], if there is such an element,
+ and where [y] is defined by [f x = Some y].
+
+ It returns [None] if there is no such element.
+
+ The sequence [xs] must be finite.
+
+ @since 4.14 *)
+
+val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
+(** [iter2 f xs ys] invokes [f x y] successively for every pair [(x, y)] of
+ elements drawn synchronously from the sequences [xs] and [ys].
+
+ If the sequences [xs] and [ys] have different lengths, then
+ iteration stops as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
+
+ Iteration terminates only if at least one of the sequences
+ [xs] and [ys] is finite.
+
+ [iter2 f xs ys] is equivalent to
+ [iter (fun (x, y) -> f x y) (zip xs ys)].
+
+ @since 4.14 *)
+
+val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b t -> 'c t -> 'a
+(** [fold_left2 f _ xs ys] invokes [f _ x y] successively
+ for every pair [(x, y)] of elements drawn synchronously
+ from the sequences [xs] and [ys].
+
+ An accumulator of type ['a] is threaded through the calls to [f].
+
+ If the sequences [xs] and [ys] have different lengths, then
+ iteration stops as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
+
+ Iteration terminates only if at least one of the sequences
+ [xs] and [ys] is finite.
+
+ [fold_left2 f accu xs ys] is equivalent to
+ [fold_left (fun accu (x, y) -> f accu x y) (zip xs ys)].
+
+ @since 4.14 *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [for_all2 p xs ys] determines whether all pairs [(x, y)] of elements
+ drawn synchronously from the sequences [xs] and [ys] satisfy [p x y].
+
+ If the sequences [xs] and [ys] have different lengths, then
+ iteration stops as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
+ In particular, if [xs] or [ys] is empty, then
+ [for_all2 p xs ys] is true. This is where
+ [for_all2] and [equal] differ: [equal eq xs ys] can
+ be true only if [xs] and [ys] have the same length.
+
+ At least one of the sequences [xs] and [ys] must be finite.
+
+ [for_all2 p xs ys] is equivalent to [for_all (fun b -> b) (map2 p xs ys)].
+
+ @since 4.14 *)
+
+val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** [exists2 p xs ys] determines whether some pair [(x, y)] of elements
+ drawn synchronously from the sequences [xs] and [ys] satisfies [p x y].
+
+ If the sequences [xs] and [ys] have different lengths, then
+ iteration must stop as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
+
+ At least one of the sequences [xs] and [ys] must be finite.
+
+ [exists2 p xs ys] is equivalent to [exists (fun b -> b) (map2 p xs ys)].
+
+ @since 4.14 *)
+
+val equal : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+(** Provided the function [eq] defines an equality on elements,
+ [equal eq xs ys] determines whether the sequences [xs] and [ys]
+ are pointwise equal.
+
+ At least one of the sequences [xs] and [ys] must be finite.
+
+ @since 4.14 *)
+
+val compare : ('a -> 'b -> int) -> 'a t -> 'b t -> int
+(** Provided the function [cmp] defines a preorder on elements,
+ [compare cmp xs ys] compares the sequences [xs] and [ys]
+ according to the lexicographic preorder.
+
+ For more details on comparison functions, see {!Array.sort}.
+
+ At least one of the sequences [xs] and [ys] must be finite.
+
+ @since 4.14 *)
+
+(** {1 Constructing sequences} *)
+
+(** The functions in this section are lazy: that is, they return sequences
+ whose elements are computed only when demanded. *)
val empty : 'a t
-(** The empty sequence, containing no elements. *)
+(** [empty] is the empty sequence.
+ It has no elements. Its length is 0. *)
val return : 'a -> 'a t
-(** The singleton sequence containing only the given element. *)
+(** [return x] is the sequence whose sole element is [x].
+ Its length is 1. *)
val cons : 'a -> 'a t -> 'a t
-(** [cons x xs] is the sequence containing the element [x] followed by
- the sequence [xs] @since 4.11 *)
+(** [cons x xs] is the sequence that begins with the element [x],
+ followed with the sequence [xs].
+
+ Writing [cons (f()) xs] causes the function call [f()]
+ to take place immediately. For this call to be delayed until the
+ sequence is queried, one must instead write
+ [(fun () -> Cons(f(), xs))].
+
+ @since 4.11 *)
+
+val init : int -> (int -> 'a) -> 'a t
+(** [init n f] is the sequence [f 0; f 1; ...; f (n-1)].
+
+ [n] must be nonnegative.
+
+ If desired, the infinite sequence [f 0; f 1; ...]
+ can be defined as [map f (ints 0)].
+
+ @raise Invalid_argument if [n] is negative.
+
+ @since 4.14 *)
+
+val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
+(** [unfold] constructs a sequence
+ out of a step function and an initial state.
+
+ If [f u] is [None] then
+ [unfold f u] is the empty sequence.
+ If [f u] is [Some (x, u')] then
+ [unfold f u] is the nonempty sequence [cons x (unfold f u')].
+
+ For example, [unfold (function [] -> None | h :: t -> Some (h, t)) l]
+ is equivalent to [List.to_seq l].
-val append : 'a t -> 'a t -> 'a t
-(** [append xs ys] is the sequence [xs] followed by the sequence [ys]
@since 4.11 *)
+val repeat : 'a -> 'a t
+(** [repeat x] is the infinite sequence
+ where the element [x] is repeated indefinitely.
+
+ [repeat x] is equivalent to [cycle (return x)].
+
+ @since 4.14 *)
+
+val forever : (unit -> 'a) -> 'a t
+(** [forever f] is an infinite sequence where every element is produced
+ (on demand) by the function call [f()].
+
+ For instance,
+ [forever Random.bool] is an infinite sequence of random bits.
+
+ [forever f] is equivalent to [map f (repeat ())].
+
+ @since 4.14 *)
+
+val cycle : 'a t -> 'a t
+(** [cycle xs] is the infinite sequence that consists of an infinite
+ number of repetitions of the sequence [xs].
+
+ If [xs] is an empty sequence,
+ then [cycle xs] is empty as well.
+
+ Consuming (a prefix of) the sequence [cycle xs] once
+ can cause the sequence [xs] to be consumed more than once.
+ Therefore, [xs] must be persistent.
+
+ @since 4.14 *)
+
+val iterate : ('a -> 'a) -> 'a -> 'a t
+(** [iterate f x] is the infinite sequence whose elements are
+ [x], [f x], [f (f x)], and so on.
+
+ In other words, it is the orbit of the function [f],
+ starting at [x].
+
+ @since 4.14 *)
+
+(** {1 Transforming sequences} *)
+
+(** The functions in this section are lazy: that is, they return sequences
+ whose elements are computed only when demanded. *)
+
val map : ('a -> 'b) -> 'a t -> 'b t
-(** [map f seq] returns a new sequence whose elements are the elements of
- [seq], transformed by [f].
- This transformation is lazy, it only applies when the result is traversed.
+(** [map f xs] is the image of the sequence [xs] through the
+ transformation [f].
+
+ If [xs] is the sequence [x0; x1; ...] then
+ [map f xs] is the sequence [f x0; f x1; ...]. *)
- If [seq = [1;2;3]], then [map f seq = [f 1; f 2; f 3]]. *)
+val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
+(** [mapi] is analogous to [map], but applies the function [f] to
+ an index and an element.
+
+ [mapi f xs] is equivalent to [map2 f (ints 0) xs].
+
+ @since 4.14 *)
val filter : ('a -> bool) -> 'a t -> 'a t
-(** Remove from the sequence the elements that do not satisfy the
- given predicate.
- This transformation is lazy, it only applies when the result is
- traversed. *)
+(** [filter p xs] is the sequence of the elements [x] of [xs]
+ that satisfy [p x].
+
+ In other words, [filter p xs] is the sequence [xs],
+ deprived of the elements [x] such that [p x] is false. *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
-(** Apply the function to every element; if [f x = None] then [x] is dropped;
- if [f x = Some y] then [y] is returned.
- This transformation is lazy, it only applies when the result is
- traversed. *)
+(** [filter_map f xs] is the sequence of the elements [y] such that
+ [f x = Some y], where [x] ranges over [xs].
+
+ [filter_map f xs] is equivalent to
+ [map Option.get (filter Option.is_some (map f xs))]. *)
+
+val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
+(** If [xs] is a sequence [[x0; x1; x2; ...]], then
+ [scan f a0 xs] is a sequence of accumulators
+ [[a0; a1; a2; ...]]
+ where [a1] is [f a0 x0], [a2] is [f a1 x1], and so on.
+
+ Thus, [scan f a0 xs] is conceptually related to
+ [fold_left f a0 xs]. However, instead of performing an
+ eager iteration and immediately returning the final accumulator,
+ it returns a sequence of accumulators.
+
+ For instance, [scan (+) 0] transforms a sequence of integers
+ into the sequence of its partial sums.
+
+ If [xs] has length [n]
+ then [scan f a0 xs] has length [n+1].
+
+ @since 4.14 *)
+
+val take : int -> 'a t -> 'a t
+(** [take n xs] is the sequence of the first [n] elements of [xs].
+
+ If [xs] has fewer than [n] elements,
+ then [take n xs] is equivalent to [xs].
+
+ [n] must be nonnegative.
+
+ @raise Invalid_argument if [n] is negative.
+
+ @since 4.14 *)
+
+val drop : int -> 'a t -> 'a t
+(** [drop n xs] is the sequence [xs], deprived of its first [n] elements.
+
+ If [xs] has fewer than [n] elements,
+ then [drop n xs] is empty.
+
+ [n] must be nonnegative.
+
+ [drop] is lazy: the first [n+1] elements of the sequence [xs]
+ are demanded only when the first element of [drop n xs] is
+ demanded. For this reason, [drop 1 xs] is {i not} equivalent
+ to [tail xs], which queries [xs] immediately.
+
+ @raise Invalid_argument if [n] is negative.
+
+ @since 4.14 *)
+
+val take_while : ('a -> bool) -> 'a t -> 'a t
+(** [take_while p xs] is the longest prefix of the sequence [xs]
+ where every element [x] satisfies [p x].
+
+ @since 4.14 *)
+
+val drop_while : ('a -> bool) -> 'a t -> 'a t
+(** [drop_while p xs] is the sequence [xs], deprived of the prefix
+ [take_while p xs].
+
+ @since 4.14 *)
+
+val group : ('a -> 'a -> bool) -> 'a t -> 'a t t
+(** Provided the function [eq] defines an equality on elements,
+ [group eq xs] is the sequence of the maximal runs
+ of adjacent duplicate elements of the sequence [xs].
+
+ Every element of [group eq xs] is a nonempty sequence of equal elements.
+
+ The concatenation [concat (group eq xs)] is equal to [xs].
+
+ Consuming [group eq xs], and consuming the sequences that it contains,
+ can cause [xs] to be consumed more than once. Therefore, [xs] must be
+ persistent.
+
+ @since 4.14 *)
+
+val memoize : 'a t -> 'a t
+(** The sequence [memoize xs] has the same elements as the sequence [xs].
+
+ Regardless of whether [xs] is ephemeral or persistent,
+ [memoize xs] is persistent: even if it is queried several times,
+ [xs] is queried at most once.
+
+ The construction of the sequence [memoize xs] internally relies on
+ suspensions provided by the module {!Lazy}. These suspensions are
+ {i not} thread-safe. Therefore, the sequence [memoize xs]
+ must {i not} be queried by multiple threads concurrently.
+
+ @since 4.14 *)
+
+exception Forced_twice
+(** This exception is raised when a sequence returned by {!once}
+ (or a suffix of it) is queried more than once.
+
+ @since 4.14 *)
+
+val once : 'a t -> 'a t
+(** The sequence [once xs] has the same elements as the sequence [xs].
+
+ Regardless of whether [xs] is ephemeral or persistent,
+ [once xs] is an ephemeral sequence: it can be queried at most once.
+ If it (or a suffix of it) is queried more than once, then the exception
+ [Forced_twice] is raised. This can be useful, while debugging or testing,
+ to ensure that a sequence is consumed at most once.
+
+ @raise Forced_twice if [once xs], or a suffix of it,
+ is queried more than once.
+
+ @since 4.14 *)
+
+val transpose : 'a t t -> 'a t t
+(** If [xss] is a matrix (a sequence of rows), then [transpose xss] is
+ the sequence of the columns of the matrix [xss].
+
+ The rows of the matrix [xss] are not required to have the same length.
+
+ The matrix [xss] is not required to be finite (in either direction).
+
+ The matrix [xss] must be persistent.
+
+ @since 4.14 *)
+
+(** {1 Combining sequences} *)
+
+val append : 'a t -> 'a t -> 'a t
+(** [append xs ys] is the concatenation of the sequences [xs] and [ys].
+
+ Its elements are the elements of [xs], followed by the elements of [ys].
+
+ @since 4.11 *)
val concat : 'a t t -> 'a t
-(** concatenate a sequence of sequences.
+(** If [xss] is a sequence of sequences,
+ then [concat xss] is its concatenation.
+
+ If [xss] is the sequence [xs0; xs1; ...] then
+ [concat xss] is the sequence [xs0 @ xs1 @ ...].
- @since 4.13
- *)
+ @since 4.13 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
-(** Map each element to a subsequence, then return each element of this
- sub-sequence in turn.
- This transformation is lazy, it only applies when the result is
- traversed. *)
+(** [flat_map f xs] is equivalent to [concat (map f xs)]. *)
val concat_map : ('a -> 'b t) -> 'a t -> 'b t
-(** Alias for {!flat_map}.
+(** [concat_map f xs] is equivalent to [concat (map f xs)].
- @since 4.13
-*)
+ [concat_map] is an alias for [flat_map].
-val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
-(** Traverse the sequence from left to right, combining each element with the
- accumulator using the given function.
- The traversal happens immediately and will not terminate on infinite
- sequences.
+ @since 4.13 *)
- Also see {!List.fold_left} *)
+val zip : 'a t -> 'b t -> ('a * 'b) t
+(** [zip xs ys] is the sequence of pairs [(x, y)]
+ drawn synchronously from the sequences [xs] and [ys].
-val iter : ('a -> unit) -> 'a t -> unit
-(** Iterate on the sequence, calling the (imperative) function on every element.
- The traversal happens immediately and will not terminate on infinite
- sequences. *)
+ If the sequences [xs] and [ys] have different lengths, then
+ the sequence ends as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
-val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
-(** Build a sequence from a step function and an initial value.
- [unfold f u] returns [empty] if [f u] returns [None],
- or [fun () -> Cons (x, unfold f y)] if [f u] returns [Some (x, y)].
+ [zip xs ys] is equivalent to [map2 (fun a b -> (a, b)) xs ys].
- For example, [unfold (function [] -> None | h::t -> Some (h,t)) l]
- is equivalent to [List.to_seq l].
- @since 4.11 *)
+ @since 4.14 *)
+
+val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** [map2 f xs ys] is the sequence of the elements [f x y],
+ where the pairs [(x, y)] are drawn synchronously from the
+ sequences [xs] and [ys].
+
+ If the sequences [xs] and [ys] have different lengths, then
+ the sequence ends as soon as one sequence is exhausted;
+ the excess elements in the other sequence are ignored.
+
+ [map2 f xs ys] is equivalent to [map (fun (x, y) -> f x y) (zip xs ys)].
+
+ @since 4.14 *)
+
+val interleave : 'a t -> 'a t -> 'a t
+(** [interleave xs ys] is the sequence that begins with the first element of
+ [xs], continues with the first element of [ys], and so on.
+
+ When one of the sequences [xs] and [ys] is exhausted,
+ [interleave xs ys] continues with the rest of the other sequence.
+
+ @since 4.14 *)
+
+val sorted_merge : ('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
+(** If the sequences [xs] and [ys] are sorted according to the total preorder
+ [cmp], then [sorted_merge cmp xs ys] is the sorted sequence obtained by
+ merging the sequences [xs] and [ys].
+
+ For more details on comparison functions, see {!Array.sort}.
+
+ @since 4.14 *)
+
+val product : 'a t -> 'b t -> ('a * 'b) t
+(** [product xs ys] is the Cartesian product of the sequences [xs] and [ys].
+
+ For every element [x] of [xs] and for every element [y] of [ys],
+ the pair [(x, y)] appears once as an element of [product xs ys].
+
+ The order in which the pairs appear is unspecified.
+
+ The sequences [xs] and [ys] are not required to be finite.
+
+ The sequences [xs] and [ys] must be persistent.
+
+ @since 4.14 *)
+
+val map_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** The sequence [map_product f xs ys] is the image through [f]
+ of the Cartesian product of the sequences [xs] and [ys].
+
+ For every element [x] of [xs] and for every element [y] of [ys],
+ the element [f x y] appears once as an element of [map_product f xs ys].
+
+ The order in which these elements appear is unspecified.
+
+ The sequences [xs] and [ys] are not required to be finite.
+
+ The sequences [xs] and [ys] must be persistent.
+
+ [map_product f xs ys] is equivalent to
+ [map (fun (x, y) -> f x y) (product xs ys)].
+
+ @since 4.14 *)
+
+(** {1 Splitting a sequence into two sequences} *)
+
+val unzip : ('a * 'b) t -> 'a t * 'b t
+(** [unzip] transforms a sequence of pairs into a pair of sequences.
+
+ [unzip xs] is equivalent to [(map fst xs, map snd xs)].
+
+ Querying either of the sequences returned by [unzip xs]
+ causes [xs] to be queried.
+ Therefore, querying both of them
+ causes [xs] to be queried twice.
+ Thus, [xs] must be persistent and cheap.
+ If that is not the case, use [unzip (memoize xs)].
+
+ @since 4.14 *)
+
+val split : ('a * 'b) t -> 'a t * 'b t
+(** [split] is an alias for [unzip].
+
+ @since 4.14 *)
+
+val partition_map : ('a -> ('b, 'c) Either.t) -> 'a t -> 'b t * 'c t
+(** [partition_map f xs] returns a pair of sequences [(ys, zs)], where:
+
+ - [ys] is the sequence of the elements [y] such that
+ [f x = Left y], where [x] ranges over [xs];
+
+ - [zs] is the sequence of the elements [z] such that
+ [f x = Right z], where [x] ranges over [xs].
+
+ [partition_map f xs] is equivalent to a pair of
+ [filter_map Either.find_left (map f xs)] and
+ [filter_map Either.find_right (map f xs)].
+
+ Querying either of the sequences returned by [partition_map f xs]
+ causes [xs] to be queried.
+ Therefore, querying both of them
+ causes [xs] to be queried twice.
+ Thus, [xs] must be persistent and cheap.
+ If that is not the case, use [partition_map f (memoize xs)].
+
+ @since 4.14 *)
+
+val partition : ('a -> bool) -> 'a t -> 'a t * 'a t
+(** [partition p xs] returns a pair of the subsequence of the elements
+ of [xs] that satisfy [p] and the subsequence of the elements of
+ [xs] that do not satisfy [p].
+
+ [partition p xs] is equivalent to
+ [filter p xs, filter (fun x -> not (p x)) xs].
+
+ Consuming both of the sequences returned by [partition p xs] causes
+ [xs] to be consumed twice and causes the function [f] to be applied
+ twice to each element of the list.
+ Therefore, [f] should be pure and cheap.
+ Furthermore, [xs] should be persistent and cheap.
+ If that is not the case, use [partition p (memoize xs)].
+
+ @since 4.14 *)
+
+(** {1 Converting between sequences and dispensers} *)
+
+(** A dispenser is a representation of a sequence as a function of type
+ [unit -> 'a option]. Every time this function is invoked, it returns
+ the next element of the sequence. When there are no more elements,
+ it returns [None]. A dispenser has mutable internal state, therefore
+ is ephemeral: the sequence that it represents can be consumed at most
+ once. *)
+
+val of_dispenser : (unit -> 'a option) -> 'a t
+(** [of_dispenser it] is the sequence of the elements produced by the
+ dispenser [it]. It is an ephemeral sequence: it can be consumed at most
+ once. If a persistent sequence is needed, use
+ [memoize (of_dispenser it)].
+
+ @since 4.14 *)
+
+val to_dispenser : 'a t -> (unit -> 'a option)
+(** [to_dispenser xs] is a fresh dispenser on the sequence [xs].
+
+ This dispenser has mutable internal state,
+ which is not protected by a lock;
+ so, it must not be used by several threads concurrently.
+
+ @since 4.14 *)
+
+(** {1 Sequences of integers} *)
+
+val ints : int -> int t
+(** [ints i] is the infinite sequence of the integers beginning at [i] and
+ counting up.
+
+ @since 4.14 *)
(** Return the list of all elements of the given set.
The returned list is sorted in increasing order with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}. *)
+ given to {!Stdlib.Set.Make}. *)
val min_elt: t -> elt
(** Return the smallest element of the given set
*)
val max_elt: t -> elt
- (** Same as {!S.min_elt}, but returns the largest element of the
+ (** Same as {!min_elt}, but returns the largest element of the
given set. *)
val max_elt_opt: t -> elt option
- (** Same as {!S.min_elt_opt}, but returns the largest element of the
+ (** Same as {!min_elt_opt}, but returns the largest element of the
given set.
@since 4.05
*)
module Gc = Gc
module Genlex = Genlex
module Hashtbl = Hashtbl
+module In_channel = In_channel
module Int = Int
module Int32 = Int32
module Int64 = Int64
module Obj = Obj
module Oo = Oo
module Option = Option
+module Out_channel = Out_channel
module Parsing = Parsing
module Pervasives = Pervasives
module Printexc = Printexc
val read_line : unit -> string
(** Flush standard output, then read characters from standard input
- until a newline character is encountered. Return the string of
- all characters read, without the newline character at the end. *)
+ until a newline character is encountered.
+
+ Return the string of all characters read, without the newline character
+ at the end.
+
+ @raise End_of_file if the end of the file is reached at the beginning of
+ line.
+*)
val read_int_opt: unit -> int option
(** Flush standard output, then read one line from standard input
val input_byte : in_channel -> int
(** Same as {!Stdlib.input_char}, but return the 8-bit integer representing
the character.
- @raise End_of_file if an end of file was reached. *)
+ @raise End_of_file if the end of file was reached. *)
val input_binary_int : in_channel -> int
(** Read an integer encoded in binary format (4 bytes, big-endian)
from the given input channel. See {!Stdlib.output_binary_int}.
- @raise End_of_file if an end of file was reached while reading the
+ @raise End_of_file if the end of file was reached while reading the
integer. *)
val input_value : in_channel -> 'a
For [printf]-style functions from module {!Printf}, ['b] is typically
[out_channel];
for [printf]-style functions from module {!Format}, ['b] is typically
- {!Format.formatter};
+ {!type:Format.formatter};
for [scanf]-style functions from module {!Scanf}, ['b] is typically
{!Scanf.Scanning.in_channel}.
module Fun = Fun
module Gc = Gc
module Genlex = Genlex
+[@@deprecated "Use the camlp-streams library instead."]
module Hashtbl = Hashtbl
+module In_channel = In_channel
module Int = Int
module Int32 = Int32
module Int64 = Int64
module Obj = Obj
module Oo = Oo
module Option = Option
+module Out_channel = Out_channel
module Parsing = Parsing
module Pervasives = Pervasives
[@@deprecated "Use Stdlib instead.\n\
module Stack = Stack
module StdLabels = StdLabels
module Stream = Stream
+[@@deprecated "Use the camlp-streams library instead."]
module String = String
module StringLabels = StringLabels
module Sys = Sys
let of_seq g = B.of_seq g |> bts
+(* UTF decoders and validators *)
+
+let get_utf_8_uchar s i = B.get_utf_8_uchar (bos s) i
+let is_valid_utf_8 s = B.is_valid_utf_8 (bos s)
+
+let get_utf_16be_uchar s i = B.get_utf_16be_uchar (bos s) i
+let is_valid_utf_16be s = B.is_valid_utf_16be (bos s)
+
+let get_utf_16le_uchar s i = B.get_utf_16le_uchar (bos s) i
+let is_valid_utf_16le s = B.is_valid_utf_16le (bos s)
+
(** {6 Binary encoding/decoding of integers} *)
external get_uint8 : string -> int -> int = "%string_safe_get"
@since 4.07 *)
+(** {1:utf UTF decoding and validations}
+
+ @since 4.14 *)
+
+(** {2:utf_8 UTF-8} *)
+
+val get_utf_8_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_8_uchar b i] decodes an UTF-8 character at index [i] in
+ [b]. *)
+
+val is_valid_utf_8 : t -> bool
+(** [is_valid_utf_8 b] is [true] if and only if [b] contains valid
+ UTF-8 data. *)
+
+(** {2:utf_16be UTF-16BE} *)
+
+val get_utf_16be_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16be_uchar b i] decodes an UTF-16BE character at index
+ [i] in [b]. *)
+
+val is_valid_utf_16be : t -> bool
+(** [is_valid_utf_16be b] is [true] if and only if [b] contains valid
+ UTF-16BE data. *)
+
+(** {2:utf_16le UTF-16LE} *)
+
+val get_utf_16le_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16le_uchar b i] decodes an UTF-16LE character at index
+ [i] in [b]. *)
+
+val is_valid_utf_16le : t -> bool
+(** [is_valid_utf_16le b] is [true] if and only if [b] contains valid
+ UTF-16LE data. *)
+
(** {1:deprecated Deprecated functions} *)
external create : int -> bytes = "caml_create_string"
@since 4.07 *)
+(** {1:utf UTF decoding and validations}
+
+ @since 4.14 *)
+
+(** {2:utf_8 UTF-8} *)
+
+val get_utf_8_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_8_uchar b i] decodes an UTF-8 character at index [i] in
+ [b]. *)
+
+val is_valid_utf_8 : t -> bool
+(** [is_valid_utf_8 b] is [true] if and only if [b] contains valid
+ UTF-8 data. *)
+
+(** {2:utf_16be UTF-16BE} *)
+
+val get_utf_16be_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16be_uchar b i] decodes an UTF-16BE character at index
+ [i] in [b]. *)
+
+val is_valid_utf_16be : t -> bool
+(** [is_valid_utf_16be b] is [true] if and only if [b] contains valid
+ UTF-16BE data. *)
+
+(** {2:utf_16le UTF-16LE} *)
+
+val get_utf_16le_uchar : t -> int -> Uchar.utf_decode
+(** [get_utf_16le_uchar b i] decodes an UTF-16LE character at index
+ [i] in [b]. *)
+
+val is_valid_utf_16le : t -> bool
+(** [is_valid_utf_16le b] is [true] if and only if [b] contains valid
+ UTF-16LE data. *)
+
(** {1:deprecated Deprecated functions} *)
external create : int -> bytes = "caml_create_string"
--- /dev/null
+(* @configure_input@ *)
+#2 "stdlib/sys.ml.in"
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type backend_type =
+ | Native
+ | Bytecode
+ | Other of string
+(* System interface *)
+
+external get_config: unit -> string * int * bool = "caml_sys_get_config"
+external get_executable_name : unit -> string = "caml_sys_executable_name"
+external argv : string array = "%sys_argv"
+external big_endian : unit -> bool = "%big_endian"
+external word_size : unit -> int = "%word_size"
+external int_size : unit -> int = "%int_size"
+external max_wosize : unit -> int = "%max_wosize"
+external unix : unit -> bool = "%ostype_unix"
+external win32 : unit -> bool = "%ostype_win32"
+external cygwin : unit -> bool = "%ostype_cygwin"
+external get_backend_type : unit -> backend_type = "%backend_type"
+
+let executable_name = get_executable_name()
+let (os_type, _, _) = get_config()
+let backend_type = get_backend_type ()
+let big_endian = big_endian ()
+let word_size = word_size ()
+let int_size = int_size ()
+let unix = unix ()
+let win32 = win32 ()
+let cygwin = cygwin ()
+let max_array_length = max_wosize ()
+let max_floatarray_length = max_array_length / (64 / word_size)
+let max_string_length = word_size / 8 * max_array_length - 1
+external runtime_variant : unit -> string = "caml_runtime_variant"
+external runtime_parameters : unit -> string = "caml_runtime_parameters"
+
+external file_exists: string -> bool = "caml_sys_file_exists"
+external is_directory : string -> bool = "caml_sys_is_directory"
+external remove: string -> unit = "caml_sys_remove"
+external rename : string -> string -> unit = "caml_sys_rename"
+external getenv: string -> string = "caml_sys_getenv"
+
+let getenv_opt s =
+ (* TODO: expose a non-raising primitive directly. *)
+ try Some (getenv s)
+ with Not_found -> None
+
+external command: string -> int = "caml_sys_system_command"
+external time: unit -> (float [@unboxed]) =
+ "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
+external chdir: string -> unit = "caml_sys_chdir"
+external mkdir: string -> int -> unit = "caml_sys_mkdir"
+external rmdir: string -> unit = "caml_sys_rmdir"
+external getcwd: unit -> string = "caml_sys_getcwd"
+external readdir : string -> string array = "caml_sys_read_directory"
+
+let interactive = ref false
+
+type signal_behavior =
+ Signal_default
+ | Signal_ignore
+ | Signal_handle of (int -> unit)
+
+external signal : int -> signal_behavior -> signal_behavior
+ = "caml_install_signal_handler"
+
+let set_signal sig_num sig_beh = ignore(signal sig_num sig_beh)
+
+let sigabrt = -1
+let sigalrm = -2
+let sigfpe = -3
+let sighup = -4
+let sigill = -5
+let sigint = -6
+let sigkill = -7
+let sigpipe = -8
+let sigquit = -9
+let sigsegv = -10
+let sigterm = -11
+let sigusr1 = -12
+let sigusr2 = -13
+let sigchld = -14
+let sigcont = -15
+let sigstop = -16
+let sigtstp = -17
+let sigttin = -18
+let sigttou = -19
+let sigvtalrm = -20
+let sigprof = -21
+let sigbus = -22
+let sigpoll = -23
+let sigsys = -24
+let sigtrap = -25
+let sigurg = -26
+let sigxcpu = -27
+let sigxfsz = -28
+
+exception Break
+
+let catch_break on =
+ if on then
+ set_signal sigint (Signal_handle(fun _ -> raise Break))
+ else
+ set_signal sigint Signal_default
+
+
+external enable_runtime_warnings: bool -> unit =
+ "caml_ml_enable_runtime_warnings"
+external runtime_warnings_enabled: unit -> bool =
+ "caml_ml_runtime_warnings_enabled"
+
+(* The version string is found in file ../VERSION *)
+
+let ocaml_version = "@VERSION@"
+
+let development_version = @OCAML_DEVELOPMENT_VERSION@
+
+type extra_prefix = Plus | Tilde
+
+type extra_info = extra_prefix * string
+
+type ocaml_release_info = {
+ major : int;
+ minor : int;
+ patchlevel : int;
+ extra : extra_info option
+}
+
+let ocaml_release = {
+ major = @OCAML_VERSION_MAJOR@;
+ minor = @OCAML_VERSION_MINOR@;
+ patchlevel = @OCAML_VERSION_PATCHLEVEL@;
+ extra = @OCAML_RELEASE_EXTRA@
+}
+
+(* 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
["major.minor[.patchlevel][(+|~)additional-info]"],
where [major], [minor], and [patchlevel] are integers, and
[additional-info] is an arbitrary string.
- The [[.patchlevel]] part is absent for versions anterior to 3.08.0.
+ The [[.patchlevel]] part was absent before version 3.08.0 and
+ became mandatory from 3.08.0 onwards.
The [[(+|~)additional-info]] part may be absent. *)
+val development_version : bool
+(** [true] if this is a development version, [false] otherwise.
+ @since 4.14.0
+*)
+
+type extra_prefix = Plus | Tilde
+
+type extra_info = extra_prefix * string
+
+type ocaml_release_info = {
+ major : int;
+ minor : int;
+ patchlevel : int;
+ extra : extra_info option
+}
+
+val ocaml_release : ocaml_release_info
val enable_runtime_warnings: bool -> unit
(** Control whether the OCaml runtime system can emit warnings
+++ /dev/null
-#2 "stdlib/sys.mlp"
-(**************************************************************************)
-(* *)
-(* 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. *)
-(* *)
-(**************************************************************************)
-
-(* WARNING: sys.ml is generated from sys.mlp. DO NOT EDIT sys.ml or
- your changes will be lost.
-*)
-
-type backend_type =
- | Native
- | Bytecode
- | Other of string
-(* System interface *)
-
-external get_config: unit -> string * int * bool = "caml_sys_get_config"
-external get_executable_name : unit -> string = "caml_sys_executable_name"
-external argv : string array = "%sys_argv"
-external big_endian : unit -> bool = "%big_endian"
-external word_size : unit -> int = "%word_size"
-external int_size : unit -> int = "%int_size"
-external max_wosize : unit -> int = "%max_wosize"
-external unix : unit -> bool = "%ostype_unix"
-external win32 : unit -> bool = "%ostype_win32"
-external cygwin : unit -> bool = "%ostype_cygwin"
-external get_backend_type : unit -> backend_type = "%backend_type"
-
-let executable_name = get_executable_name()
-let (os_type, _, _) = get_config()
-let backend_type = get_backend_type ()
-let big_endian = big_endian ()
-let word_size = word_size ()
-let int_size = int_size ()
-let unix = unix ()
-let win32 = win32 ()
-let cygwin = cygwin ()
-let max_array_length = max_wosize ()
-let max_floatarray_length = max_array_length / (64 / word_size)
-let max_string_length = word_size / 8 * max_array_length - 1
-external runtime_variant : unit -> string = "caml_runtime_variant"
-external runtime_parameters : unit -> string = "caml_runtime_parameters"
-
-external file_exists: string -> bool = "caml_sys_file_exists"
-external is_directory : string -> bool = "caml_sys_is_directory"
-external remove: string -> unit = "caml_sys_remove"
-external rename : string -> string -> unit = "caml_sys_rename"
-external getenv: string -> string = "caml_sys_getenv"
-
-let getenv_opt s =
- (* TODO: expose a non-raising primitive directly. *)
- try Some (getenv s)
- with Not_found -> None
-
-external command: string -> int = "caml_sys_system_command"
-external time: unit -> (float [@unboxed]) =
- "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
-external chdir: string -> unit = "caml_sys_chdir"
-external mkdir: string -> int -> unit = "caml_sys_mkdir"
-external rmdir: string -> unit = "caml_sys_rmdir"
-external getcwd: unit -> string = "caml_sys_getcwd"
-external readdir : string -> string array = "caml_sys_read_directory"
-
-let interactive = ref false
-
-type signal_behavior =
- Signal_default
- | Signal_ignore
- | Signal_handle of (int -> unit)
-
-external signal : int -> signal_behavior -> signal_behavior
- = "caml_install_signal_handler"
-
-let set_signal sig_num sig_beh = ignore(signal sig_num sig_beh)
-
-let sigabrt = -1
-let sigalrm = -2
-let sigfpe = -3
-let sighup = -4
-let sigill = -5
-let sigint = -6
-let sigkill = -7
-let sigpipe = -8
-let sigquit = -9
-let sigsegv = -10
-let sigterm = -11
-let sigusr1 = -12
-let sigusr2 = -13
-let sigchld = -14
-let sigcont = -15
-let sigstop = -16
-let sigtstp = -17
-let sigttin = -18
-let sigttou = -19
-let sigvtalrm = -20
-let sigprof = -21
-let sigbus = -22
-let sigpoll = -23
-let sigsys = -24
-let sigtrap = -25
-let sigurg = -26
-let sigxcpu = -27
-let sigxfsz = -28
-
-exception Break
-
-let catch_break on =
- if on then
- set_signal sigint (Signal_handle(fun _ -> raise Break))
- else
- set_signal sigint Signal_default
-
-
-external enable_runtime_warnings: bool -> unit =
- "caml_ml_enable_runtime_warnings"
-external runtime_warnings_enabled: unit -> bool =
- "caml_ml_runtime_warnings_enabled"
-
-(* The version string is found in file ../VERSION *)
-
-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
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
of OCaml. For randomized hash tables, the order of enumeration
is entirely random.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
by [f] during the iteration.
*)
several bindings for the same key, they appear in reversed order of
introduction, that is, the most recent binding appears first.
- The behavior is not defined if the hash table is modified
+ The behavior is not specified if the hash table is modified
during the iteration.
@since 4.07 *)
(** A seeded hashing function on keys. The first argument is
the seed. It must be the case that if [equal x y] is true,
then [hash seed x = hash seed y] for any value of [seed].
- A suitable choice for [hash] is the function {!seeded_hash}
- below. *)
+ A suitable choice for [hash] is the function
+ {!Stdlib.Hashtbl.seeded_hash} below. *)
end
(** The input signature of the functor {!MakeSeeded}.
@since 4.00.0 *)
(** Return the list of all bindings of the given map.
The returned list is sorted in increasing order of keys with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}.
+ given to {!Stdlib.Map.Make}.
@since 3.12.0
*)
*)
val max_binding: 'a t -> (key * 'a)
- (** Same as {!S.min_binding}, but returns the binding with
+ (** Same as {!min_binding}, but returns the binding with
the largest key in the given map.
@since 3.12.0
*)
val max_binding_opt: 'a t -> (key * 'a) option
- (** Same as {!S.min_binding_opt}, but returns the binding with
+ (** Same as {!min_binding_opt}, but returns the binding with
the largest key in the given map.
@since 4.05
*)
with respect to the ordering over the type of the keys. *)
val mapi: f:(key -> 'a -> 'b) -> 'a t -> 'b t
- (** Same as {!S.map}, but the function receives as arguments both the
+ (** Same as {!map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
(** {1 Maps and Sequences} *)
(** Return the list of all elements of the given set.
The returned list is sorted in increasing order with respect
to the ordering [Ord.compare], where [Ord] is the argument
- given to {!Make}. *)
+ given to {!Stdlib.Set.Make}. *)
val min_elt: t -> elt
(** Return the smallest element of the given set
*)
val max_elt: t -> elt
- (** Same as {!S.min_elt}, but returns the largest element of the
+ (** Same as {!min_elt}, but returns the largest element of the
given set. *)
val max_elt_opt: t -> elt option
- (** Same as {!S.min_elt_opt}, but returns the largest element of the
+ (** Same as {!min_elt_opt}, but returns the largest element of the
given set.
@since 4.05
*)
let equal : int -> int -> bool = ( = )
let compare : int -> int -> int = Stdlib.compare
let hash = to_int
+
+(* UTF codecs tools *)
+
+type utf_decode = int
+(* This is an int [0xDUUUUUU] decomposed as follows:
+ - [D] is four bits for decode information, the highest bit is set if the
+ decode is valid. The three lower bits indicate the number of elements
+ from the source that were consumed by the decode.
+ - [UUUUUU] is the decoded Unicode character or the Unicode replacement
+ character U+FFFD if for invalid decodes. *)
+
+let valid_bit = 27
+let decode_bits = 24
+
+let[@inline] utf_decode_is_valid d = (d lsr valid_bit) = 1
+let[@inline] utf_decode_length d = (d lsr decode_bits) land 0b111
+let[@inline] utf_decode_uchar d = unsafe_of_int (d land 0xFFFFFF)
+let[@inline] utf_decode n u = ((8 lor n) lsl decode_bits) lor (to_int u)
+let[@inline] utf_decode_invalid n = (n lsl decode_bits) lor rep
+
+let utf_8_byte_length u = match to_int u with
+| u when u < 0 -> assert false
+| u when u <= 0x007F -> 1
+| u when u <= 0x07FF -> 2
+| u when u <= 0xFFFF -> 3
+| u when u <= 0x10FFFF -> 4
+| _ -> assert false
+
+let utf_16_byte_length u = match to_int u with
+| u when u < 0 -> assert false
+| u when u <= 0xFFFF -> 2
+| u when u <= 0x10FFFF -> 4
+| _ -> assert false
@since 4.03 *)
type t
+[@@immediate]
(** The type for Unicode characters.
A value of this type represents a Unicode
val hash : t -> int
(** [hash u] associates a non-negative integer to [u]. *)
+
+(** {1:utf UTF codecs tools}
+
+ @since 4.14 *)
+
+type utf_decode [@@immediate]
+(** The type for UTF decode results. Values of this type represent
+ the result of a Unicode Transformation Format decoding attempt. *)
+
+val utf_decode_is_valid : utf_decode -> bool
+(** [utf_decode_is_valid d] is [true] if and only if [d] holds a valid
+ decode. *)
+
+val utf_decode_uchar : utf_decode -> t
+(** [utf_decode_uchar d] is the Unicode character decoded by [d] if
+ [utf_decode_is_valid d] is [true] and {!Uchar.rep} otherwise. *)
+
+val utf_decode_length : utf_decode -> int
+(** [utf_decode_length d] is the number of elements from the source
+ that were consumed by the decode [d]. This is always strictly
+ positive and smaller or equal to [4]. The kind of source elements
+ depends on the actual decoder; for the decoders of the standard
+ library this function always returns a length in bytes. *)
+
+val utf_decode : int -> t -> utf_decode
+(** [utf_decode n u] is a valid UTF decode for [u] that consumed [n]
+ elements from the source for decoding. [n] must be positive and
+ smaller or equal to [4] (this is not checked by the module). *)
+
+val utf_decode_invalid : int -> utf_decode
+(** [utf_decode_invalid n] is an invalid UTF decode that consumed [n]
+ elements from the source to error. [n] must be positive and
+ smaller or equal to [4] (this is not checked by the module). The
+ resulting decode has {!rep} as the decoded Unicode character. *)
+
+val utf_8_byte_length : t -> int
+(** [utf_8_byte_length u] is the number of bytes needed to encode
+ [u] in UTF-8. *)
+
+val utf_16_byte_length : t -> int
+(** [utf_16_byte_length u] is the number of bytes needed to encode
+ [u] in UTF-16. *)
BASEDIR := $(shell pwd)
-FIND=find
ROOTDIR = ..
include $(ROOTDIR)/Makefile.common
+ifeq "$(UNIX_OR_WIN32)" "win32"
+ CYGPATH=cygpath -m
+ # Ensure that the test runners definitely use Cygwin's sort and not the
+ # Windows sort command
+ SORT=/usr/bin/sort
+else
+ CYGPATH=echo
+ SORT=sort
+endif
+
BASEDIR_HOST := $(shell $(CYGPATH) "$(BASEDIR)")
ROOTDIR_HOST := $(BASEDIR_HOST)/$(ROOTDIR)
clean:
@$(MAKE) -C lib clean
@cd tools && $(MAKE) BASEDIR=$(BASEDIR) clean
- $(FIND) . -name '*_ocamltest*' | xargs rm -rf
+ find . -name '*_ocamltest*' | xargs rm -rf
rm -f $(failstamp)
.PHONY: report
--- /dev/null
+(* TEST
+*)
+external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+external caml_bytes_get_16 : bytes -> int -> int = "%caml_bytes_get16"
+external caml_bytes_set_16 : bytes -> int -> int -> unit = "%caml_bytes_set16"
+
+open Bigarray
+type bigstring = (char, int8_unsigned_elt, c_layout) Array1.t
+
+external caml_bigstring_get_16 :
+ bigstring -> int -> int = "%caml_bigstring_get16"
+
+external caml_bigstring_set_16 :
+ bigstring -> int -> int -> unit = "%caml_bigstring_set16"
+
+let bigstring_of_string s =
+ let a = Array1.create char c_layout (String.length s) in
+ for i = 0 to String.length s - 1 do
+ a.{i} <- s.[i]
+ done;
+ a
+
+let () =
+ (* stringref_safe *)
+ String.get (print_endline "hello"; "foo") (print_endline "world"; 0)
+ |> Printf.printf "%c\n";
+
+ (* string_load *)
+ caml_bytes_get_16 (print_endline "hello"; Bytes.make 10 '\x00')
+ (print_endline "world"; 0)
+ |> Printf.printf "%x\n";
+
+ (* bigstring_load *)
+ caml_bigstring_get_16 (print_endline "hello";
+ bigstring_of_string (String.make 10 '\x00'))
+ (print_endline "world"; 0)
+ |> Printf.printf "%x\n";
+
+ (* bytes_set *)
+ caml_bytes_set_16 (print_endline "a"; Bytes.make 10 '\x00')
+ (print_endline "b"; 0)
+ (print_endline "c"; 0xFF);
+
+ (* bigstring_set *)
+ caml_bigstring_set_16 (print_endline "a";
+ bigstring_of_string (String.make 10 '\x00'))
+ (print_endline "b"; 0)
+ (print_endline "c"; 0xFF);
+
+ (* mk_compare_ints_untagged *)
+ print_int (compare (print_endline "A"; Sys.opaque_identity (2))
+ (print_endline "B"; Sys.opaque_identity (3)));
+ print_newline ();
+
+ (* mk_compare_floats *)
+ print_int (compare (print_endline "A"; Sys.opaque_identity (2.0))
+ (print_endline "B"; Sys.opaque_identity (3.5)));
+ print_newline ();
+
+ (* bytesset_safe *)
+ Bytes.set (print_endline "a"; Bytes.make 10 '\x00')
+ (print_endline "b"; 0)
+ (print_endline "c"; 'c');
+
+ (* safe_div_bi *)
+ Printf.printf "%nd\n"
+ (Nativeint.div (print_endline "A"; Sys.opaque_identity (6n))
+ (print_endline "B"; Sys.opaque_identity (3n)));
+
+ (* arrayref_unsafe *)
+ let[@inline never] test_arrayref_unsafe
+ : type t . t array -> int -> (t -> string) -> unit =
+ fun a i c ->
+ print_endline (c (Array.unsafe_get (print_endline "A"; a) (print_endline "B"; i)))
+ in
+ test_arrayref_unsafe [| "1";"2";"3" |] 0 Fun.id;
+
+ ()
--- /dev/null
+world
+hello
+f
+world
+hello
+0
+world
+hello
+0
+c
+b
+a
+c
+b
+a
+B
+A
+-1
+B
+A
+-1
+c
+b
+a
+B
+A
+2
+B
+A
+1
--- /dev/null
+File "poll_attr_both.ml", line 1:
+Error: Function with poll-error attribute contains polling points:
+ allocation at File "poll_attr_both.ml", line 16, characters 29-37
+ function call at File "poll_attr_both.ml", line 17, characters 13-16
+ (plus compiler-inserted polling point(s) in prologue and/or loop back edges)
+
--- /dev/null
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ocamlopt_byte_exit_status = "2"
+ *** check-ocamlopt.byte-output
+
+ * setup-ocamlopt.opt-build-env
+ ** ocamlopt.opt
+ocamlopt_opt_exit_status = "2"
+ *** check-ocamlopt.opt-output
+*)
+
+let[@inline never][@local never] v x = x + 1
+
+let[@poll error] c x =
+ let y = Sys.opaque_identity(ref 42) in
+ let x2 = v x in
+ for c = 0 to x2 do
+ ignore(Sys.opaque_identity(42))
+ done;
+ x2 + !y
--- /dev/null
+File "poll_attr_inserted.ml", line 1:
+Error: Function with poll-error attribute contains polling points (inserted by the compiler)
+
--- /dev/null
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ocamlopt_byte_exit_status = "2"
+ *** check-ocamlopt.byte-output
+
+ * setup-ocamlopt.opt-build-env
+ ** ocamlopt.opt
+ocamlopt_opt_exit_status = "2"
+ *** check-ocamlopt.opt-output
+*)
+
+let[@poll error] c x =
+ for c = 0 to 2 do
+ ignore(Sys.opaque_identity(42))
+ done
--- /dev/null
+File "poll_attr_prologue.ml", line 1:
+Error: Function with poll-error attribute contains polling points:
+ function call at File "poll_attr_prologue.ml", line 16, characters 15-38
+ (plus compiler-inserted polling point(s) in prologue and/or loop back edges)
+
--- /dev/null
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ocamlopt_byte_exit_status = "2"
+ *** check-ocamlopt.byte-output
+
+ * setup-ocamlopt.opt-build-env
+ ** ocamlopt.opt
+ocamlopt_opt_exit_status = "2"
+ *** check-ocamlopt.opt-output
+*)
+
+let[@poll error] rec c x l =
+ match l with
+ | [] -> 0
+ | _ :: tl -> (c[@tailcall]) (x+1) tl
--- /dev/null
+File "poll_attr_user.ml", line 1:
+Error: Function with poll-error attribute contains polling points:
+ allocation at File "poll_attr_user.ml", line 16, characters 29-37
+ function call at File "poll_attr_user.ml", line 17, characters 13-16
+ allocation at File "poll_attr_user.ml", line 19, characters 34-42
+
--- /dev/null
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ocamlopt_byte_exit_status = "2"
+ *** check-ocamlopt.byte-output
+
+ * setup-ocamlopt.opt-build-env
+ ** ocamlopt.opt
+ocamlopt_opt_exit_status = "2"
+ *** check-ocamlopt.opt-output
+*)
+
+let[@inline never][@local never] v x = x + 1
+
+let[@poll error] c x =
+ let y = Sys.opaque_identity(ref 42) in
+ let x2 = v x in
+ for c = 0 to x2 do
+ ignore(Sys.opaque_identity(ref 42))
+ done;
+ x2 + !y
allocating_func_match minors_before
(* This function tests that polls are not added to the back edge of
- where loop bodies allocat unconditionally *)
+ where loop bodies allocate unconditionally *)
let polls_not_added_to_allocating_loops () =
let current_minors = ref (minor_gcs ()) in
request_minor_gc ();
Called from Callstack.f1 in file "callstack.ml", line 12, characters 27-32
Called from Callstack.f2 in file "callstack.ml", line 13, characters 27-32
Called from Callstack.f3 in file "callstack.ml", line 14, characters 27-32
-Called from Thread.create.(fun) in file "thread.ml", line 41, characters 8-14
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
(apply (field 1 (global CamlinternalMod!)) [0: [0]] B
(module-defn(B) Anonymous anonymous.ml(33):703-773
(let (x = [0: "foo" "bar"]) (makeblock 0))))
- (let (f = (function param 0) s = (makemutable 0 ""))
+ (let (f = (function param : int 0) s = (makemutable 0 ""))
(seq
(ignore
(let (*match* = (setfield_ptr 0 s "Hello World!"))
(makeblock 0)))
(let
- (drop = (function param 0) *match* = (apply drop (field 0 s)))
+ (drop = (function param : int 0)
+ *match* = (apply drop (field 0 s)))
(makeblock 0 A B f s drop))))))))
(apply (field 1 (global CamlinternalMod!)) [0: [0]] B
(module-defn(B) Anonymous anonymous.ml(33):703-773
(let (x = [0: "foo" "bar"]) (makeblock 0))))
- (let (f = (function param 0) s = (makemutable 0 ""))
+ (let (f = (function param : int 0) s = (makemutable 0 ""))
(seq
(ignore
(let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0)))
- (let (drop = (function param 0) *match* = (apply drop (field 0 s)))
+ (let
+ (drop = (function param : int 0)
+ *match* = (apply drop (field 0 s)))
(makeblock 0 A B f s drop)))))))
(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 0))
+ (let (f = (function param : int 0))
(setfield_ptr(root-init) 2 (global Anonymous!) f))
(let (s = (makemutable 0 ""))
(setfield_ptr(root-init) 3 (global Anonymous!) s))
(*match* =
(setfield_ptr 0 (field 3 (global Anonymous!)) "Hello World!"))
(makeblock 0)))
- (let (drop = (function param 0))
+ (let (drop = (function param : int 0))
(setfield_ptr(root-init) 4 (global Anonymous!) drop))
(let
(*match* =
val minus_one: t
val min_int: t
val max_int: t
- val format : string -> t -> string
val to_string: t -> string
val of_string: string -> t
end
test 10 (of_string "0x80000000") min_int;
test 11 (of_string "0xFFFFFFFF") minus_one;
- testing_function "to_string, format";
+ testing_function "to_string";
List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
[1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
5, "1073741824"; 6, "2147483647"; 7, "-2147483648"];
- List.iter (fun (n, s) -> test n (format "0x%X" (of_string s)) s)
- [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x12345678";
- 12, "0x7FFFFFFF"; 13, "0x80000000"; 14, "0xFFFFFFFF"];
- test 15 (to_string max_int) "2147483647";
- test 16 (to_string min_int) "-2147483648";
- test 17 (to_string zero) "0";
- test 18 (to_string one) "1";
- test 19 (to_string minus_one) "-1";
+ test 8 (to_string max_int) "2147483647";
+ test 9 (to_string min_int) "-2147483648";
+ test 10 (to_string zero) "0";
+ test 11 (to_string one) "1";
+ test 12 (to_string minus_one) "-1";
testing_function "neg";
test 1 (neg (of_int 0)) (of_int 0);
test 10 (of_string "0x8000000000000000") min_int;
test 11 (of_string "0xFFFFFFFFFFFFFFFF") minus_one;
- testing_function "to_string, format";
+ testing_function "to_string";
List.iter (fun (n, s) -> test n (to_string (of_string s)) s)
[1, "0"; 2, "123"; 3, "-456"; 4, "1234567890";
5, "1234567890123456789";
6, "9223372036854775807";
7, "-9223372036854775808"];
- List.iter (fun (n, s) -> test n ("0x" ^ format "%X" (of_string s)) s)
- [8, "0x0"; 9, "0x123"; 10, "0xABCDEF"; 11, "0x1234567812345678";
- 12, "0x7FFFFFFFFFFFFFFF"; 13, "0x8000000000000000";
- 14, "0xFFFFFFFFFFFFFFFF"];
- test 15 (to_string max_int) "9223372036854775807";
- test 16 (to_string min_int) "-9223372036854775808";
- test 17 (to_string zero) "0";
- test 18 (to_string one) "1";
- test 19 (to_string minus_one) "-1";
+ test 8 (to_string max_int) "9223372036854775807";
+ test 9 (to_string min_int) "-9223372036854775808";
+ test 10 (to_string zero) "0";
+ test 11 (to_string one) "1";
+ test 12 (to_string minus_one) "-1";
testing_function "neg";
test 1 (neg (of_int 0)) (of_int 0);
1... 2... 3... 4... 5... 6...
of_string
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
-to_string, format
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+to_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
neg
1... 2... 3... 4... 5... 6...
add
1... 2... 3... 4... 5... 6...
of_string
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
-to_string, format
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+to_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
neg
1... 2... 3... 4... 5... 6...
add
1... 2... 3... 4... 5... 6...
of_string
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
-to_string, format
- 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13... 14... 15... 16... 17... 18... 19...
+to_string
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
neg
1... 2... 3... 4... 5... 6...
add
--- /dev/null
+(* TEST *)
+
+(* closed, inlined *)
+let[@inline always] f () () = print_endline "4"
+let () = (let () = print_string "3" in f) (print_string "2") (print_string "1")
+
+(* closed, not inlined *)
+let[@inline never] f () () = print_endline "4"
+let () = (let () = print_string "3" in f) (print_string "2") (print_string "1")
+
+(* closure, inlined *)
+let[@inline never] g x =
+ (let () = print_string "3" in fun () () -> print_endline x)
+ (print_string "2") (print_string "1")
+let () = g "4"
+
+(* closure, not inlined *)
+let[@inline never] g x =
+ (let () = print_string "3" in
+ let[@inline never] f () () = print_endline x in f)
+ (print_string "2") (print_string "1")
+let () = g "4"
--- /dev/null
+1234
+1234
+1234
+1234
--- /dev/null
+(* TEST *)
+
+
+(* Non-regression for bug #10763, fixed in #10764 *)
+
+module W = struct
+ let r = ref (object method m x = Printf.printf "BAD %i\n%!" x end)
+end
+
+let proxy = object method m = (!W.r) # m end
+
+let () =
+ W.r := object method m x = Printf.printf "OK %i\n%!" x end;
+ proxy # m 3
-(* TEST *)
+(* TEST
+unset DOES_NOT_EXIST
+*)
let () =
- assert(Sys.getenv_opt "FOOBAR_UNLIKELY_TO_EXIST_42" = None);
+ assert(Sys.getenv_opt "DOES_NOT_EXIST" = None);
assert(int_of_string_opt "foo" = None);
assert(int_of_string_opt "42" = Some 42);
| _ -> false
;;
[%%expect{|
-(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1)
+(let (*match*/274 = 3 *match*/275 = 2 *match*/276 = 1)
(catch
(catch
- (catch (if (!= *match*/89 3) (exit 3) (exit 1)) with (3)
- (if (!= *match*/88 1) (exit 2) (exit 1)))
+ (catch (if (!= *match*/275 3) (exit 3) (exit 1)) with (3)
+ (if (!= *match*/274 1) (exit 2) (exit 1)))
with (2) 0)
with (1) 1))
-(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1)
- (catch (if (!= *match*/89 3) (if (!= *match*/88 1) 0 (exit 1)) (exit 1))
+(let (*match*/274 = 3 *match*/275 = 2 *match*/276 = 1)
+ (catch (if (!= *match*/275 3) (if (!= *match*/274 1) 0 (exit 1)) (exit 1))
with (1) 1))
- : bool = false
|}];;
| _ -> false
;;
[%%expect{|
-(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1)
+(let (*match*/279 = 3 *match*/280 = 2 *match*/281 = 1)
(catch
(catch
(catch
- (if (!= *match*/94 3) (exit 6)
- (let (x/97 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
- (exit 4 x/97)))
+ (if (!= *match*/280 3) (exit 6)
+ (let (x/283 =a (makeblock 0 *match*/279 *match*/280 *match*/281))
+ (exit 4 x/283)))
with (6)
- (if (!= *match*/93 1) (exit 5)
- (let (x/96 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
- (exit 4 x/96))))
+ (if (!= *match*/279 1) (exit 5)
+ (let (x/282 =a (makeblock 0 *match*/279 *match*/280 *match*/281))
+ (exit 4 x/282))))
with (5) 0)
- with (4 x/91) (seq (ignore x/91) 1)))
-(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1)
+ with (4 x/277) (seq (ignore x/277) 1)))
+(let (*match*/279 = 3 *match*/280 = 2 *match*/281 = 1)
(catch
- (if (!= *match*/94 3)
- (if (!= *match*/93 1) 0
- (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95)))
- (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95)))
- with (4 x/91) (seq (ignore x/91) 1)))
+ (if (!= *match*/280 3)
+ (if (!= *match*/279 1) 0
+ (exit 4 (makeblock 0 *match*/279 *match*/280 *match*/281)))
+ (exit 4 (makeblock 0 *match*/279 *match*/280 *match*/281)))
+ with (4 x/277) (seq (ignore x/277) 1)))
- : bool = false
|}];;
| ((true, _) as _g)
| ((false, _) as _g) -> ()
[%%expect{|
-(function a/98 b/99 0)
-(function a/98 b/99 0)
+(function a/284[int] b/285 : int 0)
+(function a/284[int] b/285 : int 0)
- : bool -> 'a -> unit = <fun>
|}];;
| (false, _) as p -> p
(* outside, trivial *)
[%%expect {|
-(function a/102 b/103 (let (p/104 =a (makeblock 0 a/102 b/103)) p/104))
-(function a/102 b/103 (makeblock 0 a/102 b/103))
+(function a/288[int] b/289 (let (p/290 =a (makeblock 0 a/288 b/289)) p/290))
+(function a/288[int] b/289 (makeblock 0 a/288 b/289))
- : bool -> 'a -> bool * 'a = <fun>
|}]
| ((false, _) as p) -> p
(* inside, trivial *)
[%%expect{|
-(function a/106 b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108))
-(function a/106 b/107 (makeblock 0 a/106 b/107))
+(function a/292[int] b/293 (let (p/294 =a (makeblock 0 a/292 b/293)) p/294))
+(function a/292[int] b/293 (makeblock 0 a/292 b/293))
- : bool -> 'a -> bool * 'a = <fun>
|}];;
| (false as x, _) as p -> x, p
(* outside, simple *)
[%%expect {|
-(function a/112 b/113
- (let (x/114 =a a/112 p/115 =a (makeblock 0 a/112 b/113))
- (makeblock 0 x/114 p/115)))
-(function a/112 b/113 (makeblock 0 a/112 (makeblock 0 a/112 b/113)))
+(function a/298[int] b/299
+ (let (x/300 =a[int] a/298 p/301 =a (makeblock 0 a/298 b/299))
+ (makeblock 0 (int,*) x/300 p/301)))
+(function a/298[int] b/299
+ (makeblock 0 (int,*) a/298 (makeblock 0 a/298 b/299)))
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|}]
| ((false as x, _) as p) -> x, p
(* inside, simple *)
[%%expect {|
-(function a/118 b/119
- (let (x/120 =a a/118 p/121 =a (makeblock 0 a/118 b/119))
- (makeblock 0 x/120 p/121)))
-(function a/118 b/119 (makeblock 0 a/118 (makeblock 0 a/118 b/119)))
+(function a/304[int] b/305
+ (let (x/306 =a[int] a/304 p/307 =a (makeblock 0 a/304 b/305))
+ (makeblock 0 (int,*) x/306 p/307)))
+(function a/304[int] b/305
+ (makeblock 0 (int,*) a/304 (makeblock 0 a/304 b/305)))
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|}]
| (false, x) as p -> x, p
(* outside, complex *)
[%%expect{|
-(function a/128 b/129
- (if a/128
- (let (x/130 =a a/128 p/131 =a (makeblock 0 a/128 b/129))
- (makeblock 0 x/130 p/131))
- (let (x/132 =a b/129 p/133 =a (makeblock 0 a/128 b/129))
- (makeblock 0 x/132 p/133))))
-(function a/128 b/129
- (if a/128 (makeblock 0 a/128 (makeblock 0 a/128 b/129))
- (makeblock 0 b/129 (makeblock 0 a/128 b/129))))
+(function a/314[int] b/315[int]
+ (if a/314
+ (let (x/316 =a[int] a/314 p/317 =a (makeblock 0 a/314 b/315))
+ (makeblock 0 (int,*) x/316 p/317))
+ (let (x/318 =a b/315 p/319 =a (makeblock 0 a/314 b/315))
+ (makeblock 0 (int,*) x/318 p/319))))
+(function a/314[int] b/315[int]
+ (if a/314 (makeblock 0 (int,*) a/314 (makeblock 0 a/314 b/315))
+ (makeblock 0 (int,*) b/315 (makeblock 0 a/314 b/315))))
- : bool -> bool -> bool * (bool * bool) = <fun>
|}]
-> x, p
(* inside, complex *)
[%%expect{|
-(function a/134 b/135
+(function a/320[int] b/321[int]
(catch
- (if a/134
- (let (x/142 =a a/134 p/143 =a (makeblock 0 a/134 b/135))
- (exit 10 x/142 p/143))
- (let (x/140 =a b/135 p/141 =a (makeblock 0 a/134 b/135))
- (exit 10 x/140 p/141)))
- with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
-(function a/134 b/135
+ (if a/320
+ (let (x/328 =a[int] a/320 p/329 =a (makeblock 0 a/320 b/321))
+ (exit 10 x/328 p/329))
+ (let (x/326 =a b/321 p/327 =a (makeblock 0 a/320 b/321))
+ (exit 10 x/326 p/327)))
+ with (10 x/322[int] p/323) (makeblock 0 (int,*) x/322 p/323)))
+(function a/320[int] b/321[int]
(catch
- (if a/134 (exit 10 a/134 (makeblock 0 a/134 b/135))
- (exit 10 b/135 (makeblock 0 a/134 b/135)))
- with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
+ (if a/320 (exit 10 a/320 (makeblock 0 a/320 b/321))
+ (exit 10 b/321 (makeblock 0 a/320 b/321)))
+ with (10 x/322[int] p/323) (makeblock 0 (int,*) x/322 p/323)))
- : bool -> bool -> bool * (bool * bool) = <fun>
|}]
| (false as x, _) as p -> x, p
(* outside, onecase *)
[%%expect {|
-(function a/144 b/145
- (if a/144
- (let (x/146 =a a/144 _p/147 =a (makeblock 0 a/144 b/145))
- (makeblock 0 x/146 [0: 1 1]))
- (let (x/148 =a a/144 p/149 =a (makeblock 0 a/144 b/145))
- (makeblock 0 x/148 p/149))))
-(function a/144 b/145
- (if a/144 (makeblock 0 a/144 [0: 1 1])
- (makeblock 0 a/144 (makeblock 0 a/144 b/145))))
+(function a/330[int] b/331[int]
+ (if a/330
+ (let (x/332 =a[int] a/330 _p/333 =a (makeblock 0 a/330 b/331))
+ (makeblock 0 (int,*) x/332 [0: 1 1]))
+ (let (x/334 =a[int] a/330 p/335 =a (makeblock 0 a/330 b/331))
+ (makeblock 0 (int,*) x/334 p/335))))
+(function a/330[int] b/331[int]
+ (if a/330 (makeblock 0 (int,*) a/330 [0: 1 1])
+ (makeblock 0 (int,*) a/330 (makeblock 0 a/330 b/331))))
- : bool -> bool -> bool * (bool * bool) = <fun>
|}]
| ((false as x, _) as p) -> x, p
(* inside, onecase *)
[%%expect{|
-(function a/150 b/151
- (let (x/152 =a a/150 p/153 =a (makeblock 0 a/150 b/151))
- (makeblock 0 x/152 p/153)))
-(function a/150 b/151 (makeblock 0 a/150 (makeblock 0 a/150 b/151)))
+(function a/336[int] b/337
+ (let (x/338 =a[int] a/336 p/339 =a (makeblock 0 a/336 b/337))
+ (makeblock 0 (int,*) x/338 p/339)))
+(function a/336[int] b/337
+ (makeblock 0 (int,*) a/336 (makeblock 0 a/336 b/337)))
- : bool -> 'a -> bool * (bool * 'a) = <fun>
|}]
| (_, _) as p -> p
(* outside, tuplist *)
[%%expect {|
-(function a/163 b/164
+(function a/349[int] b/350
(catch
- (if a/163 (if b/164 (let (p/165 =a (field 0 b/164)) p/165) (exit 12))
+ (if a/349 (if b/350 (let (p/351 =a (field 0 b/350)) p/351) (exit 12))
(exit 12))
- with (12) (let (p/166 =a (makeblock 0 a/163 b/164)) p/166)))
-(function a/163 b/164
- (catch (if a/163 (if b/164 (field 0 b/164) (exit 12)) (exit 12)) with (12)
- (makeblock 0 a/163 b/164)))
+ with (12) (let (p/352 =a (makeblock 0 a/349 b/350)) p/352)))
+(function a/349[int] b/350
+ (catch (if a/349 (if b/350 (field 0 b/350) (exit 12)) (exit 12)) with (12)
+ (makeblock 0 a/349 b/350)))
- : bool -> bool tuplist -> bool * bool tuplist = <fun>
|}]
| ((_, _) as p) -> p
(* inside, tuplist *)
[%%expect{|
-(function a/167 b/168
+(function a/353[int] b/354
(catch
(catch
- (if a/167
- (if b/168 (let (p/172 =a (field 0 b/168)) (exit 13 p/172)) (exit 14))
+ (if a/353
+ (if b/354 (let (p/358 =a (field 0 b/354)) (exit 13 p/358)) (exit 14))
(exit 14))
- with (14) (let (p/171 =a (makeblock 0 a/167 b/168)) (exit 13 p/171)))
- with (13 p/169) p/169))
-(function a/167 b/168
+ with (14) (let (p/357 =a (makeblock 0 a/353 b/354)) (exit 13 p/357)))
+ with (13 p/355) p/355))
+(function a/353[int] b/354
(catch
(catch
- (if a/167 (if b/168 (exit 13 (field 0 b/168)) (exit 14)) (exit 14))
- with (14) (exit 13 (makeblock 0 a/167 b/168)))
- with (13 p/169) p/169))
+ (if a/353 (if b/354 (exit 13 (field 0 b/354)) (exit 14)) (exit 14))
+ with (14) (exit 13 (makeblock 0 a/353 b/354)))
+ with (13 p/355) p/355))
- : bool -> bool tuplist -> bool * bool tuplist = <fun>
|}]
;;
[%%expect{|
(let
- (last_is_anys/10 =
- (function param/12 : int
+ (last_is_anys/11 =
+ (function param/13 : int
(catch
- (if (field 0 param/12) (if (field 1 param/12) (exit 1) 1)
- (if (field 1 param/12) (exit 1) 2))
+ (if (field 0 param/13) (if (field 1 param/13) (exit 1) 1)
+ (if (field 1 param/13) (exit 1) 2))
with (1) 3)))
- (apply (field 1 (global Toploop!)) "last_is_anys" last_is_anys/10))
+ (apply (field 1 (global Toploop!)) "last_is_anys" last_is_anys/11))
val last_is_anys : bool * bool -> int = <fun>
|}]
;;
[%%expect{|
(let
- (last_is_vars/17 =
- (function param/21 : int
+ (last_is_vars/18 =
+ (function param/22 : int
(catch
- (if (field 0 param/21) (if (field 1 param/21) (exit 3) 1)
- (if (field 1 param/21) (exit 3) 2))
+ (if (field 0 param/22) (if (field 1 param/22) (exit 3) 1)
+ (if (field 1 param/22) (exit 3) 2))
with (3) 3)))
- (apply (field 1 (global Toploop!)) "last_is_vars" last_is_vars/17))
+ (apply (field 1 (global Toploop!)) "last_is_vars" last_is_vars/18))
val last_is_vars : bool * bool -> int = <fun>
|}]
0
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)))
+ (A/26 = (makeblock 248 "A" (caml_fresh_oo_id 0))
+ B/27 = (makeblock 248 "B" (caml_fresh_oo_id 0))
+ C/28 = (makeblock 248 "C" (caml_fresh_oo_id 0)))
+ (seq (apply (field 1 (global Toploop!)) "A/26" A/26)
+ (apply (field 1 (global Toploop!)) "B/27" B/27)
+ (apply (field 1 (global Toploop!)) "C/28" C/28)))
type t += A | B of unit | C of bool * int
|}]
;;
[%%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))
+ (C/28 = (apply (field 0 (global Toploop!)) "C/28")
+ B/27 = (apply (field 0 (global Toploop!)) "B/27")
+ A/26 = (apply (field 0 (global Toploop!)) "A/26")
+ f/29 =
+ (function param/31 : int
+ (let (*match*/32 =a (field 0 param/31))
(catch
- (if (== *match*/31 A/25) (if (field 1 param/30) 1 (exit 8))
+ (if (== *match*/32 A/26) (if (field 1 param/31) 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))
+ (if (field 1 param/31)
+ (if (== (field 0 *match*/32) B/27) 2
+ (if (== (field 0 *match*/32) C/28) 3 4))
+ (if (field 2 param/31) 12 11))))))
+ (apply (field 1 (global Toploop!)) "f" f/29))
val f : t * bool * bool -> int = <fun>
|}]
else tailcall16 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
(i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+let rec tailcall32 a b c d e f g h i j k l m n o p
+ q r s t u v w x y z aa bb cc dd ee ff =
+ if a < 0
+ then b
+ else tailcall32 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+ (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+ (q+16) (r+17) (s+18) (t+19) (u+20) (v+21) (w+22) (x+23)
+ (y+24) (z+25) (aa+26) (bb+27) (cc+28) (dd+29) (ee+30) (ff+31)
+
let indtailcall8 fn a b c d e f g h =
fn a b c d e f g h
let indtailcall16 fn a b c d e f g h i j k l m n o p =
fn a b c d e f g h i j k l m n o p
+let rec muttailcall8 a b c d e f g h =
+ if a < 0
+ then b
+ else auxtailcall8 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+
+and auxtailcall8 a b c d e f g h =
+ muttailcall8 a b c d e f g h
+
+let rec muttailcall16 a b c d e f g h i j k l m n o p =
+ if a < 0
+ then b
+ else auxtailcall16 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+ (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+
+and auxtailcall16 a b c d e f g h i j k l m n o p =
+ muttailcall16 a b c d e f g h i j k l m n o p
+
+let rec muttailcall32 a b c d e f g h i j k l m n o p
+ q r s t u v w x y z aa bb cc dd ee ff =
+ if a < 0
+ then b
+ else auxtailcall32 (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+ (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+ (q+16) (r+17) (s+18) (t+19) (u+20) (v+21) (w+22) (x+23)
+ (y+24) (z+25) (aa+26) (bb+27) (cc+28) (dd+29) (ee+30) (ff+31)
+
+and auxtailcall32 a b c d e f g h i j k l m n o p
+ q r s t u v w x y z aa bb cc dd ee ff =
+ muttailcall32 a b c d e f g h i j k l m n o p
+ q r s t u v w x y z aa bb cc dd ee ff
+
(* regression test for PR#6441: *)
let rec tailcall16_value_closures a b c d e f g h i j k l m n o p =
if a < 0
print_int (tailcall8 10000000 0 0 0 0 0 0 0); print_newline();
print_int (tailcall16 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
print_newline();
+ print_int (tailcall32 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+ print_newline();
print_int (indtailcall8 tailcall8 10 0 0 0 0 0 0 0); print_newline();
print_int (indtailcall16 tailcall16 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
print_newline();
print_int (tailcall16_value_closures 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+ print_newline();
+ print_int (muttailcall8 10000000 0 0 0 0 0 0 0); print_newline();
+ print_int (muttailcall16 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+ print_newline();
+ print_int (muttailcall32 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
print_newline()
10000001
10000001
10000001
+10000001
11
11
10000001
+10000001
+10000001
+10000001
+++ /dev/null
-(* 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
+++ /dev/null
-v is young
+++ /dev/null
-#include <stdio.h>
-
-#include <caml/minor_gc.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-#include <caml/alloc.h>
-#include <caml/address_class.h>
-/* 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
-}
#include <stdlib.h>
#include <stdio.h>
+#define CAML_INTERNALS
+#include <caml/misc.h>
#include <caml/callback.h>
extern int fib(int n);
extern char * format_result(int n);
-#ifdef _WIN32
-int wmain(int argc, wchar_t ** argv)
-#else
-int main(int argc, char ** argv)
-#endif
+int main_os(int argc, char_os ** argv)
{
printf("Initializing OCaml code...\n");
Line 1, characters 15-41:
1 | include struct open struct type t = T end let x = T end
^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The type t/150 introduced by this open appears in the signature
+Error: The type t/337 introduced by this open appears in the signature
Line 1, characters 46-47:
- The value x has no valid type if t/150 is hidden
+ The value x has no valid type if t/337 is hidden
|}];;
module A = struct
4 | type t = T
5 | let x = T
6 | end
-Error: The type t/155 introduced by this open appears in the signature
+Error: The type t/342 introduced by this open appears in the signature
Line 7, characters 8-9:
- The value y has no valid type if t/155 is hidden
+ The value y has no valid type if t/342 is hidden
|}];;
module A = struct
3 | ....open struct
4 | type t = T
5 | end
-Error: The type t/160 introduced by this open appears in the signature
+Error: The type t/347 introduced by this open appears in the signature
Line 6, characters 8-9:
- The value y has no valid type if t/160 is hidden
+ The value y has no valid type if t/347 is hidden
|}]
(* It was decided to not allow this anymore. *)
--- /dev/null
+(* TEST
+*)
+
+(* UTF codec tests *)
+
+let fold_uchars f acc =
+ let rec loop f acc u =
+ let acc = f acc u in
+ if Uchar.equal u Uchar.max then acc else loop f acc (Uchar.succ u)
+ in
+ loop f acc Uchar.min
+
+(* This tests that we encode and decode each character according
+ to its specification. *)
+
+let utf_8_spec =
+ (* UTF-8 byte sequences, cf. table 3.7 Unicode 14. *)
+ [(0x0000,0x007F), [|(0x00,0x7F)|];
+ (0x0080,0x07FF), [|(0xC2,0xDF); (0x80,0xBF)|];
+ (0x0800,0x0FFF), [|(0xE0,0xE0); (0xA0,0xBF); (0x80,0xBF)|];
+ (0x1000,0xCFFF), [|(0xE1,0xEC); (0x80,0xBF); (0x80,0xBF)|];
+ (0xD000,0xD7FF), [|(0xED,0xED); (0x80,0x9F); (0x80,0xBF)|];
+ (0xE000,0xFFFF), [|(0xEE,0xEF); (0x80,0xBF); (0x80,0xBF)|];
+ (0x10000,0x3FFFF), [|(0xF0,0xF0); (0x90,0xBF); (0x80,0xBF); (0x80,0xBF)|];
+ (0x40000,0xFFFFF), [|(0xF1,0xF3); (0x80,0xBF); (0x80,0xBF); (0x80,0xBF)|];
+ (0x100000,0x10FFFF), [|(0xF4,0xF4); (0x80,0x8F); (0x80,0xBF); (0x80,0xBF)|]]
+
+let utf_16be_spec =
+ (* UTF-16BE byte sequences, derived from table 3.5 Unicode 14. *)
+ [(0x0000,0xD7FF), [|(0x00,0xD7); (0x00,0xFF)|];
+ (0xE000,0xFFFF), [|(0xE0,0xFF); (0x00,0xFF)|];
+ (0x10000,0x10FFFF), [|(0xD8,0xDB); (0x00,0xFF); (0xDC,0xDF); (0x00,0xFF)|]]
+
+let uchar_map_of_spec spec =
+ (* array mapping Uchar.t as ints to byte sequences according to [spec]. *)
+ let map = Array.make ((Uchar.to_int Uchar.max) + 1) Bytes.empty in
+ let add_range ((umin, umax), bytes) =
+ let len = Array.length bytes in
+ let bmin i = if i < len then fst bytes.(i) else max_int in
+ let bmax i = if i < len then snd bytes.(i) else min_int in
+ let uchar = ref umin in
+ let buf = Bytes.create len in
+ let add len' = match len = len' with
+ | false -> ()
+ | true -> map.(!uchar) <- Bytes.copy buf; incr uchar
+ in
+ for b0 = bmin 0 to bmax 0 do Bytes.set_uint8 buf 0 b0;
+ for b1 = bmin 1 to bmax 1 do Bytes.set_uint8 buf 1 b1;
+ for b2 = bmin 2 to bmax 2 do Bytes.set_uint8 buf 2 b2;
+ for b3 = bmin 3 to bmax 3 do Bytes.set_uint8 buf 3 b3; add 4
+ done; add 3;
+ done; add 2;
+ done; add 1;
+ done; assert (!uchar - 1 = umax)
+ in
+ List.iter add_range spec;
+ map
+
+let uchar_map_get u map = map.(Uchar.to_int u)
+let utf_8 = uchar_map_of_spec utf_8_spec
+let utf_16be = uchar_map_of_spec utf_16be_spec
+let utf_16le =
+ let swap u b =
+ let len = Bytes.length b in
+ if len = 0 then () else
+ for i = 0 to Bytes.length b / 2 - 1 do
+ let j = i * 2 in
+ Bytes.set_uint16_le b j (Bytes.get_uint16_be b j);
+ done;
+ in
+ let map = Array.map Bytes.copy utf_16be in
+ Array.iteri swap map; map
+
+let test_utf utf utf_len get_utf set_utf utf_is_valid =
+ (* Test codec and validation of each Uchar.t against the spec. *)
+ let f () u =
+ let utf_len = utf_len u in
+ let buf = Bytes.create utf_len in
+ assert (set_utf buf 0 u = utf_len);
+ assert (Bytes.equal buf (uchar_map_get u utf));
+ assert (Bytes.equal buf (uchar_map_get u utf));
+ let dec = get_utf buf 0 in
+ assert (Uchar.utf_decode_is_valid dec);
+ assert (Uchar.utf_decode_length dec = utf_len);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) u);
+ assert (utf_is_valid buf);
+ ()
+ in
+ fold_uchars f ()
+
+let () =
+ test_utf utf_8 Uchar.utf_8_byte_length
+ Bytes.get_utf_8_uchar Bytes.set_utf_8_uchar Bytes.is_valid_utf_8
+
+let () =
+ test_utf utf_16be Uchar.utf_16_byte_length
+ Bytes.get_utf_16be_uchar Bytes.set_utf_16be_uchar Bytes.is_valid_utf_16be
+
+let () =
+ test_utf utf_16le Uchar.utf_16_byte_length
+ Bytes.get_utf_16le_uchar Bytes.set_utf_16le_uchar Bytes.is_valid_utf_16le
+
+let () =
+ (* Test out of bounds *)
+ let raises f = assert (try f (); false with Invalid_argument _ -> true) in
+ (raises @@ fun () -> Bytes.get_utf_8_uchar Bytes.empty 0);
+ (raises @@ fun () -> Bytes.set_utf_8_uchar Bytes.empty 0 Uchar.min);
+ (raises @@ fun () -> Bytes.get_utf_16le_uchar Bytes.empty 0);
+ (raises @@ fun () -> Bytes.set_utf_16le_uchar Bytes.empty 0 Uchar.min);
+ (raises @@ fun () -> Bytes.get_utf_16be_uchar Bytes.empty 0);
+ (raises @@ fun () -> Bytes.set_utf_16be_uchar Bytes.empty 0 Uchar.min);
+ ()
+
+let () =
+ (* Test lack of space encodes *)
+ let b = Bytes.make 1 '\xab' in
+ assert (Bytes.set_utf_8_uchar b 0 Uchar.max = 0 && Bytes.get b 0 = '\xab');
+ assert (Bytes.set_utf_16be_uchar b 0 Uchar.max = 0 && Bytes.get b 0 = '\xab');
+ assert (Bytes.set_utf_16le_uchar b 0 Uchar.max = 0 && Bytes.get b 0 = '\xab');
+ ()
+
+let () =
+ (* Test bug found during review *)
+ let b = Bytes.create 2 in
+ let () = Bytes.set_uint8 b 0 0xC3 in
+ let () = Bytes.set_uint8 b 1 0x00 in
+ assert (not (Bytes.is_valid_utf_8 b))
+
+let () =
+ (* Test used bytes and replacement according to WHATWG recommendation.
+ This is just a recommendation.
+ These examples are from TUS p. 126-127 Unicode 14 *)
+ let b = Bytes.of_string "\xC0\xAF\xE0\x80\xBF\xF0\x81\x82\x41" in
+ let ok i = i = Bytes.length b - 1 in
+ for i = 0 to Bytes.length b - 1 do
+ let dec = Bytes.get_utf_8_uchar b i in
+ if not (ok i) then begin
+ assert (Uchar.utf_decode_is_valid dec = false);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) Uchar.rep)
+ end else begin
+ assert (Uchar.utf_decode_is_valid dec = true);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) (Uchar.of_int 0x0041))
+ end
+ done;
+ let b = Bytes.of_string "\xED\xA0\x80\xED\xBF\xBF\xED\xAF\x41" in
+ let ok i = i = Bytes.length b - 1 in
+ for i = 0 to Bytes.length b - 1 do
+ let dec = Bytes.get_utf_8_uchar b i in
+ if not (ok i) then begin
+ assert (Uchar.utf_decode_is_valid dec = false);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) Uchar.rep)
+ end else begin
+ assert (Uchar.utf_decode_is_valid dec = true);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) (Uchar.of_int 0x0041))
+ end
+ done;
+ let b = Bytes.of_string "\xF4\x91\x92\x93\xFF\x41\x80\xBF\x42" in
+ let ok i = i = 5 || i = 8 in
+ for i = 0 to Bytes.length b - 1 do
+ let dec = Bytes.get_utf_8_uchar b i in
+ if not (ok i) then begin
+ assert (Uchar.utf_decode_is_valid dec = false);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec) Uchar.rep)
+ end else begin
+ assert (Uchar.utf_decode_is_valid dec = true);
+ assert (Uchar.utf_decode_length dec = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar dec)
+ (Uchar.of_char (Bytes.get b i)))
+ end
+ done;
+ let b = Bytes.of_string "\xE1\x80\xE2\xF0\x91\x92\xF1\xBF\x41" in
+ let d0 = Bytes.get_utf_8_uchar b 0 in
+ assert (Uchar.utf_decode_is_valid d0 = false);
+ assert (Uchar.utf_decode_length d0 = 2);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d0) Uchar.rep);
+ let d2 = Bytes.get_utf_8_uchar b 2 in
+ assert (Uchar.utf_decode_is_valid d2 = false);
+ assert (Uchar.utf_decode_length d2 = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d2) Uchar.rep);
+ let d3 = Bytes.get_utf_8_uchar b 3 in
+ assert (Uchar.utf_decode_is_valid d3 = false);
+ assert (Uchar.utf_decode_length d3 = 3);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d3) Uchar.rep);
+ let d6 = Bytes.get_utf_8_uchar b 6 in
+ assert (Uchar.utf_decode_is_valid d6 = false);
+ assert (Uchar.utf_decode_length d6 = 2);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d6) Uchar.rep);
+ let d8 = Bytes.get_utf_8_uchar b 8 in
+ assert (Uchar.utf_decode_length d8 = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d8) (Uchar.of_int 0x0041));
+ ()
+
+let () = Printf.printf "All UTF tests passed!\n"
+
+(* This is a very long test added here for reference just in case. It
+ is not run.
+
+ It assumes the good encoding and decodes have been checked by test_utf
+ above. It exhaustively tests all 1-4 bytes invalid sequences for decodes.
+ This ensures we do not decode invalid sequence to uchars. *)
+
+let test_invalid_decodes () =
+ let module Sset = Set.Make (String) in
+ let utf_8_encs, utf_16be_encs, utf_16le_encs =
+ Printf.printf "Building encoding sequence sets\n%!";
+ let add (set8, set16be, set16le) u =
+ let s = Bytes.unsafe_to_string in
+ let e8 = Bytes.create (Uchar.utf_8_byte_length u) in
+ let e16be = Bytes.create (Uchar.utf_16_byte_length u) in
+ let e16le = Bytes.create (Uchar.utf_16_byte_length u) in
+ ignore (Bytes.set_utf_8_uchar e8 0 u);
+ ignore (Bytes.set_utf_16be_uchar e16be 0 u);
+ ignore (Bytes.set_utf_16le_uchar e16le 0 u);
+ Sset.add (s e8) set8,
+ Sset.add (s e16be) set16be,
+ Sset.add (s e16le) set16le
+ in
+ fold_uchars add (Sset.empty, Sset.empty, Sset.empty)
+ in
+ let test_seqs utf utf_encs get_utf_char is_valid_utf =
+ let test seq =
+ let dec = get_utf_char seq 0 in
+ let valid = Uchar.utf_decode_is_valid dec in
+ let is_valid = is_valid_utf seq in
+ let is_enc = Sset.mem (Bytes.unsafe_to_string seq) utf_encs in
+ if not ((valid && is_enc) || (not valid && not is_enc)) ||
+ not ((is_valid && is_enc) || (not is_valid && not is_enc))
+ then begin
+ for i = 0 to Bytes.length seq - 1 do
+ Printf.printf "%02X " (Bytes.get_uint8 seq i);
+ done;
+ Printf.printf "valid: %b is_encoding: %b decode: U+%04X\n is_valid:%b"
+ valid is_enc (Uchar.to_int (Uchar.utf_decode_uchar dec)) is_valid;
+ assert false
+ end;
+ valid
+ in
+ let[@inline] set buf i b = Bytes.unsafe_set buf i (Char.unsafe_chr b) in
+ let s1 = Bytes.create 1 and s2 = Bytes.create 2
+ and s3 = Bytes.create 3 and s4 = Bytes.create 4 in
+ Printf.printf "Testing %s invalid decodes...\n%!" utf;
+ for b0 = 0x00 to 0xFF do
+ set s1 0 b0;
+ if test s1 then ((* this prefix decoded, stop here *)) else begin
+ set s2 0 b0;
+ for b1 = 0x00 to 0xFF do
+ set s2 1 b1;
+ if test s2 then ((* this prefix decoded, stop here *)) else begin
+ set s3 0 b0;
+ set s3 1 b1;
+ for b2 = 0x00 to 0xFF do
+ set s3 2 b2;
+ if test s3 then ((* this prefix decoded, stop here *)) else begin
+ set s4 0 b0;
+ set s4 1 b1;
+ set s4 2 b2;
+ for b3 = 0x00 to 0xFF do set s4 3 b3; ignore (test s4) done;
+ end
+ done;
+ end
+ done;
+ end
+ done
+ in
+ test_seqs "UTF-8" utf_8_encs Bytes.get_utf_8_uchar Bytes.is_valid_utf_8;
+ test_seqs "UTF-16BE"
+ utf_16be_encs Bytes.get_utf_16be_uchar Bytes.is_valid_utf_16be;
+ test_seqs "UTF-16LE" utf_16le_encs Bytes.get_utf_16le_uchar
+ Bytes.is_valid_utf_16le;
+ ()
--- /dev/null
+All UTF tests passed!
--- /dev/null
+(* TEST *)
+
+(* baseline *)
+let () =
+ print_string "stdout 1\n";
+ prerr_string "stderr 1\n";
+ flush stdout;
+ flush stderr
+
+(* stderr unbuffered *)
+let () =
+ Out_channel.set_buffered stderr false;
+ print_string "stdout 2\n";
+ prerr_string "stderr 2\n";
+ print_string (Bool.to_string (Out_channel.is_buffered stderr));
+ print_char '\n';
+ flush stdout
+
+(* switching to unbuffered flushes the channel *)
+let () =
+ print_string "stdout 3\n";
+ prerr_string "stderr 3\n";
+ Out_channel.set_buffered stderr false;
+ flush stdout
+
+(* stderr back to buffered *)
+let () =
+ Out_channel.set_buffered stderr true;
+ print_string "stdout 4\n";
+ prerr_string "stderr 4\n";
+ print_string (Bool.to_string (Out_channel.is_buffered stderr));
+ print_char '\n';
+ flush stdout;
+ flush stderr
--- /dev/null
+stdout 1
+stderr 1
+stderr 2
+stdout 2
+false
+stderr 3
+stdout 3
+stdout 4
+true
+stderr 4
--- /dev/null
+(* TEST
+include systhreads
+readonly_files = "input_all.ml"
+*)
+
+let data_file =
+ "data.txt"
+
+let random_string size =
+ String.init size (fun _ -> Char.chr (Random.int 256))
+
+(* various sizes, binary mode *)
+
+let check size =
+ let data = random_string size in
+ Out_channel.with_open_bin data_file (fun oc -> Out_channel.output_string oc data);
+ let read_data = In_channel.with_open_bin data_file In_channel.input_all in
+ assert (data = read_data)
+
+let () =
+ List.iter check [ 0; 1; 65536; 65536 + 1; 2 * 65536 ]
+
+(* binary mode; non-zero starting position *)
+
+let data_size = 65536
+
+let check midpoint =
+ let data = random_string data_size in
+ Out_channel.with_open_bin data_file
+ (fun oc -> Out_channel.output_string oc data);
+ let contents =
+ In_channel.with_open_bin data_file
+ (fun ic ->
+ let s1 = Option.get (In_channel.really_input_string ic midpoint) in
+ let s2 = In_channel.input_all ic in
+ s1 ^ s2
+ )
+ in
+ assert (contents = data)
+
+let () =
+ List.iter check [0; 1; 100; data_size]
+
+(* text mode *)
+
+(* translates into LF *)
+let dos2unix inp out =
+ let s = In_channel.with_open_text inp In_channel.input_all in
+ Out_channel.with_open_bin out
+ (fun oc -> Out_channel.output_string oc s)
+
+(* translates into CRLF *)
+let unix2dos inp out =
+ let s = In_channel.with_open_text inp In_channel.input_all in
+ Out_channel.with_open_text out
+ (fun oc -> Out_channel.output_string oc s)
+
+let source_fn =
+ "input_all.ml"
+
+let source_fn_lf =
+ source_fn ^ ".lf"
+
+let source_fn_crlf =
+ source_fn ^ ".crlf"
+
+let () =
+ dos2unix source_fn source_fn_lf
+
+let () =
+ unix2dos source_fn source_fn_crlf
+
+let raw_contents =
+ In_channel.with_open_bin source_fn_lf
+ (fun ic -> Stdlib.really_input_string ic (Stdlib.in_channel_length ic))
+
+let check midpoint =
+ let contents =
+ In_channel.with_open_text source_fn_crlf
+ (fun ic ->
+ let s1 = Option.get (In_channel.really_input_string ic midpoint) in
+ let s2 = In_channel.input_all ic in
+ s1 ^ s2
+ )
+ in
+ assert (contents = raw_contents)
+
+let () =
+ List.iter check [0; 1; String.length raw_contents]
+
+let random_char () =
+ Char.chr (Random.int 256)
+
+let test_pipe n =
+ let buf = Bytes.init n (fun _ -> random_char ()) in
+ let toread, towrite = Unix.pipe () in
+ let producer () =
+ let rec loop pos rem =
+ let n = Unix.write towrite buf pos rem in
+ if n = rem then Unix.close towrite
+ else loop (pos + n) (rem - n)
+ in
+ loop 0 (Bytes.length buf)
+ in
+ let read_buf = ref "" in
+ let consumer () = read_buf := In_channel.input_all (Unix.in_channel_of_descr toread) in
+ let producer = Thread.create producer () in
+ let consumer = Thread.create consumer () in
+ Thread.join producer;
+ Thread.join consumer;
+ assert (!read_buf = Bytes.unsafe_to_string buf)
+
+let () =
+ test_pipe 655397
module TI2 = Test(HI2)(MI)
module TSP = Test(HSP)(MSP)
module TSL = Test(HSL)(MSL)
+
+(* These work with the old ephemeron API *)
+[@@@alert "-old_ephemeron_api"]
module TWS = Test(WS)(MS)
module TWSP1 = Test(WSP1)(MSP)
module TWSP2 = Test(WSP2)(MSP)
--- /dev/null
+(* TEST
+*)
+
+let _ =
+ (* In 4.13 this causes Obj.reachable_words to segfault
+ because of a missing initialization in caml_obj_reachable_words *)
+ ignore (Marshal.(to_string 123 [No_sharing]));
+ let n = Obj.reachable_words (Obj.repr (Array.init 10 (fun i -> i))) in
+ assert (n = 11)
open Testing;;
open Printf;;
+let test_roundtrip fmt of_string s =
+ test (sprintf fmt (of_string s) = s)
+;;
+
try
printf "d/i positive\n%!";
test (sprintf "%*lX" 5 42l = " 2A");
(*test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");*)
(* >> '-' is incompatible with '0' *)
+ test_roundtrip "0x%lX" Int32.of_string "0x0";
+ test_roundtrip "0x%lX" Int32.of_string "0x123";
+ test_roundtrip "0x%lX" Int32.of_string "0xABCDEF";
+ test_roundtrip "0x%lX" Int32.of_string "0x12345678";
+ test_roundtrip "0x%lX" Int32.of_string "0x7FFFFFFF";
- printf "\nlx negative\n%!";
+ printf "\nlX negative\n%!";
test (sprintf "%lX" (-42l) = "FFFFFFD6");
+ test_roundtrip "0x%lX" Int32.of_string "0x80000000";
+ test_roundtrip "0x%lX" Int32.of_string "0xFFFFFFFF";
printf "\nlo positive\n%!";
test (sprintf "%lo" 42l = "52");
test (sprintf "%*LX" 5 42L = " 2A");
(*test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");*)
(* >> '-' is incompatible with '0' *)
+ test_roundtrip "0x%LX" Int64.of_string "0x0";
+ test_roundtrip "0x%LX" Int64.of_string "0x123";
+ test_roundtrip "0x%LX" Int64.of_string "0xABCDEF";
+ test_roundtrip "0x%LX" Int64.of_string "0x1234567812345678";
+ test_roundtrip "0x%LX" Int64.of_string "0x7FFFFFFFFFFFFFFF";
- printf "\nLx negative\n%!";
+ printf "\nLX negative\n%!";
test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
+ test_roundtrip "0x%LX" Int64.of_string "0x8000000000000000";
+ test_roundtrip "0x%LX" Int64.of_string "0xFFFFFFFFFFFFFFFF";
printf "\nLo positive\n%!";
test (sprintf "%Lo" 42L = "52");
lx negative
239
lX positive
- 240 241 242 243 244 245
-lx negative
- 246
+ 240 241 242 243 244 245 246 247 248 249 250
+lX negative
+ 251 252 253
lo positive
- 247 248 249 250 251 252
+ 254 255 256 257 258 259
lo negative
- 253
+ 260
Ld/Li positive
- 254 255 256 257 258
+ 261 262 263 264 265
Ld/Li negative
- 259 260 261 262 263
+ 266 267 268 269 270
Lu positive
- 264 265 266 267 268
+ 271 272 273 274 275
Lu negative
- 269
-Lx positive
- 270 271 272 273 274 275
-Lx negative
276
-LX positive
+Lx positive
277 278 279 280 281 282
Lx negative
283
+LX positive
+ 284 285 286 287 288 289 290 291 292 293 294
+LX negative
+ 295 296 297
Lo positive
- 284 285 286 287 288 289
+ 298 299 300 301 302 303
Lo negative
- 290
+ 304
a
- 291
+ 305
t
- 292
+ 306
{...%}
- 293
+ 307
(...%)
- 294
+ 308
! % @ , and constants
- 295 296 297 298 299 300 301
+ 309 310 311 312 313 314 315
end of tests
All tests succeeded.
(fun () -> int_of_float (Random.float 1.0 *. 256.0));
test "Random.float 1.0 (next 8 bits)"
(fun () -> int_of_float (Random.float 1.0 *. 65536.0));
+ test "Random.bits32 (bits 0-7)"
+ (fun () -> Int32.to_int (Random.bits32()));
+ test "Random.bits32 (bits 20-27)"
+ (fun () -> Int32.(to_int (shift_right (Random.bits32()) 20)));
test "Random.int32 2^30 (bits 0-7)"
(fun () -> Int32.to_int (Random.int32 0x40000000l));
test "Random.int32 2^30 (bits 20-27)"
test "Random.int32 (256 * p) / p"
(let p = 7048673l in
fun () -> Int32.(to_int (div (Random.int32 (mul 256l p)) p)));
+ test "Random.bits64 (bits 0-7)"
+ (fun () -> Int64.to_int (Random.bits64()));
+ test "Random.bits64 (bits 30-37)"
+ (fun () -> Int64.(to_int (shift_right (Random.bits64()) 30)));
+ test "Random.bits64 (bits 52-59)"
+ (fun () -> Int64.(to_int (shift_right (Random.bits64()) 52)));
test "Random.int64 2^60 (bits 0-7)"
(fun () -> Int64.to_int (Random.int64 0x1000000000000000L));
test "Random.int64 2^60 (bits 30-37)"
(* TEST
*)
-let filter1 x = x mod 2 = 0 ;;
+let (!?) = List.to_seq
+let (!!) = List.of_seq
+let cmp = compare
+
+let head s = match s() with Seq.Cons(x,_) -> x | _ -> assert false
+
+let poison : _ Seq.t =
+ fun () ->
+ failwith "Poisoned"
(* Standard test case *)
let () =
Seq.unfold step first
in
begin
- assert ([1;2;3] = List.of_seq (range 1 3));
- assert ([] = List.of_seq (range 1 0));
+ assert ([1;2;3] = !!(range 1 3));
+ assert ([] = !!(range 1 0));
end
;;
let () =
assert (
List.concat [[1]; []; [2; 3];]
- = (let (!?) = List.to_seq in
- List.of_seq (Seq.concat !?[!?[1]; !?[]; !?[2; 3]])))
+ = !!(Seq.concat !?[!?[1]; !?[]; !?[2; 3]])
+ )
+
+(* [cycle empty] is empty. *)
+let () =
+ let xs = Seq.(cycle empty) in
+ assert (Seq.length xs = 0)
+
+(* [cycle] of a singleton. *)
+let () =
+ let xs = Seq.(take 7 (cycle !?[1])) in
+ assert (!!xs = [1;1;1;1;1;1;1])
+
+(* [cycle] of a longer sequence. *)
+let () =
+ let xs = Seq.(take 7 (cycle !?[1;2;3])) in
+ assert (!!xs = [1;2;3;1;2;3;1])
+
+(* [iterate] *)
+let () =
+ let f x = x + 7 in
+ let xs = Seq.(take 4 (iterate f 0)) in
+ assert (!!xs = [0; 7; 14; 21])
+
+(* [iterate] must not invoke [f] too early. (An easy trap to fall into.)
+ The function [f] does not tolerate being invoked 4 times. Indeed, in
+ this example, it should be called 3 times only. *)
+let () =
+ let c = ref 0 in
+ let f x = incr c; assert (!c < 4); x + 7 in
+ let xs = Seq.(take 4 (iterate f 0)) in
+ assert (!!xs = [0; 7; 14; 21])
+
+(* [init] *)
+let () =
+ let xs = Seq.(init 4 (fun i -> i+10)) in
+ assert (!!xs = [10;11;12;13])
+
+(* [fold_lefti] *)
+let () =
+ let xs = !?["a"; "b"] in
+ assert (
+ Seq.fold_lefti (fun acc i x -> (i, x) :: acc) [] xs = [ 1, "b"; 0, "a" ]
+ )
+
+(* [scan] *)
+let () =
+ let xs = Seq.(scan (+) 0 !?[1;2;3;4;5]) in
+ assert (!!xs = [0; 1; 3; 6; 10; 15])
+
+(* [scan] *)
+let () =
+ let xs = Seq.(scan (fun acc x -> x+1::acc) [] !?[1;2;3;4;5]) in
+ assert (!!xs = [[]; [2]; [3;2]; [4;3;2]; [5;4;3;2]; [6;5;4;3;2]])
+
+(* [is_empty] *)
+let () =
+ assert (Seq.is_empty Seq.empty);
+ assert (not @@ Seq.is_empty (List.to_seq [1;2;3]))
+
+(* [uncons] *)
+let () =
+ assert (match Seq.uncons (List.to_seq [1;2;3]) with
+ | None -> false
+ | Some (x,tl) -> x = 1 && List.of_seq tl = [2;3])
+
+(* [repeat] *)
+let () =
+ let seq = Seq.repeat 1 in
+ assert (Seq.length (Seq.take 1000 seq) = 1000);
+ assert (head seq = 1);
+ assert (head (Seq.drop 100_000 seq) = 1);
+ ()
+
+(* [forever] *)
+let () =
+ let r = ref 0 in
+ let seq = Seq.forever (fun () ->
+ let x = !r in incr r; x)
+ in
+ assert (List.of_seq (Seq.take 10 seq) = [0;1;2;3;4;5;6;7;8;9]);
+ assert (head seq = 10);
+ assert (Seq.length (Seq.take 1_000_000 seq) = 1_000_000);
+ ()
+
+(* [scan] must not invoke [f] too early. (An easy trap to fall into.)
+ The function [f] does not tolerate being invoked 4 times. Indeed, in
+ this example, it should be called 3 times only. *)
+let () =
+ let c = ref 0 in
+ let f x y = incr c; assert (!c < 4); x + y in
+ let xs = Seq.(take 4 (scan f 0 !?[1;2;3;4;5])) in
+ assert (!!xs = [0; 1; 3; 6])
+
+(* [take] *)
+let () =
+ let xs = Seq.take 0 poison in
+ assert (!!xs = [])
+
+(* [take_while] *)
+let () =
+ let xs = Seq.iterate succ 0 |> Seq.take_while (fun x->x<10) in
+ assert (!!xs = [0;1;2;3;4;5;6;7;8;9])
+
+(* [take_while] *)
+let () =
+ let xs = Seq.append (List.to_seq [1;2;3]) poison |> Seq.take_while (fun x -> x<3) in
+ assert (!!xs = [1;2])
+
+(* [drop] *)
+let () =
+ let xs = !?[1;2;3] in
+ assert (Seq.drop 0 xs == xs);
+ assert (!!(Seq.drop 1 xs) = [2;3]);
+ assert (!!(Seq.drop 2 xs) = [3]);
+ assert (!!(Seq.drop 3 xs) = []);
+ assert (!!(Seq.drop 4 xs) = []);
+ ()
+
+(* [sorted_merge] *)
+let () =
+ let xs = !?[1;3;4;7]
+ and ys = !?[2;2;5;7;16] in
+ assert (!!(Seq.sorted_merge cmp xs ys) = [1;2;2;3;4;5;7;7;16])
+
+(* [sorted_merge] should not consume its arguments too far. *)
+let () =
+ let (_ : int Seq.t) = Seq.sorted_merge cmp poison poison in
+ assert true;
+ let xs = Seq.(cons 1 (cons 3 poison))
+ and ys = Seq.(cons 2 poison) in
+ assert (!!(Seq.(take 2 (sorted_merge cmp xs ys))) = [1;2]);
+ assert (!!(Seq.(take 2 (sorted_merge cmp ys xs))) = [1;2]);
+ ()
+
+(* [interleave] *)
+let () =
+ let xs = !?[1;2;3]
+ and ys = !?[4;5] in
+ assert (!!(Seq.interleave xs ys) = [1;4;2;5;3]);
+ let xs = Seq.repeat 0 in
+ assert (!!(Seq.(take 6 (interleave xs ys))) = [0;4;0;5;0;0]);
+ let ys = Seq.repeat 1 in
+ assert (!!(Seq.(take 6 (interleave xs ys))) = [0;1;0;1;0;1]);
+ ()
+
+(* [once] *)
+let () =
+ let xs = Seq.once (!?[1;2;3]) in
+ let (n : int) = Seq.length xs in
+ assert (n = 3);
+ try
+ let (_ : int) = Seq.length xs in
+ print_endline "Oops"
+ with Seq.Forced_twice ->
+ ()
+
+(* [memoize] *)
+let () =
+ let xs = Seq.(memoize (once (!?[1;2;3]))) in
+ assert (Seq.length xs = 3);
+ assert (Seq.fold_left (+) 0 xs = 6);
+ ()
+
+(* [of_dispenser] *)
+let () =
+ let c = ref 0 in
+ let it () = let x = !c in c := x + 1; Some x in
+ let xs = Seq.of_dispenser it in
+ assert (!!(Seq.take 5 xs) = [0;1;2;3;4]);
+ assert (!!(Seq.take 5 xs) = [5;6;7;8;9]);
+ ()
+
+(* [memoize] and [of_dispenser] *)
+let () =
+ let c = ref 0 in
+ let it () = let x = !c in c := x + 1; Some x in
+ let xs = Seq.(memoize (of_dispenser it)) in
+ assert (!!(Seq.take 5 xs) = [0;1;2;3;4]);
+ assert (!!(Seq.take 5 xs) = [0;1;2;3;4]);
+ ()
+
+(* [mapi] *)
+let() =
+ let seq = List.to_seq [0;1;2;3] |> Seq.mapi (fun i x -> i, x) in
+ assert (Seq.length seq = 4);
+ assert (Seq.for_all (fun (x,y) -> x=y) seq)
+
+(* [product] *)
+let () =
+ (* test it works on infinite sequences *)
+ let s = Seq.(product (repeat 1) (repeat true)) in
+ assert ([1,true; 1,true; 1,true] = List.of_seq (Seq.take 3 s));
+ (* basic functionality test *)
+ let s = Seq.product (List.to_seq [1;2;3]) (List.to_seq [true;false]) in
+ assert ([1,false; 1,true; 2,false; 2,true; 3,false; 3,true]
+ = (List.of_seq s |> List.sort compare));
+ ()
+
+(* Auxiliary definitions of 2d matrices. *)
+let square n f =
+ Seq.(init n (fun i -> init n (fun j -> f i j)))
+
+let rec infinite i () =
+ Seq.(Cons (
+ map (fun j -> (i, j)) (ints 0),
+ infinite (i+1)
+ ))
+
+(* [transpose] of a finite square matrix. *)
+let () =
+ let matrix = square 3 (fun i j -> (i, j)) in
+ (* Check the first line of our square matrix. *)
+ assert (!!(head matrix) = [(0, 0); (0, 1); (0, 2)]);
+ (* Check the first column of our square matrix. *)
+ assert (!!(Seq.map head matrix) = [(0, 0); (1, 0); (2, 0)]);
+ (* Transpose the matrix. *)
+ let matrix = Seq.transpose matrix in
+ (* Check the first line of the transposed matrix. *)
+ assert (!!(head matrix) = [(0, 0); (1, 0); (2, 0)]);
+ (* Check the first column of the transposed matrix. *)
+ assert (!!(Seq.map head matrix) = [(0, 0); (0, 1); (0, 2)]);
+ ()
+
+(* [transpose] of a doubly-infinite matrix. *)
+let () =
+ let matrix = infinite 0 in
+ (* Check the first line. *)
+ assert (!!(Seq.(take 3 (head matrix))) = [(0, 0); (0, 1); (0, 2)]);
+ (* Check the first column. *)
+ assert (!!(Seq.(take 3 (map head matrix))) = [(0, 0); (1, 0); (2, 0)]);
+ (* Transpose the matrix. *)
+ let matrix = Seq.transpose matrix in
+ (* Check the first line of the transposed matrix. *)
+ assert (!!(Seq.(take 3 (head matrix))) = [(0, 0); (1, 0); (2, 0)]);
+ (* Check the first column of the transposed matrix. *)
+ assert (!!(Seq.(take 3 (map head matrix))) = [(0, 0); (0, 1); (0, 2)]);
+ ()
let () = print_endline "OK";;
(* TEST
+ flags = "-w -3"
include testing
*)
(* TEST
+ flags = "-w -3"
readonly_files = "mpr7769.txt"
*)
(* TEST
+unset DOES_NOT_EXIST
+
* hassysthreads
include systhreads
** bytecode
| s -> print_string "Surprising but OK\n"
let _ =
- let th = Thread.create crashme "no such variable" in
+ let th = Thread.create crashme "DOES_NOT_EXIST" in
Thread.join th
--- /dev/null
+(* TEST
+
+flags = "-g"
+ocamlrunparam += ",b=1"
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+(* Testing if uncaught exception handlers are behaving properly *)
+
+let () = Printexc.record_backtrace true
+
+exception UncaughtHandlerExn
+exception CallbackExn
+
+let handler final_exn exn =
+ let id = Thread.self () |> Thread.id in
+ let msg = Printexc.to_string exn in
+ Printf.eprintf "[thread %d] caught %s\n" id msg;
+ Printexc.print_backtrace stderr;
+ flush stderr;
+ raise final_exn
+
+let fn () = Printexc.raise_with_backtrace
+ CallbackExn
+ (Printexc.get_raw_backtrace ())
+
+let _ =
+ let th = Thread.create fn () in
+ Thread.join th;
+ Thread.set_uncaught_exception_handler (handler UncaughtHandlerExn);
+ let th = Thread.create fn () in
+ Thread.join th;
+ Thread.set_uncaught_exception_handler (handler Thread.Exit);
+ let th = Thread.create fn () in
+ Thread.join th
--- /dev/null
+Thread 1 killed on uncaught exception Uncaught_exception_handler.CallbackExn
+Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
+[thread 2] caught Uncaught_exception_handler.CallbackExn
+Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
+Thread 2 killed on uncaught exception Uncaught_exception_handler.CallbackExn
+Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
+Thread 2 uncaught exception handler raised Uncaught_exception_handler.UncaughtHandlerExn
+Raised at Uncaught_exception_handler.handler in file "uncaught_exception_handler.ml", line 26, characters 2-17
+Called from Thread.create.(fun) in file "thread.ml", line 58, characters 10-41
+[thread 3] caught Uncaught_exception_handler.CallbackExn
+Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
assert (Uchar.(compare max min) = 1);
()
+let test_utf_decode () =
+ let d0 = Uchar.utf_decode 1 Uchar.min in
+ let d1 = Uchar.utf_decode 4 Uchar.max in
+ let invalid = Uchar.utf_decode_invalid 3 in
+ assert (Uchar.utf_decode_is_valid d0);
+ assert (Uchar.utf_decode_length d0 = 1);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d0) Uchar.min);
+ assert (Uchar.utf_decode_is_valid d1);
+ assert (Uchar.utf_decode_length d1 = 4);
+ assert (Uchar.equal (Uchar.utf_decode_uchar d1) Uchar.max);
+ assert (not (Uchar.utf_decode_is_valid invalid));
+ assert (Uchar.utf_decode_length invalid = 3);
+ assert (Uchar.equal (Uchar.utf_decode_uchar invalid) Uchar.rep);
+ ()
+
+let test_utf_x_byte_length () =
+ assert (Uchar.utf_8_byte_length Uchar.min = 1);
+ assert (Uchar.utf_16_byte_length Uchar.min = 2);
+ assert (Uchar.utf_8_byte_length Uchar.max = 4);
+ assert (Uchar.utf_16_byte_length Uchar.max = 4);
+ let c = Uchar.of_int 0x1F42B in
+ assert (Uchar.utf_8_byte_length c = 4);
+ assert (Uchar.utf_16_byte_length c = 4);
+ let c = Uchar.of_int 0x9A7C in
+ assert (Uchar.utf_8_byte_length c = 3);
+ assert (Uchar.utf_16_byte_length c = 2);
+ ()
+
let tests () =
test_constants ();
test_succ ();
test_to_char ();
test_equal ();
test_compare ();
+ test_utf_decode ();
+ test_utf_x_byte_length ();
()
let () =
(* TEST
readonly_files = "reflector.ml"
+unset XVAR
* hasunix
** setup-ocamlc.byte-build-env
*)
-open Unix
-
let prog_name = "cmdline_prog.exe"
let run args =
- let out, inp = pipe () in
- let in_chan = in_channel_of_descr out in
+ let out, inp = Unix.pipe () in
+ let in_chan = Unix.in_channel_of_descr out in
set_binary_mode_in in_chan false;
let pid =
- create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args))
+ Unix.create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args))
Unix.stdin inp Unix.stderr in
List.iter (fun arg ->
let s = input_line in_chan in
Printf.printf "%S -> %S [%s]\n" arg s (if s = arg then "OK" else "FAIL")
) args;
close_in in_chan;
- let _, exit = waitpid [] pid in
- assert (exit = WEXITED 0)
+ let _, exit = Unix.waitpid [] pid in
+ assert (exit = Unix.WEXITED 0)
let exec args =
- execv ("./" ^ prog_name) (Array.of_list (prog_name :: args))
+ Unix.execv ("./" ^ prog_name) (Array.of_list (prog_name :: args))
let () =
List.iter run
(* TEST
+ unset FOO
* hasunix
include unix
script = "sh ${test_source_directory}/has-execvpe.sh"
-open Unix
-
let path_of_addr = function
- | ADDR_UNIX path -> path
+ | Unix.ADDR_UNIX path -> path
| _ -> assert false
;;
let test_sender ~client_socket ~server_socket ~server_addr ~client_addr =
Printf.printf "%S" (path_of_addr client_addr);
let byte = Bytes.make 1 't' in
- let sent_len = sendto client_socket byte 0 1 [] server_addr in
+ let sent_len = Unix.sendto client_socket byte 0 1 [] server_addr in
assert (sent_len = 1);
let buf = Bytes.make 1024 '\x00' in
- let (recv_len, sender) = recvfrom server_socket buf 0 1024 [] in
+ let (recv_len, sender) = Unix.recvfrom server_socket buf 0 1024 [] in
Printf.printf " as %S: " (path_of_addr sender);
assert (sender = client_addr);
print_endline "OK";;
let ensure_no_file path =
- try unlink path with Unix_error (ENOENT, _, _) -> ();;
+ try Unix.unlink path with Unix.Unix_error (ENOENT, _, _) -> ();;
let with_socket fn =
- let s = socket PF_UNIX SOCK_DGRAM 0 in
- Fun.protect ~finally:(fun () -> close s) (fun () -> fn s)
+ let s = Unix.socket PF_UNIX SOCK_DGRAM 0 in
+ Fun.protect ~finally:(fun () -> Unix.close s) (fun () -> fn s)
let with_bound_socket path fn =
with_socket (fun s ->
- let addr = ADDR_UNIX path in
- bind s addr;
+ let addr = Unix.ADDR_UNIX path in
+ Unix.bind s addr;
fn addr s
)
(* TEST
+unset FOO
+unset FOO2
include unix
flags += "-strict-sequence -safe-string -w +A-70 -warn-error +A"
modules = "stubs.c"
--- /dev/null
+#!/bin/sh
+
+# Test if the OS runtime has afunix enabled.
+
+if sc query afunix > /dev/null; then
+ exit "${TEST_PASS}";
+fi
+exit "${TEST_SKIP}"
--- /dev/null
+(* TEST
+
+* libwin32unix
+ script = "sh ${test_source_directory}/has-afunix.sh"
+** hassysthreads
+ include systhreads
+*** script
+**** bytecode
+output = "${test_build_directory}/program-output"
+stdout = "${output}"
+**** native
+output = "${test_build_directory}/program-output"
+stdout = "${output}"
+
+ *)
+
+let peer id fd =
+ let msg = Bytes.of_string (Printf.sprintf "%d" id) in
+ ignore (Unix.write fd msg 0 (Bytes.length msg));
+ ignore (Unix.read fd msg 0 (Bytes.length msg));
+ let expected = Bytes.of_string (Printf.sprintf "%d" (if id = 0 then 1 else 0)) in
+ if msg = expected then
+ Printf.printf "Ok\n%!"
+ else
+ Printf.printf "%d: %s\n%!" id (Bytes.to_string msg);
+ flush_all ()
+
+let () =
+ let fd0, fd1 = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+ let t0, t1 = Thread.create (peer 0) fd0, Thread.create (peer 1) fd1 in
+ Thread.join t0; Thread.join t1;
+ Unix.close fd0; Unix.close fd1
** native
*)
-open Unix
-
external set_fake_clock : int64 -> unit = "set_fake_clock"
-let real_time tm = {tm with tm_year = tm.tm_year + 1900; tm_mon = tm.tm_mon + 1}
+let real_time tm =
+ Unix.{tm with tm_year = tm.tm_year + 1900; tm_mon = tm.tm_mon + 1}
let print_time () =
let time = Unix.time () |> Unix.gmtime |> real_time in
let link1 = "link1"
let link2 = "link2"
+let link3 = "link3"
+let link_dir = "link_directory"
+let dir = "directory"
+let did_raise = ref false
let link_exists s =
try (Unix.lstat s).Unix.st_kind = Unix.S_LNK with _ -> false
+let directory_exists s =
+ try (Unix.lstat s).Unix.st_kind = Unix.S_DIR with _ -> false
+
let main () =
close_out (open_out "test.txt");
if link_exists link1 then Sys.remove link1;
print_endline "Unix.symlink works with backwards slashes";
Unix.symlink ~to_dir:false "./test.txt" link2;
assert ((Unix.stat link2).Unix.st_kind = Unix.S_REG);
- print_endline "Unix.symlink works with forward slashes"
+ print_endline "Unix.symlink works with forward slashes";
+
+ did_raise := false;
+ if not (directory_exists dir) then
+ Unix.mkdir dir 0o644;
+ begin try Unix.unlink dir with
+ | Unix.Unix_error((EISDIR (* Linux *) | EPERM (* POSIX *) | EACCES (* Windows *)), _, _) ->
+ did_raise := true end;
+ assert (!did_raise);
+ assert (directory_exists dir);
+ print_endline "Unix.unlink cannot delete directories";
+
+ did_raise := false;
+ if not (directory_exists dir) then
+ Unix.mkdir dir 0o644;
+ begin try Sys.remove dir with Sys_error _ -> did_raise := true end;
+ assert (!did_raise);
+ assert (directory_exists dir);
+ print_endline "Sys.remove cannot delete directories";
+
+ if not (directory_exists dir) then
+ Unix.mkdir dir 0o644;
+ if not (link_exists link_dir) then
+ Unix.symlink ~to_dir:true dir link_dir;
+ Unix.unlink link_dir;
+ print_endline "Unix.unlink can delete symlinks to directories";
+
+ if not (link_exists link3) then
+ Unix.symlink ~to_dir:false "test.txt" link3;
+ Unix.unlink link3;
+ print_endline "Unix.unlink can delete symlinks to files";
+
+ if not (directory_exists dir) then
+ Unix.mkdir dir 0o644;
+ if not (link_exists link_dir) then
+ Unix.symlink ~to_dir:true dir link_dir;
+ Sys.remove link_dir;
+ print_endline "Sys.remove can delete symlinks to directories";
+
+ if not (link_exists link3) then
+ Unix.symlink ~to_dir:false "test.txt" link3;
+ Sys.remove link3;
+ print_endline "Sys.remove can delete symlinks to files"
let () =
Unix.handle_unix_error main ()
Unix.symlink works with backwards slashes
Unix.symlink works with forward slashes
+Unix.unlink cannot delete directories
+Sys.remove cannot delete directories
+Unix.unlink can delete symlinks to directories
+Unix.unlink can delete symlinks to files
+Sys.remove can delete symlinks to directories
+Sys.remove can delete symlinks to files
--- /dev/null
+(* TEST
+ * expect
+*)
+
+ let x = abc
+;;
+[%%expect{|
+Line 1, characters 10-13:
+1 | let x = abc
+ ^^^
+Error: Unbound value abc
+Hint: Did you mean abs?
+|}];;
(* Testing handling of infix_tag by ephemeron *)
+(* This test will have to be ported to the new ephemeron API *)
+[@@@alert "-old_ephemeron_api"]
+
let infix n = let rec f () = n and g () = f () in g
(* Issue #9485 *)
--- /dev/null
+(* TEST *)
+
+(* Testing handling of infix_tag by ephemeron *)
+
+let infix n = let rec f () = n and g () = f () in g
+
+(* Issue #9485 *)
+let () =
+ let w = Weak.create 1 in
+ Weak.set w 0 (Some (infix 12));
+ match Weak.get_copy w 0 with Some h -> ignore (h ()) | _ -> ()
+
+(* Issue #7810 *)
+let ephe x =
+ let open Ephemeron.K1 in
+ let e = make x 42 in
+ Gc.full_major ();
+ (x, query e x)
+
+let () =
+ assert (ephe (ref 1000) = (ref 1000, Some 42));
+ match ephe (infix 12) with
+ | (h, Some 42) -> ()
+ | _ -> assert false
--- /dev/null
+(* TEST
+*)
+
+(* This test is only relevant to the old ephemeron API *)
+[@@@alert "-old_ephemeron_api"]
+
+let debug = false
+
+open Printf
+open Ephemeron
+
+let empty = ref 0
+let make_ra ~size = Array.init size (fun _ -> ref 1) [@@inline never]
+let make_ephes ~size = Array.init size (fun _ -> Ephemeron.K1.create ()) [@@inline never]
+
+let test ~size ~slice =
+ let keys1 = make_ra ~size in
+ let keys2 = make_ra ~size in
+ let datas1 = make_ra ~size in
+ let datas2 = make_ra ~size in
+ let ephe1 = make_ephes ~size in
+ let ephe2 = make_ephes ~size in
+ if debug then Gc.set { (Gc.get ()) with Gc.verbose = 0x3 };
+ (** Fill ephe.(i )from key.(i) to data.(i) *)
+ for i=0 to size-1 do Ephemeron.K1.set_key ephe1.(i) keys1.(i); done;
+ for i=0 to size-1 do Ephemeron.K1.set_data ephe1.(i) datas1.(i); done;
+ for i=0 to size-1 do Ephemeron.K1.set_key ephe2.(i) keys2.(i); done;
+ for i=0 to size-1 do Ephemeron.K1.set_data ephe2.(i) datas2.(i); done;
+ (** Push everything in the major heap *)
+ if debug then Printf.eprintf "Start minor major\n%!";
+ Gc.minor ();
+ Gc.major ();
+ if debug then Printf.eprintf "start emptying\n%!";
+ for i=0 to size-1 do keys1.(i) <- empty; done;
+ for i=0 to size-1 do datas1.(i) <- empty; done;
+ (** The emptying is done during a major so keys and data are kept alive by the
+ assignments. Restart a new major *)
+ Gc.major ();
+ if debug then Printf.eprintf "Start checking state\n%!";
+ (** Fill the ephemeron with an alive key *)
+ if debug then Printf.eprintf "Start replacing dead key into alive one\n%!";
+ (* Printf.eprintf "put in set (2) %i\n%!" (Gc.major_slice (10*4*slice*6)); *)
+ for i=0 to size-1 do
+ ignore (Gc.major_slice (4));
+ if debug then Printf.eprintf "@%!";
+ Ephemeron.K1.blit_data ephe1.(i) ephe2.(i);
+ if debug && 0 = i mod (size / 10) then Printf.eprintf "done %5i/%i\n%!" i size;
+ done;
+ if debug then Printf.eprintf "end\n%!";
+ (** Finish all, assertion in clean phase should not find a dangling data *)
+ Gc.full_major ();
+ let r = ref 0 in
+ if debug then
+ for i=0 to size-1 do
+ if Ephemeron.K1.check_data ephe2.(size-1-i) then incr r;
+ if 0 = i mod (size / 10) then Printf.eprintf "done %5i/%i %i\n%!" i size !r;
+ done;
+ (* keep the arrays alive *)
+ assert (Array.length keys1 = size);
+ assert (Array.length keys2 = size);
+ assert (Array.length datas1 = size);
+ assert (Array.length datas2 = size);
+ assert (Array.length ephe1 = size);
+ assert (Array.length ephe2 = size)
+[@@inline never]
+
+let () =
+ test ~size:1000 ~slice:5;
+ test ~size:1000 ~slice:10;
+ test ~size:1000 ~slice:15
(* TEST
*)
+(* These tests will have to be ported to the new API *)
+[@@@alert "-old_ephemeron_api"]
+
let debug = false
open Printf
*)
+(* This will have to be ported to the new ephemeron API *)
+[@@@alert "-old_ephemeron_api"]
+
let nb_test = 4
let max_level = 10
(** probability that a branch is not linked to a previous one *)
--- /dev/null
+(* TEST
+*)
+
+(***
+ This test evaluate boolean formula composed by conjunction and
+ disjunction using ephemeron:
+ - true == alive, false == garbage collected
+ - and == an n-ephemeron, or == many 1-ephemeron
+
+*)
+
+let nb_test = 4
+let max_level = 10
+ (** probability that a branch is not linked to a previous one *)
+let proba_no_shared = 0.2
+let arity_max = 4
+
+let proba_new = proba_no_shared ** (1./.(float_of_int max_level))
+
+open Format
+open Ephemeron
+
+let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
+let is_false test s b = is_true test s (not b)
+
+type varephe = int ref
+type ephe = (varephe,varephe) Kn.t
+
+type formula =
+ | Constant of bool
+ | And of var array
+ | Or of var array
+
+and var = {
+ form: formula;
+ value: bool;
+ ephe: varephe Weak.t;
+}
+
+let print_short_bool fmt b =
+ if b
+ then pp_print_string fmt "t"
+ else pp_print_string fmt "f"
+
+let rec pp_form fmt = function
+ | Constant b ->
+ fprintf fmt "%B" b
+ | And a ->
+ fprintf fmt "And[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
+ | Or a ->
+ fprintf fmt "Or[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
+
+and pp_var fmt v =
+ fprintf fmt "%a%a:%a;@ "
+ print_short_bool v.value
+ print_short_bool (Weak.check v.ephe 0)
+ pp_form v.form
+
+type env = {
+ (** resizable array for cheap *)
+ vars : (int,var) Hashtbl.t;
+ (** the ephemerons must be alive *)
+ ephes : ephe Stack.t;
+ (** keep alive the true constant *)
+ varephe_true : varephe Stack.t;
+(** keep temporarily alive the false constant *)
+ varephe_false : varephe Stack.t;
+}
+
+let new_env () = {
+ vars = Hashtbl.create 100;
+ ephes = Stack.create ();
+ varephe_true = Stack.create ();
+ varephe_false = Stack.create ();
+}
+
+let evaluate = function
+ | Constant b -> b
+ | And a -> Array.fold_left (fun acc e -> acc && e.value) true a
+ | Or a -> Array.fold_left (fun acc e -> acc || e.value) false a
+
+let get_ephe v =
+ match Weak.get v.ephe 0 with
+ | None ->
+ invalid_arg "Error: weak dead but nothing have been released"
+ | Some r -> r
+
+(** create a variable and its definition in the boolean world and
+ ephemerons world *)
+let rec create env rem_level (** remaining level *) =
+ let varephe = ref 1 in
+ let form =
+ if rem_level = 0 then (** Constant *)
+ if Random.bool ()
+ then (Stack.push varephe env.varephe_true ; Constant true )
+ else (Stack.push varephe env.varephe_false; Constant false)
+ else
+ let size = (Random.int (arity_max - 1)) + 2 in
+ let new_link _ =
+ if (Hashtbl.length env.vars) = 0 || Random.float 1. < proba_new
+ then create env (rem_level -1)
+ else Hashtbl.find env.vars (Random.int (Hashtbl.length env.vars))
+ in
+ let args = Array.init size new_link in
+ if Random.bool ()
+ then begin (** Or *)
+ Array.iter (fun v ->
+ let r = get_ephe v in
+ let e = Kn.make [| r |] varephe in
+ Stack.push e env.ephes
+ ) args; Or args
+ end
+ else begin (** And *)
+ let e = Kn.make (Array.map get_ephe args) varephe in
+ Stack.push e env.ephes;
+ And args
+ end
+ in
+ let create_weak e =
+ let w = Weak.create 1 in
+ Weak.set w 0 (Some e);
+ w
+ in
+ let v = {form; value = evaluate form;
+ ephe = create_weak varephe;
+ } in
+ Hashtbl.add env.vars (Hashtbl.length env.vars) v;
+ v
+
+
+let check_var v = v.value = Weak.check v.ephe 0
+
+let run test init =
+ Random.init init;
+ let env = new_env () in
+ let _top = create env max_level in
+ (** release false ref *)
+ Stack.clear env.varephe_false;
+ Gc.full_major ();
+ let res = Hashtbl.fold (fun _ v acc -> acc && check_var v) env.vars true in
+ is_true test "check" res;
+ env (* Keep env.varephe_true alive. *)
+
+let () =
+ for i = 0 to nb_test do
+ ignore (run ("test"^(Int.to_string i)) i);
+ done
--- /dev/null
+test0 check: OK
+test1 check: OK
+test2 check: OK
+test3 check: OK
+test4 check: OK
--- /dev/null
+(* TEST
+*)
+
+let debug = false
+
+open Printf
+open Ephemeron
+
+let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
+let is_false test s b = is_true test s (not b)
+
+let final r v = Gc.finalise_last (fun () -> r := false) v
+
+let is_key_value test (key_alive, _) = is_true test "key set" !key_alive
+let is_data_value test (_, data_alive) = is_true test "data set" !data_alive
+
+let is_key_unset test (key_alive, _) = is_false test "key unset" !key_alive
+let is_data_unset test (_, data_alive) = is_false test "data unset" !data_alive
+
+let make_ra () = ref (ref 1) [@@inline never]
+let make_rb () = ref (ref (ref 2)) [@@inline never]
+let ra = make_ra ()
+let rb = make_rb ()
+
+let create key data =
+ let key_alive = ref true in
+ let data_alive = ref true in
+ let eph = K1.make key data in
+ final key_alive key;
+ final data_alive data;
+ (eph, (key_alive, data_alive))
+
+(** test: key alive data dangling *)
+let test1 () =
+ let test = "test1" in
+ Gc.minor ();
+ Gc.full_major ();
+ let (eph, flags) = create !ra (ref 42) in
+ is_key_value test flags;
+ is_data_value test flags;
+ Gc.minor ();
+ is_key_value test flags;
+ is_data_value test flags;
+ Gc.full_major ();
+ is_key_value test flags;
+ is_data_value test flags;
+ ra := ref 12;
+ Gc.full_major ();
+ is_key_unset test flags;
+ is_data_unset test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test1 [@inlined never]) ()
+
+(** test: key dangling data dangling *)
+let test2 () =
+ let test = "test2" in
+ Gc.minor ();
+ Gc.full_major ();
+ let (eph, flags) = create (ref 125) (ref 42) in
+ is_key_value test flags;
+ is_data_value test flags;
+ ra := ref 13;
+ Gc.minor ();
+ is_key_unset test flags;
+ is_data_unset test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test2 [@inlined never]) ()
+
+(** test: key dangling data alive *)
+let test3 () =
+ let test = "test3" in
+ Gc.minor ();
+ Gc.full_major ();
+ let (eph, flags) = create (ref 125) !ra in
+ is_key_value test flags;
+ is_data_value test flags;
+ ra := ref 14;
+ Gc.minor ();
+ is_key_unset test flags;
+ is_data_value test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test3 [@inlined never]) ()
+
+(** test: key alive but one away, data dangling *)
+let test4 () =
+ let test = "test4" in
+ Gc.minor ();
+ Gc.full_major ();
+ rb := ref (ref 3);
+ let (eph, flags) = create !(!rb) (ref 43) in
+ is_key_value test flags;
+ is_data_value test flags;
+ Gc.minor ();
+ Gc.minor ();
+ is_key_value test flags;
+ is_data_value test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test4 [@inlined never]) ()
+
+(** test: key dangling but one away, data dangling *)
+let test5 () =
+ let test = "test5" in
+ Gc.minor ();
+ Gc.full_major ();
+ rb := ref (ref 3);
+ let (eph, flags) = create !(!rb) (ref 43) in
+ is_key_value test flags;
+ is_data_value test flags;
+ !rb := ref 4;
+ Gc.minor ();
+ Gc.minor ();
+ is_key_unset test flags;
+ is_data_unset test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test5 [@inlined never]) ()
+
+(** test: key accessible from data but all dangling *)
+let test6 () =
+ let test = "test6" in
+ Gc.minor ();
+ Gc.full_major ();
+ rb := ref (ref 3);
+ let (eph, flags) = create !(!rb) (ref !(!rb)) in
+ Gc.minor ();
+ is_key_value test flags;
+ !rb := ref 4;
+ Gc.full_major ();
+ is_key_unset test flags;
+ is_data_unset test flags;
+ ignore (Sys.opaque_identity eph)
+let () = (test6 [@inlined never]) ()
+
+(** test: ephemeron accessible from data but they are dangling *)
+type t =
+ | No
+ | Ephe of (int ref, t ref) K1.t
+
+let make_rc () = ref (ref No) [@@inline never]
+let rc = make_rc ()
+
+let test7 () =
+ let test = "test7" in
+ Gc.minor ();
+ Gc.full_major ();
+ ra := ref 42;
+ let weak : t ref Weak.t = Weak.create 1 in
+ let eph = ref (K1.make !ra !rc) in
+ !rc := Ephe !eph;
+ Weak.set weak 0 (Some !rc);
+ Gc.minor ();
+ is_true test "before" (Weak.check weak 0);
+ eph := K1.make (ref 0) (ref No);
+ rc := ref No;
+ Gc.full_major ();
+ Gc.full_major ();
+ Gc.full_major ();
+ is_false test "after" (Weak.check weak 0)
+let () = (test7 [@inlined never]) ()
--- /dev/null
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key set: OK
+test1 data set: OK
+test1 key unset: OK
+test1 data unset: OK
+test2 key set: OK
+test2 data set: OK
+test2 key unset: OK
+test2 data unset: OK
+test3 key set: OK
+test3 data set: OK
+test3 key unset: OK
+test3 data set: OK
+test4 key set: OK
+test4 data set: OK
+test4 key set: OK
+test4 data set: OK
+test5 key set: OK
+test5 data set: OK
+test5 key unset: OK
+test5 data unset: OK
+test6 key set: OK
+test6 key unset: OK
+test6 data unset: OK
+test7 before: OK
+test7 after: OK
+#define CAML_INTERNALS
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/callback.h>
#include <caml/memory.h>
+#include <caml/misc.h>
-#ifdef _WIN32
-int wmain(int argc, wchar_t ** argv){
-#else
-int main(int argc, char ** argv){
-#endif
-
+int main_os(int argc, char_os **argv)
+{
caml_startup(argv);
return 0;
}
readonly_files = "puts.c"
use_runtime = "false"
+unset FOO
* hasunix
include unix
core_type (//toplevel//[4,29+8]..[4,29+11])
Ptyp_constr "int" (//toplevel//[4,29+8]..[4,29+11])
[]
- expression (//toplevel//[4,29+4]..[4,29+15]) ghost
+ expression (//toplevel//[4,29+4]..[4,29+15])
Pexp_constraint
expression (//toplevel//[4,29+14]..[4,29+15])
Pexp_constant PConst_int (3,None)
expression (//toplevel//[4,17+17]..[4,17+29])
Pexp_record
[
- "contents" (//toplevel//[4,17+19]..[4,17+27])
- expression (//toplevel//[4,17+19]..[4,17+27]) ghost
- Pexp_ident "contents" (//toplevel//[4,17+19]..[4,17+27]) ghost
+ "contents" (//toplevel//[4,17+19]..[4,17+27]) ghost
+ expression (//toplevel//[4,17+19]..[4,17+27])
+ Pexp_ident "contents" (//toplevel//[4,17+19]..[4,17+27])
]
None
]
Pexp_record
[
"contents" (//toplevel//[2,1+10]..[2,1+18])
- expression (//toplevel//[2,1+10]..[2,1+28]) ghost
+ expression (//toplevel//[2,1+19]..[2,1+28])
Pexp_constraint
expression (//toplevel//[2,1+27]..[2,1+28])
Pexp_constant PConst_int (3,None)
expression (//toplevel//[2,1+17]..[2,1+35])
Pexp_record
[
- "contents" (//toplevel//[2,1+19]..[2,1+27])
- expression (//toplevel//[2,1+19]..[2,1+33]) ghost
+ "contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
+ expression (//toplevel//[2,1+19]..[2,1+33])
Pexp_constraint
- expression (//toplevel//[2,1+19]..[2,1+33]) ghost
- Pexp_ident "contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
+ expression (//toplevel//[2,1+19]..[2,1+27])
+ Pexp_ident "contents" (//toplevel//[2,1+19]..[2,1+27])
core_type (//toplevel//[2,1+30]..[2,1+33])
Ptyp_constr "int" (//toplevel//[2,1+30]..[2,1+33])
[]
Ppat_record Closed
[
"contents" (//toplevel//[2,1+19]..[2,1+27]) ghost
- pattern (//toplevel//[2,1+19]..[2,1+33]) ghost
+ pattern (//toplevel//[2,1+19]..[2,1+33])
Ppat_constraint
pattern (//toplevel//[2,1+19]..[2,1+27])
Ppat_var "contents" (//toplevel//[2,1+19]..[2,1+27])
Ppat_record Closed
[
"contents" (//toplevel//[2,1+19]..[2,1+27])
- pattern (//toplevel//[2,1+19]..[2,1+37]) ghost
+ pattern (//toplevel//[2,1+28]..[2,1+37])
Ppat_constraint
pattern (//toplevel//[2,1+36]..[2,1+37])
Ppat_var "i" (//toplevel//[2,1+36]..[2,1+37])
]
val x : int ref -> int = <fun>
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[3,9+50])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_any
+ expression (//toplevel//[3,9+2]..[3,9+50])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[3,9+8]..[3,9+8]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[3,9+9]..[3,9+21])
+ Pcf_val Immutable
+ "foo" (//toplevel//[3,9+13]..[3,9+16])
+ Concrete Fresh
+ expression (//toplevel//[3,9+19]..[3,9+21])
+ Pexp_constant PConst_int (12,None)
+ class_field (//toplevel//[3,9+22]..[3,9+46])
+ Pcf_method Public
+ "x" (//toplevel//[3,9+29]..[3,9+30])
+ Concrete Fresh
+ expression (//toplevel//[3,9+31]..[3,9+46]) ghost
+ Pexp_poly
+ expression (//toplevel//[3,9+31]..[3,9+46]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[3,9+31]..[3,9+34])
+ Ppat_var "foo" (//toplevel//[3,9+31]..[3,9+34])
+ expression (//toplevel//[3,9+37]..[3,9+46])
+ Pexp_override
+ [
+ <override> "foo" (//toplevel//[3,9+40]..[3,9+43]) ghost
+ expression (//toplevel//[3,9+40]..[3,9+43])
+ Pexp_ident "foo" (//toplevel//[3,9+40]..[3,9+43])
+ ]
+ None
+ ]
+ ]
+ ]
+
+- : < x : int -> 'a > as 'a = <obj>
Ptop_def
[
structure_item (//toplevel//[4,19+0]..[4,19+26])
]
val x : int = 42
+Ptop_def
+ [
+ structure_item (//toplevel//[3,56+0]..[3,56+31])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[3,56+4]..[3,56+5])
+ Ppat_var "x" (//toplevel//[3,56+4]..[3,56+5])
+ expression (//toplevel//[3,56+8]..[3,56+31])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[3,56+14]..[3,56+14]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[3,56+15]..[3,56+27])
+ Pcf_method Public
+ "f" (//toplevel//[3,56+22]..[3,56+23])
+ Concrete Fresh
+ expression (//toplevel//[3,56+26]..[3,56+27]) ghost
+ Pexp_poly
+ expression (//toplevel//[3,56+26]..[3,56+27])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ ]
+ ]
+
+val x : < f : int > = <obj>
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+35])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[1,0+4]..[1,0+5])
+ Ppat_var "x" (//toplevel//[1,0+4]..[1,0+5])
+ expression (//toplevel//[1,0+8]..[1,0+35])
+ Pexp_send "f"
+ expression (//toplevel//[1,0+8]..[1,0+31])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[1,0+14]..[1,0+14]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[1,0+15]..[1,0+27])
+ Pcf_method Public
+ "f" (//toplevel//[1,0+22]..[1,0+23])
+ Concrete Fresh
+ expression (//toplevel//[1,0+26]..[1,0+27]) ghost
+ Pexp_poly
+ expression (//toplevel//[1,0+26]..[1,0+27])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ ]
+ ]
+
+val x : int = 1
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+36])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[1,0+4]..[1,0+5])
+ Ppat_var "x" (//toplevel//[1,0+4]..[1,0+5])
+ expression (//toplevel//[1,0+8]..[1,0+36])
+ Pexp_construct "Some" (//toplevel//[1,0+8]..[1,0+12])
+ Some
+ expression (//toplevel//[1,0+13]..[1,0+36])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[1,0+19]..[1,0+19]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[1,0+20]..[1,0+32])
+ Pcf_method Public
+ "f" (//toplevel//[1,0+27]..[1,0+28])
+ Concrete Fresh
+ expression (//toplevel//[1,0+31]..[1,0+32]) ghost
+ Pexp_poly
+ expression (//toplevel//[1,0+31]..[1,0+32])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ ]
+ ]
+
+val x : < f : int > option = Some <obj>
+Ptop_def
+ [
+ structure_item (//toplevel//[1,0+0]..[1,0+40])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[1,0+4]..[1,0+5])
+ Ppat_var "x" (//toplevel//[1,0+4]..[1,0+5])
+ expression (//toplevel//[1,0+8]..[1,0+40])
+ Pexp_construct "Some" (//toplevel//[1,0+8]..[1,0+12])
+ Some
+ expression (//toplevel//[1,0+13]..[1,0+40])
+ Pexp_send "f"
+ expression (//toplevel//[1,0+13]..[1,0+36])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[1,0+19]..[1,0+19]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[1,0+20]..[1,0+32])
+ Pcf_method Public
+ "f" (//toplevel//[1,0+27]..[1,0+28])
+ Concrete Fresh
+ expression (//toplevel//[1,0+31]..[1,0+32]) ghost
+ Pexp_poly
+ expression (//toplevel//[1,0+31]..[1,0+32])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ ]
+ ]
+
+val x : int option = Some 1
+Ptop_def
+ [
+ structure_item (//toplevel//[2,1+0]..[5,76+12])
+ Pstr_eval
+ expression (//toplevel//[2,1+0]..[5,76+12])
+ Pexp_let Nonrec
+ [
+ <def>
+ pattern (//toplevel//[2,1+4]..[2,1+5])
+ Ppat_var "f" (//toplevel//[2,1+4]..[2,1+5])
+ expression (//toplevel//[2,1+6]..[2,1+15]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[2,1+6]..[2,1+7])
+ Ppat_var "x" (//toplevel//[2,1+6]..[2,1+7])
+ expression (//toplevel//[2,1+8]..[2,1+15]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[2,1+8]..[2,1+9])
+ Ppat_var "y" (//toplevel//[2,1+8]..[2,1+9])
+ expression (//toplevel//[2,1+10]..[2,1+15]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[2,1+10]..[2,1+11])
+ Ppat_var "z" (//toplevel//[2,1+10]..[2,1+11])
+ expression (//toplevel//[2,1+14]..[2,1+15])
+ Pexp_ident "x" (//toplevel//[2,1+14]..[2,1+15])
+ ]
+ expression (//toplevel//[3,20+0]..[5,76+12])
+ Pexp_apply
+ expression (//toplevel//[3,20+0]..[3,20+1])
+ Pexp_ident "f" (//toplevel//[3,20+0]..[3,20+1])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[3,20+2]..[3,20+25])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[3,20+8]..[3,20+8]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[3,20+9]..[3,20+21])
+ Pcf_method Public
+ "f" (//toplevel//[3,20+16]..[3,20+17])
+ Concrete Fresh
+ expression (//toplevel//[3,20+20]..[3,20+21]) ghost
+ Pexp_poly
+ expression (//toplevel//[3,20+20]..[3,20+21])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ <arg>
+ Nolabel
+ expression (//toplevel//[4,46+2]..[4,46+29])
+ Pexp_send "f"
+ expression (//toplevel//[4,46+2]..[4,46+25])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[4,46+8]..[4,46+8]) ghost
+ Ppat_any
+ [
+ class_field (//toplevel//[4,46+9]..[4,46+21])
+ Pcf_method Public
+ "f" (//toplevel//[4,46+16]..[4,46+17])
+ Concrete Fresh
+ expression (//toplevel//[4,46+20]..[4,46+21]) ghost
+ Pexp_poly
+ expression (//toplevel//[4,46+20]..[4,46+21])
+ Pexp_constant PConst_int (1,None)
+ None
+ ]
+ <arg>
+ Nolabel
+ expression (//toplevel//[5,76+2]..[5,76+12])
+ Pexp_object
+ class_structure
+ pattern (//toplevel//[5,76+8]..[5,76+8]) ghost
+ Ppat_any
+ []
+ ]
+ ]
+
+- : < f : int > = <obj>
+Ptop_def
+ [
+ structure_item (//toplevel//[3,66+0]..[5,98+12])
+ Pstr_value Nonrec
+ [
+ <def>
+ pattern (//toplevel//[3,66+4]..[3,66+5])
+ Ppat_var "g" (//toplevel//[3,66+4]..[3,66+5])
+ expression (//toplevel//[3,66+6]..[5,98+12]) ghost
+ Pexp_fun
+ Nolabel
+ None
+ pattern (//toplevel//[3,66+6]..[3,66+7])
+ Ppat_var "y" (//toplevel//[3,66+6]..[3,66+7])
+ expression (//toplevel//[4,76+2]..[5,98+12])
+ Pexp_let Nonrec
+ [
+ <def>
+ pattern (//toplevel//[4,76+6]..[4,76+7])
+ Ppat_var "f" (//toplevel//[4,76+6]..[4,76+7])
+ expression (//toplevel//[4,76+8]..[4,76+18]) ghost
+ Pexp_fun
+ Labelled "y"
+ None
+ pattern (//toplevel//[4,76+9]..[4,76+10])
+ Ppat_var "y" (//toplevel//[4,76+9]..[4,76+10])
+ expression (//toplevel//[4,76+13]..[4,76+18])
+ Pexp_apply
+ expression (//toplevel//[4,76+15]..[4,76+16])
+ Pexp_ident "+" (//toplevel//[4,76+15]..[4,76+16])
+ [
+ <arg>
+ Nolabel
+ expression (//toplevel//[4,76+13]..[4,76+14])
+ Pexp_ident "y" (//toplevel//[4,76+13]..[4,76+14])
+ <arg>
+ Nolabel
+ expression (//toplevel//[4,76+17]..[4,76+18])
+ Pexp_constant PConst_int (1,None)
+ ]
+ ]
+ expression (//toplevel//[5,98+2]..[5,98+12])
+ Pexp_apply
+ expression (//toplevel//[5,98+2]..[5,98+3])
+ Pexp_ident "f" (//toplevel//[5,98+2]..[5,98+3])
+ [
+ <arg>
+ Labelled "y"
+ expression (//toplevel//[5,98+5]..[5,98+12])
+ Pexp_constraint
+ expression (//toplevel//[5,98+6]..[5,98+7])
+ Pexp_ident "y" (//toplevel//[5,98+6]..[5,98+7])
+ core_type (//toplevel//[5,98+8]..[5,98+11])
+ Ptyp_constr "int" (//toplevel//[5,98+8]..[5,98+11])
+ []
+ ]
+ ]
+ ]
+
+val g : int -> int = <fun>
let x = function { contents : int = i } -> i;;
+let _ =
+ object val foo = 12 method x foo = {< foo >} end
+;;
+
(* Local open *)
let x = M.{ contents = 3 };;
42
(** Another docstring attached to x. *)
;;
+
+(* No surrounding parentheses for immediate objects *)
+let x = object method f = 1 end;;
+let x = object method f = 1 end # f;;
+let x = Some object method f = 1 end;;
+let x = Some object method f = 1 end # f;;
+
+let f x y z = x in
+f object method f = 1 end
+ object method f = 1 end # f
+ object end
+;;
+
+(* Punning of labelled function argument with type constraint *)
+let g y =
+ let f ~y = y + 1 in
+ f ~(y:int)
+;;
let%foo x and y and z in (x,y,z)
end
+(* No surrounding parentheses for immediate objects *)
+let x = object method f = 1 end;;
+let x = object method f = 1 end # f;;
+let x = Some object method f = 1 end;;
+let x = Some object method f = 1 end # f;;
+
+let f x y z = x in
+f object method f = 1 end
+ object method f = 1 end # f
+ object end
+
+(* Punning of labelled function argument with type constraint *)
+let g y =
+ let f ~y = y + 1 in
+ f ~(y:int)
+
let goober a = match a with C (type a b) y -> y
type !'a x = private [> `x ] constraint 'a = 'a x
is not included in
type 'a x
- Their constraints differ.
+ Their parameters differ
+ The type 'b x as 'b is not equal to the type 'a
|}, Principal{|
Line 1:
Error: Type declarations do not match:
type !'a x = private 'a constraint 'a = [> `x ]
is not included in
type 'a x
- Their constraints differ.
+ Their parameters differ
+ The type [> `x ] is not equal to the type 'a
|}];;
raise Stack_overflow
let _ =
+ let p = Sys.opaque_identity (ref 42) in
begin
try
ignore(f 0)
with Stack_overflow ->
print_string "Stack overflow caught"; print_newline()
end ;
+ for i = 1 to 1000 do ignore (Sys.opaque_identity (ref 1_000_000)) done;
(* GPR#1289 *)
Printexc.record_backtrace true;
begin
ignore(f 0)
with Stack_overflow ->
print_string "second Stack overflow caught"; print_newline()
- end
+ end;
+ print_string "!p = "; print_int !p; print_newline ()
x = 10000
x = 0
second Stack overflow caught
+!p = 42
x = 10000
x = 0
second Stack overflow caught
+!p = 42
File "cannot_shadow_error.ml", line 24, characters 2-36:
24 | include Comparable with type t = t
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Illegal shadowing of included type t/9 by t/13
+Error: Illegal shadowing of included type t/10 by t/15
File "cannot_shadow_error.ml", line 23, characters 2-19:
- Type t/9 came from this include
+ Type t/10 came from this include
File "cannot_shadow_error.ml", line 14, characters 2-23:
- The value print has no valid type if t/9 is shadowed
+ The value print has no valid type if t/10 is shadowed
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type t/146 by t/163
+Error: Illegal shadowing of included type t/147 by t/164
Line 2, characters 2-11:
- Type t/146 came from this include
+ Type t/147 came from this include
Line 3, characters 2-24:
- The value ignore has no valid type if t/146 is shadowed
+ The value ignore has no valid type if t/147 is shadowed
|}]
module type Module = sig
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module M/236 by M/253
+Error: Illegal shadowing of included module M/237 by M/254
Line 2, characters 2-11:
- Module M/236 came from this include
+ Module M/237 came from this include
Line 3, characters 2-26:
- The value ignore has no valid type if M/236 is shadowed
+ The value ignore has no valid type if M/237 is shadowed
|}]
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module type T/322 by T/339
+Error: Illegal shadowing of included module type T/323 by T/340
Line 2, characters 2-11:
- Module type T/322 came from this include
+ Module type T/323 came from this include
Line 3, characters 2-39:
- The module F has no valid type if T/322 is shadowed
+ The module F has no valid type if T/323 is shadowed
|}]
module type Extension = sig
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type ext/357 by ext/374
+Error: Illegal shadowing of included type ext/358 by ext/375
Line 2, characters 2-11:
- Type ext/357 came from this include
+ Type ext/358 came from this include
Line 3, characters 14-16:
- The extension constructor C2 has no valid type if ext/357 is shadowed
+ The extension constructor C2 has no valid type if ext/358 is shadowed
|}]
module type Class = sig
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
[%%expect{|
module Module_type :
sig
- module type U = sig end
+ module type U = N.T
type t = N.t
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
val unit : unit
external e : unit -> unit = "%identity"
module M = N.M
- module type T = sig end
+ module type T = N.T
exception E
type ext = N.ext = ..
type ext += C
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+(* Make sure that shapes of compilation units are never eagerly loaded,
+ regardless of the context. *)
+
+module Mdirect = Stdlib__Unit
+[%%expect{|
+{
+ "Mdirect"[module] -> CU Stdlib__Unit;
+ }
+module Mdirect = Unit
+|}]
+
+module Mproj = Stdlib.Unit
+[%%expect{|
+{
+ "Mproj"[module] -> (CU Stdlib . "Unit"[module])<.1>;
+ }
+module Mproj = Unit
+|}]
+
+module F (X : sig type t end) = X
+[%%expect{|
+{
+ "F"[module] -> Abs<.4>(X/277, X/277<.3>);
+ }
+module F : functor (X : sig type t end) -> sig type t = X.t end
+|}]
+
+module App_direct = F (Stdlib__Unit)
+[%%expect{|
+{
+ "App_direct"[module] -> CU Stdlib__Unit;
+ }
+module App_direct : sig type t = Unit.t end
+|}]
+
+module App_proj = F (Stdlib.Unit)
+[%%expect{|
+{
+ "App_proj"[module] -> (CU Stdlib . "Unit"[module])<.6>;
+ }
+module App_proj : sig type t = Unit.t end
+|}]
+
+module App_direct_indir = F (Mdirect)
+[%%expect{|
+{
+ "App_direct_indir"[module] -> CU Stdlib__Unit;
+ }
+module App_direct_indir : sig type t = Mdirect.t end
+|}]
+
+module App_proj_indir = F (Mproj)
+[%%expect{|
+{
+ "App_proj_indir"[module] -> (CU Stdlib . "Unit"[module])<.1>;
+ }
+module App_proj_indir : sig type t = Mproj.t end
+|}]
+
+(* In the following the shape are not loaded, we just know what the signature
+ are and build shapes from them. *)
+
+include Stdlib__Unit
+[%%expect{|
+{
+ "compare"[value] -> CU Stdlib__Unit . "compare"[value];
+ "equal"[value] -> CU Stdlib__Unit . "equal"[value];
+ "t"[type] -> CU Stdlib__Unit . "t"[type];
+ "to_string"[value] -> CU Stdlib__Unit . "to_string"[value];
+ }
+type t = unit = ()
+val equal : t -> t -> bool = <fun>
+val compare : t -> t -> int = <fun>
+val to_string : t -> string = <fun>
+|}]
+
+include Stdlib.Unit
+[%%expect{|
+{
+ "compare"[value] -> CU Stdlib . "Unit"[module] . "compare"[value];
+ "equal"[value] -> CU Stdlib . "Unit"[module] . "equal"[value];
+ "t"[type] -> CU Stdlib . "Unit"[module] . "t"[type];
+ "to_string"[value] -> CU Stdlib . "Unit"[module] . "to_string"[value];
+ }
+type t = unit = ()
+val equal : t -> t -> bool = <fun>
+val compare : t -> t -> int = <fun>
+val to_string : t -> string = <fun>
+|}]
+
+module Without_constraint = Set.Make(Int)
+[%%expect{|
+{
+ "Without_constraint"[module] ->
+ CU Stdlib . "Set"[module] . "Make"[module](
+ CU Stdlib . "Int"[module])<.9>;
+ }
+module Without_constraint :
+ sig
+ type elt = Int.t
+ type t = Set.Make(Int).t
+ val empty : t
+ val is_empty : t -> bool
+ val mem : elt -> t -> bool
+ val add : elt -> t -> t
+ val singleton : elt -> t
+ val remove : elt -> t -> t
+ val union : t -> t -> t
+ val inter : t -> t -> t
+ val disjoint : t -> t -> bool
+ val diff : t -> t -> t
+ val compare : t -> t -> int
+ val equal : t -> t -> bool
+ val subset : t -> t -> bool
+ val iter : (elt -> unit) -> t -> unit
+ val map : (elt -> elt) -> t -> t
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ val for_all : (elt -> bool) -> t -> bool
+ val exists : (elt -> bool) -> t -> bool
+ val filter : (elt -> bool) -> t -> t
+ val filter_map : (elt -> elt option) -> t -> t
+ val partition : (elt -> bool) -> t -> t * t
+ val cardinal : t -> int
+ val elements : t -> elt list
+ val min_elt : t -> elt
+ val min_elt_opt : t -> elt option
+ val max_elt : t -> elt
+ val max_elt_opt : t -> elt option
+ val choose : t -> elt
+ val choose_opt : t -> elt option
+ val split : elt -> t -> t * bool * t
+ val find : elt -> t -> elt
+ val find_opt : elt -> t -> elt option
+ val find_first : (elt -> bool) -> t -> elt
+ val find_first_opt : (elt -> bool) -> t -> elt option
+ val find_last : (elt -> bool) -> t -> elt
+ val find_last_opt : (elt -> bool) -> t -> elt option
+ val of_list : elt list -> t
+ val to_seq_from : elt -> t -> elt Seq.t
+ val to_seq : t -> elt Seq.t
+ val to_rev_seq : t -> elt Seq.t
+ val add_seq : elt Seq.t -> t -> t
+ val of_seq : elt Seq.t -> t
+ end
+|}]
+
+module With_identity_constraint : sig
+ module M : Set.S
+end = struct
+ module M = Set.Make(Int)
+end
+[%%expect{|
+{
+ "With_identity_constraint"[module] ->
+ {<.12>
+ "M"[module] ->
+ CU Stdlib . "Set"[module] . "Make"[module](
+ CU Stdlib . "Int"[module])<.10>;
+ };
+ }
+module With_identity_constraint : sig module M : Set.S end
+|}]
+
+module With_constraining_constraint : sig
+ module M : sig type t end
+end = struct
+ module M = Set.Make(Int)
+end
+[%%expect{|
+{
+ "With_constraining_constraint"[module] ->
+ {<.16>
+ "M"[module] ->
+ {<.13>
+ "t"[type] ->
+ CU Stdlib . "Set"[module] . "Make"[module](
+ CU Stdlib . "Int"[module])<.13> . "t"[type];
+ };
+ };
+ }
+module With_constraining_constraint : sig module M : sig type t end end
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+module type S = sig
+ type t
+ val x : t
+end
+[%%expect{|
+{
+ "S"[module type] -> <.2>;
+ }
+module type S = sig type t val x : t end
+|}]
+
+module Falias (X : S) = X
+[%%expect{|
+{
+ "Falias"[module] -> Abs<.4>(X/279, X/279<.3>);
+ }
+module Falias : functor (X : S) -> sig type t = X.t val x : t end
+|}]
+
+module Finclude (X : S) = struct
+ include X
+end
+[%%expect{|
+{
+ "Finclude"[module] ->
+ Abs<.6>
+ (X/283,
+ {
+ "t"[type] -> X/283<.5> . "t"[type];
+ "x"[value] -> X/283<.5> . "x"[value];
+ });
+ }
+module Finclude : functor (X : S) -> sig type t = X.t val x : t end
+|}]
+
+module Fredef (X : S) = struct
+ type t = X.t
+ let x = X.x
+end
+[%%expect{|
+{
+ "Fredef"[module] ->
+ Abs<.10>(X/290, {
+ "t"[type] -> <.8>;
+ "x"[value] -> <.9>;
+ });
+ }
+module Fredef : functor (X : S) -> sig type t = X.t val x : X.t end
+|}]
+
+module Fignore (_ : S) = struct
+ type t = Fresh
+ let x = Fresh
+end
+[%%expect{|
+{
+ "Fignore"[module] ->
+ Abs<.14>(()/1, {
+ "t"[type] -> <.11>;
+ "x"[value] -> <.13>;
+ });
+ }
+module Fignore : S -> sig type t = Fresh val x : t end
+|}]
+
+module Arg : S = struct
+ type t = T
+ let x = T
+end
+[%%expect{|
+{
+ "Arg"[module] -> {<.18>
+ "t"[type] -> <.15>;
+ "x"[value] -> <.17>;
+ };
+ }
+module Arg : S
+|}]
+
+include Falias(Arg)
+[%%expect{|
+{
+ "t"[type] -> <.15>;
+ "x"[value] -> <.17>;
+ }
+type t = Arg.t
+val x : t = <abstr>
+|}]
+
+include Finclude(Arg)
+[%%expect{|
+{
+ "t"[type] -> <.15>;
+ "x"[value] -> <.17>;
+ }
+type t = Arg.t
+val x : t = <abstr>
+|}]
+
+include Fredef(Arg)
+[%%expect{|
+{
+ "t"[type] -> <.8>;
+ "x"[value] -> <.9>;
+ }
+type t = Arg.t
+val x : Arg.t = <abstr>
+|}]
+
+include Fignore(Arg)
+[%%expect{|
+{
+ "t"[type] -> <.11>;
+ "x"[value] -> <.13>;
+ }
+type t = Fignore(Arg).t = Fresh
+val x : t = Fresh
+|}]
+
+include Falias(struct type t = int let x = 0 end)
+[%%expect{|
+{
+ "t"[type] -> <.19>;
+ "x"[value] -> <.20>;
+ }
+type t = int
+val x : t = 0
+|}]
+
+include Finclude(struct type t = int let x = 0 end)
+[%%expect{|
+{
+ "t"[type] -> <.21>;
+ "x"[value] -> <.22>;
+ }
+type t = int
+val x : t = 0
+|}]
+
+include Fredef(struct type t = int let x = 0 end)
+[%%expect{|
+{
+ "t"[type] -> <.8>;
+ "x"[value] -> <.9>;
+ }
+type t = int
+val x : int = 0
+|}]
+
+include Fignore(struct type t = int let x = 0 end)
+[%%expect{|
+{
+ "t"[type] -> <.11>;
+ "x"[value] -> <.13>;
+ }
+type t = Fresh
+val x : t = Fresh
+|}]
+
+module Fgen () = struct
+ type t = Fresher
+ let x = Fresher
+end
+[%%expect{|
+{
+ "Fgen"[module] -> Abs<.30>(()/1, {
+ "t"[type] -> <.27>;
+ "x"[value] -> <.29>;
+ });
+ }
+module Fgen : functor () -> sig type t = Fresher val x : t end
+|}]
+
+include Fgen ()
+[%%expect{|
+{
+ "t"[type] -> <.27>;
+ "x"[value] -> <.29>;
+ }
+type t = Fresher
+val x : t = Fresher
+|}]
+
+(***************************************************************************)
+(* Make sure we restrict shapes even when constraints imply [Tcoerce_none] *)
+(***************************************************************************)
+
+module type Small = sig
+ type t
+end
+[%%expect{|
+{
+ "Small"[module type] -> <.32>;
+ }
+module type Small = sig type t end
+|}]
+
+module type Big = sig
+ type t
+ type u
+end
+[%%expect{|
+{
+ "Big"[module type] -> <.35>;
+ }
+module type Big = sig type t type u end
+|}]
+
+module type B2S = functor (X : Big) -> Small with type t = X.t
+[%%expect{|
+{
+ "B2S"[module type] -> <.38>;
+ }
+module type B2S = functor (X : Big) -> sig type t = X.t end
+|}]
+
+module Big_to_small1 : B2S = functor (X : Big) -> X
+[%%expect{|
+{
+ "Big_to_small1"[module] ->
+ Abs<.40>(X/385, {<.39>
+ "t"[type] -> X/385<.39> . "t"[type];
+ });
+ }
+module Big_to_small1 : B2S
+|}]
+
+module Big_to_small2 : B2S = functor (X : Big) -> struct include X end
+[%%expect{|
+{
+ "Big_to_small2"[module] ->
+ Abs<.42>(X/388, {
+ "t"[type] -> X/388<.41> . "t"[type];
+ });
+ }
+module Big_to_small2 : B2S
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+module Foo : sig
+ module Bar : sig
+ end
+end = struct
+ module Bar = struct
+ end
+end
+;;
+[%%expect{|
+{
+ "Foo"[module] -> {<.2>
+ "Bar"[module] -> {<.0>
+ };
+ };
+ }
+module Foo : sig module Bar : sig end end
+|}]
+
+module type Extended = sig
+ include module type of struct include Foo end
+ module Bar : sig
+ include module type of struct include Bar end
+ end
+end
+;;
+[%%expect{|
+{
+ "Extended"[module type] -> <.4>;
+ }
+module type Extended = sig module Bar : sig end end
+|}]
+
+module E : Extended = struct
+ module Bar = struct end
+end
+
+[%%expect{|
+{
+ "E"[module] -> {<.6>
+ "Bar"[module] -> {<.5>
+ };
+ };
+ }
+module E : Extended
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+module type Make = functor (I : sig end) -> sig
+ open I
+end
+;;
+
+[%%expect{|
+{
+ "Make"[module type] -> <.1>;
+ }
+module type Make = functor (I : sig end) -> sig end
+|}]
+
+module Make (I : sig end) : sig
+ open I
+end = struct end
+;;
+
+[%%expect{|
+{
+ "Make"[module] -> Abs<.3>(I/279, {
+ });
+ }
+module Make : functor (I : sig end) -> sig end
+|}]
+
+module type Make = functor (I : sig end) ->
+module type of struct
+ open I
+end
+
+[%%expect{|
+{
+ "Make"[module type] -> <.5>;
+ }
+module type Make = functor (I : sig end) -> sig end
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+(* Everything that couldn't go anywhere else. *)
+
+open struct
+ module M = struct
+ type t = A
+ end
+end
+[%%expect{|
+{
+ }
+module M : sig type t = A end
+|}]
+
+include M
+[%%expect{|
+{
+ "t"[type] -> <.0>;
+ }
+type t = M.t = A
+|}]
+
+module N = M
+[%%expect{|
+{
+ "N"[module] -> {<.2>
+ "t"[type] -> <.0>;
+ };
+ }
+module N = M
+|}]
+
+(* Not open structs, but the code handling the following is currently very
+ similar to the one for open struct (i.e. calls [Env.enter_signature]), and
+ so we are likely to encounter the same bugs, if any. *)
+
+include struct
+ module M' = struct
+ type t = A
+ end
+end
+[%%expect{|
+{
+ "M'"[module] -> {<.6>
+ "t"[type] -> <.4>;
+ };
+ }
+module M' : sig type t = A end
+|}]
+
+module N' = M'
+[%%expect{|
+{
+ "N'"[module] -> {<.6>
+ "t"[type] -> <.4>;
+ };
+ }
+module N' = M'
+|}]
+
+module Test = struct
+ module M = struct
+ type t = A
+ end
+end
+[%%expect{|
+{
+ "Test"[module] -> {<.11>
+ "M"[module] -> {<.10>
+ "t"[type] -> <.8>;
+ };
+ };
+ }
+module Test : sig module M : sig type t = A end end
+|}]
+
+include Test
+[%%expect{|
+{
+ "M"[module] -> {<.10>
+ "t"[type] -> <.8>;
+ };
+ }
+module M = Test.M
+|}]
+
+module N = M
+[%%expect{|
+{
+ "N"[module] -> {<.10>
+ "t"[type] -> <.8>;
+ };
+ }
+module N = M
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+(**********)
+(* Simple *)
+(**********)
+
+module rec A : sig
+ type t = Leaf of B.t
+ end = struct
+ type t = Leaf of B.t
+ end
+ and B
+ : sig type t = int end
+ = struct type t = int end
+[%%expect{|
+{
+ "A"[module] -> {
+ "t"[type] -> <.8>;
+ };
+ "B"[module] -> {
+ "t"[type] -> <.10>;
+ };
+ }
+module rec A : sig type t = Leaf of B.t end
+and B : sig type t = int end
+|}]
+
+(*****************)
+(* Intf only ... *)
+(*****************)
+
+(* reduce is going to die on this. *)
+
+module rec A : sig
+ type t = Leaf of B.t
+ end = A
+
+and B : sig
+ type t = int
+end = B
+[%%expect{|
+{
+ "A"[module] -> A/302<.11>;
+ "B"[module] -> B/303<.12>;
+ }
+module rec A : sig type t = Leaf of B.t end
+and B : sig type t = int end
+|}]
+
+(***************************)
+(* Example from the manual *)
+(***************************)
+
+ module rec A : sig
+ type t = Leaf of string | Node of ASet.t
+ val compare: t -> t -> int
+ end = struct
+ type t = Leaf of string | Node of ASet.t
+ let compare t1 t2 =
+ match (t1, t2) with
+ | (Leaf s1, Leaf s2) -> Stdlib.compare s1 s2
+ | (Leaf _, Node _) -> 1
+ | (Node _, Leaf _) -> -1
+ | (Node n1, Node n2) -> ASet.compare n1 n2
+ end
+
+(* we restrict the sig to limit the bloat in the expected output. *)
+and ASet : sig
+ type t
+ type elt = A.t
+ val compare : t -> t -> int
+end = Set.Make(A)
+[%%expect{|
+{
+ "A"[module] -> {
+ "compare"[value] -> <.38>;
+ "t"[type] -> <.35>;
+ };
+ "ASet"[module] ->
+ {
+ "compare"[value] ->
+ CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) .
+ "compare"[value];
+ "elt"[type] ->
+ CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) .
+ "elt"[type];
+ "t"[type] ->
+ CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) . "t"[type];
+ };
+ }
+module rec A :
+ sig
+ type t = Leaf of string | Node of ASet.t
+ val compare : t -> t -> int
+ end
+and ASet : sig type t type elt = A.t val compare : t -> t -> int end
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+(* We depart slightly from the example in the PLDI'19 paper, which actually
+ doesn't type... *)
+
+module type Stringable = sig
+ type t
+ val to_string : t -> string
+end
+[%%expect{|
+{
+ "Stringable"[module type] -> <.2>;
+ }
+module type Stringable = sig type t val to_string : t -> string end
+|}]
+
+module Pair (X : Stringable) (Y : Stringable) = struct
+ type t = X.t * Y.t
+ let to_string (x, y) =
+ X.to_string x ^ " " ^ Y.to_string y
+end
+[%%expect{|
+{
+ "Pair"[module] ->
+ Abs<.9>
+ (X/279, Abs(Y/280, {
+ "t"[type] -> <.5>;
+ "to_string"[value] -> <.6>;
+ }));
+ }
+module Pair :
+ functor (X : Stringable) (Y : Stringable) ->
+ sig type t = X.t * Y.t val to_string : X.t * Y.t -> string end
+|}]
+
+module Int = struct
+ type t = int
+ let to_string i = string_of_int i
+end
+[%%expect{|
+{
+ "Int"[module] -> {<.13>
+ "t"[type] -> <.10>;
+ "to_string"[value] -> <.11>;
+ };
+ }
+module Int : sig type t = int val to_string : int -> string end
+|}]
+
+module String = struct
+ type t = string
+ let to_string s = s
+end
+[%%expect{|
+{
+ "String"[module] -> {<.17>
+ "t"[type] -> <.14>;
+ "to_string"[value] -> <.15>;
+ };
+ }
+module String : sig type t = string val to_string : 'a -> 'a end
+|}]
+
+module P = Pair(Int)(Pair(String)(Int))
+[%%expect{|
+{
+ "P"[module] -> {<.18>
+ "t"[type] -> <.5>;
+ "to_string"[value] -> <.6>;
+ };
+ }
+module P :
+ sig
+ type t = Int.t * Pair(String)(Int).t
+ val to_string : Int.t * Pair(String)(Int).t -> string
+ end
+|}];;
+
+P.to_string (0, ("!=", 1))
+[%%expect{|
+{
+ }
+- : string = "0 != 1"
+|}]
--- /dev/null
+(* TEST *)
+
+(* Note: we do *not* enable -dshapes, as in this example
+ shape sizs grow exponentially in the size of the M1..M7 family below. *)
+
+module type S0 = sig
+ type key
+ type value
+
+ type z1
+ type z2
+ type z3
+ type z4
+ type z5
+
+ type z6
+ type z7
+ type z8
+ type z9
+ type z10
+end
+
+module M0 = struct
+ type key
+ type value
+
+ type z1
+ type z2
+ type z3
+ type z4
+ type z5
+
+ type z6
+ type z7
+ type z8
+ type z9
+ type z10
+end
+
+module type S0' = sig
+ include S0
+ type additional
+end
+
+(* note: our terms M{n} use a coercion from S0' to S0,
+ which avoids the 'identity coercion' fast path in includemod;
+ removing the 'additional' field from S0' above makes the
+ -dshape output smaller (from exponential to constant). *)
+module type S1 = (S0 -> S0') -> S0
+module M1 : S1 = functor (P1 : S0 -> S0') -> P1(M0)
+
+module type S2 = (S1 -> S0') -> S0
+module M2 : S2 = functor (P1 : S1 -> S0') -> P1(M1)
+
+module type S3 = (S2 -> S0') -> S0
+module M3 : S3 = functor (P2 : S2 -> S0') -> P2(M2)
+
+module type S4 = (S3 -> S0') -> S0
+module M4 : S4 = functor (P3 : S3 -> S0') -> P3(M3)
+
+module type S5 = (S4 -> S0') -> S0
+module M5 : S5 = functor (P4 : S4 -> S0') -> P4(M4)
+
+module type S6 = (S5 -> S0') -> S0
+module M6 : S6 = functor (P5 : S5 -> S0') -> P5(M5)
+
+module type S7 = (S6 -> S0') -> S0
+module M7 : S7 = functor (P6 : S6 -> S0') -> P6(M6)
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+let x = ()
+[%%expect{|
+{
+ "x"[value] -> <.0>;
+ }
+val x : unit = ()
+|}]
+
+external y : int -> int = "%identity"
+[%%expect{|
+{
+ "y"[value] -> <.1>;
+ }
+external y : int -> int = "%identity"
+|}]
+
+type t = A of foo
+and foo = Bar
+[%%expect{|
+{
+ "foo"[type] -> <.3>;
+ "t"[type] -> <.2>;
+ }
+type t = A of foo
+and foo = Bar
+|}]
+
+module type S = sig
+ type t
+end
+[%%expect{|
+{
+ "S"[module type] -> <.7>;
+ }
+module type S = sig type t end
+|}]
+
+exception E
+[%%expect{|
+{
+ "E"[extension constructor] -> <.8>;
+ }
+exception E
+|}]
+
+type ext = ..
+[%%expect{|
+{
+ "ext"[type] -> <.9>;
+ }
+type ext = ..
+|}]
+
+type ext += A | B
+[%%expect{|
+{
+ "A"[extension constructor] -> <.10>;
+ "B"[extension constructor] -> <.11>;
+ }
+type ext += A | B
+|}]
+
+module M = struct
+ type ext += C
+end
+[%%expect{|
+{
+ "M"[module] -> {<.13>
+ "C"[extension constructor] -> <.12>;
+ };
+ }
+module M : sig type ext += C end
+|}]
+
+module _ = struct
+ type t = Should_not_appear_in_shape
+end
+[%%expect{|
+{
+ }
+|}]
+
+module rec M1 : sig
+ type t = C of M2.t
+end = struct
+ type t = C of M2.t
+end
+
+and M2 : sig
+ type t
+ val x : t
+end = struct
+ type t = T
+ let x = T
+end
+[%%expect{|
+{
+ "M1"[module] -> {
+ "t"[type] -> <.27>;
+ };
+ "M2"[module] -> {
+ "t"[type] -> <.29>;
+ "x"[value] -> <.31>;
+ };
+ }
+module rec M1 : sig type t = C of M2.t end
+and M2 : sig type t val x : t end
+|}]
+
+class c = object end
+[%%expect{|
+{
+ "#c"[type] -> <.32>;
+ "c"[type] -> <.32>;
+ "c"[class] -> <.32>;
+ "c"[class type] -> <.32>;
+ }
+class c : object end
+|}]
+
+class type c = object end
+[%%expect{|
+{
+ "#c"[type] -> <.34>;
+ "c"[type] -> <.34>;
+ "c"[class type] -> <.34>;
+ }
+class type c = object end
+|}]
--- /dev/null
+(* TEST
+ flags = "-dshape"
+ * expect
+*)
+
+module type S = sig
+ module M: sig
+ (** A module M *)
+ end
+
+ module type T = module type of struct include M end
+end
+
+[%%expect{|
+{
+ "S"[module type] -> <.2>;
+ }
+module type S = sig module M : sig end module type T = sig end end
+|}]
--- /dev/null
+(* TEST
+ * expect *)
+type 'a tree =
+| Leaf of 'a
+| Node of 'a tree * 'a tree
+[%%expect{|
+type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
+|}]
+
+module Ambiguous = struct
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (left, right) ->
+ Node (map f left, map f right)
+end
+[%%expect{|
+Line 5, characters 4-34:
+5 | Node (map f left, map f right)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
+ in several different ways. Please disambiguate by adding an explicit
+ [@tailcall] attribute to the call that should be made tail-recursive,
+ or a [@tailcall false] attribute on calls that should not be
+ transformed.
+Line 5, characters 10-20:
+5 | Node (map f left, map f right)
+ ^^^^^^^^^^
+ This call could be annotated.
+Line 5, characters 22-33:
+5 | Node (map f left, map f right)
+ ^^^^^^^^^^^
+ This call could be annotated.
+|}]
+
+module Positive_disambiguation = struct
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (left, right) ->
+ Node (map f left, (map [@tailcall]) f right)
+end
+[%%expect{|
+module Positive_disambiguation :
+ sig val map : ('a -> 'b) -> 'a tree -> 'b tree end
+|}]
+
+module Negative_disambiguation = struct
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (left, right) ->
+ Node ((map [@tailcall false]) f left, map f right)
+end
+[%%expect{|
+module Negative_disambiguation :
+ sig val map : ('a -> 'b) -> 'a tree -> 'b tree end
+|}]
+
+module Positive_and_negative_disambiguation = struct
+ (* in-depth disambiguations *)
+ type 'a t =
+ | N
+ | C of 'a t * ('a t * 'a t)
+
+ let[@tail_mod_cons] rec map1 f l =
+ match l with
+ | N -> N
+ | C (a, (b, c)) ->
+ C ((map1 [@tailcall]) f a, ((map1 [@tailcall false]) f b, map1 f c))
+
+ let[@tail_mod_cons] rec map2 f l =
+ match l with
+ | N -> N
+ | C (a, (b, c)) ->
+ C ((map2 [@tailcall false]) f a, ((map2 [@tailcall]) f b, map2 f c))
+end
+[%%expect {|
+module Positive_and_negative_disambiguation :
+ sig
+ type 'a t = N | C of 'a t * ('a t * 'a t)
+ val map1 : 'a -> 'b t -> 'c t
+ val map2 : 'a -> 'b t -> 'c t
+ end
+|}]
+
+module Long_before_and_after = struct
+ type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree * 'a tree * 'a tree * 'a tree
+
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (t1, t2, t3, t4, t5) ->
+ (* manual unfolding *)
+ Node (map f t1, map f t2, (map[@tailcall]) f t3, map f t4, map f t5)
+
+ let () =
+ assert (map succ (Node (Leaf 0, Leaf 1, Leaf 2, Leaf 3, Leaf 4))
+ = Node (Leaf 1, Leaf 2, Leaf 3, Leaf 4, Leaf 5))
+end
+[%%expect {|
+module Long_before_and_after :
+ sig
+ type 'a tree =
+ Leaf of 'a
+ | Node of 'a tree * 'a tree * 'a tree * 'a tree * 'a tree
+ val map : ('a -> 'b) -> 'a tree -> 'b tree
+ end
+|}]
+
+
+module Deep_nesting_nonambiguous = struct
+ type 'a tree = Leaf of 'a | Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
+
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (t1, (t2, (t3, (t4, t5)))) ->
+ Node (map f t1, (map f t2, ((map[@tailcall]) f t3, (map f t4, map f t5))))
+
+ let () =
+ assert (map succ (Node (Leaf 0, (Leaf 1, (Leaf 2, (Leaf 3, Leaf 4)))))
+ = Node (Leaf 1, (Leaf 2, (Leaf 3, (Leaf 4, Leaf 5)))))
+end
+[%%expect {|
+module Deep_nesting_nonambiguous :
+ sig
+ type 'a tree =
+ Leaf of 'a
+ | Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
+ val map : ('a -> 'b) -> 'a tree -> 'b tree
+ end
+|}]
+
+module Deep_nesting_ambiguous = struct
+ type 'a tree = Leaf of 'a | Node of 'a tree * ('a tree * ('a tree * ('a tree * 'a tree)))
+
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (t1, (t2, (t3, (t4, t5)))) ->
+ Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+
+ let () =
+ assert (map succ (Node (Leaf 0, (Leaf 1, (Leaf 2, (Leaf 3, Leaf 4)))))
+ = Node (Leaf 1, (Leaf 2, (Leaf 3, (Leaf 4, Leaf 5)))))
+end
+[%%expect {|
+Line 7, characters 10-71:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
+ in several different ways. Please disambiguate by adding an explicit
+ [@tailcall] attribute to the call that should be made tail-recursive,
+ or a [@tailcall false] attribute on calls that should not be
+ transformed.
+Line 7, characters 16-24:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^
+ This call could be annotated.
+Line 7, characters 27-35:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^
+ This call could be annotated.
+Line 7, characters 38-46:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^
+ This call could be annotated.
+Line 7, characters 49-57:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^
+ This call could be annotated.
+Line 7, characters 59-67:
+7 | Node (map f t1, (map f t2, (map f t3, (map f t4, map f t5))))
+ ^^^^^^^^
+ This call could be annotated.
+|}]
+
+
+module Disjunctions_ambiguous = struct
+ type t = Leaf of int | Node of t * t
+
+ (** [shift ~flip:false k t] shifts all the leaves of [t] by [k].
+ When [~flip:true], leaves of even level are shifted by k,
+ leaves of odd level by (-k) *)
+ let[@tail_mod_cons] rec shift ~flip k = function
+ | Leaf n -> Leaf (n + k)
+ | Node (left, right) ->
+ (* This example contains several ambiguous TMC calls per constructor argument:
+ the two subcalls of each arguments are *both* in TMC position, and annotating
+ either of them is enough to fix the ambiguity error. *)
+ Node (
+ (if flip
+ then shift ~flip (- k) left
+ else shift ~flip k left),
+ (if flip
+ then shift ~flip (- k) right
+ else shift ~flip k right)
+ )
+end
+[%%expect {|
+Lines 13-20, characters 8-9:
+13 | ........Node (
+14 | (if flip
+15 | then shift ~flip (- k) left
+16 | else shift ~flip k left),
+17 | (if flip
+18 | then shift ~flip (- k) right
+19 | else shift ~flip k right)
+20 | )
+Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
+ in several different ways. Please disambiguate by adding an explicit
+ [@tailcall] attribute to the call that should be made tail-recursive,
+ or a [@tailcall false] attribute on calls that should not be
+ transformed.
+Line 15, characters 16-38:
+15 | then shift ~flip (- k) left
+ ^^^^^^^^^^^^^^^^^^^^^^
+ This call could be annotated.
+Line 16, characters 16-34:
+16 | else shift ~flip k left),
+ ^^^^^^^^^^^^^^^^^^
+ This call could be annotated.
+Line 18, characters 16-39:
+18 | then shift ~flip (- k) right
+ ^^^^^^^^^^^^^^^^^^^^^^^
+ This call could be annotated.
+Line 19, characters 16-35:
+19 | else shift ~flip k right)
+ ^^^^^^^^^^^^^^^^^^^
+ This call could be annotated.
+|}]
+
+module Disjunctions_disambiguated = struct
+ type t = Leaf of int | Node of t * t
+
+ let[@tail_mod_cons] rec shift ~flip k = function
+ | Leaf n -> Leaf (n + k)
+ | Node (left, right) ->
+ Node (
+ (if flip
+ then shift ~flip (- k) left
+ else shift ~flip k left),
+ (if flip
+ then shift ~flip (- k) right
+ else (shift[@tailcall]) ~flip k right)
+ )
+end
+[%%expect {|
+module Disjunctions_disambiguated :
+ sig
+ type t = Leaf of int | Node of t * t
+ val shift : flip:bool -> int -> t -> t
+ end
+|}]
+
+module Disjunctions_ambiguous_again = struct
+ type t = Leaf of int | Node of t * t
+
+ let[@tail_mod_cons] rec shift ~flip k = function
+ | Leaf n -> Leaf (n + k)
+ | Node (left, right) ->
+ Node (
+ (if flip
+ then (shift[@tailcall]) ~flip (- k) left
+ else shift ~flip k left),
+ (if flip
+ then shift ~flip (- k) right
+ else (shift[@tailcall]) ~flip k right)
+ )
+end
+[%%expect {|
+Lines 7-14, characters 8-9:
+ 7 | ........Node (
+ 8 | (if flip
+ 9 | then (shift[@tailcall]) ~flip (- k) left
+10 | else shift ~flip k left),
+11 | (if flip
+12 | then shift ~flip (- k) right
+13 | else (shift[@tailcall]) ~flip k right)
+14 | )
+Error: [@tail_mod_cons]: this constructor application may be TMC-transformed
+ in several different ways. Only one of the arguments may become a TMC
+ call, but several arguments contain calls that are explicitly marked
+ as tail-recursive. Please fix the conflict by reviewing and fixing the
+ conflicting annotations.
+Line 9, characters 16-51:
+9 | then (shift[@tailcall]) ~flip (- k) left
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ This call is explicitly annotated.
+Line 13, characters 16-48:
+13 | else (shift[@tailcall]) ~flip k right)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ This call is explicitly annotated.
+|}]
--- /dev/null
+(* TEST
+ * expect *)
+
+module Non_recursive_let_bad = struct
+ type 'a t =
+ | N of 'a
+ | C of 'a t * 'a t
+
+ let[@tail_mod_cons] rec map f l =
+ match l with
+ | N v -> N (f v)
+ | C (a, b) ->
+ let map' l = map f l in
+ C (map' a, (map' [@tailcall]) b)
+end
+[%%expect {|
+Lines 6-11, characters 30-40:
+ 6 | ..............................f l =
+ 7 | match l with
+ 8 | | N v -> N (f v)
+ 9 | | C (a, b) ->
+10 | let map' l = map f l in
+11 | C (map' a, (map' [@tailcall]) b)
+Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
+but is never applied in TMC position.
+Line 11, characters 19-39:
+11 | C (map' a, (map' [@tailcall]) b)
+ ^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+Line 11, characters 19-39:
+11 | C (map' a, (map' [@tailcall]) b)
+ ^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+module Non_recursive_let_bad :
+ sig
+ type 'a t = N of 'a | C of 'a t * 'a t
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ end
+|}]
+
+
+module Non_recursive_let_good = struct
+ type 'a t =
+ | N of 'a
+ | C of 'a t * 'a t
+
+ let[@tail_mod_cons] rec map f l =
+ match l with
+ | N v -> N (f v)
+ | C (a, b) ->
+ let[@tail_mod_cons] map' l = map f l in
+ C (map' a, (map' [@tailcall]) b)
+end
+[%%expect {|
+module Non_recursive_let_good :
+ sig
+ type 'a t = N of 'a | C of 'a t * 'a t
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ end
+|}]
--- /dev/null
+File "partial_application.ml", line 7, characters 26-36:
+7 | let[@tail_mod_cons] rec f () () = ()
+ ^^^^^^^^^^
+Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
+but is never applied in TMC position.
--- /dev/null
+(* TEST
+ * bytecode
+ * native
+*)
+type t = Ret of (unit -> unit) | Next of t
+
+let[@tail_mod_cons] rec f () () = ()
+
+and[@tail_mod_cons] g ~first:b =
+ if b then Next (g ~first:false)
+ else
+ (* The call below is in TMC position but partially-applied;
+ we should not compile it like a TMC call. *)
+ Ret (f ())
+
+let () =
+ match g ~first:true with
+ | Next (Ret f) -> f ()
+ | _ -> assert false
--- /dev/null
+(* TEST
+ flags = "-dlambda -dno-unique-ids"
+ * expect *)
+
+(* Check that the code produced by TMC reads reasonably well. *)
+let[@tail_mod_cons] rec map f = function
+ | [] -> []
+ | x :: xs -> f x :: map f xs
+;;
+[%%expect{|
+(letrec
+ (map
+ (function f param tail_mod_cons
+ (if param
+ (let (block = (makemutable 0 (apply f (field 0 param)) 24029))
+ (seq (apply map_dps block 1 f (field 1 param)) block))
+ 0))
+ map_dps
+ (function dst offset[int] f param tail_mod_cons
+ (if param
+ (let
+ (block0_arg0 = (apply f (field 0 param))
+ block = (makemutable 0 block0_arg0 24029))
+ (seq (setfield_ptr(heap-init)_computed dst offset block)
+ (apply map_dps block 1 f (field 1 param) tailcall)))
+ (setfield_ptr(heap-init)_computed dst offset 0))))
+ (apply (field 1 (global Toploop!)) "map" map))
+val map : ('a -> 'b) -> 'a list -> 'b list = <fun>
+|}]
+
+(* check that TMC works for records as well *)
+type 'a cell = { hd : 'a; tl : 'a rec_list }
+and 'a rec_list = 'a cell option
+[%%expect{|
+0
+type 'a cell = { hd : 'a; tl : 'a rec_list; }
+and 'a rec_list = 'a cell option
+|}]
+
+let[@tail_mod_cons] rec rec_map f = function
+ | None -> None
+ | Some {hd; tl} -> Some { hd = f hd; tl = rec_map f tl }
+;;
+[%%expect{|
+(letrec
+ (rec_map
+ (function f param tail_mod_cons
+ (if param
+ (let (*match* =a (field 0 param))
+ (makeblock 0
+ (let (block = (makemutable 0 (apply f (field 0 *match*)) 24029))
+ (seq (apply rec_map_dps block 1 f (field 1 *match*)) block))))
+ 0))
+ rec_map_dps
+ (function dst offset[int] f param tail_mod_cons
+ (if param
+ (let
+ (*match* =a (field 0 param)
+ block1_arg0 = (apply f (field 0 *match*))
+ block = (makemutable 0 block1_arg0 24029))
+ (seq
+ (setfield_ptr(heap-init)_computed dst offset
+ (makeblock 0 block))
+ (apply rec_map_dps block 1 f (field 1 *match*) tailcall)))
+ (setfield_ptr(heap-init)_computed dst offset 0))))
+ (apply (field 1 (global Toploop!)) "rec_map" rec_map))
+val rec_map : ('a -> 'b) -> 'a rec_list -> 'b rec_list = <fun>
+|}]
+
+(* check the case where several constructors are nested;
+ we want to avoid creating an intermediate destination
+ for each constructor. *)
+let[@tail_mod_cons] rec trip = function
+ | [] -> []
+ | x :: xs -> (x, 0) :: (x, 1) :: (x, 2) :: trip xs
+;;
+[%%expect{|
+(letrec
+ (trip
+ (function param tail_mod_cons
+ (if param
+ (let (x =a (field 0 param))
+ (makeblock 0 (makeblock 0 (*,int) x 0)
+ (makeblock 0 (makeblock 0 (*,int) x 1)
+ (let (block = (makemutable 0 (makeblock 0 (*,int) x 2) 24029))
+ (seq (apply trip_dps block 1 (field 1 param)) block)))))
+ 0))
+ trip_dps
+ (function dst offset[int] param tail_mod_cons
+ (if param
+ (let
+ (x =a (field 0 param)
+ block0_arg0 = (makeblock 0 (*,int) x 0)
+ block1_arg0 = (makeblock 0 (*,int) x 1)
+ block2_arg0 = (makeblock 0 (*,int) x 2)
+ block = (makemutable 0 block2_arg0 24029))
+ (seq
+ (setfield_ptr(heap-init)_computed dst offset
+ (makeblock 0 block0_arg0 (makeblock 0 block1_arg0 block)))
+ (apply trip_dps block 1 (field 1 param) tailcall)))
+ (setfield_ptr(heap-init)_computed dst offset 0))))
+ (apply (field 1 (global Toploop!)) "trip" trip))
+val trip : 'a list -> ('a * int) list = <fun>
+|}]
+
+(* check nested-constructors whose arguments
+ are effectful: they need to be let-bound appropriately
+ (ideally, only in the DPS version) *)
+let[@tail_mod_cons] rec effects f = function
+ | [] -> []
+ | (x, y) :: xs -> f x :: f y :: effects f xs
+;;
+[%%expect{|
+(letrec
+ (effects
+ (function f param tail_mod_cons
+ (if param
+ (let (*match* =a (field 0 param))
+ (makeblock 0 (apply f (field 0 *match*))
+ (let (block = (makemutable 0 (apply f (field 1 *match*)) 24029))
+ (seq (apply effects_dps block 1 f (field 1 param)) block))))
+ 0))
+ effects_dps
+ (function dst offset[int] f param tail_mod_cons
+ (if param
+ (let
+ (*match* =a (field 0 param)
+ block0_arg0 = (apply f (field 0 *match*))
+ block1_arg0 = (apply f (field 1 *match*))
+ block = (makemutable 0 block1_arg0 24029))
+ (seq
+ (setfield_ptr(heap-init)_computed dst offset
+ (makeblock 0 block0_arg0 block))
+ (apply effects_dps block 1 f (field 1 param) tailcall)))
+ (setfield_ptr(heap-init)_computed dst offset 0))))
+ (apply (field 1 (global Toploop!)) "effects" effects))
+val effects : ('a -> 'b) -> ('a * 'a) list -> 'b list = <fun>
+|}]
+
+(* Check the case where several constructors
+ are nested across a duplicating context: the [f None ::]
+ part should not be duplicated in each branch. *)
+let[@tail_mod_cons] rec map_stutter f xs =
+ f None :: (
+ match xs with
+ | [] -> []
+ | x :: xs -> f (Some x) :: map_stutter f xs
+ )
+;;
+[%%expect{|
+(letrec
+ (map_stutter
+ (function f xs tail_mod_cons
+ (makeblock 0 (apply f 0)
+ (if xs
+ (let
+ (block =
+ (makemutable 0 (apply f (makeblock 0 (field 0 xs))) 24029))
+ (seq (apply map_stutter_dps block 1 f (field 1 xs)) block))
+ 0)))
+ map_stutter_dps
+ (function dst offset[int] f xs tail_mod_cons
+ (let
+ (block0_arg0 = (apply f 0)
+ block = (makemutable 0 block0_arg0 24029))
+ (seq (setfield_ptr(heap-init)_computed dst offset block)
+ (if xs
+ (let
+ (block0_arg0 = (apply f (makeblock 0 (field 0 xs)))
+ block = (makemutable 0 block0_arg0 24029))
+ (seq (setfield_ptr(heap-init)_computed block 1 block)
+ (apply map_stutter_dps block 1 f (field 1 xs) tailcall)))
+ (setfield_ptr(heap-init)_computed block 1 0))))))
+ (apply (field 1 (global Toploop!)) "map_stutter" map_stutter))
+val map_stutter : ('a option -> 'b) -> 'a list -> 'b list = <fun>
+|}]
+
+(* Check the case where several constructors
+ are nested across a non-duplicating context;
+ the [f None :: .] part can be delayed below the let..in,
+ buts it expression argument must be let-bound
+ before the let..in is evaluated. *)
+type 'a stream = { hd : 'a; tl : unit -> 'a stream }
+let[@tail_mod_cons] rec smap_stutter f xs n =
+ if n = 0 then []
+ else f None :: (
+ let v = f (Some xs.hd) in
+ v :: smap_stutter f (xs.tl ()) (n - 1)
+ )
+;;
+[%%expect{|
+0
+type 'a stream = { hd : 'a; tl : unit -> 'a stream; }
+(letrec
+ (smap_stutter
+ (function f xs n[int] tail_mod_cons
+ (if (== n 0) 0
+ (makeblock 0 (apply f 0)
+ (let
+ (v = (apply f (makeblock 0 (field 0 xs)))
+ block = (makemutable 0 v 24029))
+ (seq
+ (apply smap_stutter_dps block 1 f (apply (field 1 xs) 0)
+ (- n 1))
+ block)))))
+ smap_stutter_dps
+ (function dst offset[int] f xs n[int] tail_mod_cons
+ (if (== n 0) (setfield_ptr(heap-init)_computed dst offset 0)
+ (let
+ (block0_arg0 = (apply f 0)
+ v = (apply f (makeblock 0 (field 0 xs)))
+ block = (makemutable 0 v 24029))
+ (seq
+ (setfield_ptr(heap-init)_computed dst offset
+ (makeblock 0 block0_arg0 block))
+ (apply smap_stutter_dps block 1 f (apply (field 1 xs) 0)
+ (- n 1) tailcall))))))
+ (apply (field 1 (global Toploop!)) "smap_stutter" smap_stutter))
+val smap_stutter : ('a option -> 'b) -> 'a stream -> int -> 'b list = <fun>
+|}]
--- /dev/null
+(* TEST
+ * bytecode
+*)
+
+(* Test that evaluation order of constructor arguments is preserved.
+
+ Depending on whether we evaluate the head argument or tail argument
+ first, for a given call to `map`, there are two possible outputs:
+
+ tl `n` \ printed in evaluation
+ <prints from recursive calls> / of tl
+ hd `n` > printed in evaluation of hd
+
+ and
+
+ hd `n` > printed in evaluation of hd
+ tl `n` \ printed in evaluation
+ <prints from recursive calls> / of tl
+
+ With TMC, only the second version can happen, and this test ensures
+ that the effects of [Format.printf "hd %d@." n; f x] are not moved
+ inside the effectful [Format.printf "tl %d@." n; .] context.
+
+ (Note that due to the left-to-right evaluation order, a non-TMC version
+ would use the first version, and TMC is changing the evaluation order
+ here -- this is allowed by the language specification, as long as
+ each argument is fully evaluated before starting to evaluate another
+ argument, which is what we are testing here)
+*)
+let [@tail_mod_cons] rec verbose_map n f xs =
+ match xs with
+ | [] -> Format.printf "nil %d@." n; []
+ | x :: xs -> (Format.printf "hd %d@." n; f x) :: (Format.printf "tl %d@." n; verbose_map (n + 1)f xs)
+
+let _ =
+ assert (verbose_map 0 (fun x -> x + 1) [1; 2; 3] = [2; 3; 4])
+
+(* Test that delayed constructors are properly restored inside non-TMC contexts *)
+let[@tail_mod_cons] rec weird xs =
+ () :: match xs with [] -> [] | x :: xs -> x :: weird xs
+
+let _ =
+ assert (weird [] = [()]);
+ assert (weird [()] = [(); (); ()]);
+ assert (weird [(); ()] = [(); (); (); (); ()]);
--- /dev/null
+hd 0
+tl 0
+hd 1
+tl 1
+hd 2
+tl 2
+nil 3
--- /dev/null
+(* TEST
+ ocamlrunparam += ",l=10"
+ * bytecode
+*)
+
+(* large with respect to the stack-size=10 setting above *)
+let large = 1000
+
+let init n f =
+ let[@tail_mod_cons] rec init_aux i n f =
+ if i = n then []
+ else f i :: init_aux (i + 1) n f
+ in init_aux 0 n f
+
+module ListMap = struct
+ let[@tail_mod_cons] rec map f = function
+ | [] -> []
+ | x :: xs ->
+ (* Note: tail-mod-cons guarantees that 'map f xs' is evaluated last *)
+ f x :: map f xs
+
+ let _ =
+ init large Fun.id
+ |> map succ
+end
+
+module TreeMap = struct
+ type 'a tree =
+ | Leaf of 'a
+ | Node of 'a tree * 'a tree
+
+ let[@tail_mod_cons] rec map f = function
+ | Leaf v -> Leaf (f v)
+ | Node (left, right) ->
+ Node (map f left, (map [@tailcall]) f right)
+
+ let _ =
+ init large Fun.id
+ |> List.fold_left (fun t n -> Node (Leaf n, t)) (Leaf (-1))
+ (* large right-leaning tree *)
+ |> map succ
+end
--- /dev/null
+(* TEST
+ * bytecode
+ * native
+*)
+type 'a t =
+ | N of 'a
+ | C of 'a t * 'a t
+
+(* This function is recognized as 'tupled' by the backend; it is
+ a regression-test to check that our TMC transformation works as
+ expected for tupled (rather than curried) functions.
+
+ Note: it is important to test the 'native' compiler here, as the
+ bytecode does not perform the same arity-raising optimizations. *)
+let[@tail_mod_cons] rec map (f, l) =
+ match l with
+ | N v -> N (f v)
+ | C (a, b) ->
+ C (map (f, a), (map [@tailcall]) (f, b))
+
+let v = C (C (N 1, N 2), N 3)
+
+let v' =
+ let arg = (succ, v) in
+ map arg
+
+let () =
+ assert (v' = C (C (N 2, N 3), N 4))
--- /dev/null
+(* TEST
+ * bytecode
+ * native
+*)
+
+(* this works as expected *)
+let[@tail_mod_cons] rec tupled_map (f, li) =
+ match li with
+ | [] -> []
+ | x :: xs -> f x :: tupled_map (f, xs)
+
+(* The recursive call here is not "direct" for the
+ Tupled calling convention (which is only used by the native compiler),
+ so it will not be eligible for TMC optimization.
+ We expect a warning here, when compiling with the native compiler. *)
+let[@tail_mod_cons] rec tupled_map_not_direct (f, li) =
+ match li with
+ | [] -> []
+ | x :: xs ->
+ let pair = (f, xs) in
+ f x :: (tupled_map_not_direct[@tailcall true]) pair
--- /dev/null
+File "tupled_function_calls.ml", lines 16-21, characters 46-57:
+16 | ..............................................(f, li) =
+17 | match li with
+18 | | [] -> []
+19 | | x :: xs ->
+20 | let pair = (f, xs) in
+21 | f x :: (tupled_map_not_direct[@tailcall true]) pair
+Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
+but is never applied in TMC position.
+File "tupled_function_calls.ml", line 21, characters 13-57:
+21 | f x :: (tupled_map_not_direct[@tailcall true]) pair
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+File "tupled_function_calls.ml", line 21, characters 13-57:
+21 | f x :: (tupled_map_not_direct[@tailcall true]) pair
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
--- /dev/null
+(* TEST
+ * expect *)
+
+(* build-up *)
+let[@tail_mod_cons] rec append xs ys =
+ match xs with
+ | [] -> ys
+ | x :: xs -> x :: append xs ys
+[%%expect {|
+val append : 'a list -> 'a list -> 'a list = <fun>
+|}]
+
+(* incorrect version: this cannot work *)
+let[@tail_mod_cons] rec flatten = function
+ | [] -> []
+ | xs :: xss -> append xs (flatten xss)
+[%%expect {|
+Line 3, characters 17-40:
+3 | | xs :: xss -> append xs (flatten xss)
+ ^^^^^^^^^^^^^^^^^^^^^^^
+Warning 72 [tmc-breaks-tailcall]: This call
+is in tail-modulo-cons positionin a TMC function,
+but the function called is not itself specialized for TMC,
+so the call will not be transformed into a tail call.
+Please either mark the called function with the [@tail_mod_cons]
+attribute, or mark this call with the [@tailcall false] attribute
+to make its non-tailness explicit.
+Lines 1-3, characters 34-40:
+1 | ..................................function
+2 | | [] -> []
+3 | | xs :: xss -> append xs (flatten xss)
+Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
+but is never applied in TMC position.
+val flatten : 'a list list -> 'a list = <fun>
+|}]
+
+(* correct version *)
+let[@tail_mod_cons] rec flatten = function
+ | [] -> []
+ | xs :: xss ->
+ let[@tail_mod_cons] rec append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs -> x :: append_flatten xs xss
+ in append_flatten xs xss
+[%%expect {|
+val flatten : 'a list list -> 'a list = <fun>
+|}]
+
+(* incorrect version *)
+let[@tail_mod_cons] rec flatten = function
+ | [] -> []
+ | xs :: xss ->
+ let rec append_flatten xs xss =
+ match xs with
+ | [] -> flatten xss
+ | x :: xs ->
+ (* incorrect: this call to append_flatten is not transformed *)
+ x :: append_flatten xs xss
+ in append_flatten xs xss
+[%%expect {|
+Line 10, characters 9-30:
+10 | in append_flatten xs xss
+ ^^^^^^^^^^^^^^^^^^^^^
+Warning 72 [tmc-breaks-tailcall]: This call
+is in tail-modulo-cons positionin a TMC function,
+but the function called is not itself specialized for TMC,
+so the call will not be transformed into a tail call.
+Please either mark the called function with the [@tail_mod_cons]
+attribute, or mark this call with the [@tailcall false] attribute
+to make its non-tailness explicit.
+Lines 1-10, characters 34-30:
+ 1 | ..................................function
+ 2 | | [] -> []
+ 3 | | xs :: xss ->
+ 4 | let rec append_flatten xs xss =
+ 5 | match xs with
+ 6 | | [] -> flatten xss
+ 7 | | x :: xs ->
+ 8 | (* incorrect: this call to append_flatten is not transformed *)
+ 9 | x :: append_flatten xs xss
+10 | in append_flatten xs xss
+Warning 71 [unused-tmc-attribute]: This function is marked @tail_mod_cons
+but is never applied in TMC position.
+val flatten : 'a list list -> 'a list = <fun>
+|}]
+
+(* incorrect version: the call to append-flatten is not transformed *)
+let rec flatten = function
+ | [] -> []
+ | xs :: xss ->
+ let[@tail_mod_cons] rec append_flatten xs xss =
+ match xs with
+ | [] ->
+ (* incorrect: if flatten does not have a TMC version,
+ this call is not tail-recursive in the TMC version of
+ append-flatten, so this version is in fact equivalent
+ to the "cannot work" version above: the "append" part
+ runs in constant stack space, but the "flatten" part is
+ not tail-recursive. *)
+ flatten xss
+ | x :: xs ->
+ x :: append_flatten xs xss
+ in append_flatten xs xss
+[%%expect {|
+Line 13, characters 12-23:
+13 | flatten xss
+ ^^^^^^^^^^^
+Warning 72 [tmc-breaks-tailcall]: This call
+is in tail-modulo-cons positionin a TMC function,
+but the function called is not itself specialized for TMC,
+so the call will not be transformed into a tail call.
+Please either mark the called function with the [@tail_mod_cons]
+attribute, or mark this call with the [@tailcall false] attribute
+to make its non-tailness explicit.
+val flatten : 'a list list -> 'a list = <fun>
+|}]
+
+
+
+module Tail_calls_to_non_specialized_functions = struct
+(* This module contains regression tests for some delicate warning behavior:
+ if the list_id call below goes to a non-specialized function,
+ it gets the "use [@tailcall false]" warning, but it is in tailcall
+ position in the direct-style version, so it could also get the
+ "invalid [@tailcall false] assumption" warning. *)
+
+ (* *not* TMC-specialized *)
+ let list_id = function
+ | [] -> []
+ | x :: xs -> x :: xs
+
+ let[@tail_mod_cons] rec filter_1 f li =
+ match li with
+ | [] -> []
+ | x :: xs ->
+ if f x
+ then x :: filter_1 f xs
+ else
+ list_id
+ (* no [@tailcall false]: this should warn that
+ the call becomes non-tailcall in the TMC version. *)
+ (filter_1 f xs)
+
+ let[@tail_mod_cons] rec filter_2 f li =
+ match li with
+ | [] -> []
+ | x :: xs ->
+ if f x
+ then x :: filter_2 f xs
+ else
+ (list_id[@tailcall false])
+ (* [@tailcall false]: this should *not* warn that
+ the call is in fact in tail position in the direct version. *)
+ (filter_2 f xs)
+end
+[%%expect {|
+Lines 20-23, characters 10-27:
+20 | ..........list_id
+21 | (* no [@tailcall false]: this should warn that
+22 | the call becomes non-tailcall in the TMC version. *)
+23 | (filter_1 f xs)
+Warning 72 [tmc-breaks-tailcall]: This call
+is in tail-modulo-cons positionin a TMC function,
+but the function called is not itself specialized for TMC,
+so the call will not be transformed into a tail call.
+Please either mark the called function with the [@tail_mod_cons]
+attribute, or mark this call with the [@tailcall false] attribute
+to make its non-tailness explicit.
+module Tail_calls_to_non_specialized_functions :
+ sig
+ val list_id : 'a list -> 'a list
+ val filter_1 : ('a -> bool) -> 'a list -> 'a list
+ val filter_2 : ('a -> bool) -> 'a list -> 'a list
+ end
+|}]
+
+module All_annotations_correctly_used = struct
+ type 'a t =
+ | N of 'a
+ | Graft of int
+ | Tau of 'a t
+ | C of 'a t * 'a t
+
+ let[@inline never] rec graft n =
+ graft n
+
+ let[@tail_mod_cons] rec map f l =
+ (* this function should never warn *)
+ match l with
+ | N v -> N (f v)
+ | Graft n ->
+ if n >= 0
+ then (graft[@tailcall false]) n
+ else Tau ((graft[@tailcall false]) n)
+ | Tau t -> (map[@tailcall]) f t
+ | C (a, b) ->
+ let[@tail_mod_cons] map' l = map f l in
+ C (map' a, (map' [@tailcall]) b)
+end
+[%%expect {|
+module All_annotations_correctly_used :
+ sig
+ type 'a t = N of 'a | Graft of int | Tau of 'a t | C of 'a t * 'a t
+ val graft : 'a -> 'b
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ end
+|}]
+
+module All_annotations_flipped = struct
+ type 'a t =
+ | N of 'a
+ | Graft of int
+ | Tau of 'a t
+ | C of 'a t * 'a t
+
+ let[@inline never] rec graft n =
+ graft n
+
+ let[@tail_mod_cons] rec map_wrong f l =
+ match l with
+ | N v -> N (f v)
+ | Graft n ->
+ if n >= 0
+ then (graft[@tailcall]) (* this should warn *) n
+ else Tau ((graft[@tailcall]) (* this should also warn *) n)
+ | Tau t ->
+ (map_wrong[@tailcall false])
+ (* this attribute disables the TMC call here,
+ so it does generate non-tail code:
+ the annotation is erased in direct-style, kept in DPS,
+ and the generated code must not warn. *)
+ f t
+ | C (a, b) ->
+ let[@tail_mod_cons] map' l = map_wrong f l in
+ C (map' a,
+ (map' [@tailcall false])
+ (* this attribute results in the other map' being selected for TMC,
+ no warning here. *)
+ b)
+end
+[%%expect {|
+Line 16, characters 13-56:
+16 | then (graft[@tailcall]) (* this should warn *) n
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 72 [tmc-breaks-tailcall]: This call
+is in tail-modulo-cons positionin a TMC function,
+but the function called is not itself specialized for TMC,
+so the call will not be transformed into a tail call.
+Please either mark the called function with the [@tail_mod_cons]
+attribute, or mark this call with the [@tailcall false] attribute
+to make its non-tailness explicit.
+Line 17, characters 17-67:
+17 | else Tau ((graft[@tailcall]) (* this should also warn *) n)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+Line 16, characters 13-56:
+16 | then (graft[@tailcall]) (* this should warn *) n
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+Line 17, characters 17-67:
+17 | else Tau ((graft[@tailcall]) (* this should also warn *) n)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 51 [wrong-tailcall-expectation]: expected tailcall
+module All_annotations_flipped :
+ sig
+ type 'a t = N of 'a | Graft of int | Tau of 'a t | C of 'a t * 'a t
+ val graft : 'a -> 'b
+ val map_wrong : ('a -> 'b) -> 'a t -> 'b t
+ end
+|}]
--- /dev/null
+load_printer main.cmo
+install_printer Main.Submodule.pp
+goto 0
+break @ Main 26
+run
+print value
+quit
--- /dev/null
+(* TEST
+flags += " -g "
+ocamldebug_script = "${test_source_directory}/input_script"
+* debugger
+** shared-libraries
+*** setup-ocamlc.byte-build-env
+**** ocamlc.byte
+***** check-ocamlc.byte-output
+****** ocamldebug
+******* check-program-output
+*)
+
+module Submodule = struct
+
+ type t = unit
+
+ let value = ()
+
+ let pp (fmt : Format.formatter) (_ : t) : unit =
+ Format.fprintf fmt "DEBUG: Aux.Submodule.pp"
+
+end
+
+let debug () =
+ let value = Submodule.value in
+ ignore value
+
+;;
+
+debug ();
--- /dev/null
+File main.cmo loaded
+Loading program... done.
+Beginning of program.
+Breakpoint: 1
+26 <|b|>ignore value
+value: unit = DEBUG: Aux.Submodule.pp
(* We use `max_printer_depth` to tweak the output so that
this test shows that the printer not only compiles
against the debugger's code, but also uses its state. *)
- for _i = 1 to min n !Printval.max_printer_depth do
+ for _i = 1 to min n !Ocamldebug.Printval.max_printer_depth do
Format.pp_print_string fmt "S ";
done;
Format.pp_print_string fmt "O"
--- /dev/null
+(* TEST
+ocaml_script_as_argument = "true"
+ocaml_exit_status = "125"
+* setup-ocaml-build-env
+** ocaml
+*)
+
+#use "no";;
+let () = () ;;
(* this is a set of tests to test the #show functionality
* of toplevel *)
+class o = object val x = 0 end;;
+[%%expect{|
+class o : object val x : int end
+|}];;
+#show o;;
+[%%expect{|
+type o = < >
+class o : object val x : int end
+class type o = object val x : int end
+|}];;
+class type t = object val x : int end;;
+[%%expect{|
+class type t = object val x : int end
+|}];;
+#show t;;
+[%%expect{|
+type t = < >
+class type t = object val x : int end
+|}];;
+
#show Foo;;
[%%expect {|
Unknown element.
--- /dev/null
+module A :
+ sig type ('foo, 'bar) t val get_foo : ('foo, 'a) t -> 'foo option end
+- : ('foo, 'a) A.t -> 'foo option = <fun>
+val _bar : ('a, 'b) A.t -> 'a option = <fun>
+- : int = 42
+- : bool = false
+- : string = ""
+- : char = 'd'
+- : float = 42.
+
--- /dev/null
+(* TEST
+ * toplevel
+ * toplevel.opt
+*)
+
+(* Various test-cases ensuring that the native and bytecode toplevels produce
+ the same output *)
+
+(* PR 10712 *)
+module A : sig
+ type ('foo, 'bar) t
+
+ val get_foo : ('foo, _) t -> 'foo option
+end = struct
+ type ('foo, 'bar) t =
+ | Foo of 'foo
+ | Bar of 'bar
+
+ let get_foo = function
+ | Foo foo -> Some foo
+ | Bar _ -> None
+end
+;;
+
+(* Type variables should be 'foo and 'a (name persists) *)
+A.get_foo
+;;
+
+(* Type variables be 'a and 'b (original names lost in let-binding) *)
+let _bar = A.get_foo
+;;
+
+(* PR 10849 *)
+let _ : int = 42
+;;
+
+let (_ : bool) : bool = false
+;;
+
+let List.(_) = ""
+;;
+
+let List.(String.(_)) = 'd'
+;;
+
+let List.(_) : float = 42.0
+;;
(array.unsafe_get[addr] addr_a 0)
(function a (array.unsafe_get[gen] a 0)) (array.set[int] int_a 0 1)
(array.set[float] float_a 0 1.) (array.set[addr] addr_a 0 "a")
- (function a x (array.set[gen] a 0 x)) (array.unsafe_set[int] int_a 0 1)
+ (function a x : int (array.set[gen] a 0 x))
+ (array.unsafe_set[int] int_a 0 1)
(array.unsafe_set[float] float_a 0 1.)
(array.unsafe_set[addr] addr_a 0 "a")
- (function a x (array.unsafe_set[gen] a 0 x))
+ (function a x : int (array.unsafe_set[gen] a 0 x))
(let
(eta_gen_len = (function prim stub (array.length[gen] prim))
eta_gen_safe_get =
(array.unsafe_get[addr] addr_a 0)
(function a (array.unsafe_get[addr] a 0)) (array.set[int] int_a 0 1)
(array.set[addr] float_a 0 1.) (array.set[addr] addr_a 0 "a")
- (function a x (array.set[addr] a 0 x))
+ (function a x : int (array.set[addr] a 0 x))
(array.unsafe_set[int] int_a 0 1) (array.unsafe_set[addr] float_a 0 1.)
(array.unsafe_set[addr] addr_a 0 "a")
- (function a x (array.unsafe_set[addr] a 0 x))
+ (function a x : int (array.unsafe_set[addr] a 0 x))
(let
(eta_gen_len = (function prim stub (array.length[addr] prim))
eta_gen_safe_get =
(let
(gen_cmp = (function x y : int (caml_compare x y))
int_cmp = (function x[int] y[int] : int (compare_ints x y))
- bool_cmp = (function x y : int (compare_ints x y))
- intlike_cmp = (function x y : int (compare_ints x y))
+ bool_cmp = (function x[int] y[int] : int (compare_ints x y))
+ intlike_cmp = (function x[int] y[int] : int (compare_ints x y))
float_cmp = (function x[float] y[float] : int (compare_floats x y))
string_cmp = (function x y : int (caml_string_compare x y))
int32_cmp = (function x[int32] y[int32] : int (compare_bints int32 x y))
nativeint_cmp =
(function x[nativeint] y[nativeint] : int
(compare_bints nativeint x y))
- gen_eq = (function x y (caml_equal x y))
- int_eq = (function x[int] y[int] (== x y))
- bool_eq = (function x y (== x y))
- intlike_eq = (function x y (== x y))
- float_eq = (function x[float] y[float] (==. x y))
- string_eq = (function x y (caml_string_equal x y))
- int32_eq = (function x[int32] y[int32] (Int32.== x y))
- int64_eq = (function x[int64] y[int64] (Int64.== x y))
- nativeint_eq = (function x[nativeint] y[nativeint] (Nativeint.== x y))
- gen_ne = (function x y (caml_notequal x y))
- int_ne = (function x[int] y[int] (!= x y))
- bool_ne = (function x y (!= x y))
- intlike_ne = (function x y (!= x y))
- float_ne = (function x[float] y[float] (!=. x y))
- string_ne = (function x y (caml_string_notequal x y))
- int32_ne = (function x[int32] y[int32] (Int32.!= x y))
- int64_ne = (function x[int64] y[int64] (Int64.!= x y))
- nativeint_ne = (function x[nativeint] y[nativeint] (Nativeint.!= x y))
- gen_lt = (function x y (caml_lessthan x y))
- int_lt = (function x[int] y[int] (< x y))
- bool_lt = (function x y (< x y))
- intlike_lt = (function x y (< x y))
- float_lt = (function x[float] y[float] (<. x y))
- string_lt = (function x y (caml_string_lessthan x y))
- int32_lt = (function x[int32] y[int32] (Int32.< x y))
- int64_lt = (function x[int64] y[int64] (Int64.< x y))
- nativeint_lt = (function x[nativeint] y[nativeint] (Nativeint.< x y))
- gen_gt = (function x y (caml_greaterthan x y))
- int_gt = (function x[int] y[int] (> x y))
- bool_gt = (function x y (> x y))
- intlike_gt = (function x y (> x y))
- float_gt = (function x[float] y[float] (>. x y))
- string_gt = (function x y (caml_string_greaterthan x y))
- int32_gt = (function x[int32] y[int32] (Int32.> x y))
- int64_gt = (function x[int64] y[int64] (Int64.> x y))
- nativeint_gt = (function x[nativeint] y[nativeint] (Nativeint.> x y))
- gen_le = (function x y (caml_lessequal x y))
- int_le = (function x[int] y[int] (<= x y))
- bool_le = (function x y (<= x y))
- intlike_le = (function x y (<= x y))
- float_le = (function x[float] y[float] (<=. x y))
- string_le = (function x y (caml_string_lessequal x y))
- int32_le = (function x[int32] y[int32] (Int32.<= x y))
- int64_le = (function x[int64] y[int64] (Int64.<= x y))
- nativeint_le = (function x[nativeint] y[nativeint] (Nativeint.<= x y))
- gen_ge = (function x y (caml_greaterequal x y))
- int_ge = (function x[int] y[int] (>= x y))
- bool_ge = (function x y (>= x y))
- intlike_ge = (function x y (>= x y))
- float_ge = (function x[float] y[float] (>=. x y))
- string_ge = (function x y (caml_string_greaterequal x y))
- int32_ge = (function x[int32] y[int32] (Int32.>= x y))
- int64_ge = (function x[int64] y[int64] (Int64.>= x y))
- nativeint_ge = (function x[nativeint] y[nativeint] (Nativeint.>= x y))
+ gen_eq = (function x y : int (caml_equal x y))
+ int_eq = (function x[int] y[int] : int (== x y))
+ bool_eq = (function x[int] y[int] : int (== x y))
+ intlike_eq = (function x[int] y[int] : int (== x y))
+ float_eq = (function x[float] y[float] : int (==. x y))
+ string_eq = (function x y : int (caml_string_equal x y))
+ int32_eq = (function x[int32] y[int32] : int (Int32.== x y))
+ int64_eq = (function x[int64] y[int64] : int (Int64.== x y))
+ nativeint_eq =
+ (function x[nativeint] y[nativeint] : int (Nativeint.== x y))
+ gen_ne = (function x y : int (caml_notequal x y))
+ int_ne = (function x[int] y[int] : int (!= x y))
+ bool_ne = (function x[int] y[int] : int (!= x y))
+ intlike_ne = (function x[int] y[int] : int (!= x y))
+ float_ne = (function x[float] y[float] : int (!=. x y))
+ string_ne = (function x y : int (caml_string_notequal x y))
+ int32_ne = (function x[int32] y[int32] : int (Int32.!= x y))
+ int64_ne = (function x[int64] y[int64] : int (Int64.!= x y))
+ nativeint_ne =
+ (function x[nativeint] y[nativeint] : int (Nativeint.!= x y))
+ gen_lt = (function x y : int (caml_lessthan x y))
+ int_lt = (function x[int] y[int] : int (< x y))
+ bool_lt = (function x[int] y[int] : int (< x y))
+ intlike_lt = (function x[int] y[int] : int (< x y))
+ float_lt = (function x[float] y[float] : int (<. x y))
+ string_lt = (function x y : int (caml_string_lessthan x y))
+ int32_lt = (function x[int32] y[int32] : int (Int32.< x y))
+ int64_lt = (function x[int64] y[int64] : int (Int64.< x y))
+ nativeint_lt =
+ (function x[nativeint] y[nativeint] : int (Nativeint.< x y))
+ gen_gt = (function x y : int (caml_greaterthan x y))
+ int_gt = (function x[int] y[int] : int (> x y))
+ bool_gt = (function x[int] y[int] : int (> x y))
+ intlike_gt = (function x[int] y[int] : int (> x y))
+ float_gt = (function x[float] y[float] : int (>. x y))
+ string_gt = (function x y : int (caml_string_greaterthan x y))
+ int32_gt = (function x[int32] y[int32] : int (Int32.> x y))
+ int64_gt = (function x[int64] y[int64] : int (Int64.> x y))
+ nativeint_gt =
+ (function x[nativeint] y[nativeint] : int (Nativeint.> x y))
+ gen_le = (function x y : int (caml_lessequal x y))
+ int_le = (function x[int] y[int] : int (<= x y))
+ bool_le = (function x[int] y[int] : int (<= x y))
+ intlike_le = (function x[int] y[int] : int (<= x y))
+ float_le = (function x[float] y[float] : int (<=. x y))
+ string_le = (function x y : int (caml_string_lessequal x y))
+ int32_le = (function x[int32] y[int32] : int (Int32.<= x y))
+ int64_le = (function x[int64] y[int64] : int (Int64.<= x y))
+ nativeint_le =
+ (function x[nativeint] y[nativeint] : int (Nativeint.<= x y))
+ gen_ge = (function x y : int (caml_greaterequal x y))
+ int_ge = (function x[int] y[int] : int (>= x y))
+ bool_ge = (function x[int] y[int] : int (>= x y))
+ intlike_ge = (function x[int] y[int] : int (>= x y))
+ float_ge = (function x[float] y[float] : int (>=. x y))
+ string_ge = (function x y : int (caml_string_greaterequal x y))
+ int32_ge = (function x[int32] y[int32] : int (Int32.>= x y))
+ int64_ge = (function x[int64] y[int64] : int (Int64.>= x y))
+ nativeint_ge =
+ (function x[nativeint] y[nativeint] : int (Nativeint.>= x y))
eta_gen_cmp = (function prim prim stub (caml_compare prim prim))
eta_int_cmp = (function prim prim stub (compare_ints prim prim))
eta_bool_cmp = (function prim prim stub (compare_ints prim prim))
(setglobal Ref_spec!
(let
(int_ref = (makemutable 0 (int) 1)
- var_ref = (makemutable 0 65)
+ var_ref = (makemutable 0 (int) 65)
vargen_ref = (makemutable 0 65)
- cst_ref = (makemutable 0 0)
+ cst_ref = (makemutable 0 (int) 0)
gen_ref = (makemutable 0 0)
flt_ref = (makemutable 0 (float) 0.))
(seq (setfield_imm 0 int_ref 2) (setfield_imm 0 var_ref 66)
(setfield_imm 0 cst_ref 1) (setfield_ptr 0 gen_ref [0: "foo"])
(setfield_ptr 0 gen_ref 0) (setfield_ptr 0 flt_ref 1.)
(let
- (int_rec = (makemutable 0 (*,int) 0 1)
- var_rec = (makemutable 0 0 65)
- vargen_rec = (makemutable 0 0 65)
- cst_rec = (makemutable 0 0 0)
- gen_rec = (makemutable 0 0 0)
- flt_rec = (makemutable 0 (*,float) 0 0.)
+ (int_rec = (makemutable 0 (int,int) 0 1)
+ var_rec = (makemutable 0 (int,int) 0 65)
+ vargen_rec = (makemutable 0 (int,*) 0 65)
+ cst_rec = (makemutable 0 (int,int) 0 0)
+ gen_rec = (makemutable 0 (int,*) 0 0)
+ flt_rec = (makemutable 0 (int,float) 0 0.)
flt_rec' = (makearray[float] 0. 0.))
(seq (setfield_imm 1 int_rec 2) (setfield_imm 1 var_rec 66)
(setfield_ptr 1 vargen_rec [0: 66 0])
(setfield_ptr 1 gen_rec [0: "foo"]) (setfield_ptr 1 gen_rec 0)
(setfield_ptr 1 flt_rec 1.) (setfloatfield 1 flt_rec' 1.)
(let
- (set_open_poly = (function r y (setfield_ptr 0 r y))
- set_open_poly = (function r y (setfield_imm 0 r y))
- set_open_poly = (function r y (setfield_imm 0 r y))
- set_open_poly = (function r y (setfield_imm 0 r y))
- set_open_poly = (function r y (setfield_ptr 0 r y))
- set_open_poly = (function r y (setfield_ptr 0 r y))
- set_open_poly = (function r y (setfield_ptr 0 r y))
- set_open_poly = (function r y (setfield_ptr 0 r y)))
+ (set_open_poly = (function r y : int (setfield_ptr 0 r y))
+ set_open_poly = (function r y[int] : int (setfield_imm 0 r y))
+ set_open_poly = (function r y[int] : int (setfield_imm 0 r y))
+ set_open_poly = (function r y[int] : int (setfield_imm 0 r y))
+ set_open_poly = (function r y : int (setfield_ptr 0 r y))
+ set_open_poly = (function r y : int (setfield_ptr 0 r y))
+ set_open_poly = (function r y : int (setfield_ptr 0 r y))
+ set_open_poly = (function r y : int (setfield_ptr 0 r y)))
(makeblock 0 int_ref var_ref vargen_ref cst_ref gen_ref flt_ref
int_rec var_rec vargen_rec cst_rec gen_rec flt_rec flt_rec'
set_open_poly)))))))
type ('a, 'b) bar += A of int
Constructors do not match:
A of float
- is not compatible with:
+ is not the same as:
A of int
- The types are not equal.
+ The type float is not equal to the type int
|}]
module M : sig
type ('a, 'b) bar += A of 'a
Constructors do not match:
A of 'b
- is not compatible with:
+ is not the same as:
A of 'a
- The types are not equal.
+ The type 'b is not equal to the type 'a
|}]
module M : sig
type ('a, 'b) bar = A of 'a
Constructors do not match:
A of 'a
- is not compatible with:
+ is not the same as:
A of 'a
- The types are not equal.
+ The type 'a is not equal to the type 'b
|}];;
type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
Constructors do not match:
A : 'd -> ('c, 'd) bar
- is not compatible with:
+ is not the same as:
A : 'c -> ('c, 'd) bar
- The types are not equal.
+ The type 'd is not equal to the type 'c
|}]
(* Extensions can be rebound *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type
('a, 'a) foo
- Their constraints differ.
+ Their parameters differ
+ The type 'a is not equal to the type 'b
|}]
(* Check that signatures can hide exstensibility *)
type foo = M.foo = private ..
is not included in
type foo = ..
- A private type would be revealed.
+ A private extensible variant would be revealed.
|}]
val r : '_weak1 list ref
is not included in
val r : T.u list ref
+ The type '_weak1 list ref is not compatible with the type T.u list ref
+ Type '_weak1 is not compatible with type T.u = T.t
+ This instance of T.t is ambiguous:
+ it would escape the scope of its equation
|}]
module M = struct
val r : '_weak2 list ref
is not included in
val r : T.t list ref
+ The type '_weak2 list ref is not compatible with the type T.t list ref
+ Type '_weak2 is not compatible with type T.t = T.u
+ This instance of T.u is ambiguous:
+ it would escape the scope of its equation
|}]
(('a, 'b, (suc, int -> int, 'c) rcons) rcons, int) lam = <fun>
val _1 : ((zero, int, (suc, int -> int, '_weak1) rcons) rcons, int) lam =
App (Shift (Var Suc), Var Zero)
-val _2 : ((zero, int, (suc, int -> int, '_weak2) rcons) rcons, int) lam =
+val _2 : ((zero, int, (suc, int -> int, '_weak1) rcons) rcons, int) lam =
App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))
-val _3 : ((zero, int, (suc, int -> int, '_weak3) rcons) rcons, int) lam =
+val _3 : ((zero, int, (suc, int -> int, '_weak1) rcons) rcons, int) lam =
App (Shift (Var Suc),
App (Shift (Var Suc), App (Shift (Var Suc), Var Zero)))
val add :
App (App (Shift (Shift (Shift (Var Add))), Var <poly>), Var <poly>))
val ex3 :
((zero, int,
- (suc, int -> int, (add, int -> int -> int, '_weak4) rcons) rcons)
+ (suc, int -> int, (add, int -> int -> int, '_weak2) rcons) rcons)
rcons, int)
lam =
App
Here is an example of a case that is not matched:
Some A
val g : 'a M.j t option -> unit = <fun>
-|}, Principal{|
-module M :
- sig
- type 'a d
- type i = < m : 'c. 'c -> 'c d >
- type 'a j = < m : 'c. 'c -> 'a >
- end
-type _ t = A : M.i t
-File "_none_", line 1:
-Warning 18 [not-principal]: typing this pattern requires considering $0 and 'c M.d as equal.
-But the knowledge of these types is not principal.
-Line 9, characters 2-20:
-9 | let None = y in () ;;
- ^^^^^^^^^^^^^^^^^^
-Warning 8 [partial-match]: this pattern-matching is not exhaustive.
-Here is an example of a case that is not matched:
-Some A
-val g : 'a M.j t option -> unit = <fun>
|}]
(* more examples by @lpw25 *)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module X : sig
+ type 'a t
+end = struct
+ type 'a t
+end
+
+type 'a t
+
+type (_,_) eq = Refl : ('a,'a) eq
+[%%expect{|
+module X : sig type 'a t end
+type 'a t
+type (_, _) eq = Refl : ('a, 'a) eq
+|}]
+
+let () =
+ let (Refl : (bool X.t, bool t) eq) as t = Obj.magic () in ()
+[%%expect{|
+Line 2, characters 7-11:
+2 | let (Refl : (bool X.t, bool t) eq) as t = Obj.magic () in ()
+ ^^^^
+Error: This pattern matches values of type (bool X.t, bool X.t) eq
+ but a pattern was expected which matches values of type
+ (bool X.t, bool t) eq
+ Type bool X.t is not compatible with type bool t
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* from @dyzsr *)
+type 'a t = T : ('a -> 'b) * ('b -> 'a) -> 'a t;;
+[%%expect{|
+type 'a t = T : ('a -> 'b) * ('b -> 'a) -> 'a t
+|}]
+
+let t = T ((fun x -> x), (fun x -> x));;
+[%%expect{|
+val t : 'a t = T (<fun>, <fun>)
+|}]
+
+let t1 = let T (g, h) = t in h (g 1);;
+[%%expect{|
+val t1 : int = 1
+|}]
+
+let f x = let T (g, h) = t in h (g x);;
+[%%expect{|
+val f : 'a -> 'a = <fun>
+|}]
+
+(* reformulation by @gasche *)
+
+(* an isomorphism between 'a and 'b *)
+type ('a, 'b) iso = ('a -> 'b) * ('b -> 'a)
+
+(* exists 'b. ('a, 'b) iso *)
+type 'a some_iso = Iso : ('a, 'b) iso -> 'a some_iso
+[%%expect{|
+type ('a, 'b) iso = ('a -> 'b) * ('b -> 'a)
+type 'a some_iso = Iso : ('a, 'b) iso -> 'a some_iso
+|}]
+
+(* forall 'a. exists 'b. ('a, 'b) iso *)
+let t : 'a . 'a some_iso =
+ Iso ((fun x -> x), (fun x -> x))
+[%%expect{|
+val t : 'a some_iso = Iso (<fun>, <fun>)
+|}]
+
+let unsound_cast : 'a 'b. 'a -> 'b = fun x ->
+ match t with Iso (g, h) -> h (g x)
+[%%expect{|
+Lines 1-2, characters 37-36:
+1 | .....................................fun x ->
+2 | match t with Iso (g, h) -> h (g x)
+Error: This definition has type 'c. 'c -> 'c which is less general than
+ 'a 'b. 'a -> 'b
+|}]
Line 7, characters 35-43:
7 | | (Kind _, Ast_Text txt) -> Text txt
^^^^^^^^
-Error: This expression has type ([< inkind > `Nonlink ] as 'a) inline_t
+Error: This expression has type [< inkind > `Nonlink ] 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 ]
+ Type [< inkind > `Nonlink ] = [< `Link | `Nonlink > `Nonlink ]
+ is not compatible with type a = [< `Link | `Nonlink ]
The second variant type is bound to $'a,
it may not allow the tag(s) `Nonlink
|}];;
Line 25, characters 23-27:
25 | | WrapPoly ATag -> intA
^^^^
-Error: This expression has type ([< `TagA of 'b ] as 'a) -> 'b
+Error: This expression has type [< `TagA of 'a ] -> 'a
but an expression was expected of type a -> int
- Type [< `TagA of 'b ] as 'a is not compatible with type
+ Type [< `TagA of 'a ] is not compatible with type
a = [< `TagA of int | `TagB ]
The first variant type does not allow tag(s) `TagB
|}];;
Error: This variant or record definition does not match that of type 'a t
Constructors do not match:
Same : 'l t -> 'l t
- is not compatible with:
+ is not the same as:
Same : 'l1 t -> 'l2 t
- The types are not equal.
+ The type 'l t is not equal to the type 'l1 t
+ Type 'l is not equal to type 'l1
|}];;
type bar = < bar : unit >
type _ ty = Int : int ty
type dyn = Dyn : 'a ty -> dyn
-Lines 7-12, characters 0-5:
- 7 | class foo =
- 8 | object (this)
+Lines 8-12, characters 2-5:
+ 8 | ..object (this)
9 | method foo (Dyn ty) =
10 | match ty with
11 | | Int -> (this :> bar)
12 | end.................................
-Error: This class should be virtual.
- The following methods are undefined : bar
+Error: This non-virtual class has undeclared virtual methods.
+ The following methods were not declared : bar
|}];;
Error: This variant or record definition does not match that of type X.t
Constructors do not match:
A : 'a * 'b * ('a -> unit) -> X.t
- is not compatible with:
+ is not the same as:
A : 'a * 'b * ('b -> unit) -> X.t
- The types are not equal.
+ The type 'a -> unit is not equal to the type 'b -> unit
+ Type 'a is not equal to type 'b
|}]
(* would segfault
object ('a)
method private virtual parent : < previous : 'a option; .. >
end
-- : < child : child2; previous : child2 option > = <obj>
+- : < child : child1; previous : child1 option > = <obj>
|}]
(* Worked in 4.03 *)
end
end;;
[%%expect{|
-- : < child : unit -> child2; previous : child2 option > = <obj>
+- : < child : unit -> child1; previous : child1 option > = <obj>
|}]
(* Worked in 4.03 *)
end
end;;
[%%expect{|
-- : < child : unit -> child2; previous : child2 option > = <obj>
+- : < child : unit -> child1; previous : child1 option > = <obj>
|}]
(* Didn't work in 4.03, but works in 4.07 *)
in o
end;;
[%%expect{|
-- : < child : child2; previous : child2 option > = <obj>
+- : < child : child1; previous : child1 option > = <obj>
|}]
(* Also didn't work in 4.03 *)
end;;
[%%expect{|
type gadt = Not_really_though : gadt
-- : < child : gadt -> child2; previous : child2 option > = <obj>
+- : < child : gadt -> child1; previous : child1 option > = <obj>
|}]
Line 3, characters 26-31:
3 | | { x = (x : int); eq = Refl3 } -> x
^^^^^
-Warning 18 [not-principal]: typing this pattern requires considering M.t and int as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
But the knowledge of these types is not principal.
val foo : int foo -> int = <fun>
|}]
Line 3, characters 29-34:
3 | | { x = (x : string); eq = Refl3 } -> x
^^^^^
-Warning 18 [not-principal]: typing this pattern requires considering M.t and string as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
But the knowledge of these types is not principal.
val foo : string foo -> string = <fun>
|}]
[%%expect{|
val bar : string foo -> string = <fun>
|}]
+
+(* #10822 *)
+type t
+type u = private t
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+[%%expect{|
+type t
+type u = private t
+type ('a, 'b) eq = Refl : ('a, 'a) eq
+|}]
+
+let foo (type s) x (Refl : (s, u) eq) =
+ (x : s :> t)
+[%%expect{|
+val foo : 's -> ('s, u) eq -> t = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type i = int
+
+type 'a t = T : i
+[%%expect{|
+type i = int
+Line 3, characters 16-17:
+3 | type 'a t = T : i
+ ^
+Error: Constraints are not satisfied in this type.
+ Type i should be an instance of 'a t
+|}]
+
+type 'a t = T : i t
+type 'a s = 'a t = T : i t
+[%%expect{|
+type 'a t = T : i t
+Line 2, characters 23-26:
+2 | type 'a s = 'a t = T : i t
+ ^^^
+Error: Constraints are not satisfied in this type.
+ Type i t should be an instance of 'a s
+|}]
+
+type 'a t = T : i s
+and 'a s = 'a t
+[%%expect{|
+Line 1, characters 16-19:
+1 | type 'a t = T : i s
+ ^^^
+Error: Constraints are not satisfied in this type.
+ Type i s should be an instance of 'a t
+|}]
This instance of int is ambiguous:
it would escape the scope of its equation
|}];;
+
+module M = struct
+ type t
+end
+type (_,_) eq = Refl: ('a,'a) eq
+let f (x:M.t) (y: (M.t, int -> int) eq) =
+ let Refl = y in
+ if true then x else fun x -> x + 1
+[%%expect{|
+module M : sig type t end
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 7, characters 22-36:
+7 | if true then x else fun x -> x + 1
+ ^^^^^^^^^^^^^^
+Error: This expression has type 'a -> 'b
+ but an expression was expected of type M.t = int -> int
+ This instance of int -> int is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+(* Check got/expected when the order changes *)
+module M = struct
+ type t
+end
+type (_,_) eq = Refl: ('a,'a) eq
+let f (x:M.t) (y: (M.t, int -> int) eq) =
+ let Refl = y in
+ if true then fun x -> x + 1 else x
+[%%expect{|
+module M : sig type t end
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 7, characters 35-36:
+7 | if true then fun x -> x + 1 else x
+ ^
+Error: This expression has type M.t = int -> int
+ but an expression was expected of type int -> int
+ This instance of int -> int is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+module M = struct
+ type t
+end
+type (_,_) eq = Refl: ('a,'a) eq
+let f w (x:M.t) (y: (M.t, <m:int>) eq) =
+ let Refl = y in
+ let z = if true then x else w in
+ z#m
+[%%expect{|
+module M : sig type t end
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 8, characters 2-3:
+8 | z#m
+ ^
+Error: This expression has type M.t but an expression was expected of type
+ < m : 'a; .. >
+ This instance of < m : int > is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+(* Check got/expected when the order changes *)
+module M = struct
+ type t
+end
+type (_,_) eq = Refl: ('a,'a) eq
+let f w (x:M.t) (y: (M.t, <m:int>) eq) =
+ let Refl = y in
+ let z = if true then w else x in
+ z#m
+[%%expect{|
+module M : sig type t end
+type (_, _) eq = Refl : ('a, 'a) eq
+Line 8, characters 2-3:
+8 | z#m
+ ^
+Error: This expression has type M.t but an expression was expected of type
+ < m : 'a; .. >
+ This instance of < m : int > is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+type (_,_) eq = Refl: ('a,'a) eq
+module M = struct
+ type t = C : (<m:int; ..> as 'a) * ('a, <m:int; b:bool>) eq -> t
+end
+let f (C (x,y) : M.t) =
+ let g w =
+ let Refl = y in
+ let z = if true then w else x in
+ z#b
+ in ()
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+module M :
+ sig
+ type t =
+ C : (< m : int; .. > as 'a) * ('a, < b : bool; m : int >) eq -> t
+ end
+Line 9, characters 4-5:
+9 | z#b
+ ^
+Error: This expression has type $C_'a = < b : bool >
+ but an expression was expected of type < b : 'a; .. >
+ This instance of < b : bool > is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+(* Check got/expected when the order changes *)
+type (_,_) eq = Refl: ('a,'a) eq
+module M = struct
+ type t = C : (<m:int; ..> as 'a) * ('a, <m:int; b:bool>) eq -> t
+end
+let f (C (x,y) : M.t) =
+ let g w =
+ let Refl = y in
+ let z = if true then x else w in
+ z#b
+ in ()
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+module M :
+ sig
+ type t =
+ C : (< m : int; .. > as 'a) * ('a, < b : bool; m : int >) eq -> t
+ end
+Line 9, characters 4-5:
+9 | z#b
+ ^
+Error: This expression has type $C_'a = < b : bool >
+ but an expression was expected of type < b : 'a; .. >
+ This instance of < b : bool > is ambiguous:
+ it would escape the scope of its equation
+|}]
Line 1, characters 0-32:
1 | type 'a t = [`A of 'a t t] as 'a;; (* fails *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The definition of t contains a cycle:
- 'a t t as 'a
+Error: The type abbreviation t is cyclic
|}, Principal{|
Line 1, characters 0-32:
1 | type 'a t = [`A of 'a t t] as 'a;; (* fails *)
Type int * int is not compatible with type float * float
Type int is not compatible with type float
|}]
+
+(* #11101 *)
+type ('node,'self) extension = < node: 'node; self: 'self > as 'self
+type 'ext node = < > constraint 'ext = ('ext node, 'self) extension;;
+[%%expect{|
+type ('node, 'a) extension = 'a constraint 'a = < node : 'node; self : 'a >
+type 'a node = < >
+ constraint 'a = ('a node, < node : 'a node; self : 'b > as 'b) extension
+|}, Principal{|
+type ('node, 'a) extension = < node : 'node; self : 'b > as 'b
+ constraint 'a = < node : 'node; self : 'a >
+type 'a node = < >
+ constraint 'a = ('a node, < node : 'a node; self : 'b > as 'b) extension
+|}]
+
+class type ['node] extension =
+ object ('self)
+ method clone : 'self
+ method node : 'node
+ end
+type 'ext node = < >
+ constraint 'ext = 'ext node #extension ;;
+[%%expect{|
+class type ['node] extension =
+ object ('a) method clone : 'a method node : 'node end
+type 'a node = < > constraint 'a = < clone : 'a; node : 'a node; .. >
+|}]
+
+module Raise: sig val default_extension: 'a node extension as 'a end = struct
+ let default_extension = failwith "Default_extension failure"
+end;;
+[%%expect{|
+Exception: Failure "Default_extension failure".
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M : sig
+ val x : bool * int
+end = struct
+ let x = false , "not an int"
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let x = false , "not an int"
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig val x : bool * string end
+ is not included in
+ sig val x : bool * int end
+ Values do not match:
+ val x : bool * string
+ is not included in
+ val x : bool * int
+ The type bool * string is not compatible with the type bool * int
+ Type string is not compatible with type int
+|}]
+
+module T : sig
+ val f : int -> (float * string option) list
+end = struct
+ let f x = x + List.length [0.0, Some true]
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f x = x + List.length [0.0, Some true]
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : int -> int end
+ is not included in
+ sig val f : int -> (float * string option) list end
+ Values do not match:
+ val f : int -> int
+ is not included in
+ val f : int -> (float * string option) list
+ The type int -> int is not compatible with the type
+ int -> (float * string option) list
+ Type int is not compatible with type (float * string option) list
+|}]
+
+(* Alpha-equivalence *)
+module T : sig
+ val f : ('a list * 'b list -> int)
+end = struct
+ let f : ('c list * 'd option -> int) = assert false
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f : ('c list * 'd option -> int) = assert false
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : 'c list * 'd option -> int end
+ is not included in
+ sig val f : 'a list * 'b list -> int end
+ Values do not match:
+ val f : 'c list * 'd option -> int
+ is not included in
+ val f : 'a list * 'b list -> int
+ The type 'a list * 'b option -> int is not compatible with the type
+ 'a list * 'c list -> int
+ Type 'b option is not compatible with type 'c list
+|}]
+
+module T : sig
+ type t = int * float
+end = struct
+ type t = bool * float
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = bool * float
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = bool * float end
+ is not included in
+ sig type t = int * float end
+ Type declarations do not match:
+ type t = bool * float
+ is not included in
+ type t = int * float
+ The type bool * float is not equal to the type int * float
+ Type bool is not equal to type int
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(** The aim of this file is to keep track of programs that are "far" from being well-typed *)
+
+
+(** Arity mismatch between structure and signature *)
+
+module M : sig
+ type (_, _) t
+ val f : (_, _) t -> unit
+end = struct
+ type _ t
+ let f _ = ()
+end
+
+[%%expect{|
+Lines 9-12, characters 6-3:
+ 9 | ......struct
+10 | type _ t
+11 | let f _ = ()
+12 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type _ t val f : 'a -> unit end
+ is not included in
+ sig type (_, _) t val f : ('a, 'b) t -> unit end
+ Type declarations do not match:
+ type _ t
+ is not included in
+ type (_, _) t
+ They have different arities.
+|}]
type t = A.t = A | B
is not included in
type t = int * string
+ The type A.t is not equal to the type int * string
|}]
module rec B : sig
type 'a t = 'a B.t = A of 'a | B
is not included in
type 'a t = 'a
+ The type 'a B.t is not equal to the type 'a
|}];;
module rec C : sig
type 'a t = 'a D.t = A of 'a | B
is not included in
type 'a t = int
+ The type 'a D.t is not equal to the type int
|}];;
module rec E : sig
type 'a t = 'a E.t = A of 'a | B
is not included in
type 'a t = 'a constraint 'a = [> `Foo ]
+ The type 'a is not equal to the type [> `Foo ]
|}];;
module rec E2 : sig
type 'a t = 'a E2.t = A of 'a | B
is not included in
type 'a t = [ `Foo ]
+ The type 'a E2.t is not equal to the type [ `Foo ]
|}];;
module rec E3 : sig
type 'a t = 'a E3.t = A of 'a | B
is not included in
type 'a t = 'a constraint 'a = [< `Foo ]
+ The type 'a is not equal to the type [< `Foo ]
|}];;
type ('a, 'b) t = Foo of 'a
Constructors do not match:
Foo of 'b
- is not compatible with:
+ is not the same as:
Foo of 'a
- The types are not equal.
+ The type 'b is not equal to the type 'a
|}];;
end
[%%expect {|
class virtual t : object method virtual x : float end
-Line 4, characters 16-17:
+Line 4, characters 8-17:
4 | inherit t
- ^
+ ^^^^^^^^^
Error: The method x has type int but is expected to have type float
Type int is not compatible with type float
|}]
3 | method foo = "foo"
4 | method private virtual cast: int
5 | end
-Error: The class type object method foo : string end
+Error: The class type
+ object method private virtual cast : int method foo : string end
is not matched by the class type foo_t
The virtual method cast cannot be hidden
|}]
1 | foo (fun ?opt () -> ()) ;; (* fails *)
^^^^^^^^^^^^^^^^^^^
Error: This function should have type unit -> unit
- but its first argument is labelled ?opt
+ but its first argument is labeled ?opt instead of being unlabeled
|}];;
+(* filter_arrow *)
+
+let (f : x:int -> int) = fun y -> y
+[%%expect{|
+Line 1, characters 25-35:
+1 | let (f : x:int -> int) = fun y -> y
+ ^^^^^^^^^^
+Error: This function should have type x:int -> int
+ but its first argument is unlabeled instead of being labeled ~x
+|}];;
+
+let (f : int -> int) = fun ~y -> y
+[%%expect{|
+Line 1, characters 23-34:
+1 | let (f : int -> int) = fun ~y -> y
+ ^^^^^^^^^^^
+Error: This function should have type int -> int
+ but its first argument is labeled ~y instead of being unlabeled
+|}];;
+
+let (f : x:int -> int) = fun ~y -> y
+[%%expect{|
+Line 1, characters 25-36:
+1 | let (f : x:int -> int) = fun ~y -> y
+ ^^^^^^^^^^^
+Error: This function should have type x:int -> int
+ but its first argument is labeled ~y instead of ~x
+|}];;
(* More examples *)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* Optional binders can be used in value declarations,
+ and signatures are equivalent with or without them. *)
+module type Id1 = sig val id : 'a -> 'a end
+module type Id2 = sig val id : 'a . 'a -> 'a end
+module F (X : Id1) : Id2 = X
+module G (X : Id2) : Id1 = X
+module Id : Id2 = struct let id x = x end
+[%%expect{|
+module type Id1 = sig val id : 'a -> 'a end
+module type Id2 = sig val id : 'a -> 'a end
+module F : functor (X : Id1) -> Id2
+module G : functor (X : Id2) -> Id1
+module Id : Id2
+|}]
+
+
+(* If present, the variables must be universally quantified *)
+type 'a constrained = string constraint 'a = int
+module type Ok_constraint = sig val c : 'a constrained end
+[%%expect{|
+type 'a constrained = string constraint 'a = int
+module type Ok_constraint = sig val c : int constrained end
+|}]
+module type Bad_constraint = sig val c : 'a . 'a constrained end
+[%%expect{|
+Line 1, characters 41-60:
+1 | module type Bad_constraint = sig val c : 'a . 'a constrained end
+ ^^^^^^^^^^^^^^^^^^^
+Error: The universal type variable 'a cannot be generalized: it is bound to
+ int.
+|}]
+
+(* with the usual caveat for row variables *)
+module type Row = sig val poly : 'a 'b . ([> `Foo of int] as 'a) * 'b end
+module type NotRow = sig val poly : 'a 'b . (int as 'a) * 'b end
+[%%expect{|
+module type Row = sig val poly : [> `Foo of int ] * 'b end
+Line 2, characters 36-60:
+2 | module type NotRow = sig val poly : 'a 'b . (int as 'a) * 'b end
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The universal type variable 'a cannot be generalized: it is bound to
+ int.
+|}]
+
+(* If present, the quantifier must quantify all variables *)
+module type F1 = sig
+ val four : 'a 'b 'c 'd . 'a -> 'b -> 'c -> 'd -> 'a * 'b * 'c * 'd
+end
+[%%expect{|
+module type F1 = sig val four : 'a -> 'b -> 'c -> 'd -> 'a * 'b * 'c * 'd end
+|}]
+;;
+module type F2 = sig
+ val four : 'a 'b 'd . 'a -> 'b -> 'c -> 'd -> 'a * 'b * 'c * 'd
+end
+[%%expect{|
+Line 2, characters 36-38:
+2 | val four : 'a 'b 'd . 'a -> 'b -> 'c -> 'd -> 'a * 'b * 'c * 'd
+ ^^
+Error: The type variable 'c is unbound in this type declaration.
+|}]
+
+
+(* Explicit quantifiers may also be used in external definitions *)
+module Ident : sig
+ external identity : 'a . 'a -> 'a = "%identity"
+end = struct
+ external identity : 'a . 'a -> 'a = "%identity"
+end
+[%%expect{|
+module Ident : sig external identity : 'a -> 'a = "%identity" end
+|}]
+
+
+(* Explicit quantifiers may also be used in GADTs *)
+type g1 = Foo : 'a * ('a -> unit) -> g1
+type g2 = g1 = Foo : 'a . 'a * ('a -> unit) -> g2
+type g3 = g2 = Foo : 'b 'c 'd . 'd * ('d -> unit) -> g3
+let intro = Foo (5, print_int)
+let elim (Foo (x, f)) = f x
+[%%expect{|
+type g1 = Foo : 'a * ('a -> unit) -> g1
+type g2 = g1 = Foo : 'a * ('a -> unit) -> g2
+type g3 = g2 = Foo : 'd * ('d -> unit) -> g3
+val intro : g3 = Foo (<poly>, <fun>)
+val elim : g3 -> unit = <fun>
+|}]
+
+(* In GADT syntax, all type variables must be bound, even parameters *)
+type 'a t =
+ | Ok1 : 'b 'a . 'a -> 'a t
+ | Ok2 of 'a
+ | Bad : 'b . 'a -> 'a t
+[%%expect{|
+Line 4, characters 15-17:
+4 | | Bad : 'b . 'a -> 'a t
+ ^^
+Error: The type variable 'a is unbound in this type declaration.
+|}]
('e, 'c, 'b, 'd, 'a) c = [ `C of ('e, 'c, 'b, 'd, 'a) a ]
All uses need to match the definition for the recursive type to be regular.
|}]
+
+(* PR 10762 *)
+type a = int
+type t = [ `A of a ]
+let inspect: [< t ] -> unit = function
+ | `A 0 -> ()
+ | `A _ -> ()
+[%%expect {|
+type a = int
+type t = [ `A of a ]
+val inspect : [< `A of a & int ] -> unit = <fun>
+|}]
val f : t/1 -> unit
is not included in
val f : t/2 -> unit
+ The type t/1 -> unit is not compatible with the type t/2 -> unit
+ Type t/1 is not compatible with type t/2
Line 6, characters 4-14:
Definition of type t/1
Line 2, characters 2-12:
type u = A of t/2
Constructors do not match:
A of t/1
- is not compatible with:
+ is not the same as:
A of t/2
- The types are not equal.
+ The type t/1 is not equal to the type t/2
Line 4, characters 9-19:
Definition of type t/1
Line 2, characters 2-11:
type t = A of T/2.t
Constructors do not match:
A of T/1.t
- is not compatible with:
+ is not the same as:
A of T/2.t
- The types are not equal.
+ The type T/1.t is not equal to the type T/2.t
Line 5, characters 6-34:
Definition of module T/1
Line 2, characters 2-30:
val f : (module s/1) -> t/2 -> t/1
is not included in
val f : (module s/2) -> t/2 -> t/2
+ The type (module s/1) -> t/2 -> t/1 is not compatible with the type
+ (module s/2) -> t/2 -> t/2
+ Type (module s/1) is not compatible with type (module s/2)
Line 5, characters 23-33:
Definition of type t/1
Line 3, characters 2-12:
val f : a/2 -> 'a -> a/1
is not included in
val f : a/2 -> (module a) -> a/2
+ The type a/2 -> (module a) -> a/1 is not compatible with the type
+ a/2 -> (module a) -> a/2
+ Type a/1 is not compatible with type a/2
Line 5, characters 12-22:
Definition of type a/1
Line 3, characters 2-12:
class b : a
does not match
class b : a/2
- The first class type has no method m
The public method c cannot be hidden
+ The first class type has no method m
Line 5, characters 4-74:
Definition of class type a/1
Line 2, characters 2-36:
type a = M/1.t
is not included in
type a = M/2.t
+ The type M/1.t = M/2.M.t is not equal to the type M/2.t
Line 2, characters 14-42:
Definition of module M/1
File "_none_", line 1:
val f : t/2 -> t/3 -> t/4 -> t/1
is not included in
val f : t/1 -> t/1 -> t/1 -> t/1
+ The type t/2 -> t/3 -> t/4 -> t/1 is not compatible with the type
+ t/1 -> t/1 -> t/1 -> t/1
+ Type t/2 is not compatible with type t/1
Line 4, characters 0-10:
Definition of type t/1
Line 1, characters 0-10:
type t = [ `T of t/2 ]
is not included in
type t = [ `T of t/1 ]
- Line 1, characters 0-12:
- Definition of type t/1
+ The type [ `T of t/1 ] is not equal to the type [ `T of t/2 ]
+ Type t/1 = [ `T of t/1 ] is not equal to type t/2 = int
+ Types for tag `T are incompatible
Line 4, characters 2-20:
+ Definition of type t/1
+ Line 1, characters 0-12:
Definition of type t/2
|}]
1 | let _ = fun (x : a t) -> f x;;
^
Error: This expression has type a t but an expression was expected of type
- (< .. > as 'a) t
- Type a is not compatible with type < .. > as 'a
+ < .. > t
+ Type a is not compatible with type < .. >
|}];;
let _ = fun (x : a t) -> g x;;
1 | let _ = fun (x : a t) -> g x;;
^
Error: This expression has type a t but an expression was expected of type
- ([< `b ] as 'a) t
- Type a is not compatible with type [< `b ] as 'a
+ [< `b ] t
+ Type a is not compatible with type [< `b ]
|}];;
let _ = fun (x : a t) -> h x;;
1 | let _ = fun (x : a t) -> h x;;
^
Error: This expression has type a t but an expression was expected of type
- ([> `b ] as 'a) t
- Type a is not compatible with type [> `b ] as 'a
+ [> `b ] t
+ Type a is not compatible with type [> `b ]
|}];;
[> `B of [> `BA | `BB of int list ] | `C of unit ]
is not included in
val a : t -> t
+ The type
+ [ `A of int | `B of [ `BA | `BB of unit list ] | `C of unit ] ->
+ [> `B of [> `BA | `BB of int list ] | `C of unit ]
+ is not compatible with the type t -> t
+ Type [> `B of [> `BA | `BB of int list ] | `C of unit ]
+ is not compatible with type
+ t = [ `A of int | `B of [ `BA | `BB of unit list ] | `C of unit ]
+ Types for tag `BB are incompatible
|}]
Line 1, characters 32-36:
1 | let h: 'a. 'a r -> _ = function true | false -> ();;
^^^^
-Error: This pattern matches values of type bool
- but a pattern was expected which matches values of type
- ([< `X of int & 'a ] as 'a) r
+Error: This pattern should not be a boolean literal, the expected type is
+ ([< `X of int & 'a ] as 'a) r
|}]
Line 1, characters 32-48:
1 | let i: 'a. 'a r -> _ = function { contents = 0 } -> ();;
^^^^^^^^^^^^^^^^
-Error: This pattern matches values of type int ref
- but a pattern was expected which matches values of type
- ([< `X of int & 'a ] as 'a) r
+Error: This pattern should not be a record, the expected type is
+ ([< `X of int & 'a ] as 'a) r
|}]
^
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
+ but the expected method type was 'a. 'a * ('a * < m : 'a. 'd >) as 'd
The universal variable 'a would escape its scope
|}]
Line 1, characters 2-6:
1 | { true with contents = 0 };;
^^^^
-Error: This expression has type bool but an expression was expected of type
- 'a ref
+Error: This expression has type bool which is not a record type.
|}];;
type ('a, 'b) t = { fst : 'a; snd : 'b };;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type
(int, [> `A ]) def
- Their constraints differ.
+ Their parameters differ
+ The type int is not equal to the type 'a
|}]
type ('a,'b) kind = ('a, 'b) def = A constraint 'b = [> `A];;
Error: This variant or record definition does not match that of type d
Fields do not match:
y : int;
- is not compatible with:
+ is not the same as:
mutable y : int;
This is mutable and the original is not.
|}]
1 | type missing = d = { x:int }
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The field y is only present in the original definition.
+ An extra field, y, is provided in the original definition.
|}]
type wrong_type = d = {x:float}
1 | type wrong_type = d = {x:float}
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- Fields do not match:
+ 1. Fields do not match:
x : int;
- is not compatible with:
+ is not the same as:
x : float;
- The types are not equal.
+ The type int is not equal to the type float
+ 2. An extra field, y, is provided in the original definition.
|}]
type mono = {foo:int}
1 | type perm = d = {y:int; x:int}
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- Fields number 1 have different names, x and y.
+ Fields x and y have been swapped.
|}]
type t = X.t = A | B
is not included in
type t = int * bool
+ The type X.t is not equal to the type int * bool
|}];;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type
(int, [> `A ]) def
- Their constraints differ.
+ Their parameters differ
+ The type int is not equal to the type 'a
|}]
type ('a,'b) kind = ('a, 'b) def = {a:int} constraint 'b = [> `A];;
3 | type missing = d = X of int
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- The constructor Y is only present in the original definition.
+ An extra constructor, Y, is provided in the original definition.
|}]
type wrong_type = d = X of float
1 | type wrong_type = d = X of float
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- Constructors do not match:
+ 1. Constructors do not match:
X of int
- is not compatible with:
+ is not the same as:
X of float
- The types are not equal.
+ The type int is not equal to the type float
+ 2. An extra constructor, Y, is provided in the original definition.
|}]
type mono = Foo of float
1 | type perm = d = Y of int | X of int
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type d
- Constructors number 1 have different names, X and Y.
+ Constructors X and Y have been swapped.
|}]
module M : sig
type t = Foo of int
Constructors do not match:
Foo : int -> t
- is not compatible with:
+ is not the same as:
Foo of int
The first has explicit return type and the second doesn't.
|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module Constr = struct
+ type t = A | B | C
+
+ let get _ _ = A
+
+ let put f = ignore (f () : t)
+end
+
+module Record = struct
+ type t = { a : int; b : int; c : int }
+
+ let get _ _ = { a = 0; b = 0; c = 0 }
+
+ let put f = ignore (f () : t)
+end
+
+module Bool = struct
+ type t = true | false
+
+ let get _ _ = true
+
+ let put f = ignore (f () : t)
+end
+
+module List = struct
+ type 'a t = [] | (::) of 'a * 'a t
+
+ let get _ _ = []
+
+ let put f = ignore (f () : int t)
+end
+
+module Unit = struct
+ [@@@warning "-redefining-unit"]
+ type t = ()
+
+ let get _ _ = ()
+
+ let put f = ignore (f (() : unit) : t)
+end;;
+[%%expect{|
+module Constr :
+ sig
+ type t = A | B | C
+ val get : 'a -> 'b -> t
+ val put : (unit -> t) -> unit
+ end
+module Record :
+ sig
+ type t = { a : int; b : int; c : int; }
+ val get : 'a -> 'b -> t
+ val put : (unit -> t) -> unit
+ end
+module Bool :
+ sig
+ type t = true | false
+ val get : 'a -> 'b -> t
+ val put : (unit -> t) -> unit
+ end
+module List :
+ sig
+ type 'a t = [] | (::) of 'a * 'a t
+ val get : 'a -> 'b -> 'c t
+ val put : (unit -> int t) -> unit
+ end
+module Unit :
+ sig type t = () val get : 'a -> 'b -> t val put : (unit -> t) -> unit end
+|}]
+
+let () =
+ match Constr.get () with
+ | A | B | C -> ();;
+[%%expect{|
+Line 3, characters 4-5:
+3 | | A | B | C -> ();;
+ ^
+Error: This pattern should not be a constructor, the expected type is
+ 'a -> Constr.t
+|}]
+
+let () =
+ match Record.get () with
+ | { a; _ } -> ();;
+[%%expect{|
+Line 3, characters 4-12:
+3 | | { a; _ } -> ();;
+ ^^^^^^^^
+Error: This pattern should not be a record, the expected type is
+ 'a -> Record.t
+|}]
+
+let () =
+ match Bool.get () with
+ | true -> ();;
+[%%expect{|
+Line 3, characters 4-8:
+3 | | true -> ();;
+ ^^^^
+Error: This pattern should not be a boolean literal, the expected type is
+ 'a -> Bool.t
+|}]
+
+let () =
+ match Bool.get () with
+ | false -> ();;
+[%%expect{|
+Line 3, characters 4-9:
+3 | | false -> ();;
+ ^^^^^
+Error: This pattern should not be a boolean literal, the expected type is
+ 'a -> Bool.t
+|}]
+
+let () =
+ match List.get () with
+ | [] -> ();;
+[%%expect{|
+Line 3, characters 4-6:
+3 | | [] -> ();;
+ ^^
+Error: This pattern should not be a list literal, the expected type is
+ 'a -> 'b List.t
+|}]
+
+let () =
+ match List.get () with
+ | _ :: _ -> ();;
+[%%expect{|
+Line 3, characters 4-10:
+3 | | _ :: _ -> ();;
+ ^^^^^^
+Error: This pattern should not be a list literal, the expected type is
+ 'a -> 'b List.t
+|}]
+
+let () =
+ match Unit.get () with
+ | () -> ();;
+[%%expect{|
+Line 3, characters 4-6:
+3 | | () -> ();;
+ ^^
+Error: This pattern should not be a unit literal, the expected type is
+ 'a -> Unit.t
+|}]
+
+let () = Constr.put A;;
+[%%expect{|
+Line 1, characters 20-21:
+1 | let () = Constr.put A;;
+ ^
+Error: This expression should not be a constructor, the expected type is
+ unit -> Constr.t
+|}]
+
+let () = Record.put { a = 0; b = 0; c = 0 };;
+[%%expect{|
+Line 1, characters 20-43:
+1 | let () = Record.put { a = 0; b = 0; c = 0 };;
+ ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression should not be a record, the expected type is
+ unit -> Record.t
+|}]
+
+let () = Bool.put true;;
+[%%expect{|
+Line 1, characters 18-22:
+1 | let () = Bool.put true;;
+ ^^^^
+Error: This expression should not be a boolean literal, the expected type is
+ unit -> Bool.t
+|}]
+
+let () = Bool.put false;;
+[%%expect{|
+Line 1, characters 18-23:
+1 | let () = Bool.put false;;
+ ^^^^^
+Error: This expression should not be a boolean literal, the expected type is
+ unit -> Bool.t
+|}]
+
+let () = List.put [];;
+[%%expect{|
+Line 1, characters 18-20:
+1 | let () = List.put [];;
+ ^^
+Error: This expression should not be a list literal, the expected type is
+ unit -> int List.t
+|}]
+
+let () = List.put (1 :: 2);;
+[%%expect{|
+Line 1, characters 18-26:
+1 | let () = List.put (1 :: 2);;
+ ^^^^^^^^
+Error: This expression should not be a list literal, the expected type is
+ unit -> int List.t
+|}]
+
+let () = Unit.put ();;
+[%%expect{|
+Line 1, characters 18-20:
+1 | let () = Unit.put ();;
+ ^^
+Error: This expression should not be a unit literal, the expected type is
+ unit -> Unit.t
+|}]
+
+let () =
+ ignore ((Record.get ()).a);;
+[%%expect{|
+Line 2, characters 10-25:
+2 | ignore ((Record.get ()).a);;
+ ^^^^^^^^^^^^^^^
+Error: This expression has type 'a -> Record.t which is not a record type.
+|}]
+
+let () =
+ (Record.get ()).a <- 5;;
+[%%expect{|
+Line 2, characters 2-17:
+2 | (Record.get ()).a <- 5;;
+ ^^^^^^^^^^^^^^^
+Error: This expression has type 'a -> Record.t which is not a record type.
+|}]
+
+let () =
+ ignore { (Record.get ()) with a = 5 };;
+[%%expect{|
+Line 2, characters 11-26:
+2 | ignore { (Record.get ()) with a = 5 };;
+ ^^^^^^^^^^^^^^^
+Error: This expression has type 'a -> Record.t which is not a record type.
+|}]
+
+let foo x =
+ Record.put { x with a = 5 };;
+[%%expect{|
+Line 2, characters 13-29:
+2 | Record.put { x with a = 5 };;
+ ^^^^^^^^^^^^^^^^
+Error: This expression should not be a record, the expected type is
+ unit -> Record.t
+|}]
type pack1 = (module Original.T with type t = int)
module type T = sig module M : Original.T end
type pack2 = (module T with type M.t = int)
+
+(* Check the detection of type kind in type-directed disambiguation. *)
+type r = Original.r = { x:unit }
+let r = Original.r
+
+type s = Original.s = S
+let s = Original.s
type 'a t = T
module type T = sig type t end
+
+type r = { x:unit }
+let r = { x = () }
+
+type s = S
+let s = S
#directory "ocamlc.byte";;
+#load "original.cmo"
#load "middle.cmo"
let x:'a. 'a Middle.t =
Error: Type Middle.pack2 = (module Middle.T with type M.t = int)
is not a subtype of (module T2)
|}]
+
+(* Check the detection of type kind in type-directed disambiguation . *)
+let t = Middle.r.Middle.x
+[%%expect {|
+val t : unit = ()
+|}]
+
+let k = match Middle.s with Middle.S -> ()
+[%%expect {|
+val k : unit = ()
+|}]
--- /dev/null
+File "pr10693_bad.ml", line 27, characters 26-27:
+27 | module Bad (A : S') : S = A
+ ^
+Error: Signature mismatch:
+ Modules do not match:
+ sig val x : 'a option module M : Dep -> S end
+ is not included in
+ S
+ In module M:
+ Modules do not match:
+ Dep -> S
+ is not included in
+ functor (X : Dep) ->
+ sig
+ val x : X.t option
+ module M : functor (Y : Dep) -> sig val x : X.t option end
+ end
+ In module M:
+ Modules do not match:
+ S
+ is not included in
+ sig
+ val x : X.t option
+ module M : functor (Y : Dep) -> sig val x : X.t option end
+ end
+ In module M.M:
+ Modules do not match:
+ functor (X : Dep) ->
+ sig
+ val x : X.t option
+ module M : functor (Y : Dep) -> sig val x : X.t option end
+ end
+ is not included in
+ functor (Y : Dep) -> sig val x : X.t option end
+ In module M.M:
+ Modules do not match:
+ sig
+ val x : X/2.t option
+ module M : functor (Y : Dep) -> sig val x : X/2.t option end
+ end
+ is not included in
+ sig val x : X.t option end
+ In module M.M:
+ Values do not match:
+ val x : X/1.t option
+ is not included in
+ val x : X/2.t option
+ The type X/1.t option is not compatible with the type X/2.t option
+ Type X/1.t is not compatible with type X/2.t
+ File "_none_", line 1:
+ Definition of module X/1
+ File "_none_", line 1:
+ Definition of module X/2
+ File "pr10693_bad.ml", line 17, characters 6-24: Expected declaration
+ File "pr10693_bad.ml", line 15, characters 4-22: Actual declaration
--- /dev/null
+(* TEST
+flags = "-no-app-funct"
+ocamlc_byte_exit_status = "2"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+*** check-ocamlc.byte-output
+*)
+module type Dep = sig type t val x : t end
+module String = struct type t = string let x = "Forty Two" end
+module Int = struct type t = int let x = 42 end
+
+module type S = sig
+ val x : 'a option
+ module M : functor (X : Dep) -> sig
+ val x : X.t option
+ module M : functor (Y : Dep) -> sig
+ val x : X.t option
+ end
+ end
+end
+
+module type S' = sig
+ val x : 'a option
+ module M : functor (_ : Dep) -> S
+end
+
+module Bad (A : S') : S = A
+
+module M = struct
+ let x = None
+ module M (_ : Dep) = struct
+ let x = None
+ module M (X : Dep) = struct
+ let x = Some X.x
+ module M (Y : Dep) = struct
+ let x = Some X.x
+ end
+ end
+ end
+end
+
+module N = Bad(M)
+module N' = N.M(String)
+module N'' = N'.M(Int)
+
+let () = print_endline (Option.get N''.x)
val r : '_weak1 list ref ref
is not included in
val r : Choice.t list ref ref
+ The type '_weak1 list ref ref is not compatible with the type
+ Choice.t list ref ref
+ The type constructor Choice.t would escape its scope
File "pr7414_2_bad.ml", line 29, characters 2-31: Expected declaration
File "pr7414_2_bad.ml", line 40, characters 8-9: Actual declaration
val r : '_weak1 list ref ref
is not included in
val r : Choice.t list ref ref
+ The type '_weak1 list ref ref is not compatible with the type
+ Choice.t list ref ref
+ The type constructor Choice.t would escape its scope
File "pr7414_bad.ml", line 38, characters 2-31: Expected declaration
File "pr7414_bad.ml", line 33, characters 6-7: Actual declaration
Error: This variant or record definition does not match that of type u
Constructors do not match:
X of bool
- is not compatible with:
+ is not the same as:
X of int
- The types are not equal.
+ The type bool is not equal to the type int
|}];;
(* PR#5815 *)
type t += E
Constructors do not match:
E of int
- is not compatible with:
+ is not the same as:
E
They have different arities.
|}];;
type t += E of char
Constructors do not match:
E of int
- is not compatible with:
+ is not the same as:
E of char
- The types are not equal.
+ The type int is not equal to the type char
|}];;
module M : sig type t += C of int end = struct type t += E of int end;;
type t += E of { x : int; }
Constructors do not match:
E of int
- is not compatible with:
+ is not the same as:
E of { x : int; }
The second uses inline records and the first doesn't.
|}];;
val equal : 'a -> 'a -> bool
is not included in
val equal : unit
+ The type 'a -> 'a -> bool is not compatible with the type unit
|} ]
type t += F
Constructors do not match:
F of int
- is not compatible with:
+ is not the same as:
F
They have different arities.
|}];;
type t += private A
is not included in
type t += A
- A private type would be revealed.
+ Private extension constructor(s) would be revealed.
+|}];;
+
+module M2 : sig type t += A end = struct type t += private A | B end;;
+[%%expect{|
+Line 1, characters 34-68:
+1 | module M2 : sig type t += A end = struct type t += private A | B end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t += private A | B 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
+ Private extension constructor(s) would be revealed.
|}];;
module type t = arg -> sig type arg = A.arg end
end
module Add_one :
- sig
- type witness
- module M = Add_one'.M
- module type t = arg -> sig type arg = A.arg end
- end
+ sig type witness module M = Add_one'.M module type t = Add_one'.t end
module Add_three' :
sig
module M : arg -> arg -> arg -> sig type arg = A.arg end
module type t = arg -> arg -> arg -> sig type arg = A.arg end
end
module Add_three :
- sig
- module M = Add_three'.M
- module type t = arg -> arg -> arg -> sig type arg = A.arg end
- type witness
- end
+ sig module M = Add_three'.M module type t = Add_three'.t type witness end
Line 22, characters 21-43:
22 | module Wrong_intro = F(Add_three')(A)(A)(A)
^^^^^^^^^^^^^^^^^^^^^^
functor (X : $T1) arg arg arg -> ...
1. Modules do not match:
Add_three' :
- sig
- module M = Add_three'.M
- module type t = arg -> arg -> arg -> sig type arg = A.arg end
- end
+ sig module M = Add_three'.M module type t = Add_three'.t end
is not included in
$T1 = sig type witness module type t module M : t end
The type `witness' is required but not provided
functor (X : ...) arg arg arg -> ...
1. The following extra argument is provided
Add_one' :
- sig
- module M = Add_one'.M
- module type t = arg -> sig type arg = A.arg end
- end
+ sig module M = Add_one'.M module type t = Add_one'.t end
2. Module Add_three matches the expected module type
3. Module A matches the expected module type arg
4. Module A matches the expected module type arg
sig
type witness = Add_one.witness
module M = Add_one'.M
- module type t = arg -> sig type arg = A.arg end
+ module type t = Add_one.t
end
2. Module Add_three matches the expected module type
3. Module A matches the expected module type arg
type t = Y of X.t
Constructors do not match:
Y of int
- is not compatible with:
+ is not the same as:
Y of X.t
- The types are not equal.
- Line 5, characters 0-32:
- Definition of module X/1
+ The type int is not equal to the type X.t
4. Modules do not match:
Z : sig type t = Z.t = Z of int end
is not included in
type t = Z of X.t
Constructors do not match:
Z of int
- is not compatible with:
+ is not the same as:
Z of X.t
- The types are not equal.
+ The type int is not equal to the type X.t
|}]
(** Final state in the presence of extensions
type ('a, 'b) t = 'a * 'a
is not included in
type ('a, 'b) t = 'a * 'b
+ The type 'a * 'a is not equal to the type 'a * 'b
+ Type 'a is not equal to type 'b
|}];;
module M : sig
type ('a, 'b) t = 'a * 'b
is not included in
type ('a, 'b) t = 'a * 'a
+ The type 'a * 'b is not equal to the type 'a * 'a
+ Type 'b is not equal to type 'a
|}];;
+type 'a x
+module M: sig
+ type ('a,'b,'c) t = ('a * 'b * 'c * 'b * 'a) x
+end = struct
+ type ('b,'c,'a) t = ('b * 'c * 'a * 'c * 'a) x
+end
+[%%expect{|
+type 'a x
+Lines 4-6, characters 6-3:
+4 | ......struct
+5 | type ('b,'c,'a) t = ('b * 'c * 'a * 'c * 'a) x
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('b, 'c, 'a) t = ('b * 'c * 'a * 'c * 'a) x end
+ is not included in
+ sig type ('a, 'b, 'c) t = ('a * 'b * 'c * 'b * 'a) x end
+ Type declarations do not match:
+ type ('b, 'c, 'a) t = ('b * 'c * 'a * 'c * 'a) x
+ is not included in
+ type ('a, 'b, 'c) t = ('a * 'b * 'c * 'b * 'a) x
+ The type ('b * 'c * 'a * 'c * 'a) x is not equal to the type
+ ('b * 'c * 'a * 'c * 'b) x
+ Type 'a is not equal to type 'b
+|}]
+
module M : sig
type t = <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>
end = struct
type t = < m : 'a. 'a * ('a * 'b) > as 'b
is not included in
type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
+ The type < m : 'a. 'a * ('a * 'd) > as 'd is not equal to the type
+ < m : 'b. 'b * ('b * < m : 'c. 'c * 'e > as 'e) >
+ The method m has type 'a. 'a * ('a * < m : 'a. 'f >) as 'f,
+ but the expected method type was 'c. 'c * ('b * < m : 'c. 'g >) as 'g
+ The universal variable 'b would escape its scope
|}];;
type s = private < m : int; .. >;;
type t = < m : int >
is not included in
type t = s
+ The type < m : int > is not equal to the type s
+ The second object type has an abstract row, it cannot be closed
|}];;
module M : sig
type t = s
is not included in
type t = < m : int >
+ The type s is not equal to the type < m : int >
+ The first object type has an abstract row, it cannot be closed
|}];;
module M : sig
type t = Foo of int * float
Constructors do not match:
Foo of (int * int) * float
- is not compatible with:
+ is not the same as:
Foo of int * float
- The types are not equal.
+ The type int * int is not equal to the type int
|}];;
module M : sig
type t = int * float * int
is not included in
type t = int * float
+ The type int * float * int is not equal to the type int * float
|}];;
module M : sig
type t = < f : float; n : int >
is not included in
type t = < m : float; n : int >
+ The type < f : float; n : int > is not equal to the type
+ < m : float; n : int >
+ The second object type has no method f
|}];;
module M : sig
type t = < n : int >
is not included in
type t = < m : float; n : int >
+ The type < n : int > is not equal to the type < m : float; n : int >
+ The first object type has no method m
|}];;
module M4 : sig
type t = < m : int; n : int >
is not included in
type t = < m : float * int; n : int >
+ The type < m : int; n : int > is not equal to the type
+ < m : float * int; n : int >
+ Types for method m are incompatible
|}];;
module M4 : sig
type t = Foo of [ `Bar of string | `Foo of string ]
Constructors do not match:
Foo of [ `Bar of string ]
- is not compatible with:
+ is not the same as:
Foo of [ `Bar of string | `Foo of string ]
- The types are not equal.
+ The type [ `Bar of string ] is not equal to the type
+ [ `Bar of string | `Foo of string ]
+ The first variant type does not allow tag(s) `Foo
|}];;
module M : sig
type t = private [ `C ]
is not included in
type t = private [ `C of int ]
+ The type [ `C ] is not equal to the type [ `C of int ]
+ Types for tag `C are incompatible
|}];;
module M : sig
type t = private [ `C of int ]
is not included in
type t = private [ `C ]
+ The type [ `C of int ] is not equal to the type [ `C ]
+ Types for tag `C are incompatible
|}];;
module M : sig
type t = private [ `A of int ]
is not included in
type t = private [> `A of int ]
+ The type [ `A of int ] is not equal to the type [> `A of int ]
+ The second variant type is open and the first is not
|}];;
module M : sig
type t = private [> `A of int ]
is not included in
type t = private [ `A of int ]
+ The type [> `A of int ] is not equal to the type [ `A of int ]
+ The first variant type is open and the second is not
|}];;
module M : sig
type 'a t = 'a constraint 'a = [> `A of int ]
is not included in
type 'a t = 'a constraint 'a = [> `A of int | `B of int ]
+ The type [> `A of int ] is not equal to the type
+ [> `A of int | `B of int ]
+ The first variant type does not allow tag(s) `B
|}];;
module M : sig
type 'a t = 'a constraint 'a = [> `A of int | `C of float ]
is not included in
type 'a t = 'a constraint 'a = [> `A of int ]
+ The type [> `A of int | `C of float ] is not equal to the type
+ [> `A of int ]
+ The second variant type does not allow tag(s) `C
|}];;
module M : sig
type t = private [< `C of int & float ]
is not included in
type t = private [< `C ]
+ Types for tag `C are incompatible
|}];;
(********************************** Moregen ***********************************)
val r : '_weak1 list ref ref
is not included in
val r : Choice.t list ref ref
+ The type '_weak1 list ref ref is not compatible with the type
+ Choice.t list ref ref
+ The type constructor Choice.t would escape its scope
|}];;
module O = struct
val f : (module s/1) -> unit
is not included in
val f : (module s/2) -> unit
+ The type (module s/1) -> unit is not compatible with the type
+ (module s/2) -> unit
+ Type (module s/1) is not compatible with type (module s/2)
Line 6, characters 4-17:
Definition of module type s/1
Line 2, characters 2-15:
val f : (< m : 'a. 'a * 'b > as 'b) -> unit
is not included in
val f : < m : 'b. 'b * < m : 'c. 'c * 'a > as 'a > -> unit
+ The type (< m : 'a. 'a * 'd > as 'd) -> unit
+ is not compatible with the type
+ < m : 'b. 'b * < m : 'c. 'c * 'e > as 'e > -> unit
+ The method m has type 'a. 'a * < m : 'a. 'f > as 'f,
+ but the expected method type was 'c. 'c * ('b * < m : 'c. 'g >) as 'g
+ The universal variable 'b would escape its scope
|}];;
type s = private < m : int; .. >;;
val f : < m : int > -> < m : int >
is not included in
val f : s -> s
+ The type < m : int > -> < m : int > is not compatible with the type
+ s -> s
+ Type < m : int > is not compatible with type s = < m : int; .. >
+ The second object type has an abstract row, it cannot be closed
|}];;
+module M : sig
+ val f : 'a -> float
+end = struct
+ let f : 'b -> int = fun _ -> 0
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f : 'b -> int = fun _ -> 0
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : 'b -> int end
+ is not included in
+ sig val f : 'a -> float end
+ Values do not match:
+ val f : 'b -> int
+ is not included in
+ val f : 'a -> float
+ The type 'a -> int is not compatible with the type 'a -> float
+ Type int is not compatible with type float
+|}]
+
module M : sig
val x : 'a list ref
end = struct
val x : '_weak2 list ref
is not included in
val x : 'a list ref
+ The type '_weak2 list ref is not compatible with the type 'a list ref
+ Type '_weak2 is not compatible with type 'a
|}];;
module M = struct let r = ref [] end;;
val r : '_weak3 list ref
is not included in
val r : t list ref
+ The type '_weak3 list ref is not compatible with the type t list ref
+ The type constructor t would escape its scope
|}];;
type (_, _) eq = Refl : ('a, 'a) eq;;
val r : '_weak4 list ref
is not included in
val r : T.s list ref
+ The type '_weak4 list ref is not compatible with the type T.s list ref
+ Type '_weak4 is not compatible with type T.s = T.t
+ This instance of T.t is ambiguous:
+ it would escape the scope of its equation
|}];;
module M: sig
val f : 'a -> 'a
is not included in
val f : int -> float
+ The type int -> int is not compatible with the type int -> float
+ Type int is not compatible with type float
|}];;
module M: sig
val f : int * int -> int * int
is not included in
val f : int * float * int -> int -> int
+ The type int * int -> int * int is not compatible with the type
+ int * float * int -> int -> int
+ Type int * int is not compatible with type int * float * int
|}];;
module M: sig
val f : < f : float; m : int > -> < f : float; m : int >
is not included in
val f : < m : int; n : float > -> < m : int; n : float >
+ The type < f : float; m : int > -> < f : float; m : int >
+ is not compatible with the type
+ < m : int; n : float > -> < m : int; n : float >
+ The second object type has no method f
|}];;
module M : sig
val f : [ `Bar | `Foo ] -> unit
is not included in
val f : [ `Foo ] -> unit
+ The type [ `Bar | `Foo ] -> unit is not compatible with the type
+ [ `Foo ] -> unit
+ The second variant type does not allow tag(s) `Bar
|}];;
module M : sig
val f : [< `Foo ] -> unit
is not included in
val f : [> `Foo ] -> unit
+ The type [< `Foo ] -> unit is not compatible with the type
+ [> `Foo ] -> unit
+ The second variant type is open and the first is not
|}];;
module M : sig
val f : [< `Foo ] -> unit
is not included in
val f : [< `Bar | `Foo ] -> unit
+ The type [< `Foo ] -> unit is not compatible with the type
+ [< `Bar | `Foo ] -> unit
+ The first variant type does not allow tag(s) `Bar
|}];;
module M : sig
val f : < m : 'a. [< `Foo ] as 'a > -> unit
is not included in
val f : < m : [< `Foo ] > -> unit
+ The type < m : 'a. [< `Foo ] as 'a > -> unit
+ is not compatible with the type < m : [< `Foo ] > -> unit
+ Types for method m are incompatible
|}];;
module M : sig
val f : < m : [ `Foo ] > -> unit
is not included in
val f : < m : 'a. [< `Foo ] as 'a > -> unit
+ The type < m : [ `Foo ] > -> unit is not compatible with the type
+ < m : 'a. [< `Foo ] as 'a > -> unit
+ Types for method m are incompatible
|}];;
module M : sig
val f : [< `C of int & float ] -> unit
is not included in
val f : [< `C ] -> unit
+ The type [< `C of & int & float ] -> unit
+ is not compatible with the type [< `C ] -> unit
+ Types for tag `C are incompatible
|}];;
module M : sig
val f : [ `Foo of int ] -> unit
is not included in
val f : [ `Foo ] -> unit
+ The type [ `Foo of int ] -> unit is not compatible with the type
+ [ `Foo ] -> unit
+ Types for tag `Foo are incompatible
|}];;
module M : sig
val f : [ `Foo ] -> unit
is not included in
val f : [ `Foo of int ] -> unit
+ The type [ `Foo ] -> unit is not compatible with the type
+ [ `Foo of int ] -> unit
+ Types for tag `Foo are incompatible
|}];;
module M : sig
val f : [> `Bar | `Foo ] -> unit
is not included in
val f : [< `Bar | `Baz | `Foo ] -> unit
+ The type [> `Bar | `Foo ] -> unit is not compatible with the type
+ [< `Bar | `Baz | `Foo ] -> unit
+ The tag `Foo is guaranteed to be present in the first variant type,
+ but not in the second
|}];;
(******************************* Type manifests *******************************)
type t = [ `C ]
is not included in
type t = private [< `A | `B ]
+ The constructor C is only present in the second declaration.
|}];;
module M : sig
type t = private [> `A ]
is not included in
type t = private [< `A | `B ]
+ The second is private and closed, but the first is not closed
|}];;
module M : sig
type t = [ `B ]
is not included in
type t = private [< `A | `B > `A ]
+ The constructor A is only present in the first declaration.
|}];;
module M : sig
type t = [ `A ]
is not included in
type t = private [> `A of int ]
+ Types for tag `A are incompatible
|}];;
module M : sig
type t = private [< `A of & int ]
is not included in
type t = private [< `A of int ]
+ Types for tag `A are incompatible
|}];;
type t = private [< `A ]
is not included in
type t = private [< `A of int ]
+ Types for tag `A are incompatible
|}];;
type t = private [< `A ]
is not included in
type t = private [< `A of int & float ]
+ Types for tag `A are incompatible
|}];;
module M : sig
type t = [ `A of float ]
is not included in
type t = private [> `A of int ]
+ The type float is not equal to the type int
+|}];;
+
+module M : sig
+ type t = private [< `A | `B]
+end = struct
+ type t = private [`A | `B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [`A | `B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [ `A | `B ] end
+ is not included in
+ sig type t = private [< `A | `B ] end
+ Type declarations do not match:
+ type t = private [ `A | `B ]
+ is not included in
+ type t = private [< `A | `B ]
+ The type [ `A | `B ] is not equal to the type [< `A | `B ]
+ The tag `B is guaranteed to be present in the first variant type,
+ but not in the second
+|}];;
+
+module M : sig
+ type t = [`A | `B]
+end = struct
+ type t = private [`A | `B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [`A | `B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [ `A | `B ] end
+ is not included in
+ sig type t = [ `A | `B ] end
+ Type declarations do not match:
+ type t = private [ `A | `B ]
+ is not included in
+ type t = [ `A | `B ]
+ A private type abbreviation would be revealed.
+|}];;
+
+module M : sig
+ type t = private [< `A | `B > `B]
+end = struct
+ type t = private [< `A | `B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A | `B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A | `B ] end
+ is not included in
+ sig type t = private [< `A | `B > `B ] end
+ Type declarations do not match:
+ type t = private [< `A | `B ]
+ is not included in
+ type t = private [< `A | `B > `B ]
+ The tag `B is present in the the second declaration,
+ but might not be in the the first
|}];;
module M : sig
type t = < b : int >
is not included in
type t = private < a : int; .. >
+ The implementation is missing the method a
|}];;
module M : sig
type t = < a : int >
is not included in
type t = private < a : float; .. >
+ The type int is not equal to the type float
+ Type int is not equal to type float
|}];;
type w = private float
type t = private u
is not included in
type t = private int * (int * int)
+ The type int * q is not equal to the type int * (int * int)
+ Type q is not equal to type int * int
|}];;
type w = float
type q = (int * w)
type u = private (int * q)
-module M : sig (* Confussing error message :( *)
+module M : sig
type t = private (int * (int * int))
end = struct
type t = private u
type t = private u
is not included in
type t = private int * (int * int)
+ The type int * q is not equal to the type int * (int * int)
+ Type q = int * w is not equal to type int * int
+ Type w = float is not equal to type int
|}];;
type s = private int
type t = private s
is not included in
type t = private float
+ The type int is not equal to the type float
+|}];;
+
+module M : sig
+ type t = A
+end = struct
+ type t = private A
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A end
+ is not included in
+ sig type t = A end
+ Type declarations do not match:
+ type t = private A
+ is not included in
+ type t = A
+ Private variant constructor(s) would be revealed.
+|}];;
+
+module M : sig
+ type t = A | B
+end = struct
+ type t = private A | B
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A | B
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A | B end
+ is not included in
+ sig type t = A | B end
+ Type declarations do not match:
+ type t = private A | B
+ is not included in
+ type t = A | B
+ Private variant constructor(s) would be revealed.
+|}];;
+
+module M : sig
+ type t = A of { x : int; y : bool }
+end = struct
+ type t = private A of { x : int; y : bool }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A of { x : int; y : bool }
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A of { x : int; y : bool; } end
+ is not included in
+ sig type t = A of { x : int; y : bool; } end
+ Type declarations do not match:
+ type t = private A of { x : int; y : bool; }
+ is not included in
+ type t = A of { x : int; y : bool; }
+ Private variant constructor(s) would be revealed.
+|}];;
+
+module M : sig
+ type t = { x : int; y : bool }
+end = struct
+ type t = private { x : int; y : bool }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private { x : int; y : bool }
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private { x : int; y : bool; } end
+ is not included in
+ sig type t = { x : int; y : bool; } end
+ Type declarations do not match:
+ type t = private { x : int; y : bool; }
+ is not included in
+ type t = { x : int; y : bool; }
+ A private record constructor would be revealed.
+|}];;
+
+module M : sig
+ type t = A
+end = struct
+ type t = private A | B
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A | B
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A | B end
+ is not included in
+ sig type t = A end
+ Type declarations do not match:
+ type t = private A | B
+ is not included in
+ type t = A
+ Private variant constructor(s) would be revealed.
+|}];;
+
+module M : sig
+ type t = A | B
+end = struct
+ type t = private A
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A end
+ is not included in
+ sig type t = A | B end
+ Type declarations do not match:
+ type t = private A
+ is not included in
+ type t = A | B
+ Private variant constructor(s) would be revealed.
+|}];;
+
+module M : sig
+ type t = { x : int }
+end = struct
+ type t = private { x : int; y : bool }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private { x : int; y : bool }
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private { x : int; y : bool; } end
+ is not included in
+ sig type t = { x : int; } end
+ Type declarations do not match:
+ type t = private { x : int; y : bool; }
+ is not included in
+ type t = { x : int; }
+ A private record constructor would be revealed.
+|}];;
+
+module M : sig
+ type t = { x : int; y : bool }
+end = struct
+ type t = private { x : int }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private { x : int }
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private { x : int; } end
+ is not included in
+ sig type t = { x : int; y : bool; } end
+ Type declarations do not match:
+ type t = private { x : int; }
+ is not included in
+ type t = { x : int; y : bool; }
+ A private record constructor would be revealed.
+|}];;
+
+module M : sig
+ type t = A | B
+end = struct
+ type t = private { x : int; y : bool }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private { x : int; y : bool }
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private { x : int; y : bool; } end
+ is not included in
+ sig type t = A | B end
+ Type declarations do not match:
+ type t = private { x : int; y : bool; }
+ is not included in
+ type t = A | B
+ Their kinds differ.
+|}];;
+
+module M : sig
+ type t = { x : int; y : bool }
+end = struct
+ type t = private A | B
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private A | B
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private A | B end
+ is not included in
+ sig type t = { x : int; y : bool; } end
+ Type declarations do not match:
+ type t = private A | B
+ is not included in
+ type t = { x : int; y : bool; }
+ Their kinds differ.
+|}];;
+
+module M : sig
+ type t = [`A]
+end = struct
+ type t = private [> `A | `B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [> `A | `B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [> `A | `B ] end
+ is not included in
+ sig type t = [ `A ] end
+ Type declarations do not match:
+ type t = private [> `A | `B ]
+ is not included in
+ type t = [ `A ]
+ A private row type would be revealed.
+|}];;
+
+module M : sig
+ type t = [`A]
+end = struct
+ type t = private [< `A | `B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A | `B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A | `B ] end
+ is not included in
+ sig type t = [ `A ] end
+ Type declarations do not match:
+ type t = private [< `A | `B ]
+ is not included in
+ type t = [ `A ]
+ A private row type would be revealed.
+|}];;
+
+module M : sig
+ type t = [`A]
+end = struct
+ type t = private [< `A | `B > `A]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A | `B > `A]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A | `B > `A ] end
+ is not included in
+ sig type t = [ `A ] end
+ Type declarations do not match:
+ type t = private [< `A | `B > `A ]
+ is not included in
+ type t = [ `A ]
+ A private row type would be revealed.
+|}];;
+
+module M : sig
+ type t = < m : int >
+end = struct
+ type t = private < m : int; .. >
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private < m : int; .. >
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private < m : int; .. > end
+ is not included in
+ sig type t = < m : int > end
+ Type declarations do not match:
+ type t = private < m : int; .. >
+ is not included in
+ type t = < m : int >
+ A private row type would be revealed.
|}];;
module P : sig module M : sig type t = M.t type u = M.u end end
end
|}]
+
+(* Recursion issues *)
+
+(* Should fail rather than stack overflow *)
+module type S = sig
+ type 'a t = 'a
+ constraint 'a = < m : r >
+ and r = (< m : r >) t
+ end
+
+module type T = S with type 'a t = 'b constraint 'a = < m : 'b >;;
+[%%expect{|
+module type S =
+ sig type 'a t = 'a constraint 'a = < m : r > and r = < m : r > t end
+Uncaught exception: Stack overflow
+
+|}]
+
+(* Correct *)
+module type S = sig
+ type t = Foo of r
+ and r = t
+ end
+
+type s = Foo of s
+
+module type T = S with type t = s
+[%%expect{|
+module type S = sig type t = Foo of r and r = t end
+type s = Foo of s
+module type T = sig type t = s = Foo of r and r = t end
+|}]
+
+(* Correct *)
+module type S = sig
+ type r = t
+ and t = Foo of r
+ end
+
+type s = Foo of s
+
+module type T = S with type t = s
+[%%expect{|
+module type S = sig type r = t and t = Foo of r end
+type s = Foo of s
+module type T = sig type r = t and t = s = Foo of r end
+|}]
+
+(* Should succeed *)
+module type S = sig
+ module rec M : sig
+ type t = Foo of M.r
+ type r = t
+ end
+ end
+
+type s = Foo of s
+
+module type T = S with type M.t = s
+[%%expect{|
+module type S = sig module rec M : sig type t = Foo of M.r type r = t end end
+type s = Foo of s
+Line 10, characters 23-35:
+10 | module type T = S with type M.t = s
+ ^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type s
+ Constructors do not match:
+ Foo of s
+ is not the same as:
+ Foo of M.r
+ The type s is not equal to the type M.r = M.t
+|}]
+
+(* Should succeed *)
+module type S = sig
+ module rec M : sig
+ type t = private [`Foo of M.r]
+ type r = t
+ end
+ end
+
+type s = [`Foo of s]
+
+module type T = S with type M.t = s
+[%%expect{|
+module type S =
+ sig module rec M : sig type t = private [ `Foo of M.r ] type r = t end end
+type s = [ `Foo of s ]
+Line 10, characters 16-35:
+10 | module type T = S with type M.t = s
+ ^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of M.t
+ does not match its original definition in the constrained signature:
+ Type declarations do not match:
+ type t = s
+ is not included in
+ type t = private [ `Foo of M.r ]
+ The type s = [ `Foo of s ] is not equal to the type [ `Foo of M.r ]
+ Type s = [ `Foo of s ] is not equal to type M.r = M.t
+ Types for tag `Foo are incompatible
+|}]
+
+(* Should succeed *)
+module type S = sig
+ module rec M : sig
+ module N : sig type t = private [`Foo of M.r] end
+ type r = M.N.t
+ end
+end
+
+module X = struct type t = [`Foo of t] end
+
+module type T = S with module M.N = X
+[%%expect{|
+module type S =
+ sig
+ module rec M :
+ sig
+ module N : sig type t = private [ `Foo of M.r ] end
+ type r = M.N.t
+ end
+ end
+module X : sig type t = [ `Foo of t ] end
+Line 10, characters 16-37:
+10 | module type T = S with module M.N = X
+ ^^^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of M.N
+ does not match its original definition in the constrained signature:
+ Modules do not match:
+ sig type t = [ `Foo of t ] end
+ is not included in
+ sig type t = private [ `Foo of M.r ] end
+ Type declarations do not match:
+ type t = [ `Foo of t ]
+ is not included in
+ type t = private [ `Foo of M.r ]
+ The type [ `Foo of t ] is not equal to the type [ `Foo of M.r ]
+ Type t = [ `Foo of t ] is not equal to type M.r = M.N.t
+ Types for tag `Foo are incompatible
+|}]
+
+(* Should succeed *)
+module type S = sig
+ module rec M : sig
+ module N : sig type t = M.r type s end
+ type r = N.s
+ end
+ end
+
+module X = struct type t type s = t end
+
+module type T = S with module M.N = X
+[%%expect{|
+module type S =
+ sig
+ module rec M :
+ sig module N : sig type t = M.r type s end type r = N.s end
+ end
+module X : sig type t type s = t end
+Line 10, characters 16-37:
+10 | module type T = S with module M.N = X
+ ^^^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of M.N
+ does not match its original definition in the constrained signature:
+ Modules do not match:
+ sig type t = X.t type s = t end
+ is not included in
+ sig type t = M.r type s end
+ Type declarations do not match:
+ type t = X.t
+ is not included in
+ type t = M.r
+ The type X.t is not equal to the type M.r = M.N.s
+|}]
type t = X of x | Y of y
is not included in
type t = X of int | Y of float
- Constructors do not match:
+ 1. Constructors do not match:
X of x
- is not compatible with:
+ is not the same as:
X of int
- The types are not equal.
+ The type x is not equal to the type int
+ 2. Constructors do not match:
+ Y of y
+ is not the same as:
+ Y of float
+ The type y is not equal to the type float
|}]
(** First class module types require an identity *)
type s = t
is not included in
type s = private [ `Bar of int | `Foo of 'a -> int ] as 'a
+ The type [ `Bar of int | `Foo of t -> int ] is not equal to the type
+ [ `Bar of int | `Foo of 'a -> int ] as 'a
+ Types for tag `Foo are incompatible
|}]
(* nondep_type_decl + nondep_type_rec *)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* From jctis: <https://github.com/ocaml/ocaml/issues/10399> *)
+
+module PR10399 : sig
+ type t = < x : int >
+
+ class c : object method x : int method y : bool end
+
+ val o : t
+end = struct
+ type t = < x : int >
+
+ class c = object method x = 3 method y = true end
+
+ let o = new c
+end
+
+[%%expect{|
+Lines 7-13, characters 6-3:
+ 7 | ......struct
+ 8 | type t = < x : int >
+ 9 |
+10 | class c = object method x = 3 method y = true end
+11 |
+12 | let o = new c
+13 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = < x : int >
+ class c : object method x : int method y : bool end
+ val o : c
+ end
+ is not included in
+ sig
+ type t = < x : int >
+ class c : object method x : int method y : bool end
+ val o : t
+ end
+ Values do not match: val o : c is not included in val o : t
+ The type c is not compatible with the type t
+ The second object type has no method y
+|}]
type t = X.t = A | B
is not included in
type t = int * bool
+ The type X.t is not equal to the type int * bool
|}];;
Error: This variant or record definition does not match that of type M.t
Constructors do not match:
E of (MkT(M.T).t, MkT(M.T).t) eq
- is not compatible with:
+ is not the same as:
E of (MkT(Desc).t, MkT(Desc).t) eq
- The types are not equal.
+ The type (MkT(M.T).t, MkT(M.T).t) eq is not equal to the type
+ (MkT(Desc).t, MkT(Desc).t) eq
+ Type MkT(M.T).t = Set.Make(M.Term0).t is not equal to type
+ MkT(Desc).t = Set.Make(Desc).t
|}]
Error: This variant or record definition does not match that of type M1.t
Constructors do not match:
E of M1.x
- is not compatible with:
+ is not the same as:
E of M1.y
- The types are not equal.
+ The type M1.x = int is not equal to the type M1.y = bool
|}]
let bool_of_int x =
Error: This variant or record definition does not match that of type M1.t
Constructors do not match:
E of (M1.x, M1.x) eq
- is not compatible with:
+ is not the same as:
E of (M1.x, M1.y) eq
- The types are not equal.
+ The type (M1.x, M1.x) eq is not equal to the type (M1.x, M1.y) eq
+ Type M1.x = int is not equal to type M1.y = bool
|}]
f0 : unit * unit * unit * int * unit * unit * unit;
f1 : unit * unit * unit * int * unit * unit * unit;
}
- Fields do not match:
+ 1. Fields do not match:
f0 : unit * unit * unit * float * unit * unit * unit;
- is not compatible with:
+ is not the same as:
f0 : unit * unit * unit * int * unit * unit * unit;
- The types are not equal.
+ The type unit * unit * unit * float * unit * unit * unit
+ is not equal to the type unit * unit * unit * int * unit * unit * unit
+ Type float is not equal to type int
+ 2. Fields do not match:
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ is not the same as:
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ The type unit * unit * unit * string * unit * unit * unit
+ is not equal to the type unit * unit * unit * int * unit * unit * unit
+ Type string is not equal to type int
|}];;
mutable f0 : unit * unit * unit * int * unit * unit * unit;
f1 : unit * unit * unit * int * unit * unit * unit;
}
- Fields do not match:
+ 1. Fields do not match:
f0 : unit * unit * unit * float * unit * unit * unit;
- is not compatible with:
+ is not the same as:
mutable f0 : unit * unit * unit * int * unit * unit * unit;
The second is mutable and the first is not.
+ 2. Fields do not match:
+ f1 : unit * unit * unit * string * unit * unit * unit;
+ is not the same as:
+ f1 : unit * unit * unit * int * unit * unit * unit;
+ The type unit * unit * unit * string * unit * unit * unit
+ is not equal to the type unit * unit * unit * int * unit * unit * unit
+ Type string is not equal to type int
|}];;
module M3 : sig
type t = { f1 : unit; }
is not included in
type t = { f0 : unit; }
- Fields number 1 have different names, f1 and f0.
+ Fields have different names, f1 and f0.
|}];;
module M4 : sig
type t = { f0 : unit; }
is not included in
type t = { f0 : unit; f1 : unit; }
- The field f1 is only present in the second declaration.
+ A field, f1, is missing in the first declaration.
|}];;
+
+
+(** Random additions and deletions of fields *)
+
+module Addition : sig
+ type t = {a : unit; b : unit; c : unit; d : unit}
+end = struct
+ type t = {a : unit; b : unit; beta : unit; c : unit; d: unit}
+end
+[%%expect {|
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | type t = {a : unit; b : unit; beta : unit; c : unit; d: unit}
+7 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = { a : unit; b : unit; beta : unit; c : unit; d : unit; }
+ end
+ is not included in
+ sig type t = { a : unit; b : unit; c : unit; d : unit; } end
+ Type declarations do not match:
+ type t = { a : unit; b : unit; beta : unit; c : unit; d : unit; }
+ is not included in
+ type t = { a : unit; b : unit; c : unit; d : unit; }
+ An extra field, beta, is provided in the first declaration.
+|}]
+
+
+module Deletion : sig
+ type t = {a : unit; b : unit; c : unit; d : unit}
+end = struct
+ type t = {a : unit; c : unit; d : unit}
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = {a : unit; c : unit; d : unit}
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = { a : unit; c : unit; d : unit; } end
+ is not included in
+ sig type t = { a : unit; b : unit; c : unit; d : unit; } end
+ Type declarations do not match:
+ type t = { a : unit; c : unit; d : unit; }
+ is not included in
+ type t = { a : unit; b : unit; c : unit; d : unit; }
+ A field, b, is missing in the first declaration.
+|}]
+
+
+module Multi: sig
+ type t = {
+ a : unit;
+ b : unit;
+ c : unit;
+ d : unit;
+ e : unit;
+ f : unit;
+ g : unit
+ }
+end = struct
+ type t = {
+ a : unit;
+ b : unit;
+ beta: int;
+ c : unit;
+ d : unit;
+ f : unit;
+ g : unit;
+ phi : unit;
+ }
+end
+
+[%%expect {|
+Lines 11-22, characters 6-3:
+11 | ......struct
+12 | type t = {
+13 | a : unit;
+14 | b : unit;
+15 | beta: int;
+...
+19 | g : unit;
+20 | phi : unit;
+21 | }
+22 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = {
+ a : unit;
+ b : unit;
+ beta : int;
+ c : unit;
+ d : unit;
+ f : unit;
+ g : unit;
+ phi : unit;
+ }
+ end
+ is not included in
+ sig
+ type t = {
+ a : unit;
+ b : unit;
+ c : unit;
+ d : unit;
+ e : unit;
+ f : unit;
+ g : unit;
+ }
+ end
+ Type declarations do not match:
+ type t = {
+ a : unit;
+ b : unit;
+ beta : int;
+ c : unit;
+ d : unit;
+ f : unit;
+ g : unit;
+ phi : unit;
+ }
+ is not included in
+ type t = {
+ a : unit;
+ b : unit;
+ c : unit;
+ d : unit;
+ e : unit;
+ f : unit;
+ g : unit;
+ }
+ 3. An extra field, beta, is provided in the first declaration.
+ 5. A field, e, is missing in the first declaration.
+ 8. An extra field, phi, is provided in the first declaration.
+|}]
+
+
+(** Multiple errors *)
+
+module M : sig
+ type t = { a:int; e:int; c:int; d:int; b:int }
+end = struct
+ type t = { alpha:int; b:int; c:int; d:int; e:int }
+end
+[%%expect {|
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | type t = { alpha:int; b:int; c:int; d:int; e:int }
+7 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = { alpha : int; b : int; c : int; d : int; e : int; }
+ end
+ is not included in
+ sig type t = { a : int; e : int; c : int; d : int; b : int; } end
+ Type declarations do not match:
+ type t = { alpha : int; b : int; c : int; d : int; e : int; }
+ is not included in
+ type t = { a : int; e : int; c : int; d : int; b : int; }
+ 1. Fields have different names, alpha and a.
+ 2<->5. Fields b and e have been swapped.
+|}]
+
+
+module M: sig
+ type t = { a:int; b:int; c:int; d:int; e:int; f:float }
+end =
+struct
+ type t = { b:int; c:int; d:int; e:int; a:int; f:int }
+end
+[%%expect {|
+Lines 4-6, characters 0-3:
+4 | struct
+5 | type t = { b:int; c:int; d:int; e:int; a:int; f:int }
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type t = { b : int; c : int; d : int; e : int; a : int; f : int; }
+ end
+ is not included in
+ sig
+ type t = {
+ a : int;
+ b : int;
+ c : int;
+ d : int;
+ e : int;
+ f : float;
+ }
+ end
+ Type declarations do not match:
+ type t = { b : int; c : int; d : int; e : int; a : int; f : int; }
+ is not included in
+ type t = { a : int; b : int; c : int; d : int; e : int; f : float; }
+ 1->5. Field a has been moved from position 1 to 5.
+ 6. Fields do not match:
+ f : int;
+ is not the same as:
+ f : float;
+ The type int is not equal to the type float
+|}]
+
+(** Existential types introduce equations that must be taken in account
+ when diffing
+*)
+
+
+module Eq : sig
+ type t = A: { a:'a; b:'b; x:'a } -> t
+end = struct
+ type t = A: { a:'a; b:'b; x:'x } -> t
+end
+[%%expect {|
+Lines 8-10, characters 6-3:
+ 8 | ......struct
+ 9 | type t = A: { a:'a; b:'b; x:'x } -> t
+10 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A : { a : 'a; b : 'b; x : 'x; } -> t end
+ is not included in
+ sig type t = A : { a : 'a; b : 'b; x : 'a; } -> t end
+ Type declarations do not match:
+ type t = A : { a : 'a; b : 'b; x : 'x; } -> t
+ is not included in
+ type t = A : { a : 'a; b : 'b; x : 'a; } -> t
+ Constructors do not match:
+ A : { a : 'a; b : 'b; x : 'x; } -> t
+ is not the same as:
+ A : { a : 'a; b : 'b; x : 'a; } -> t
+ Fields do not match:
+ x : 'x;
+ is not the same as:
+ x : 'a;
+ The type 'x is not equal to the type 'a
+|}]
+
+
+module Not_a_swap: sig
+ type t = A: { x:'a; a:'a; b:'b; y:'b} -> t
+end = struct
+ type t = A: { y:'a; a:'a; b:'b; x:'b} -> t
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = A: { y:'a; a:'a; b:'b; x:'b} -> t
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A : { y : 'a; a : 'a; b : 'b; x : 'b; } -> t end
+ is not included in
+ sig type t = A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t end
+ Type declarations do not match:
+ type t = A : { y : 'a; a : 'a; b : 'b; x : 'b; } -> t
+ is not included in
+ type t = A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t
+ Constructors do not match:
+ A : { y : 'a; a : 'a; b : 'b; x : 'b; } -> t
+ is not the same as:
+ A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t
+ 1. Fields have different names, y and x.
+ 4. Fields have different names, x and y.
+|}]
+
+module Swap: sig
+ type t = A: { x:'a; a:'a; b:'b; y:'b} -> t
+end = struct
+ type t = A: { y:'b; a:'a; b:'b; x:'a} -> t
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = A: { y:'b; a:'a; b:'b; x:'a} -> t
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A : { y : 'b; a : 'a; b : 'b; x : 'a; } -> t end
+ is not included in
+ sig type t = A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t end
+ Type declarations do not match:
+ type t = A : { y : 'b; a : 'a; b : 'b; x : 'a; } -> t
+ is not included in
+ type t = A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t
+ Constructors do not match:
+ A : { y : 'b; a : 'a; b : 'b; x : 'a; } -> t
+ is not the same as:
+ A : { x : 'a; a : 'a; b : 'b; y : 'b; } -> t
+ Fields x and y have been swapped.
+|}]
+
+
+module Not_a_move: sig
+ type t = A: { a:'a; b:'b; x:'b} -> t
+end = struct
+ type t = A: { x:'a; a:'a; b:'b} -> t
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = A: { x:'a; a:'a; b:'b} -> t
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A : { x : 'a; a : 'a; b : 'b; } -> t end
+ is not included in
+ sig type t = A : { a : 'a; b : 'b; x : 'b; } -> t end
+ Type declarations do not match:
+ type t = A : { x : 'a; a : 'a; b : 'b; } -> t
+ is not included in
+ type t = A : { a : 'a; b : 'b; x : 'b; } -> t
+ Constructors do not match:
+ A : { x : 'a; a : 'a; b : 'b; } -> t
+ is not the same as:
+ A : { a : 'a; b : 'b; x : 'b; } -> t
+ 1. An extra field, x, is provided in the first declaration.
+ 3. A field, x, is missing in the first declaration.
+|}]
+
+
+module Move: sig
+ type t = A: { a:'a; b:'b; x:'b} -> t
+end = struct
+ type t = A: { x:'b; a:'a; b:'b} -> t
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = A: { x:'b; a:'a; b:'b} -> t
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A : { x : 'b; a : 'a; b : 'b; } -> t end
+ is not included in
+ sig type t = A : { a : 'a; b : 'b; x : 'b; } -> t end
+ Type declarations do not match:
+ type t = A : { x : 'b; a : 'a; b : 'b; } -> t
+ is not included in
+ type t = A : { a : 'a; b : 'b; x : 'b; } -> t
+ Constructors do not match:
+ A : { x : 'b; a : 'a; b : 'b; } -> t
+ is not the same as:
+ A : { a : 'a; b : 'b; x : 'b; } -> t
+ Field x has been moved from position 3 to 1.
+|}]
type t = Foo of int * int
Constructors do not match:
Foo of float * int
- is not compatible with:
+ is not the same as:
Foo of int * int
- The types are not equal.
+ The type float is not equal to the type int
|}];;
module M2 : sig
type t = Foo of int * int
Constructors do not match:
Foo of float
- is not compatible with:
+ is not the same as:
Foo of int * int
They have different arities.
|}];;
type t = Foo of { x : int; y : int; }
Constructors do not match:
Foo of { x : float; y : int; }
- is not compatible with:
+ is not the same as:
Foo of { x : int; y : int; }
Fields do not match:
x : float;
- is not compatible with:
+ is not the same as:
x : int;
- The types are not equal.
+ The type float is not equal to the type int
|}];;
module M4 : sig
type t = Foo of { x : int; y : int; }
Constructors do not match:
Foo of float
- is not compatible with:
+ is not the same as:
Foo of { x : int; y : int; }
The second uses inline records and the first doesn't.
|}];;
type 'a t = Foo : int -> int t
Constructors do not match:
Foo of 'a
- is not compatible with:
+ is not the same as:
Foo : int -> int t
The second has explicit return type and the first doesn't.
|}];;
type ('a, 'b) t = A of 'a
Constructors do not match:
A of 'b
- is not compatible with:
+ is not the same as:
A of 'a
- The types are not equal.
+ The type 'b is not equal to the type 'a
|}];;
module M : sig
type ('a, 'b) t = A of 'a
Constructors do not match:
A of 'a
- is not compatible with:
+ is not the same as:
A of 'a
- The types are not equal.
+ The type 'a is not equal to the type 'b
|}];;
+
+
+
+(** Random additions and deletions of constructors *)
+
+module Addition : sig
+ type t =
+ | A
+ | B
+ | C
+ | D
+end = struct
+ type t =
+ | A
+ | B
+ | Beta
+ | C
+ | D
+end
+[%%expect {|
+Lines 9-16, characters 6-3:
+ 9 | ......struct
+10 | type t =
+11 | | A
+12 | | B
+13 | | Beta
+14 | | C
+15 | | D
+16 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A | B | Beta | C | D end
+ is not included in
+ sig type t = A | B | C | D end
+ Type declarations do not match:
+ type t = A | B | Beta | C | D
+ is not included in
+ type t = A | B | C | D
+ An extra constructor, Beta, is provided in the first declaration.
+|}]
+
+
+module Addition : sig
+ type t =
+ | A
+ | B
+ | C
+ | D
+end = struct
+ type t =
+ | A
+ | B
+ | D
+end
+[%%expect {|
+Lines 7-12, characters 6-3:
+ 7 | ......struct
+ 8 | type t =
+ 9 | | A
+10 | | B
+11 | | D
+12 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A | B | D end
+ is not included in
+ sig type t = A | B | C | D end
+ Type declarations do not match:
+ type t = A | B | D
+ is not included in
+ type t = A | B | C | D
+ A constructor, C, is missing in the first declaration.
+|}]
+
+
+module Multi: sig
+ type t =
+ | A
+ | B
+ | C
+ | D
+ | E
+ | F
+ | G
+end = struct
+ type t =
+ | A
+ | B
+ | Beta
+ | C
+ | D
+ | F
+ | G
+ | Phi
+end
+
+[%%expect {|
+Lines 10-20, characters 6-3:
+10 | ......struct
+11 | type t =
+12 | | A
+13 | | B
+14 | | Beta
+...
+17 | | F
+18 | | G
+19 | | Phi
+20 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A | B | Beta | C | D | F | G | Phi end
+ is not included in
+ sig type t = A | B | C | D | E | F | G end
+ Type declarations do not match:
+ type t = A | B | Beta | C | D | F | G | Phi
+ is not included in
+ type t = A | B | C | D | E | F | G
+ 3. An extra constructor, Beta, is provided in the first declaration.
+ 5. A constructor, E, is missing in the first declaration.
+ 8. An extra constructor, Phi, is provided in the first declaration.
+|}]
+
+
+(** Swaps and moves *)
+
+module Swap : sig
+ type t =
+ | A
+ | E
+ | C
+ | D
+ | B
+end = struct
+ type t =
+ | Alpha
+ | B
+ | C
+ | D
+ | E
+end
+[%%expect {|
+Lines 10-17, characters 6-3:
+10 | ......struct
+11 | type t =
+12 | | Alpha
+13 | | B
+14 | | C
+15 | | D
+16 | | E
+17 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Alpha | B | C | D | E end
+ is not included in
+ sig type t = A | E | C | D | B end
+ Type declarations do not match:
+ type t = Alpha | B | C | D | E
+ is not included in
+ type t = A | E | C | D | B
+ 1. Constructors have different names, Alpha and A.
+ 2<->5. Constructors B and E have been swapped.
+|}]
+
+
+module Move: sig
+ type t =
+ | A of int
+ | B
+ | C
+ | D
+ | E
+ | F
+end = struct
+ type t =
+ | A of float
+ | B
+ | D
+ | E
+ | F
+ | C
+end
+[%%expect {|
+Lines 9-17, characters 6-3:
+ 9 | ......struct
+10 | type t =
+11 | | A of float
+12 | | B
+13 | | D
+14 | | E
+15 | | F
+16 | | C
+17 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = A of float | B | D | E | F | C end
+ is not included in
+ sig type t = A of int | B | C | D | E | F end
+ Type declarations do not match:
+ type t = A of float | B | D | E | F | C
+ is not included in
+ type t = A of int | B | C | D | E | F
+ 1. Constructors do not match:
+ A of float
+ is not the same as:
+ A of int
+ The type float is not equal to the type int
+ 3->6. Constructor C has been moved from position 3 to 6.
+|}]
Error: The class type
object
val l :
- [ `Abs of
- string *
- ([ `Abs of string * expr | `App of 'a * exp ] as 'b)
+ [ `Abs of string * ([> `App of 'a * exp ] as 'b)
| `App of expr * expr ] as 'a
val r : exp
method eval : (string, exp) Hashtbl.t -> 'b
The class type
object
val l :
- [ `Abs of
- string *
- ([ `Abs of string * expr | `App of 'a * exp ] as 'b)
+ [ `Abs of string * ([> `App of 'a * exp ] as 'b)
| `App of expr * expr ] as 'a
val r : exp
method eval : (string, exp) Hashtbl.t -> 'b
object method eval : (string, exp) Hashtbl.t -> expr end
The method eval has type
(string, exp) Hashtbl.t ->
- ([ `Abs of string * expr
- | `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
+ ([> `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
as 'a)
but is expected to have type (string, exp) Hashtbl.t -> expr
Type
- [ `Abs of string * expr
- | `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
+ [> `App of [ `Abs of string * 'a | `App of expr * expr ] * exp ]
as 'a
is not compatible with type
expr = [ `Abs of string * expr | `App of expr * expr ]
^^^^^^
Error: This type entity = < destroy_subject : id subject; entity_id : id >
should be an instance of type
- < destroy_subject : < add_observer : 'a entity_container -> 'c; .. >
- as 'b;
+ < destroy_subject : < add_observer : 'a entity_container -> 'b; .. >;
.. >
as 'a
Type
< add_observer : (id subject, id) observer -> unit;
notify_observers : id -> unit >
is not compatible with type
- < add_observer : 'a entity_container -> 'c; .. > as 'b
+ < add_observer : < destroy_subject : 'c; .. > entity_container -> 'b;
+ .. >
+ as 'c
Type (id subject, id) observer = < notify : id subject -> id -> unit >
is not compatible with type
- 'a entity_container =
- < add_entity : 'a -> 'c; notify : 'a -> id -> unit >
+ (< destroy_subject : < add_observer : 'd -> 'b; .. >; .. > as 'a)
+ entity_container as 'd =
+ < add_entity : 'a -> 'b; notify : 'a -> id -> unit >
Types for method add_observer are incompatible
Format.print_string ")"
end;;
[%%expect{|
-Line 3, characters 10-27:
+Line 3, characters 2-36:
3 | inherit printable_point y as super
- ^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 13 [instance-variable-override]: the following instance variables are overridden by the class printable_point :
x
-The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class printable_color_point :
int ->
string ->
#comparable as 'a = < cmp : 'a -> int; .. >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not compatible with type
- int_comparable3 =
- < cmp : int_comparable -> int; setx : int -> unit; x : int >
- The first object type has no method setx
-|}, Principal{|
-Line 1, characters 25-27:
-1 | (new sorted_list ())#add c3;;
- ^^
-Error: This expression has type
- int_comparable3 =
- < cmp : int_comparable -> int; setx : int -> unit; x : int >
- but an expression was expected of type
#comparable as 'a = < cmp : 'a -> int; .. >
- Type int_comparable = < cmp : int_comparable -> int; x : int >
- is not compatible with type 'a = < cmp : 'a -> int; .. >
The first object type has no method setx
|}];; (* Error; strange message with -principal *)
end;;
[%%expect{|
class ['a] c : unit -> object constraint 'a = int method f : int c end
-and ['a] d : unit -> object constraint 'a = int method f : int c end
+and ['a] d : unit -> object constraint 'a = int method f : 'a c end
|}];;
(* class ['a] c : unit -> object constraint 'a = int method f : 'a c end *)
(* and ['a] d : unit -> object constraint 'a = int method f : 'a c end *)
method virtual f : int
end;;
[%%expect{|
-Lines 1-3, characters 0-3:
-1 | class x () = object
+Lines 1-3, characters 13-3:
+1 | .............object
2 | method virtual f : int
3 | end..
-Error: This class should be virtual. The following methods are undefined : f
+Error: This non-virtual class has virtual methods.
+ The following methods are virtual : f
|}];;
(* The class x should be virtual: its methods f is undefined *)
class ['a, 'b] d :
unit ->
object
- constraint 'a = int -> 'c
- constraint 'b = 'a * < x : 'b > * 'c * 'd
- method f : 'a -> 'b -> unit
+ constraint 'a = int -> 'd
+ constraint 'b = 'a * (< x : 'b > as 'c) * 'd * 'e
+ method f : (int -> 'd) -> (int -> 'd) * 'c * 'd * 'e -> unit
end
|}];;
constraint 'a = int -> bool
val x : float list
val y : 'b
- method f : 'a -> unit
+ method f : (int -> bool) -> unit
method g : 'b
end
|}];;
constraint 'a = int -> bool
val x : float list
val y : 'b
- method f : 'a -> unit
+ method f : (int -> bool) -> unit
method g : 'b
end
|}];;
method b = b
end;;
[%%expect{|
-Line 3, characters 10-13:
+Line 3, characters 2-13:
3 | inherit c 5
- ^^^
+ ^^^^^^^^^^^
Warning 13 [instance-variable-override]: the following instance variables are overridden by the class c :
x
-The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Line 4, characters 6-7:
4 | val y = 3
^
Warning 13 [instance-variable-override]: the instance variable y is overridden.
-The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Line 6, characters 10-13:
+Line 6, characters 2-13:
6 | inherit d 7
- ^^^
+ ^^^^^^^^^^^
Warning 13 [instance-variable-override]: the following instance variables are overridden by the class d :
t z
-The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Line 7, characters 6-7:
7 | val u = 3
^
Warning 13 [instance-variable-override]: the instance variable u is overridden.
-The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class e :
unit ->
object
val f : (#c as 'a) -> 'a
is not included in
val f : #c -> #c
+ The type (#c as 'a) -> 'a is not compatible with the type #c -> #c
+ Type #c as 'a = < m : 'a; .. > is not compatible with type
+ #c as 'b = < m : 'b; .. >
+ Type 'a is not compatible with type 'b
|}];;
module M = struct type t = int class t () = object end end;;
Error: The ancestor variable super
cannot be accessed from the definition of an instance variable
|}];;
+
+(* Some more tests of class idiosyncrasies *)
+
+class c = object method private m = 3 end
+ and d = object method o = object inherit c end end;;
+[%%expect {|
+class c : object method private m : int end
+and d : object method o : c end
+|}];;
+
+class c = object(_ : 'self)
+ method o = object(_ : 'self) method o = assert false end
+end;;
+[%%expect {|
+Line 2, characters 13-58:
+2 | method o = object(_ : 'self) method o = assert false end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Cannot close type of object literal: < o : '_weak3; _.. >
+ it has been unified with the self type of a class that is not yet
+ completely defined.
+|}];;
+
+class c = object
+ method m = 1
+ inherit object (self)
+ method n = self#m
+ end
+ end;;
+[%%expect {|
+Line 4, characters 17-23:
+4 | method n = self#m
+ ^^^^^^
+Warning 17 [undeclared-virtual-method]: the virtual method m is not declared.
+class c : object method m : int method n : int end
+|}];;
+
+class [ 'a ] c = object (_ : 'a) end;;
+let o = object
+ method m = 1
+ inherit [ < m : int > ] c
+ end;;
+[%%expect {|
+class ['a] c : object ('a) constraint 'a = < .. > end
+Line 4, characters 14-25:
+4 | inherit [ < m : int > ] c
+ ^^^^^^^^^^^
+Error: The type parameter < m : int >
+ does not meet its constraint: it should be < .. >
+ Self type cannot be unified with a closed object type
+|}];;
+
+class type [ 'a ] d = object method a : 'a method b : 'a end
+class c : ['a] d = object (self) method a = 1 method b = assert false end;;
+[%%expect {|
+class type ['a] d = object method a : 'a method b : 'a end
+Line 2, characters 19-73:
+2 | class c : ['a] d = object (self) method a = 1 method b = assert false end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The class type object method a : int method b : 'a end
+ is not matched by the class type ['_a] d
+ The class type object method a : int method b : 'a end
+ is not matched by the class type
+ object method a : 'a method b : 'a end
+ The method a has type int but is expected to have type 'a
+ Type int is not compatible with type 'a
+|}];;
+
+class type ['a] ct = object ('a) end
+class c : [ < a : int; ..> ] ct = object method a = 3 end;;
+[%%expect {|
+class type ['a] ct = object ('a) constraint 'a = < .. > end
+Line 2, characters 10-31:
+2 | class c : [ < a : int; ..> ] ct = object method a = 3 end;;
+ ^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class has undeclared virtual methods.
+ The following methods were not declared : a
+|}];;
+
+class virtual c : [ < a : int; ..> ] ct = object method a = 3 end;;
+[%%expect {|
+class virtual c : object method virtual a : int end
+|}];;
+
+class c : object
+ method m : < m : 'a > as 'a
+ end = object (self)
+ method m = self
+end;;
+[%%expect {|
+Lines 3-5, characters 8-3:
+3 | ........object (self)
+4 | method m = self
+5 | end..
+Error: The class type object ('a) method m : < m : 'a; .. > as 'a end
+ is not matched by the class type
+ object method m : < m : 'a > as 'a end
+ The method m has type < m : 'a; .. > as 'a
+ but is expected to have type < m : 'b > as 'b
+ Type 'a is not compatible with type < >
+|}];;
+
+class c :
+ object
+ method foo : < foo : int; .. > -> < foo : int> -> unit
+ end =
+ object
+ method foo : 'a. (< foo : int; .. > as 'a) -> 'a -> unit = assert false
+ end;;
+[%%expect {|
+Lines 5-7, characters 2-5:
+5 | ..object
+6 | method foo : 'a. (< foo : int; .. > as 'a) -> 'a -> unit = assert false
+7 | end..
+Error: The class type
+ object method foo : (< foo : int; .. > as 'a) -> 'a -> unit end
+ is not matched by the class type
+ object method foo : < foo : int; .. > -> < foo : int > -> unit end
+ The method foo has type 'a. (< foo : int; .. > as 'a) -> 'a -> unit
+ but is expected to have type
+ 'b. (< foo : int; .. > as 'b) -> < foo : int > -> unit
+ Type 'c is not compatible with type < >
+|}];;
+
+
+class c = (fun x -> object(_:'foo) end) 3;;
+[%%expect {|
+class c : object end
+|}];;
+
+class virtual c =
+ ((fun (x : 'self -> unit) -> object(_:'self) end) (fun (_ : < a : int; .. >) -> ())
+ : object method virtual a : int end)
+[%%expect {|
+class virtual c : object method virtual a : int end
+|}];;
+
+class c = object
+ val x = 3
+ method o = {< x = 4; y = 5 >}
+ val y = 4
+end;;
+[%%expect {|
+class c : object ('a) val x : int val y : int method o : 'a end
+|}];;
+
+class c : object('self) method m : < m : 'a; x : int; ..> -> unit as 'a end =
+ object (_ : 'self) method m (_ : 'self) = () end;;
+[%%expect {|
+Line 2, characters 4-52:
+2 | object (_ : 'self) method m (_ : 'self) = () end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The class type
+ object ('a) method m : (< m : 'a -> unit; .. > as 'a) -> unit end
+ is not matched by the class type
+ object method m : < m : 'a; x : int; .. > -> unit as 'a end
+ The method m has type (< m : 'a -> unit; .. > as 'a) -> unit
+ but is expected to have type
+ 'b. (< m : 'c; x : int; .. > as 'b) -> unit as 'c
+ Type 'a is not compatible with type < x : int; .. >
+|}];;
+
+let is_empty (x : < >) = ()
+class c = object (self) method private foo = is_empty self end;;
+[%%expect {|
+val is_empty : < > -> unit = <fun>
+Line 2, characters 54-58:
+2 | class c = object (self) method private foo = is_empty self end;;
+ ^^^^
+Error: This expression has type < .. > but an expression was expected of type
+ < >
+ Self type cannot be unified with a closed object type
+|}];;
+
+(* Warnings about private methods implicitly made public *)
+let has_foo (x : < foo : 'a; .. >) = ()
+
+class c = object (self) method private foo = 5 initializer has_foo self end;;
+[%%expect {|
+val has_foo : < foo : 'a; .. > -> unit = <fun>
+Line 3, characters 10-75:
+3 | class c = object (self) method private foo = 5 initializer has_foo self end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ foo.
+class c : object method foo : int end
+|}];;
+
+class type c = object(< foo : 'a; ..>) method private foo : int end;;
+[%%expect {|
+class type c = object method foo : int end
+|}];;
+
+class ['a] p = object (_ : 'a) method private foo = 5 end;;
+class c = [ < foo : int; .. > ] p;;
+[%%expect {|
+class ['a] p :
+ object ('a) constraint 'a = < .. > method private foo : int end
+class c : object method foo : int end
+|}];;
+
+(* Errors for undefined methods *)
+
+class c = object method virtual foo : int end;;
+[%%expect {|
+Line 1, characters 10-45:
+1 | class c = object method virtual foo : int end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class has virtual methods.
+ The following methods are virtual : foo
+|}];;
+
+class type ct = object method virtual foo : int end;;
+[%%expect {|
+Line 1, characters 16-51:
+1 | class type ct = object method virtual foo : int end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class type has virtual methods.
+ The following methods are virtual : foo
+|}];;
+
+let o = object method virtual foo : int end;;
+[%%expect {|
+Line 1, characters 8-43:
+1 | let o = object method virtual foo : int end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This object has virtual methods.
+ The following methods are virtual : foo
+|}];;
+
+class c = object(self) initializer self#foo end;;
+[%%expect {|
+Line 1, characters 35-39:
+1 | class c = object(self) initializer self#foo end;;
+ ^^^^
+Error: This expression has no method foo
+|}];;
+
+let o = object(self) initializer self#foo end;;
+[%%expect {|
+Line 1, characters 33-37:
+1 | let o = object(self) initializer self#foo end;;
+ ^^^^
+Error: This expression has no method foo
+|}];;
+
+let has_foo (x : < foo : int; ..>) = ()
+class c = object(self) initializer has_foo self end;;
+[%%expect {|
+val has_foo : < foo : int; .. > -> unit = <fun>
+Line 2, characters 10-51:
+2 | class c = object(self) initializer has_foo self end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class has undeclared virtual methods.
+ The following methods were not declared : foo
+|}];;
+
+let o = object(self) initializer has_foo self end;;
+[%%expect {|
+Line 1, characters 41-45:
+1 | let o = object(self) initializer has_foo self end;;
+ ^^^^
+Error: This expression has type < > but an expression was expected of type
+ < foo : int; .. >
+ The first object type has no method foo
+|}];;
+
+class c = object(_ : < foo : int; ..>) end;;
+[%%expect {|
+Line 1, characters 10-42:
+1 | class c = object(_ : < foo : int; ..>) end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class has undeclared virtual methods.
+ The following methods were not declared : foo
+|}];;
+
+class type ct = object(< foo : int; ..>) end;;
+[%%expect {|
+Line 1, characters 16-44:
+1 | class type ct = object(< foo : int; ..>) end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This non-virtual class type has undeclared virtual methods.
+ The following methods were not declared : foo
+|}];;
+
+let o = object(_ : < foo : int; ..>) end;;
+[%%expect {|
+Line 1, characters 8-40:
+1 | let o = object(_ : < foo : int; ..>) end;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This object has undeclared virtual methods.
+ The following methods were not declared : foo
+|}];;
+
+(* Shadowing/overriding methods in class types *)
+
+class type c = object
+ val x : int
+ val x : float
+end;;
+[%%expect {|
+class type c = object val x : float end
+|}];;
+
+class type c = object
+ val x : int
+ val mutable x : int
+end;;
+[%%expect {|
+class type c = object val mutable x : int end
+|}];;
+
+class type c = object
+ val mutable x : int
+ val x : int
+end;;
+[%%expect {|
+class type c = object val x : int end
+|}];;
+
+class type virtual c = object
+ val virtual x : int
+ val x : int
+end;;
+[%%expect {|
+class type c = object val x : int end
+|}];;
+
+class type virtual c = object
+ val x : int
+ val virtual x : int
+end;;
+[%%expect {|
+class type c = object val x : int end
+|}];;
+
+class type virtual c = object
+ val x : int
+ val virtual x : float
+end;;
+[%%expect {|
+class type c = object val x : float end
+|}];;
+
+class c = object
+ method virtual private test : unit
+ method private test = ()
+end
+
+let () = (new c)#test
+[%%expect {|
+class c : object method private test : unit end
+Line 6, characters 9-16:
+6 | let () = (new c)#test
+ ^^^^^^^
+Error: This expression has type c
+ It has no method test
+|}];;
+
+class c = object
+ method virtual private test : unit
+ method test = ()
+end
+
+let () = (new c)#test
+[%%expect {|
+class c : object method test : unit end
+|}];;
+
+class virtual d = object
+ method virtual private test : unit
+end
+
+class c = object
+ inherit d
+ method private test = ()
+end
+
+let () = (new c)#test
+[%%expect {|
+class virtual d : object method private virtual test : unit end
+class c : object method private test : unit end
+Line 10, characters 9-16:
+10 | let () = (new c)#test
+ ^^^^^^^
+Error: This expression has type c
+ It has no method test
+|}];;
+
+class c = object
+ inherit d
+ method test = ()
+end
+
+let () = (new c)#test
+[%%expect {|
+class c : object method test : unit end
+|}];;
+
+class foo =
+ object
+ method private f (b : bool) = b
+ inherit object
+ method f (b : bool) = b
+ end
+ end
+let _ = (new foo)#f true
+[%%expect {|
+class foo : object method f : bool -> bool end
+- : bool = true
+|}];;
end
end;;
[%%expect{|
-class foo1 : object method child : child2 method previous : child2 option end
+class foo1 : object method child : child1 method previous : child1 option end
|}]
class nested = object
[%%expect{|
class nested :
object
- method obj : < child : unit -> child2; previous : child2 option >
+ method obj : < child : unit -> child1; previous : child1 option >
end
|}]
end;;
[%%expect{|
class just_to_see :
- object method child : child2 method previous : child2 option end
+ object method child : child1 method previous : child1 option end
|}]
class just_to_see2 = object
end;;
[%%expect{|
class just_to_see2 :
- object method obj : < child : child2; previous : child2 option > end
+ object method obj : < child : child1; previous : child1 option > end
|}]
type gadt = Not_really_though : gadt
[%%expect{|
type gadt = Not_really_though : gadt
class just_to_see3 :
- object method child : gadt -> child2 method previous : child2 option end
+ object method child : gadt -> child1 method previous : child1 option end
|}]
class leading_up_to = object(self : 'a)
5 | inherit child1 self
6 | inherit child2
7 | end
-Error: Cannot close type of object literal:
- < child : '_weak1; previous : 'a option; _.. > as 'a
- it has been unified with the self type of a class that is not yet
- completely defined.
+Error: This object has undeclared virtual methods.
+ The following methods were not declared : previous child
|}]
class assertion_failure = object(self : 'a)
9 | method child = assert false
10 | end
Error: Cannot close type of object literal:
- < child : '_weak2; previous : 'a option; _.. > as 'a
+ < child : '_weak1; previous : 'a option; _.. > as 'a
it has been unified with the self type of a class that is not yet
completely defined.
|}]
+
+(* MPR#7894 and variations *)
+class parameter_contains_self app = object(self)
+ method invalidate : unit =
+ app#redrawWidget self
+end;;
+[%%expect{|
+class parameter_contains_self :
+ < redrawWidget : 'a -> unit; .. > ->
+ object ('a) method invalidate : unit end
+|}]
+
+class closes_via_inheritance param =
+ let _ = new parameter_contains_self param in object
+ inherit parameter_contains_self param
+ end;;
+[%%expect{|
+Line 3, characters 36-41:
+3 | inherit parameter_contains_self param
+ ^^^^^
+Error: This expression has type
+ < redrawWidget : parameter_contains_self -> unit; .. >
+ but an expression was expected of type
+ < redrawWidget : < invalidate : unit; .. > -> unit; .. >
+ Type parameter_contains_self = < invalidate : unit >
+ is not compatible with type < invalidate : unit; .. >
+ Self type cannot be unified with a closed object type
+|}]
+
+class closes_via_application param =
+ let _ = new parameter_contains_self param in
+ parameter_contains_self param;;
+[%%expect{|
+Line 3, characters 26-31:
+3 | parameter_contains_self param;;
+ ^^^^^
+Error: This expression has type
+ < redrawWidget : parameter_contains_self -> unit; .. >
+ but an expression was expected of type
+ < redrawWidget : < invalidate : unit; .. > -> unit; .. >
+ Type parameter_contains_self = < invalidate : unit >
+ is not compatible with type < invalidate : unit; .. >
+ Self type cannot be unified with a closed object type
+|}]
+
+let escapes_via_inheritance param =
+ let module Local = struct
+ class c = object
+ inherit parameter_contains_self param
+ end
+ end in
+ ();;
+[%%expect{|
+Line 4, characters 38-43:
+4 | inherit parameter_contains_self param
+ ^^^^^
+Error: This expression has type 'a but an expression was expected of type
+ < redrawWidget : < invalidate : unit; .. > -> unit; .. >
+ Self type cannot escape its class
+|}]
+
+let escapes_via_application param =
+ let module Local = struct
+ class c = parameter_contains_self param
+ end in
+ ();;
+[%%expect{|
+Line 3, characters 38-43:
+3 | class c = parameter_contains_self param
+ ^^^^^
+Error: This expression has type 'a but an expression was expected of type
+ < redrawWidget : < invalidate : unit; .. > -> unit; .. >
+ Self type cannot escape its class
+|}]
+
+let can_close_object_via_inheritance param =
+ let _ = new parameter_contains_self param in object
+ inherit parameter_contains_self param
+ end;;
+[%%expect{|
+Line 3, characters 36-41:
+3 | inherit parameter_contains_self param
+ ^^^^^
+Error: This expression has type
+ < redrawWidget : parameter_contains_self -> unit; .. >
+ but an expression was expected of type
+ < redrawWidget : < invalidate : unit; .. > -> unit; .. >
+ Type parameter_contains_self = < invalidate : unit >
+ is not compatible with type < invalidate : unit; .. >
+ Self type cannot be unified with a closed object type
+|}]
+
+let can_escape_object_via_inheritance param = object
+ inherit parameter_contains_self param
+ end;;
+[%%expect{|
+val can_escape_object_via_inheritance :
+ < redrawWidget : parameter_contains_self -> unit; .. > ->
+ parameter_contains_self = <fun>
+|}]
+
+let can_close_object_explicitly = object (_ : < i : int >)
+ method i = 5
+end;;
+[%%expect{|
+val can_close_object_explicitly : < i : int > = <obj>
+|}]
+
+let cannot_close_object_explicitly_with_inheritance = object
+ inherit object (_ : < i : int >)
+ method i = 5
+ end
+end;;
+[%%expect{|
+Line 2, characters 17-34:
+2 | inherit object (_ : < i : int >)
+ ^^^^^^^^^^^^^^^^^
+Error: This pattern cannot match self: it only matches values of type
+ < i : int >
+|}]
+
+class closes_after_constraint =
+ ((fun (x : 'a) -> object (_:'a) end) : 'a -> object('a) end) (object end);;
+[%%expect{|
+Line 2, characters 63-75:
+2 | ((fun (x : 'a) -> object (_:'a) end) : 'a -> object('a) end) (object end);;
+ ^^^^^^^^^^^^
+Error: This expression has type < > but an expression was expected of type
+ < .. >
+ Self type cannot be unified with a closed object type
+|}];;
+
+class type ['a] ct = object ('a) end
+class type closes_via_application = [ <m : int> ] ct;;
+[%%expect{|
+class type ['a] ct = object ('a) constraint 'a = < .. > end
+Line 2, characters 38-47:
+2 | class type closes_via_application = [ <m : int> ] ct;;
+ ^^^^^^^^^
+Error: The type parameter < m : int >
+ does not meet its constraint: it should be < .. >
+ Self type cannot be unified with a closed object type
+|}];;
contains non-collapsible conjunctive types in constraints.
Type int is not compatible with type float
|}]
+
+class type ct = object
+ method x : int
+end
+
+class c (y : 'a * float) : ct = object
+ method x = y
+end
+[%%expect{|
+class type ct = object method x : int end
+Lines 5-7, characters 32-3:
+5 | ................................object
+6 | method x = y
+7 | end
+Error: The class type object method x : 'a * float end
+ is not matched by the class type ct
+ The class type object method x : 'a * float end
+ is not matched by the class type object method x : int end
+ The method x has type 'a * float but is expected to have type int
+ Type 'a * float is not compatible with type int
+|}]
+
+let foo = 42#m;;
+[%%expect{|
+Line 1, characters 10-12:
+1 | let foo = 42#m;;
+ ^^
+Error: This expression is not an object; it has type int
+|}]
+
+let foo = object (self) method foo = self#bar end;;
+[%%expect{|
+Line 1, characters 37-41:
+1 | let foo = object (self) method foo = self#bar end;;
+ ^^^^
+Error: This expression has no method bar
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type _ t = Int : int t;;
+[%%expect{|
+type _ t = Int : int t
+|}]
+
+let o =
+ object (self)
+ method private x = 3
+ method m : type a. a t -> a = fun Int -> (self#x : int)
+ end;;
+[%%expect{|
+val o : < m : 'a. 'a t -> 'a > = <obj>
+|}]
+
+let o' =
+ object (self : 's)
+ method private x = 3
+ method m : type a. a t -> 's -> a = fun Int other -> (other#x : int)
+ end;;
+
+let aargh = assert (o'#m Int o' = 3);;
+[%%expect{|
+Lines 2-5, characters 2-5:
+2 | ..object (self : 's)
+3 | method private x = 3
+4 | method m : type a. a t -> 's -> a = fun Int other -> (other#x : int)
+5 | end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o' : < m : 'a. 'a t -> 'b -> 'a; x : int > as 'b = <obj>
+val aargh : unit = ()
+|}]
+
+let o2 =
+ object (self : 's)
+ method private x = 3
+ method m : 's -> int = fun other -> (other#x : int)
+ end;;
+[%%expect{|
+Lines 2-5, characters 2-5:
+2 | ..object (self : 's)
+3 | method private x = 3
+4 | method m : 's -> int = fun other -> (other#x : int)
+5 | end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o2 : < m : 'a -> int; x : int > as 'a = <obj>
+|}]
+
+let o3 =
+ object (self : 's)
+ method private x = 3
+ method m : 's -> int = fun other ->
+ let module M = struct let other = other end in (M.other#x : int)
+ end;;
+
+let aargh = assert (o3#m o3 = 3);;
+[%%expect{|
+Lines 2-6, characters 2-5:
+2 | ..object (self : 's)
+3 | method private x = 3
+4 | method m : 's -> int = fun other ->
+5 | let module M = struct let other = other end in (M.other#x : int)
+6 | end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o3 : < m : 'a -> int; x : int > as 'a = <obj>
+val aargh : unit = ()
+|}]
^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Some type variables are unbound in this type:
class base : 'e -> ['e] t
- The method update has type 'e -> < update : 'a; .. > as 'a where 'e
- is unbound
+ The method update has type 'e -> #base where 'e is unbound
|}];;
^
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 'a. 'a
- The universal variable 'a would escape its scope
+ The method b has type 'a, but the expected method type was 'a0. 'a0
+ The universal variable 'a0 would escape its scope
|}]
5 | ..........(object
6 | method f _ = 0
7 | end)..
-Error: This expression has type < f : 'a -> int >
+Error: This expression has type < f : 'b -> int >
but an expression was expected of type t_a
- The method f has type 'a -> int, but the expected method type was
+ The method f has type 'b -> int, but the expected method type was
'a. 'a -> int
The universal variable 'a would escape its scope
|}
Line 4, characters 11-49:
4 | let () = f ( `A (object method f _ = 0 end): _ v);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type 'a v but an expression was expected of type
+Error: This expression has type 'b v but an expression was expected of type
uv
- The method f has type 'a -> int, but the expected method type was
+ The method f has type 'b -> int, but the expected method type was
'a. 'a -> int
The universal variable 'a would escape its scope
|}]
Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
n.
val f : unit -> < m : int; n : int > = <fun>
-Line 5, characters 11-56:
+Line 5, characters 27-39:
5 | let f () = object (self:c) method n = 1 method m = 2 end;;
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This object is expected to have type c but actually has type
- < m : int; n : 'a >
- The first object type has no method n
+ ^^^^^^^^^^^^
+Error: This object is expected to have type : c
+ This type does not have a method n.
|}];;
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 * (< m : 'a * < m : 'c. 'c * 'b > > as 'b),
+ 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd),
but the expected method type was
- 'c. 'c * < m : 'a * < m : 'c. 'b > > as 'b
+ 'c. 'c * < m : 'a * < m : 'c. 'e > > as 'e
The universal variable 'a would escape its scope
|}];;
val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit
is not included in
val f : < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > -> unit
+ The type (< m : 'a. 'a * ('a * 'd) > as 'd) -> unit
+ is not compatible with the type
+ < m : 'b. 'b * ('b * < m : 'c. 'c * 'e > as 'e) > -> unit
+ The method m has type 'a. 'a * ('a * < m : 'a. 'f >) as 'f,
+ but the expected method type was 'c. 'c * ('b * < m : 'c. 'g >) as 'g
+ The universal variable 'b would escape its scope
|}];;
module M : sig type 'a t type u = <m: 'a. 'a t> end
3 | :> <m:'b. (<p:int;q:int;..> as 'b) -> int>)..
Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of
< m : 'b. (< p : int; q : int; .. > as 'b) -> int >
- Type < p : int; q : int; .. > as 'c is not a subtype of
- < p : int; .. > as 'd
+ Type < p : int; q : int; .. > is not a subtype of < p : int; .. >
|}];;
(* Keep sharing the epsilons *)
is not included in
val f :
< m : 'a. [< `Bar | `Foo of 'b & int ] as 'c > -> < m : 'b. 'c >
+ The type
+ < m : 'a. [< `Bar | `Foo of 'b & int ] as 'c > -> < m : 'b. 'c >
+ is not compatible with the type
+ < m : 'a. [< `Bar | `Foo of 'b & int ] as 'd > -> < m : 'b. 'd >
+ Types for tag `Foo are incompatible
|}]
(* PR#6171 *)
^
Error: This expression has type u but an expression was expected of type v
The method m has type 'a s list * < m : 'b > as 'b,
- but the expected method type was 'a. 'a s list * < m : 'a. 'b > as 'b
+ but the expected method type was 'a. 'a s list * < m : 'a. 'c > as 'c
The universal variable 'a would escape its scope
|}]
val write : _[< `A of '_weak2 | `B of '_weak3 ] -> unit
is not included in
val write : [< `A of string | `B of int ] -> unit
+ The type _[< `A of '_weak2 | `B of '_weak3 ] -> unit
+ is not compatible with the type [< `A of string | `B of int ] -> unit
+ Type _[< `A of '_weak2 | `B of '_weak3 ] is not compatible with type
+ [< `A of string | `B of int ]
|}]
type t = M2.t
is not included in
type t = private M3.t
+ The type M2.t is not equal to the type M3.t
Line 1, characters 44-45:
1 | module M4 : sig type t = private M3.t end = M;; (* fails *)
^
type t = < m : int >
is not included in
type t = private M3.t
+ The type < m : int > is not equal to the type M3.t
Line 1, characters 44-46:
1 | module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
^^
type t = M1.t
is not included in
type t = private M3.t
+ The type M1.t is not equal to the type M3.t
module M5 : sig type t = private M1.t end
Line 1, characters 53-55:
1 | module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
type t = M1.t
is not included in
type t = private < n : int; .. >
+ The implementation is missing the method n
Line 3, characters 2-51:
3 | struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
type t = int
is not included in
type t = private Foobar.t
+ The type int is not equal to the type Foobar.t
module M : sig type t = private T of int val mk : int -> t end
module M1 : sig type t = M.t val mk : int -> t end
module M2 : sig type t = M.t val mk : int -> t end
3 | type t = M.t = T of int
^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
- A private type would be revealed.
+ Private variant constructor(s) would be revealed.
module M5 : sig type t = M.t = private T of int val mk : int -> t end
module M6 : sig type t = private T of int val mk : int -> t end
module M' :
type !'a t = private 'a constraint 'a = < x : int; .. >
is not included in
type 'a t
- Their constraints differ.
+ Their parameters differ
+ The type < x : int; .. > is not equal to the type 'a
type 'a t = private 'a constraint 'a = < x : int; .. >
type t = [ `Closed ]
type nonrec t = private [> t ]
type t = M2.t
is not included in
type t = private M3.t
+ The type M2.t is not equal to the type M3.t
Line 1, characters 44-45:
1 | module M4 : sig type t = private M3.t end = M;; (* fails *)
^
type t = < m : int >
is not included in
type t = private M3.t
+ The type < m : int > is not equal to the type M3.t
Line 1, characters 44-46:
1 | module M4 : sig type t = private M3.t end = M1;; (* might be ok *)
^^
type t = M1.t
is not included in
type t = private M3.t
+ The type M1.t is not equal to the type M3.t
module M5 : sig type t = private M1.t end
Line 1, characters 53-55:
1 | module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *)
type t = M1.t
is not included in
type t = private < n : int; .. >
+ The implementation is missing the method n
Line 3, characters 2-51:
3 | struct type t = int let f (x : int) = (x : t) end;; (* must fail *)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
type t = int
is not included in
type t = private Foobar.t
+ The type int is not equal to the type Foobar.t
module M : sig type t = private T of int val mk : int -> t end
module M1 : sig type t = M.t val mk : int -> t end
module M2 : sig type t = M.t val mk : int -> t end
3 | type t = M.t = T of int
^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
- A private type would be revealed.
+ Private variant constructor(s) would be revealed.
module M5 : sig type t = M.t = private T of int val mk : int -> t end
module M6 : sig type t = private T of int val mk : int -> t end
module M' :
type !'a t = private < x : int; .. > constraint 'a = 'a t
is not included in
type 'a t
- Their constraints differ.
+ Their parameters differ
+ The type 'b t as 'b is not equal to the type 'a
type 'a t = private 'a constraint 'a = < x : int; .. >
type t = [ `Closed ]
type nonrec t = private [> t ]
type t = int
is not included in
type t = string
+ The type t is not equal to the type string
module A : sig module B : sig type t = T end end
module M2 : sig type u = A.B.t type foo = int type v = u end
module type PR6566 = sig type t = string end;;
module PR6566 = struct type t = int end;;
module PR6566' : PR6566 = PR6566;;
+(* Short-paths is currently a bit overzealous with this error message: we print
+ "The type t is not equal to the type string" instead of "The type int is not
+ equal to the type string". This is correct, but less clear than it could
+ be. *)
module A = struct module B = struct type t = T end end;;
module M2 = struct type u = A.B.t type foo = int type v = A.B.t end;;
Line 3, characters 2-36:
3 | include Comparable with type t = t
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Illegal shadowing of included type t/98 by t/102
+Error: Illegal shadowing of included type t/284 by t/289
Line 2, characters 2-19:
- Type t/98 came from this include
+ Type t/284 came from this include
Line 3, characters 2-23:
- The value print has no valid type if t/98 is shadowed
+ The value print has no valid type if t/284 is shadowed
|}]
module type Sunderscore = sig
type elt = String.t
is not included in
type elt = unit
+ The type String.t = string is not equal to the type unit
File "test_loc_type_eq.ml", line 1, characters 31-46:
Expected declaration
File "test_functor.ml", line 8, characters 45-61: Actual declaration
type elt = String.t
is not included in
type elt = unit
+ The type String.t = string is not equal to the type unit
File "test_loc_modtype_type_eq.ml", line 1, characters 36-51:
Expected declaration
File "test_functor.ml", line 8, characters 45-61: Actual declaration
val create : elt -> t
is not included in
val create : unit -> t
+ The type elt -> t is not compatible with the type unit -> t
+ Type elt = string is not compatible with type unit
File "test_loc_type_subst.ml", line 1, characters 11-47:
Expected declaration
File "test_functor.ml", line 5, characters 2-23: Actual declaration
val create : elt -> t
is not included in
val create : unit -> t
+ The type elt -> t is not compatible with the type unit -> t
+ Type elt = string is not compatible with type unit
File "test_loc_modtype_type_subst.ml", line 1, characters 16-52:
Expected declaration
File "test_functor.ml", line 5, characters 2-23: Actual declaration
external f : int -> (int [@untagged]) = "f" "f_nat"
is not included in
external f : int -> int = "f" "f_nat"
+ The two primitives' results have different representations
|}]
module Bad2 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : (int [@untagged]) -> int = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : (int [@untagged]) -> int = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : (int [@untagged]) -> int = "f" "f_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : (int [@untagged]) -> int = "f" "f_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The two primitives' 1st arguments have different representations
+|}]
+
+module Bad3 : sig
external f : int -> int = "a" "a_nat"
end = struct
external f : (int [@untagged]) -> int = "f" "f_nat"
external f : (int [@untagged]) -> int = "f" "f_nat"
is not included in
external f : int -> int = "a" "a_nat"
+ The names of the primitives are not the same
|}]
-module Bad3 : sig
+module Bad4 : sig
external f : float -> float = "f" "f_nat"
end = struct
external f : float -> (float [@unboxed]) = "f" "f_nat"
external f : float -> (float [@unboxed]) = "f" "f_nat"
is not included in
external f : float -> float = "f" "f_nat"
+ The two primitives' results have different representations
|}]
-module Bad4 : sig
+module Bad5 : sig
+ external f : float -> float = "f" "f_nat"
+end = struct
+ external f : (float [@unboxed]) -> float = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : (float [@unboxed]) -> float = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : (float [@unboxed]) -> float = "f" "f_nat" end
+ is not included in
+ sig external f : float -> float = "f" "f_nat" end
+ Values do not match:
+ external f : (float [@unboxed]) -> float = "f" "f_nat"
+ is not included in
+ external f : float -> float = "f" "f_nat"
+ The two primitives' 1st arguments have different representations
+|}]
+
+module Bad6 : sig
external f : float -> float = "a" "a_nat"
end = struct
external f : (float [@unboxed]) -> float = "f" "f_nat"
external f : (float [@unboxed]) -> float = "f" "f_nat"
is not included in
external f : float -> float = "a" "a_nat"
+ The names of the primitives are not the same
+|}]
+
+module Bad7 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : int -> int = "f" "f_nat" [@@noalloc]
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "f" "f_nat" [@@noalloc]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "f" "f_nat" [@@noalloc] end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int = "f" "f_nat" [@@noalloc]
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The first primitive is [@@noalloc] but the second is not
|}]
(* Bad: attributes in the interface but not in the implementation *)
-module Bad5 : sig
+module Bad8 : sig
external f : int -> (int [@untagged]) = "f" "f_nat"
end = struct
external f : int -> int = "f" "f_nat"
external f : int -> int = "f" "f_nat"
is not included in
external f : int -> (int [@untagged]) = "f" "f_nat"
+ The two primitives' results have different representations
|}]
-module Bad6 : sig
+module Bad9 : sig
+ external f : (int [@untagged]) -> int = "f" "f_nat"
+end = struct
+ external f : int -> int = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "f" "f_nat" end
+ is not included in
+ sig external f : (int [@untagged]) -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int = "f" "f_nat"
+ is not included in
+ external f : (int [@untagged]) -> int = "f" "f_nat"
+ The two primitives' 1st arguments have different representations
+|}]
+
+module Bad10 : sig
external f : (int [@untagged]) -> int = "f" "f_nat"
end = struct
external f : int -> int = "a" "a_nat"
external f : int -> int = "a" "a_nat"
is not included in
external f : (int [@untagged]) -> int = "f" "f_nat"
+ The names of the primitives are not the same
|}]
-module Bad7 : sig
+module Bad11 : sig
external f : float -> (float [@unboxed]) = "f" "f_nat"
end = struct
external f : float -> float = "f" "f_nat"
external f : float -> float = "f" "f_nat"
is not included in
external f : float -> (float [@unboxed]) = "f" "f_nat"
+ The two primitives' results have different representations
|}]
-module Bad8 : sig
+module Bad12 : sig
+ external f : (float [@unboxed]) -> float = "f" "f_nat"
+end = struct
+ external f : float -> float = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : float -> float = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : float -> float = "f" "f_nat" end
+ is not included in
+ sig external f : (float [@unboxed]) -> float = "f" "f_nat" end
+ Values do not match:
+ external f : float -> float = "f" "f_nat"
+ is not included in
+ external f : (float [@unboxed]) -> float = "f" "f_nat"
+ The two primitives' 1st arguments have different representations
+|}]
+
+module Bad13 : sig
external f : (float [@unboxed]) -> float = "f" "f_nat"
end = struct
external f : float -> float = "a" "a_nat"
external f : float -> float = "a" "a_nat"
is not included in
external f : (float [@unboxed]) -> float = "f" "f_nat"
+ The names of the primitives are not the same
+|}]
+
+module Bad14 : sig
+ external f : int -> int = "f" "f_nat" [@@noalloc]
+end = struct
+ external f : int -> int = "f" "f_nat"
+end;;
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "f" "f_nat"
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "f" "f_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" [@@noalloc] end
+ Values do not match:
+ external f : int -> int = "f" "f_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat" [@@noalloc]
+ The second primitive is [@@noalloc] but the first is not
+|}]
+
+(* Bad: claiming something is a primitive when it isn't *)
+
+module Bad15 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ let f x = x + 1
+end
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f x = x + 1
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : int -> int end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ val f : int -> int
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The implementation is not a primitive.
+|}]
+
+(* Good: not claiming something is a primitive when it is *)
+
+module Good16 : sig
+ val f : int -> int
+end = struct
+ external f : int -> int = "f" "f_nat"
+end
+(* The expected error here is that "f" isn't defined -- that means typechecking
+ succeeded *)
+
+[%%expect{|
+Line 1:
+Error: The external function `f' is not available
+|}]
+
+(* Bad: mismatched names and native names *)
+
+module Bad17 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : int -> int = "gg" "f_nat"
+end
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "gg" "f_nat"
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "gg" "f_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int = "gg" "f_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The names of the primitives are not the same
+|}]
+
+module Bad18 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : int -> int = "f" "gg_nat"
+end
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "f" "gg_nat"
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "f" "gg_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int = "f" "gg_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The native names of the primitives are not the same
+|}]
+
+module Bad19 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : int -> int = "gg" "gg_nat"
+end
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int = "gg" "gg_nat"
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int = "gg" "gg_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int = "gg" "gg_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The names of the primitives are not the same
+|}]
+
+(* Bad: mismatched arities *)
+
+(* NB: The compiler checks primitive arities *syntactically*, based on the
+ number of arrows it sees. Thus, hiding function types behind type synonyms
+ will produce an error about the primitive arities not matching, even when the
+ types agree. *)
+
+module Bad20 : sig
+ type int_int := int -> int
+ external f : int -> int_int = "f" "f_nat"
+end = struct
+ external f : int -> int -> int = "f" "f_nat"
+end
+
+[%%expect{|
+Lines 4-6, characters 6-3:
+4 | ......struct
+5 | external f : int -> int -> int = "f" "f_nat"
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int -> int = "f" "f_nat" end
+ is not included in
+ sig external f : int -> int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int -> int = "f" "f_nat"
+ is not included in
+ external f : int -> int -> int = "f" "f_nat"
+ The syntactic arities of these primitives were not the same.
+ (They must have the same number of arrows present in the source.)
+|}]
+
+module Bad21 : sig
+ external f : int -> int -> int = "f" "f_nat"
+end = struct
+ type int_int = int -> int
+ external f : int -> int_int = "f" "f_nat"
+end
+
+[%%expect{|
+Lines 3-6, characters 6-3:
+3 | ......struct
+4 | type int_int = int -> int
+5 | external f : int -> int_int = "f" "f_nat"
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ type int_int = int -> int
+ external f : int -> int_int = "f" "f_nat"
+ end
+ is not included in
+ sig external f : int -> int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int_int = "f" "f_nat"
+ is not included in
+ external f : int -> int -> int = "f" "f_nat"
+ The syntactic arities of these primitives were not the same.
+ (They must have the same number of arrows present in the source.)
+|}]
+
+(* This will fail with a *type* error, instead of an arity mismatch *)
+module Bad22 : sig
+ external f : int -> int = "f" "f_nat"
+end = struct
+ external f : int -> int -> int = "f" "f_nat"
+end
+
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | external f : int -> int -> int = "f" "f_nat"
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig external f : int -> int -> int = "f" "f_nat" end
+ is not included in
+ sig external f : int -> int = "f" "f_nat" end
+ Values do not match:
+ external f : int -> int -> int = "f" "f_nat"
+ is not included in
+ external f : int -> int = "f" "f_nat"
+ The type int -> int -> int is not compatible with the type int -> int
+ Type int -> int is not compatible with type int
|}]
(* Bad: unboxed or untagged with the wrong type *)
2 | | ((Val x, _) | (_, Val x)) when x < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 11.5)
+variable x appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous_typical_example : expr * expr -> unit = <fun>
|}]
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 11.5)
+variable y appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__y : [> `B of 'a * bool option * bool option ] -> unit = <fun>
|}]
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 11.5)
+variable y appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__x_y : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
2 | | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables y,z may match different arguments. (See manual section 11.5)
+variables y, z appear in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__x_y_z : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
2 | | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 11.5)
+variable x appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__in_depth :
[> `A of [> `B of bool option * bool option ] ] -> unit = <fun>
|}]
2 | ....`A ((`B (Some x, _) | `B (_, Some x)),
3 | (`C (Some y, Some _, _) | `C (Some y, _, Some _))).................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 11.5)
+variable x appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__first_orpat :
[> `A of
[> `B of 'a option * 'a option ] *
2 | ....`A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
3 | (`C (Some y, _) | `C (_, Some y))).................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 11.5)
+variable y appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__second_orpat :
[> `A of
[> `B of 'a option * 'b option * 'c option ] *
2 | ..X (Z x,Y (y,0))
3 | | X (Z y,Y (x,_))
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 11.5)
+variables x, y appear in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__amoi : amoi -> int = <fun>
|}]
2 | ....(module M:S),_,(1,_)
3 | | _,(module M:S),(_,1)...................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable M may match different arguments. (See manual section 11.5)
+variable M appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
|}]
2 | | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 11.5)
+variables x, y appear in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
<fun>
|}, Principal{|
2 | | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 11.5)
+variables x, y appear in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
<fun>
|}]
3 | | ((Val y, _) | (_, Val y)) when y < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 11.5)
+variable y appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val guarded_ambiguity : expr * expr -> unit = <fun>
|}]
4 | | ((Val x, _) | (_, Val x)) when pred x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 11.5)
+variable x appears in different places in different or-pattern alternatives.
+Only the first match will be used to evaluate the guard expression.
+(See manual section 11.5)
val cmp : (a -> bool) -> a alg -> a alg -> unit = <fun>
|}]
--- /dev/null
+(* TEST
+ flags = " -w +A "
+ * expect
+*)
+
+class c = object
+
+ val a =
+ let b = 5 in ()
+ [@@warning "-26"]
+
+ val x =
+ let y = 5 in ()
+
+end;;
+[%%expect {|
+Line 8, characters 8-9:
+8 | let y = 5 in ()
+ ^
+Warning 26 [unused-var]: unused variable y.
+class c : object val a : unit val x : unit end
+|}];;
+
+class c = object
+
+ method a =
+ let b = 5 in ()
+ [@@warning "-26"]
+
+ method x =
+ let y = 5 in ()
+
+end;;
+[%%expect {|
+Line 8, characters 8-9:
+8 | let y = 5 in ()
+ ^
+Warning 26 [unused-var]: unused variable y.
+class c : object method a : unit method x : unit end
+|}];;
+
+class c = object
+
+ initializer
+ let b = 5 in ()
+ [@@warning "-26"]
+
+ initializer
+ let y = 5 in ()
+
+end;;
+[%%expect {|
+Line 8, characters 8-9:
+8 | let y = 5 in ()
+ ^
+Warning 26 [unused-var]: unused variable y.
+class c : object end
+|}];;
+
+class c = (object
+
+ val a =
+ let b = 5 in ()
+
+end [@warning "-26"])
+[%%expect {|
+class c : object val a : unit end
+|}];;
+
+class c = object
+
+ val a =
+ let b = 5 in ()
+
+ [@@@warning "-26"]
+
+ val x =
+ let y = 5 in ()
+
+end;;
+[%%expect {|
+Line 4, characters 8-9:
+4 | let b = 5 in ()
+ ^
+Warning 26 [unused-var]: unused variable b.
+class c : object val a : unit val x : unit end
+|}];;
+
+type dep
+[@@deprecated "deprecated"]
+
+class type c = object
+
+ val a : dep
+ [@@warning "-3"]
+
+ val x : dep
+
+end;;
+[%%expect {|
+type dep
+Line 9, characters 10-13:
+9 | val x : dep
+ ^^^
+Alert deprecated: dep
+deprecated
+class type c = object val a : dep val x : dep end
+|}];;
+
+class type c = object
+
+ method a : dep
+ [@@warning "-3"]
+
+ method x : dep
+
+end;;
+[%%expect {|
+Line 6, characters 13-16:
+6 | method x : dep
+ ^^^
+Alert deprecated: dep
+deprecated
+class type c = object method a : dep method x : dep end
+|}];;
+
+class type c = object [@warning "-3"]
+
+ val a : dep
+
+end
+[%%expect {|
+class type c = object val a : dep end
+|}];;
+
+class type c = object
+
+ val a : dep
+
+ [@@@warning "-3"]
+
+ val x : dep
+
+end;;
+[%%expect {|
+Line 3, characters 10-13:
+3 | val a : dep
+ ^^^
+Alert deprecated: dep
+deprecated
+class type c = object val a : dep val x : dep end
+|}];;
val f : fpclass -> Stdlib.fpclass
is not included in
val f : fpclass -> fpclass
+ The type fpclass -> Stdlib.fpclass is not compatible with the type
+ fpclass -> fpclass
+ Type Stdlib.fpclass is not compatible with type fpclass
|}]
module G (X : sig val x : int end) = X
module H (X : sig val x : int end) = X
+
+module type S = sig
+ module F: sig val x : int end -> sig end
+end
module G (X : sig val x : int end) : sig end
module H (X : sig val x : int end) : sig val x : int end
+
+module type S = sig
+ module F: sig val x : int end -> sig end
+end
val sys_readdir : string -> string list = <fun>
val test_readdir : (string -> string list) -> string list = <fun>
val test_open_in : unit -> string list = <fun>
-val test_getenv : unit -> (string * string) list = <fun>
+val test_getenv : unit -> ((string * string) * (string * string)) list =
+ <fun>
val test_mkdir : unit -> (bool * bool) list = <fun>
val test_chdir : (string -> unit) -> (unit -> 'a) -> 'a list = <fun>
val test_rmdir : unit -> bool list = <fun>
val t_sys_chdir : string list = ["été"; "simple"; "sœur"; "你好"]
val t_unix_chdir : string list = ["été"; "simple"; "sœur"; "你好"]
- : bool list = [false; false; false; false]
-val t_getenv : (string * string) list =
- [("верблюды", "верблюды"); ("骆驼", "骆驼");
- ("קעמל", "קעמל"); ("اونٹ", "اونٹ")]
+val t_getenv : ((string * string) * (string * string)) list =
+ [(("верблюды", "верблюды"),
+ ("верблюдыверблюды", "верблюдыверблюды"));
+ (("骆驼", "骆驼"), ("骆驼骆驼", "骆驼骆驼"));
+ (("קעמל", "קעמל"), ("קעמלקעמל", "קעמלקעמל"));
+ (("اونٹ", "اونٹ"), ("اونٹاونٹ", "اونٹاونٹ"))]
- : bool = true
;;
let test_getenv () =
+ let equiv l r =
+ assert (l = r);
+ l, r
+ in
let doit key s =
Unix.putenv key s;
- Sys.getenv key, getenvironmentenv key
+ let l = equiv (Sys.getenv key) (getenvironmentenv key) in
+ let r =
+ Unix.putenv key (s ^ s);
+ equiv (Sys.getenv key) (getenvironmentenv key)
+ in
+ l, r
in
List.map2 doit foreign_names foreign_names2
;;
end;
Compmisc.init_path ();
Toploop.initialize_toplevel_env ();
- Sys.interactive := false;
+ (* We are in interactive mode and should record directive error on stdout *)
+ Sys.interactive := true;
process_expect_file fname;
exit 0
No_CSE;
]
else [ Reduce_code_size ];
+ fun_poll = Lambda.Default_poll;
fun_dbg = debuginfo ()} }
;
fun_name:
Debuginfo.none) }
| LPAREN FLOATAREF expr expr RPAREN
{ let open Asttypes in
- Cop(Cload (Double_u, Mutable), [access_array $3 $4 Arch.size_float],
+ Cop(Cload (Double, Mutable), [access_array $3 $4 Arch.size_float],
Debuginfo.none) }
| LPAREN ADDRASET expr expr expr RPAREN
{ let open Lambda in
[access_array $3 $4 Arch.size_int; $5], Debuginfo.none) }
| LPAREN FLOATASET expr expr expr RPAREN
{ let open Lambda in
- Cop(Cstore (Double_u, Assignment),
+ Cop(Cstore (Double, Assignment),
[access_array $3 $4 Arch.size_float; $5], Debuginfo.none) }
;
exprlist:
| ADDR { Word_val }
| FLOAT32 { Single }
| FLOAT64 { Double }
- | FLOAT { Double_u }
+ | FLOAT { Double }
| VAL { Word_val }
;
unaryop:
objinfo.cmo : \
../bytecomp/symtable.cmi \
../middle_end/symbol.cmi \
+ ../typing/shape.cmi \
../middle_end/printclambda.cmi \
../utils/misc.cmi \
../middle_end/linkage_name.cmi \
objinfo.cmx : \
../bytecomp/symtable.cmx \
../middle_end/symbol.cmx \
+ ../typing/shape.cmx \
../middle_end/printclambda.cmx \
../utils/misc.cmx \
../middle_end/linkage_name.cmx \
-e '/-runstatedir /{N;N;N;N;N;N;N;N;d;}' \
-e '/--runstatedir=DIR/d' \
-e 's/ runstatedir//' \
+ -e '/split(line, arg/s|" "|/[ \\r\\t]/|' \
+ -e '/define|undef/s/|\\\$/|\\r?\\$/' \
-e '1d' \
configure >> configure.tmp
| Underline ->
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
- transform in a list of transforms *)
- type partition = U of t * t list | E of t
- let check_partition line file l =
- let init = ellipsis 0 0 in
- let rec partition = function
- | [] -> []
- | {kind=Underline; _ } as t :: q -> underline t [] q
- | {kind=Ellipsis; _ } as t :: q -> E t :: partition q
- and underline u n = function
- | [] -> end_underline u n []
- | {kind=Underline; _ } :: _ as q -> end_underline u n q
- | {kind=Ellipsis; _ } as t :: q ->
- if t.stop < u.stop then underline u (t::n) q
- else end_underline u n (t::q)
- and end_underline u n l = U(u,List.rev n) :: partition l in
- let check_elt last t =
- if t.start < last.stop then
- raise (Intersection {line;file; left = last; right = t})
- else
- t in
- let check acc = function
- | E t -> check_elt acc t
- | U(u,n) ->
- let _ = check_elt acc u in
- let _ = List.fold_left ~f:check_elt ~init n in
- u in
- List.fold_left ~f:check ~init (partition l)
- |> ignore
+ (** Merge consecutive transforms:
+ - drop nested underline transform
+ - raise an error with transforms nested under an ellipsis
+ - raise an error when consecutive transforms partially overlap
+ *)
+ let merge_transforms file line ts =
+ let rec merge (active, active_stack, acc) t =
+ if active.stop <= t.start then
+ (* no overlap, the next transform starts after the end of the current
+ active transform *)
+ match active_stack with
+ | [] ->
+ (* there were no other active transforms, the new transform becomes
+ the active one *)
+ t, [], t :: acc
+ | last :: active_stack ->
+ (* we check that [t] is still conflict-free with our parent
+ transforms *)
+ merge (last, active_stack,acc) t
+ else if active.stop < t.stop (* not nested *) then
+ raise (Intersection {line; file; left = active; right=t})
+ else (* nested transforms *)
+ match active.kind, t.kind with
+ | Ellipsis, _ -> (* no nesting allowed under an ellipsis *)
+ raise (Intersection {line; file; left = active; right=t})
+ | Underline, Ellipsis -> (* underlined ellipsis are allowed *)
+ (t , active :: active_stack, t :: acc)
+ | Underline, Underline ->
+ (* multiple underlining are flattened to one *)
+ (t, active :: active_stack, acc)
+ in
+ match ts with
+ | [] -> []
+ | a :: q ->
+ let _, _, ts = List.fold_left ~f:merge ~init:(a,[],[a]) q in
+ List.rev ts
let apply ts file line s =
(* remove duplicated transforms that can appear due to
for the two ellipses. *)
let ts = List.sort_uniq compare ts in
let ts = List.sort (fun x y -> compare x.start y.start) ts in
- check_partition line file ts;
+ let ts = merge_transforms file line ts in
let last, underline, ls =
List.fold_left ~f:(apply_transform s) ~init:(0,None,[]) ts in
let last, ls = match underline with
#* *
#**************************************************************************
-# stop early if we are not on a development version
-grep -Fq '+dev' VERSION || exit 0
-
# We try to warn if the user edits parsing/parser.mly but forgets to
# rebuild the generated parser. Our heuristic is to use the file
# modification timestamp, but just testing
echo "INFO: pruned path $2 (.git)" >&2
exit 0;;
esac
+ if git check-ignore -q "$2"; then
+ exit 0
+ fi
if test -n "$(check_prune "$2")"; then
echo "INFO: pruned path $2 (typo.prune)" >&2
exit 0
*$f*) is_cmd_line=true;;
*) is_cmd_line=false;;
esac
+ if $path_in_index || $is_cmd_line; then :; else continue; fi
if [ -z "$OCAML_CT_PREFIX" ] ; then
if [ -x "$f" ] ; then
check_script "$f"
check_script "$f"
fi
fi
- if $path_in_index || $is_cmd_line; then :; else continue; fi
attr_rules=''
if $path_in_index; then
# Below is a git plumbing command to detect whether git regards a
# Hygiene Checks: check that Changes has been updated in PRs
# One of the following must be true:
# - A commit in the PR alters the Changes file
-# - A commit in the PR contains a line like 'No change needed' ($REGEX below)
# - The no-change-entry-needed label is applied to the PR (handled in YAML)
# We need all the commits in the PR to be available
# Check if Changes has been updated in the PR
if git diff "$COMMIT_RANGE" --name-only --exit-code Changes > /dev/null; then
- # Check if any commit messages include something like No Changes entry needed
- REGEX='[Nn]o [Cc]hange.* needed'
- if [[ -n $(git log --grep="$REGEX" --max-count=1 "$COMMIT_RANGE") ]]; then
- echo -e "$MSG: \e[33mSKIPPED\e[0m (owing to commit message)"
- else
- echo -e "$MSG: \e[31mNO\e[0m"
- cat <<"EOF"
+ echo -e "$MSG: \e[31mNO\e[0m"
+ cat <<"EOF"
------------------------------------------------------------------------
Most contributions should come with a message in the Changes file, as
described in our contributor documentation:
Some very minor changes (typo fixes for example) may not need
a Changes entry. In this case, you may explicitly disable this test by
-adding the code word "No change entry needed" (on a single line) to
-a commit message of the PR, or using the "no-change-entry-needed" label
-on the github pull request.
+using the "no-change-entry-needed" label on the github pull request.
------------------------------------------------------------------------
EOF
- exit 1
- fi
+ exit 1
else
echo -e "$MSG: \e[32mYES\e[0m"
fi
;;
i386)
./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
- CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
+ CC='gcc -m32 -march=x86-64' \
+ AS='as --32' \
+ ASPP='gcc -m32 -march=x86-64 -c' \
PARTIALLD='ld -r -melf_i386' \
$configure_flags
;;
Build () {
script --return --command "$MAKE_WARN world.opt" build.log
- script --return --append --command "$MAKE_WARN ocamlnat" build.log
echo Ensuring that all names are prefixed in the runtime
./tools/check-symbol-names runtime/*.a
}
set CYGWIN_PACKAGES=cygwin make diffutils\r
set CYGWIN_COMMANDS=cygcheck make diff\r
if "%PORT%" equ "mingw32" (\r
- rem mingw64-i686-runtime does not need explictly installing, but it's useful\r
+ rem mingw64-i686-runtime does not need explicitly installing, but it's useful\r
rem to have the version reported.\r
set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-i686-gcc-core mingw64-i686-runtime\r
set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-gcc cygcheck\r
new="$1"
echo Changing executable magic number from ${old} to ${new}
# Change magic number in runtime/caml/exec.h
- sed -i 's/\x23define \+EXEC_MAGIC \+\x22'${old}\
+ sed -i.tmp 's/\x23define \+EXEC_MAGIC \+\x22'${old}\
'\x22/#define EXEC_MAGIC "'${new}'"/' runtime/caml/exec.h
+ rm -f runtime/caml/exec.h.tmp
# Change magic number in utils/config.mlp
- sed -i 's/let \+exec_magic_number \+= \+\x22'${old}\
+ sed -i.tmp 's/let \+exec_magic_number \+= \+\x22'${old}\
'\x22/let exec_magic_number = "'${new}'"/' utils/config.mlp
+ rm -f utils/config.mlp.tmp
}
remove_primitive()
printf "'%s'" "`printf %s "$1" | sed -e "s/'/'\\\\\\\\''/g"`";
}
+#########################################################################
+# Display environment information
+uname -a
+for i in issue redhat-release ; do
+ if test -e /etc/$i ; then
+ echo "/etc/$i content:"
+ cat /etc/$i | sed -e 's/^/| /'
+ fi
+done
+if command -v gcc >/dev/null ; then
+ echo "gcc info:"
+ gcc --version --verbose 2>&1 | sed -e 's/^/| /'
+fi
+
#########################################################################
# be verbose
set -x
-conf --disable-unix-lib \
-conf --disable-bigarray-lib \
-conf --disable-ocamldoc \
- -conf --disable-native-compiler \
-conf --disable-dependency-generation \
-no-native
${main} -conf --disable-naked-pointers
${main} -conf --enable-flambda -conf --disable-naked-pointers
${main} -conf --enable-reserved-header-bits=27
OCAMLRUNPARAM="c=1" ${main}
+${main} -conf --with-pic
# ocamlyacc doesn't clean memory on exit
leak:ocamlyacc
-# Alternate signal stacks are currently never freed (see #10266)
-leak:caml_setup_stack_overflow_detection
/*
Flush events are used to track the time spent by the tracing runtime flushing
- data to disk, useful to remove flushing overhead for other runtime mesurements
+ data to disk, useful to remove flushing overhead for other runtime measurements
in the trace.
*/
event {
+++ /dev/null
-#!/bin/sh
-
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Damien Doligez, projet Gallium, INRIA Rocquencourt *
-#* *
-#* Copyright 2003 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. As an exception to the licensing rules of *
-#* OCaml, this file is freely redistributable, modified or not, *
-#* without constraints. *
-#* *
-#**************************************************************************
-
-# This script extracts the components from an OCaml version number
-# and provides them as C defines:
-# OCAML_VERSION_MAJOR: the major version number
-# OCAML_VERSION_MAJOR: the minor version number
-# OCAML_VERSION_PATCHLEVEL: the patchlevel number if present, or 0 if absent
-# OCAML_VERSION_ADDITIONAL: this is defined only if the additional-info
-# field is present, and is a string that contains that field.
-# Note that additional-info is always absent in officially-released
-# versions of OCaml.
-
-# usage:
-# make-version-header.sh [version-file]
-# The argument is the VERSION file from the OCaml sources.
-# If the argument is not given, the version number from "ocamlc -v" will
-# be used.
-
-case $# in
- 0) version="`ocamlc -v | tr -d '\r' | sed -n -e 's/.*version //p'`";;
- 1) version="`sed -e 1q "$1" | tr -d '\r'`";;
- *) echo "usage: make-version-header.sh [version-file]" >&2
- exit 2;;
-esac
-
-major="`echo "$version" | sed -n -e '1s/^\([0-9]*\)\..*/\1/p'`"
-minor="`echo "$version" | sed -n -e '1s/^[0-9]*\.0*\([0-9]*\).*/\1/p'`"
-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"
-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"
-echo "#define OCAML_VERSION_STRING \"$version\""
let no_approx = ref false
let no_code = ref false
let no_crc = ref false
+let shape = ref false
module Magic_number = Misc.Magic_number
printf "cmt interface digest: %s\n"
(match cmt.cmt_interface_digest with
| None -> ""
- | Some crc -> string_of_crc crc)
+ | Some crc -> string_of_crc crc);
+ if !shape then begin
+ printf "Implementation shape: ";
+ (match cmt.cmt_impl_shape with
+ | None -> printf "(none)\n"
+ | Some shape -> Format.printf "\n%a" Shape.print shape)
+ end
let print_general_infos name crc defines cmi cmx =
printf "Name: %s\n" name;
" Do not print module approximation information";
"-no-code", Arg.Set no_code,
" Do not print code from exported flambda functions";
+ "-shape", Arg.Set shape,
+ " Print the shape of the module";
"-null-crc", Arg.Set no_crc, " Print a null CRC for imported interfaces";
"-args", Arg.Expand Arg.read_arg,
"<file> Read additional newline separated command line arguments \n\
# Bump this on any changes. It's vital that HOOK_VERSION followed by equals
# appears nowhere else in these sources!
-HOOK_VERSION=5
+HOOK_VERSION=6
# For what it's worth, allow for empty trees!
if git rev-parse --verify HEAD >/dev/null 2>&1
# See also tools/ci/actions/check-configure.sh
AUTOCONF_FILES=\
-'configure configure.ac VERSION aclocal.m4 build-aux/* '\
+'configure configure.ac aclocal.m4 build-aux/* '\
'tools/autogen tools/git-dev-options.sh'
# Convert $AUTOCONF_FILES to a BRE
| Ptop_def sstr ->
let oldenv = !toplevel_env in
Typecore.reset_delayed_checks ();
- let (str, sg, sn, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
+ let (str, sg, sn, shape, newenv) =
+ Typemod.type_toplevel_phrase oldenv sstr
+ in
if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
let sg' = Typemod.Signature_names.simplify newenv sn sg in
ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg');
Typecore.force_delayed_checks ();
+ let shape = Shape.local_reduce shape in
+ if !Clflags.dump_shape then Shape.print ppf shape;
let lam = Translmod.transl_toplevel_definition str in
Warnings.check_fatal ();
begin try
if print_outcome then
Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
match str.str_items with
- | [ { str_desc =
- (Tstr_eval (exp, _)
- |Tstr_value
- (Asttypes.Nonrecursive,
- [{vb_pat = {pat_desc=Tpat_any};
- vb_expr = exp}
- ]
- )
- )
- }
- ] ->
- let outv = outval_of_value newenv v exp.exp_type in
- let ty = Printtyp.tree_of_type_scheme exp.exp_type in
- Ophr_eval (outv, ty)
-
| [] -> Ophr_signature []
- | _ -> Ophr_signature (pr_item oldenv sg'))
+ | _ ->
+ match find_eval_phrase str with
+ | Some (exp, _, _) ->
+ let outv = outval_of_value newenv v exp.exp_type in
+ let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+ Ophr_eval (outv, ty)
+ | None -> Ophr_signature (pr_item oldenv sg'))
else Ophr_signature []
| Exception exn ->
toplevel_env := oldenv;
toplevel_env := oldenv; raise x
end
| Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
- begin match Topcommon.get_directive dir_name with
- | None ->
- fprintf ppf "Unknown directive `%s'." dir_name;
- let directives = Topcommon.all_directive_names () in
- Misc.did_you_mean ppf
- (fun () -> Misc.spellcheck directives dir_name);
- fprintf ppf "@.";
- false
- | Some d ->
- match d, pdir_arg with
- | Directive_none f, None -> f (); true
- | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
- | Directive_int f, Some {pdira_desc = Pdir_int (n,None) } ->
- begin match Int_literal_converter.int n with
- | n -> f n; true
- | exception _ ->
- fprintf ppf "Integer literal exceeds the range of \
- representable integers for directive `%s'.@."
- dir_name;
- false
- end
- | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
- fprintf ppf "Wrong integer literal for directive `%s'.@."
- dir_name;
- false
- | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
- | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
- | _ ->
- fprintf ppf "Wrong type of argument for directive `%s'.@."
- dir_name;
- false
- end
+ try_run_directive ppf dir_name pdir_arg
let execute_phrase print_outcome ppf phr =
try execute_phrase print_outcome ppf phr
if Obj.is_block clos
&& (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
&& (match
- Ctype.(repr (expand_head !Topcommon.toplevel_env desc.val_type))
- with {desc=Tarrow _} -> true | _ -> false)
+ Types.get_desc
+ (Ctype.expand_head !Topcommon.toplevel_env desc.val_type)
+ with Tarrow _ -> true | _ -> false)
then begin
match is_traced clos with
| Some opath ->
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false
-(* If [name] is "", then the "file" is stdin treated as a script file. *)
-let file_argument name =
+let input_argument name =
+ let filename = Toploop.filename_of_input name in
let ppf = Format.err_formatter in
- if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
- then preload_objects := name :: !preload_objects
+ if Filename.check_suffix filename ".cmo"
+ || Filename.check_suffix filename ".cma"
+ then preload_objects := filename :: !preload_objects
else if is_expanded !current then begin
(* Script files are not allowed in expand options because otherwise the
check in override arguments may fail since the new argv can be larger
*)
Printf.eprintf "For implementation reasons, the toplevel does not support\
\ having script files (here %S) inside expanded arguments passed through the\
- \ -args{,0} command-line option.\n" name;
+ \ -args{,0} command-line option.\n" filename;
raise (Compenv.Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !current
else raise (Compenv.Exit_with_status 2)
end
+let file_argument x = input_argument (Toploop.File x)
let wrap_expand f s =
let start = !current in
module Options = Main_args.Make_bytetop_options (struct
include Main_args.Default.Topmain
- let _stdin () = file_argument ""
+ let _stdin () = input_argument Toploop.Stdin
let _args = wrap_expand Arg.read_arg
let _args0 = wrap_expand Arg.read_arg0
let anonymous s = file_argument s
+ let _eval s = input_argument (Toploop.String s)
end)
let () =
(* If a function returns a functional value, wrap it into a trace code *)
let rec instrument_result env name ppf clos_typ =
- match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+ match get_desc (Ctype.expand_head env clos_typ) with
| Tarrow(l, t1, t2, _) ->
let starred_name =
match name with
let _ = Dummy
let instrument_closure env name ppf clos_typ =
- match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+ match get_desc (Ctype.expand_head env clos_typ) with
| Tarrow(l, t1, t2, _) ->
let trace_res = instrument_result env name ppf t2 in
(fun actual_code closure arg ->
Oide_ident name
| Pdot(p, _s) ->
if
- match (find (Lident (Out_name.print name)) env).desc with
+ match get_desc (find (Lident (Out_name.print name)) env) with
| Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'
| _ -> false
| exception Not_found -> false
let tree_of_constr =
tree_of_qualified
(fun lid env ->
- (Env.find_constructor_by_name lid env).cstr_res)
+ (Env.find_constructor_by_name lid env).cstr_res)
and tree_of_label =
tree_of_qualified
(fun lid env ->
- (Env.find_label_by_name lid env).lbl_res)
+ (Env.find_label_by_name lid env).lbl_res)
(* An abstract type *)
try
find_printer depth env ty obj
with Not_found ->
- match (Ctype.repr ty).desc with
+ match get_desc ty with
| Tvar _ | Tunivar _ ->
Oval_stuff "<poly>"
| Tarrow _ ->
let type_params =
match cd_res with
Some t ->
- begin match (Ctype.repr t).desc with
+ begin match get_desc t with
Tconstr (_,params,_) ->
params
| _ -> assert false end
Oval_stuff "<unknown constructor>"
end
| Tvariant row ->
- let row = Btype.row_repr row in
if O.is_block obj then
let tag : int = O.obj (O.field obj 0) in
let rec find = function
| (l, f) :: fields ->
if Btype.hash_variant l = tag then
- match Btype.row_field_repr f with
- | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
+ match row_field_repr f with
+ | Rpresent(Some ty) | Reither(_,[ty],_) ->
let args =
nest tree_of_val (depth - 1) (O.field obj 1) ty
in
| _ -> find fields
else find fields
| [] -> Oval_stuff "<variant>" in
- find row.row_fields
+ find (row_fields row)
else
let tag : int = O.obj obj in
let rec find = function
Oval_variant (l, None)
else find fields
| [] -> Oval_stuff "<variant>" in
- find row.row_fields
+ find (row_fields row)
| Tobject (_, _) ->
Oval_stuff "<obj>"
| Tsubst _ | Tfield(_, _, _, _) | Tnil | Tlink _ ->
if not (EVP.same_value slot (EVP.eval_address addr))
then raise Not_found;
let type_params =
- match (Ctype.repr cstr.cstr_res).desc with
+ match get_desc cstr.cstr_res with
Tconstr (_,params,_) ->
params
| _ -> assert false
then printer
else find remainder
| (_name, Generic (path, fn)) :: remainder ->
- begin match (Ctype.expand_head env ty).desc with
+ begin match get_desc (Ctype.expand_head env ty) with
| Tconstr (p, args, _) when Path.same p path ->
begin try apply_generic_printer path (fn depth) args
with exn -> (fun _obj -> out_exn path exn) end
(* The interactive toplevel loop *)
open Format
-open Config
open Misc
open Parsetree
open Types
open Outcometree
open Topcommon
-type res = Ok of Obj.t | Err of string
-type evaluation_outcome = Result of Obj.t | Exception of exn
-
-let _dummy = (Ok (Obj.magic 0), Err "")
-
-external ndl_run_toplevel: string -> string -> res
- = "caml_natdynlink_run_toplevel"
-
let implementation_label = "native toplevel"
let global_symbol id =
let sym = Compilenv.symbol_for_global id in
- match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with
+ match Tophooks.lookup sym with
| None ->
fatal_error ("Toploop.global_symbol " ^ (Ident.unique_name id))
| Some obj -> obj
-let need_symbol sym =
- Option.is_none (Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym)
-
-let dll_run dll entry =
- match (try Result (Obj.magic (ndl_run_toplevel dll entry))
- with exn -> Exception exn)
- with
- | Exception _ as r -> r
- | Result r ->
- match Obj.magic r with
- | Ok x -> Result x
- | Err s -> fatal_error ("Toploop.dll_run " ^ s)
-
-
let remembered = ref Ident.empty
let rec remember phrase_name i = function
let may_trace = ref false (* Global lock on tracing *)
-let phrase_seqid = ref 0
-let phrase_name = ref "TOP"
-
-(* CR-soon trefis for mshinwell: copy/pasted from Optmain. Should it be shared
- or?
- mshinwell: It should be shared, but after 4.03. *)
-module Backend = struct
- (* See backend_intf.mli. *)
-
- let symbol_for_global' = Compilenv.symbol_for_global'
- let closure_symbol = Compilenv.closure_symbol
-
- let really_import_approx = Import_approx.really_import_approx
- let import_symbol = Import_approx.import_symbol
-
- let size_int = Arch.size_int
- let big_endian = Arch.big_endian
-
- let max_sensible_number_of_arguments =
- (* The "-1" is to allow for a potential closure environment parameter. *)
- Proc.max_arguments_for_tailcalls - 1
-end
-let backend = (module Backend : Backend_intf.S)
-
-let load_lambda ppf ~module_ident ~required_globals lam size =
+let load_lambda ppf ~module_ident ~required_globals phrase_name lam size =
if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
let slam = Simplif.simplify_lambda lam in
if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
- let dll =
- if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
- else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
- in
- let filename = Filename.chop_extension dll in
let program =
{ Lambda.
code = slam;
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 ~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
- then Filename.concat (Sys.getcwd ()) dll
- else dll in
- match
- Fun.protect
- ~finally:(fun () ->
- (try Sys.remove dll with Sys_error _ -> ()))
- (* note: under windows, cannot remove a loaded dll
- (should remember the handles, close them in at_exit, and then
- remove files) *)
- (fun () -> dll_run dll !phrase_name)
- with
- | res -> res
- | exception x ->
- record_backtrace ();
- Exception x
+ Tophooks.load ppf phrase_name program
(* Print the outcome of an evaluation *)
(* Execute a toplevel phrase *)
+let phrase_seqid = ref 0
+
+let name_expression ~loc ~attrs exp =
+ let name = "_$" in
+ let id = Ident.create_local name in
+ let vd =
+ { val_type = exp.exp_type;
+ val_kind = Val_reg;
+ val_loc = loc;
+ val_attributes = attrs;
+ val_uid = Uid.internal_not_actually_unique; }
+ in
+ let sg = [Sig_value(id, vd, Exported)] in
+ let pat =
+ { pat_desc = Tpat_var(id, mknoloc name);
+ pat_loc = loc;
+ pat_extra = [];
+ pat_type = exp.exp_type;
+ pat_env = exp.exp_env;
+ pat_attributes = []; }
+ in
+ let vb =
+ { vb_pat = pat;
+ vb_expr = exp;
+ vb_attributes = attrs;
+ vb_loc = loc; }
+ in
+ let item =
+ { str_desc = Tstr_value(Nonrecursive, [vb]);
+ str_loc = loc;
+ str_env = exp.exp_env; }
+ in
+ let final_env = Env.add_value id vd exp.exp_env in
+ let str =
+ { str_items = [item];
+ str_type = sg;
+ str_final_env = final_env }
+ in
+ str, sg
+
let execute_phrase print_outcome ppf phr =
match phr with
| Ptop_def sstr ->
let oldenv = !toplevel_env in
incr phrase_seqid;
- phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
- Compilenv.reset ?packname:None !phrase_name;
+ let phrase_name = "TOP" ^ string_of_int !phrase_seqid in
+ Compilenv.reset ?packname:None phrase_name;
Typecore.reset_delayed_checks ();
- let sstr, rewritten =
- match sstr with
- | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ]
- | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive,
- [{ pvb_expr = e
- ; pvb_pat = { ppat_desc = Ppat_any ; _ }
- ; pvb_attributes = attrs
- ; _ }])
- ; pstr_loc = loc }
- ] ->
- let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in
- let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in
- [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true
- | _ -> sstr, false
+ let (str, sg, names, shape, newenv) =
+ Typemod.type_toplevel_phrase oldenv sstr
in
- let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
let sg' = Typemod.Signature_names.simplify newenv names sg in
ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
Typecore.force_delayed_checks ();
+ let shape = Shape.local_reduce shape in
+ if !Clflags.dump_shape then Shape.print ppf shape;
+ (* `let _ = <expression>` or even just `<expression>` require special
+ handling in toplevels, or nothing is displayed. In bytecode, the
+ lambda for <expression> is directly executed and the result _is_ the
+ value. In native, the lambda for <expression> is compiled and loaded
+ from a DLL, and the result of loading that DLL is _not_ the value
+ itself. In native, <expression> must therefore be named so that it can
+ be looked up after the DLL has been dlopen'd.
+
+ The expression is "named" after typing in order to ensure that both
+ bytecode and native toplevels always type-check _exactly_ the same
+ expression. Adding the binding at the parsetree level (before typing)
+ can create observable differences (e.g. in type variable names, see
+ tool-toplevel/topeval.ml in the testsuite) *)
+ let str, sg', rewritten =
+ match find_eval_phrase str with
+ | Some (e, attrs, loc) ->
+ let str, sg' = name_expression ~loc ~attrs e in
+ str, sg', true
+ | None -> str, sg', false
+ in
let module_ident, res, required_globals, size =
if Config.flambda then
let { Lambda.module_ident; main_module_block_size = size;
required_globals; code = res } =
- Translmod.transl_implementation_flambda !phrase_name
+ Translmod.transl_implementation_flambda phrase_name
(str, Tcoerce_none)
in
remember module_ident 0 sg';
module_ident, close_phrase res, required_globals, size
else
- let size, res = Translmod.transl_store_phrases !phrase_name str in
- Ident.create_persistent !phrase_name, res, Ident.Set.empty, size
+ let size, res = Translmod.transl_store_phrases phrase_name str in
+ Ident.create_persistent phrase_name, res, Ident.Set.empty, size
in
Warnings.check_fatal ();
begin try
toplevel_env := newenv;
- let res = load_lambda ppf ~required_globals ~module_ident res size in
+ let res =
+ load_lambda ppf ~required_globals ~module_ident phrase_name res size
+ in
let out_phr =
match res with
| Result _ ->
toplevel_env := oldenv; raise x
end
| Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
- begin match get_directive dir_name with
- | None ->
- fprintf ppf "Unknown directive `%s'.@." dir_name;
- false
- | Some d ->
- match d, pdir_arg with
- | Directive_none f, None -> f (); true
- | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
- | Directive_int f, Some {pdira_desc = Pdir_int (n,None)} ->
- begin match Int_literal_converter.int n with
- | n -> f n; true
- | exception _ ->
- fprintf ppf "Integer literal exceeds the range of \
- representable integers for directive `%s'.@."
- dir_name;
- false
- end
- | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
- fprintf ppf "Wrong integer literal for directive `%s'.@."
- dir_name;
- false
- | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
- | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
- | _ ->
- fprintf ppf "Wrong type of argument for directive `%s'.@."
- dir_name;
- false
- end
+ try_run_directive ppf dir_name pdir_arg
(* API compat *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(**************************************************************************)
+
+(* Native toplevel dynamic loading interface *)
+
+open Config
+open Misc
+open Topcommon
+
+type[@warning "-37"] res = Ok of Obj.t | Err of string
+
+external ndl_run_toplevel: string -> string -> res
+ = "caml_natdynlink_run_toplevel"
+
+let lookup sym =
+ Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym
+
+let need_symbol sym =
+ Option.is_none (Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym)
+
+let dll_run dll entry =
+ match (try Result (Obj.magic (ndl_run_toplevel dll entry))
+ with exn -> Exception exn)
+ with
+ | Exception _ as r -> r
+ | Result r ->
+ match Obj.magic r with
+ | Ok x -> Result x
+ | Err s -> fatal_error ("Toploop.dll_run " ^ s)
+
+(* CR-soon trefis for mshinwell: copy/pasted from Optmain. Should it be shared
+ or?
+ mshinwell: It should be shared, but after 4.03. *)
+module Backend = struct
+ (* See backend_intf.mli. *)
+
+ let symbol_for_global' = Compilenv.symbol_for_global'
+ let closure_symbol = Compilenv.closure_symbol
+
+ let really_import_approx = Import_approx.really_import_approx
+ let import_symbol = Import_approx.import_symbol
+
+ let size_int = Arch.size_int
+ let big_endian = Arch.big_endian
+
+ let max_sensible_number_of_arguments =
+ (* The "-1" is to allow for a potential closure environment parameter. *)
+ Proc.max_arguments_for_tailcalls - 1
+end
+let backend = (module Backend : Backend_intf.S)
+
+let load ppf phrase_name program =
+ let dll =
+ if !Clflags.keep_asm_file then phrase_name ^ ext_dll
+ else Filename.temp_file ("caml" ^ phrase_name) ext_dll
+ in
+ let filename = Filename.chop_extension dll 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 ~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
+ then Filename.concat (Sys.getcwd ()) dll
+ else dll in
+ match
+ Fun.protect
+ ~finally:(fun () ->
+ (try Sys.remove dll with Sys_error _ -> ()))
+ (* note: under windows, cannot remove a loaded dll
+ (should remember the handles, close them in at_exit, and then
+ remove files) *)
+ (fun () -> dll_run dll phrase_name)
+ with
+ | res -> res
+ | exception x ->
+ record_backtrace ();
+ Exception x
+
+type lookup_fn = string -> Obj.t option
+type load_fn =
+ Format.formatter -> string -> Lambda.program -> Topcommon.evaluation_outcome
+type assembler = {mutable lookup: lookup_fn; mutable load: load_fn}
+
+let fns = {lookup; load}
+
+let load ppf = fns.load ppf
+
+let lookup sym = fns.lookup sym
+
+let register_loader ~lookup ~load =
+ fns.lookup <- lookup;
+ fns.load <- load
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** This module contains sections of Topeval in native code which can be
+ overridden, for example to change the linker.
+*)
+
+type lookup_fn = string -> Obj.t option
+type load_fn =
+ Format.formatter -> string -> Lambda.program -> Topcommon.evaluation_outcome
+
+val lookup : lookup_fn
+(** Find a global symbol by name. Default implementation may be overridden
+ with {!register_assembler}. *)
+
+val load : load_fn
+(** [load ppf phrase_name lambda] compiles and evaluates [lambda]. [phrase_name]
+ may be used for temporary files and is unique. [ppf] may be used for
+ debugging output. Default implementation may be overridden with
+ {!register_loader}. *)
+
+val register_loader : lookup:lookup_fn -> load:load_fn -> unit
+(** Sets the functions used for {!lookup} and {!load}. *)
Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
false
-let file_argument name =
+let input_argument name =
+ let filename = Toploop.filename_of_input name in
let ppf = Format.err_formatter in
- if Filename.check_suffix name ".cmxs"
- || Filename.check_suffix name ".cmx"
- || Filename.check_suffix name ".cmxa"
- then preload_objects := name :: !preload_objects
+ if Filename.check_suffix filename ".cmxs"
+ || Filename.check_suffix filename ".cmx"
+ || Filename.check_suffix filename ".cmxa"
+ then preload_objects := filename :: !preload_objects
else if is_expanded !current then begin
(* Script files are not allowed in expand options because otherwise the
check in override arguments may fail since the new argv can be larger
*)
Printf.eprintf "For implementation reasons, the toplevel does not support\
\ having script files (here %S) inside expanded arguments passed through\
- \ the -args{,0} command-line option.\n" name;
+ \ the -args{,0} command-line option.\n" filename;
raise (Compenv.Exit_with_status 2)
end else begin
let newargs = Array.sub !argv !Arg.current
else raise (Compenv.Exit_with_status 2)
end
+let file_argument x = input_argument (Toploop.File x)
+
let wrap_expand f s =
let start = !current in
let arr = f s in
module Options = Main_args.Make_opttop_options (struct
include Main_args.Default.Opttopmain
- let _stdin () = file_argument ""
+ let _stdin () = input_argument Toploop.Stdin
let _args = wrap_expand Arg.read_arg
let _args0 = wrap_expand Arg.read_arg0
let anonymous s = file_argument s
+ let _eval s = input_argument (Toploop.String s)
+
end);;
let () =
let print_out_signature = Oprint.out_signature
let print_out_phrase = Oprint.out_phrase
+let find_eval_phrase str =
+ let open Typedtree in
+ match str.str_items with
+ | [ { str_desc = Tstr_eval (e, attrs) ; str_loc = loc } ]
+ | [ { str_desc = Tstr_value (Asttypes.Nonrecursive,
+ [{ vb_expr = e
+ ; vb_pat = { pat_desc = Tpat_any; _ }
+ ; vb_attributes = attrs }])
+ ; str_loc = loc }
+ ] ->
+ Some (e, attrs, loc)
+ | _ -> None
(* The current typing environment for the toplevel *)
let all_directive_names () =
Hashtbl.fold (fun dir _ acc -> dir::acc) directive_table []
+
+let try_run_directive ppf dir_name pdir_arg =
+ begin match get_directive dir_name with
+ | None ->
+ fprintf ppf "Unknown directive `%s'." dir_name;
+ let directives = all_directive_names () in
+ Misc.did_you_mean ppf
+ (fun () -> Misc.spellcheck directives dir_name);
+ fprintf ppf "@.";
+ false
+ | Some d ->
+ match d, pdir_arg with
+ | Directive_none f, None -> f (); true
+ | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
+ | Directive_int f, Some {pdira_desc = Pdir_int (n,None) } ->
+ begin match Misc.Int_literal_converter.int n with
+ | n -> f n; true
+ | exception _ ->
+ fprintf ppf "Integer literal exceeds the range of \
+ representable integers for directive `%s'.@."
+ dir_name;
+ false
+ end
+ | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
+ fprintf ppf "Wrong integer literal for directive `%s'.@."
+ dir_name;
+ false
+ | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
+ | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
+ | _ ->
+ let dir_type = match d with
+ | Directive_none _ -> "no argument"
+ | Directive_string _ -> "a `string' literal"
+ | Directive_int _ -> "an `int' literal"
+ | Directive_ident _ -> "an identifier"
+ | Directive_bool _ -> "a `bool' literal"
+ in
+ let arg_type = match pdir_arg with
+ | None -> "no argument"
+ | Some {pdira_desc = Pdir_string _} -> "a `string' literal"
+ | Some {pdira_desc = Pdir_int _} -> "an `int' literal"
+ | Some {pdira_desc = Pdir_ident _} -> "an identifier"
+ | Some {pdira_desc = Pdir_bool _} -> "a `bool' literal"
+ in
+ fprintf ppf "Directive `%s' expects %s, got %s.@."
+ dir_name dir_type arg_type;
+ false
+ end
(* Printing of values *)
+val find_eval_phrase :
+ Typedtree.structure ->
+ (Typedtree.expression * Typedtree.attributes * Location.t) option
+
val max_printer_depth: int ref
val max_printer_steps: int ref
val all_directive_names : unit -> string list
+val try_run_directive :
+ formatter -> string -> Parsetree.directive_argument option -> bool
+
val[@deprecated] directive_table : (string, directive_fun) Hashtbl.t
(* @deprecated please use [add_directive] instead of inserting
in this table directly. *)
open Types
open Toploop
-(* The standard output formatter *)
-let std_out = std_formatter
+let error_fmt () =
+ if !Sys.interactive then
+ Format.std_formatter
+ else
+ Format.err_formatter
+
+let action_on_suberror b =
+ if not b && not !Sys.interactive then
+ raise (Compenv.Exit_with_status 125)
(* Directive sections (used in #help) *)
let section_general = "General"
doc = "Change the current working directory.";
}
-let dir_load ppf name = ignore (Topeval.load_file false ppf name)
-let _ = add_directive "load" (Directive_string (dir_load std_out))
+let with_error_fmt f x = f (error_fmt ()) x
+
+let dir_load ppf name =
+ action_on_suberror (Topeval.load_file false ppf name)
+
+let _ = add_directive "load" (Directive_string (with_error_fmt dir_load))
{
section = section_run;
doc = "Load in memory a bytecode object, produced by ocamlc.";
}
-let dir_load_rec ppf name = ignore (Topeval.load_file true ppf name)
+let dir_load_rec ppf name =
+ action_on_suberror (Topeval.load_file true ppf name)
let _ = add_directive "load_rec"
- (Directive_string (dir_load_rec std_out))
+ (Directive_string (with_error_fmt dir_load_rec))
{
section = section_run;
doc = "As #load, but loads dependencies recursively.";
(* Load commands from a file *)
-let dir_use ppf name = ignore(Toploop.use_file ppf name)
-let dir_use_output ppf name = ignore(Toploop.use_output ppf name)
-let dir_mod_use ppf name = ignore(Toploop.mod_use_file ppf name)
+let dir_use ppf name =
+ action_on_suberror (Toploop.use_input ppf (Toploop.File name))
+let dir_use_output ppf name = action_on_suberror (Toploop.use_output ppf name)
+let dir_mod_use ppf name =
+ action_on_suberror (Toploop.mod_use_input ppf (Toploop.File name))
-let _ = add_directive "use" (Directive_string (dir_use std_out))
+let _ = add_directive "use" (Directive_string (with_error_fmt dir_use))
{
section = section_run;
doc = "Read, compile and execute source phrases from the given file.";
}
-let _ = add_directive "use_output" (Directive_string (dir_use_output std_out))
+let _ = add_directive "use_output"
+ (Directive_string (with_error_fmt dir_use_output))
{
section = section_run;
doc = "Execute a command and read, compile and execute source phrases \
from its output.";
}
-let _ = add_directive "mod_use" (Directive_string (dir_mod_use std_out))
+let _ = add_directive "mod_use" (Directive_string (with_error_fmt dir_mod_use))
{
section = section_run;
doc = "Usage is identical to #use but #mod_use \
(* Install, remove a printer *)
+exception Bad_printing_function
+
let filter_arrow ty =
let ty = Ctype.expand_head !toplevel_env ty in
- match ty.desc with
+ match get_desc ty with
| Tarrow (lbl, l, r, _) when not (Btype.is_optional lbl) -> Some (l, r)
| _ -> None
let rec extract_last_arrow desc =
match filter_arrow desc with
- | None -> raise (Ctype.Unify [])
+ | None -> raise Bad_printing_function
| Some (_, r as res) ->
try extract_last_arrow r
- with Ctype.Unify _ -> res
+ with Bad_printing_function -> res
let extract_target_type ty = fst (extract_last_arrow ty)
let extract_target_parameters ty =
let ty = extract_target_type ty |> Ctype.expand_head !toplevel_env in
- match ty.desc with
+ match get_desc ty with
| Tconstr (path, (_ :: _ as args), _)
- when Ctype.all_distinct_vars !toplevel_env args -> Some (path, args)
+ when Ctype.all_distinct_vars !toplevel_env args ->
+ Some (path, args)
| _ -> None
type 'a printer_type_new = Format.formatter -> 'a -> unit
let match_simple_printer_type desc printer_type =
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
- Ctype.unify !toplevel_env
- (Ctype.newconstr printer_type [ty_arg])
- (Ctype.instance desc.val_type);
+ begin try
+ Ctype.unify !toplevel_env
+ (Ctype.newconstr printer_type [ty_arg])
+ (Ctype.instance desc.val_type);
+ with Ctype.Unify _ ->
+ raise Bad_printing_function
+ end;
Ctype.end_def();
Ctype.generalize ty_arg;
(ty_arg, None)
let ty_expected =
List.fold_right
(fun ty_arg ty -> Ctype.newty (Tarrow (Asttypes.Nolabel, ty_arg, ty,
- Cunknown)))
+ commu_var ())))
ty_args (Ctype.newconstr printer_type [ty_target]) in
- Ctype.unify !toplevel_env
- ty_expected
- (Ctype.instance desc.val_type);
+ begin try
+ Ctype.unify !toplevel_env
+ ty_expected
+ (Ctype.instance desc.val_type);
+ with Ctype.Unify _ ->
+ raise Bad_printing_function
+ end;
Ctype.end_def();
Ctype.generalize ty_expected;
if not (Ctype.all_distinct_vars !toplevel_env args) then
- raise (Ctype.Unify []);
+ raise Bad_printing_function;
(ty_expected, Some (path, ty_args))
let match_printer_type ppf desc =
let printer_type_old = printer_type ppf "printer_type_old" in
try
(match_simple_printer_type desc printer_type_new, false)
- with Ctype.Unify _ ->
+ with Bad_printing_function ->
try
(match_simple_printer_type desc printer_type_old, true)
- with Ctype.Unify _ as exn ->
+ with Bad_printing_function as exn ->
match extract_target_parameters desc.val_type with
| None -> raise exn
| Some (path, args) ->
| (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.@."
+ | exception Bad_printing_function ->
+ fprintf ppf "%a has the wrong type for a printing function.@."
Printtyp.longident lid;
raise Exit
end
with Exit -> ()
let _ = add_directive "install_printer"
- (Directive_ident (dir_install_printer std_out))
+ (Directive_ident (with_error_fmt dir_install_printer))
{
section = section_print;
doc = "Registers a printer for values of a certain type.";
}
let _ = add_directive "remove_printer"
- (Directive_ident (dir_remove_printer std_out))
+ (Directive_ident (with_error_fmt dir_remove_printer))
{
section = section_print;
doc = "Remove the named function from the table of toplevel printers.";
let parse_warnings ppf iserr s =
try Option.iter Location.(prerr_alert none) @@ Warnings.parse_options iserr s
- with Arg.Bad err -> fprintf ppf "%s.@." err
+ with Arg.Bad err -> fprintf ppf "%s.@." err; action_on_suberror true
(* Typing information *)
all_show_funs := to_sig :: !all_show_funs;
add_directive
name
- (Directive_ident (show_prim to_sig std_out))
+ (Directive_ident (show_prim to_sig std_formatter))
{
section = section_env;
doc;
let desc = Env.lookup_constructor ~loc Env.Positive lid env in
if is_exception_constructor env desc.cstr_res then
raise Not_found;
- let path =
- match Ctype.repr desc.cstr_res with
- | {desc=Tconstr(path, _, _)} -> path
- | _ -> raise Not_found
- in
+ let path = Btype.cstr_type_path desc in
let type_decl = Env.find_type path env in
if is_extension_constructor desc.cstr_tag then
let ret_type =
let () =
reg_show_prim "show_class"
(fun env loc id lid ->
- let _path, desc = Env.lookup_class ~loc lid env in
- [ Sig_class (id, desc, Trec_not, Exported) ]
+ let path, desc_class = Env.lookup_class ~loc lid env in
+ let _path, desc_cltype = Env.lookup_cltype ~loc lid env in
+ let _path, typedcl = Env.lookup_type ~loc lid env in
+ let hash_typedcl = Env.find_hash_type path env in
+ [
+ Sig_class (id, desc_class, Trec_not, Exported);
+ Sig_class_type (id, desc_cltype, Trec_not, Exported);
+ Sig_type (id, typedcl, Trec_not, Exported);
+ Sig_type (id, hash_typedcl, Trec_not, Exported);
+ ]
)
"Print the signature of the corresponding class."
let () =
reg_show_prim "show_class_type"
(fun env loc id lid ->
- let _path, desc = Env.lookup_cltype ~loc lid env in
- [ Sig_class_type (id, desc, Trec_not, Exported) ]
+ let path, desc = Env.lookup_cltype ~loc lid env in
+ let _path, typedcl = Env.lookup_type ~loc lid env in
+ let hash_typedcl = Env.find_hash_type path env in
+ [
+ Sig_class_type (id, desc, Trec_not, Exported);
+ Sig_type (id, typedcl, Trec_not, Exported);
+ Sig_type (id, hash_typedcl, Trec_not, Exported);
+ ]
)
"Print the signature of the corresponding class type."
if sg = [] then raise Not_found else sg
let () =
- add_directive "show" (Directive_ident (show_prim show std_out))
+ add_directive "show" (Directive_ident (show_prim show std_formatter))
{
section = section_env;
doc = "Print the signatures of components \
}
let _ = add_directive "warnings"
- (Directive_string (parse_warnings std_out false))
+ (Directive_string (with_error_fmt(fun ppf s -> parse_warnings ppf false s)))
{
section = section_options;
doc = "Enable or disable warnings according to the argument.";
}
let _ = add_directive "warn_error"
- (Directive_string (parse_warnings std_out true))
+ (Directive_string (with_error_fmt(fun ppf s -> parse_warnings ppf true s)))
{
section = section_options;
doc = "Treat as errors the warnings enabled by the argument.";
List.iter (print_section ppf) (directive_sections ())
let _ = add_directive "help"
- (Directive_none (print_directives std_out))
+ (Directive_none (print_directives std_formatter))
{
section = section_general;
doc = "Prints a list of all available directives, with \
include Topcommon
include Topeval
-(* Read and execute commands from a file, or from stdin if [name] is "". *)
+type input =
+ | Stdin
+ | File of string
+ | String of string
let use_print_results = ref true
-let use_channel ppf ~wrap_in_module ic name filename =
- let lb = Lexing.from_channel ic in
+let filename_of_input = function
+ | File name -> name
+ | Stdin | String _ -> ""
+
+let use_lexbuf ppf ~wrap_in_module lb name filename =
Warnings.reset_fatal ();
Location.init lb filename;
(* Skip initial #! line if any *)
let ic = open_in_bin fn in
Misc.try_finally ~always:(fun () -> close_in ic)
(fun () ->
- use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
+ let lexbuf = (Lexing.from_channel ic) in
+ use_lexbuf ppf ~wrap_in_module:false lexbuf "" "(command-output)")
| n ->
fprintf ppf "Command exited with code %d.@." n;
false)
-let use_file ppf ~wrap_in_module name =
- match name with
- | "" ->
- use_channel ppf ~wrap_in_module stdin name "(stdin)"
- | _ ->
+let use_input ppf ~wrap_in_module input =
+ match input with
+ | Stdin ->
+ let lexbuf = Lexing.from_channel stdin in
+ use_lexbuf ppf ~wrap_in_module lexbuf "" "(stdin)"
+ | String value ->
+ let lexbuf = Lexing.from_string value in
+ use_lexbuf ppf ~wrap_in_module lexbuf "" "(command-line input)"
+ | File name ->
match Load_path.find name with
| filename ->
let ic = open_in_bin filename in
Misc.try_finally ~always:(fun () -> close_in ic)
- (fun () -> use_channel ppf ~wrap_in_module ic name filename)
+ (fun () ->
+ let lexbuf = Lexing.from_channel ic in
+ use_lexbuf ppf ~wrap_in_module lexbuf name filename)
| exception Not_found ->
fprintf ppf "Cannot find file %s.@." name;
false
-let mod_use_file ppf name =
- use_file ppf ~wrap_in_module:true name
+let mod_use_input ppf name =
+ use_input ppf ~wrap_in_module:true name
+let use_input ppf name =
+ use_input ppf ~wrap_in_module:false name
let use_file ppf name =
- use_file ppf ~wrap_in_module:false name
+ use_input ppf (File name)
let use_silently ppf name =
Misc.protect_refs
[ R (use_print_results, false) ]
- (fun () -> use_file ppf name)
+ (fun () -> use_input ppf name)
let load_file = load_file false
let run_script ppf name args =
override_sys_argv args;
- Compmisc.init_path ~dir:(Filename.dirname name) ();
+ let filename = filename_of_input name in
+ Compmisc.init_path ~dir:(Filename.dirname filename) ();
(* Note: would use [Filename.abspath] here, if we had it. *)
begin
try toplevel_env := Compmisc.initial_env()
Sys.interactive := false;
run_hooks After_setup;
let explicit_name =
+ match name with
+ | File name as filename -> (
(* Prevent use_silently from searching in the path. *)
if name <> "" && Filename.is_implicit name
- then Filename.concat Filename.current_dir_name name
- else name
+ then File (Filename.concat Filename.current_dir_name name)
+ else filename)
+ | (Stdin | String _) as x -> x
in
use_silently ppf explicit_name
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
+ | Some f ->
+ if Sys.file_exists f then ignore (use_silently ppf (File f) )
+ else fprintf ppf "Init file not found: \"%s\".@." f
| None ->
match find_ocamlinit () with
| None -> ()
- | Some file -> ignore (use_silently ppf file)
+ | Some file -> ignore (use_silently ppf (File file))
(* The interactive loop *)
Clflags.debug := true;
Location.formatter_for_warnings := ppf;
if not !Clflags.noversion then
- fprintf ppf " OCaml version %s%s%s@.@."
+ fprintf ppf "OCaml version %s%s%s@.Enter #help;; for help.@.@."
Config.version
(if Topeval.implementation_label = "" then "" else " - ")
Topeval.implementation_label;
open Format
+(* type of toplevel inputs *)
+type input =
+ | Stdin
+ | File of string
+ | String of string
+
(* Accessors for the table of toplevel value bindings. These functions
must appear as first and second exported functions in this module.
(See module Translmod.) *)
val getvalue : string -> Obj.t
val setvalue : string -> Obj.t -> unit
+
+val filename_of_input: input -> string
+
(* Set the load paths, before running anything *)
val set_paths : unit -> unit
(* Read and execute a script from the given file *)
-val run_script : formatter -> string -> string array -> bool
+val run_script : formatter -> input -> string array -> bool
(* true if successful, false if error *)
(* Interface with toplevel directives *)
formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
(* Preprocess the given toplevel phrase using regular and ppx
preprocessors. Return the updated phrase. *)
-val use_file : formatter -> string -> bool
+val use_input : formatter -> input -> bool
val use_output : formatter -> string -> bool
-val use_silently : formatter -> string -> bool
-val mod_use_file : formatter -> string -> bool
+val use_silently : formatter -> input -> bool
+val mod_use_input : formatter -> input -> bool
+val use_file : formatter -> string -> bool
(* Read and execute commands from a file.
- [use_file] prints the types and values of the results.
+ [use_input] prints the types and values of the results.
[use_silently] does not print them.
- [mod_use_file] wrap the file contents into a module. *)
+ [mod_use_input] wrap the file contents into a module. *)
val eval_module_path: Env.t -> Path.t -> Obj.t
val eval_value_path: Env.t -> Path.t -> Obj.t
val eval_extension_path: Env.t -> Path.t -> Obj.t
(**** Sets, maps and hashtables of types ****)
-module TypeSet = Set.Make(TypeOps)
-module TypeMap = Map.Make (TypeOps)
-module TypeHash = Hashtbl.Make(TypeOps)
+let wrap_repr f ty = f (Transient_expr.repr ty)
+let wrap_type_expr f tty = f (Transient_expr.type_expr tty)
+
+module TransientTypeSet = Set.Make(TransientTypeOps)
+module TypeSet = struct
+ include TransientTypeSet
+ let add = wrap_repr add
+ let mem = wrap_repr mem
+ let singleton = wrap_repr singleton
+ let exists p = TransientTypeSet.exists (wrap_type_expr p)
+ let elements set =
+ List.map Transient_expr.type_expr (TransientTypeSet.elements set)
+end
+module TransientTypeMap = Map.Make(TransientTypeOps)
+module TypeMap = struct
+ include TransientTypeMap
+ let add ty = wrap_repr add ty
+ let find ty = wrap_repr find ty
+ let singleton ty = wrap_repr singleton ty
+ let fold f = TransientTypeMap.fold (wrap_type_expr f)
+end
+module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
+module TypeHash = struct
+ include TransientTypeHash
+ let add hash = wrap_repr (add hash)
+ let find hash = wrap_repr (find hash)
+ let iter f = TransientTypeHash.iter (wrap_type_expr f)
+end
+module TransientTypePairs =
+ Hashtbl.Make (struct
+ type t = transient_expr * transient_expr
+ let equal (t1, t1') (t2, t2') = (t1 == t2) && (t1' == t2')
+ let hash (t, t') = t.id + 93 * t'.id
+ end)
+module TypePairs = struct
+ module H = TransientTypePairs
+ open Transient_expr
+
+ type t = {
+ set : unit H.t;
+ mutable elems : (transient_expr * transient_expr) list;
+ (* elems preserves the (reversed) insertion order of elements *)
+ }
+
+ let create n =
+ { elems = []; set = H.create n }
+
+ let clear t =
+ t.elems <- [];
+ H.clear t.set
+
+ let repr2 (t1, t2) = (repr t1, repr t2)
+
+ let add t p =
+ let p = repr2 p in
+ if H.mem t.set p then () else begin
+ H.add t.set p ();
+ t.elems <- p :: t.elems
+ end
+
+ let mem t p = H.mem t.set (repr2 p)
+
+ let iter f t =
+ (* iterate in insertion order, not Hashtbl.iter order *)
+ List.rev t.elems
+ |> List.iter (fun (t1,t2) ->
+ f (type_expr t1, type_expr t2))
+end
(**** Forward declarations ****)
(**** Some type creators ****)
-let new_id = s_ref (-1)
-
-let newty2 level desc =
- incr new_id;
- Private_type_expr.create desc ~level ~scope:lowest_level ~id:!new_id
-let newgenty desc = newty2 generic_level desc
+let newgenty desc = newty2 ~level:generic_level desc
let newgenvar ?name () = newgenty (Tvar name)
+let newgenstub ~scope = newty3 ~level:generic_level ~scope (Tvar None)
+
(*
let newmarkedvar level =
incr new_id; { desc = Tvar; level = pivot_level - level; id = !new_id }
(**** Check some types ****)
-let is_Tvar = function {desc=Tvar _} -> true | _ -> false
-let is_Tunivar = function {desc=Tunivar _} -> true | _ -> false
-let is_Tconstr = function {desc=Tconstr _} -> true | _ -> false
+let is_Tvar ty = match get_desc ty with Tvar _ -> true | _ -> false
+let is_Tunivar ty = match get_desc ty with Tunivar _ -> true | _ -> false
+let is_Tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false
let dummy_method = "*dummy method*"
-(**** Definitions for backtracking ****)
-
-type change =
- Ctype of type_expr * type_desc
- | Ccompress of type_expr * type_desc * type_desc
- | Clevel of type_expr * int
- | Cscope of type_expr * int
- | Cname of
- (Path.t * type_expr list) option ref * (Path.t * type_expr list) option
- | Crow of row_field option ref * row_field option
- | Ckind of field_kind option ref * field_kind option
- | Ccommu of commutable ref * commutable
- | Cuniv of type_expr option ref * type_expr option
-
-type changes =
- Change of change * changes ref
- | Unchanged
- | Invalid
-
-let trail = s_table ref Unchanged
-
-let log_change ch =
- let r' = ref Unchanged in
- !trail := Change (ch, r');
- trail := r'
-
(**** Representative of a type ****)
-let rec field_kind_repr =
- function
- Fvar {contents = Some kind} -> field_kind_repr kind
- | kind -> kind
-
-let rec repr_link compress (t : type_expr) d : type_expr -> type_expr =
- function
- {desc = Tlink t' as d'} ->
- repr_link true t d' t'
- | {desc = Tfield (_, k, _, t') as d'} when field_kind_repr k = Fabsent ->
- repr_link true t d' t'
- | t' ->
- if compress then begin
- log_change (Ccompress (t, t.desc, d)); Private_type_expr.set_desc t d
- end;
- t'
-
-let repr (t : type_expr) =
- match t.desc with
- Tlink t' as d ->
- repr_link false t d t'
- | Tfield (_, k, _, t') as d when field_kind_repr k = Fabsent ->
- repr_link false t d t'
- | _ -> t
-
-let rec commu_repr = function
- Clink r when !r <> Cunknown -> commu_repr !r
- | c -> c
-
-let rec row_field_repr_aux tl = function
- Reither(_, tl', _, {contents = Some fi}) ->
- row_field_repr_aux (tl@tl') fi
- | Reither(c, tl', m, r) ->
- Reither(c, tl@tl', m, r)
- | Rpresent (Some _) when tl <> [] ->
- Rpresent (Some (List.hd tl))
- | fi -> fi
-
-let row_field_repr fi = row_field_repr_aux [] fi
-
-let rec rev_concat l ll =
- match ll with
- [] -> l
- | l'::ll -> rev_concat (l'@l) ll
-
-let rec row_repr_aux ll row =
- match (repr row.row_more).desc with
- | Tvariant row' ->
- let f = row.row_fields in
- row_repr_aux (if f = [] then ll else f::ll) row'
- | _ ->
- if ll = [] then row else
- {row with row_fields = rev_concat row.row_fields ll}
-
-let row_repr row = row_repr_aux [] row
-
-let rec row_field tag row =
- let rec find = function
- | (tag',f) :: fields ->
- if tag = tag' then row_field_repr f else find fields
- | [] ->
- match repr row.row_more with
- | {desc=Tvariant row'} -> row_field tag row'
- | _ -> Rabsent
- in find row.row_fields
-
-let rec row_more row =
- match repr row.row_more with
- | {desc=Tvariant row'} -> row_more row'
- | ty -> ty
-
let merge_fixed_explanation fixed1 fixed2 =
match fixed1, fixed2 with
| Some Univar _ as x, _ | _, (Some Univar _ as x) -> x
let fixed_explanation row =
- let row = row_repr row in
- match row.row_fixed with
+ match row_fixed row with
| Some _ as x -> x
| None ->
- let more = repr row.row_more in
- match more.desc with
+ let ty = row_more row in
+ match get_desc ty with
| Tvar _ | Tnil -> None
- | Tunivar _ -> Some (Univar more)
+ | Tunivar _ -> Some (Univar ty)
| Tconstr (p,_,_) -> Some (Reified p)
| _ -> assert false
-let is_fixed row = match row.row_fixed with
+let is_fixed row = match row_fixed row with
| None -> false
| Some _ -> true
-let row_fixed row = fixed_explanation row <> None
-
+let has_fixed_explanation row = fixed_explanation row <> None
let static_row row =
- let row = row_repr row in
- row.row_closed &&
+ row_closed row &&
List.for_all
(fun (_,f) -> match row_field_repr f with Reither _ -> false | _ -> true)
- row.row_fields
+ (row_fields row)
let hash_variant s =
let accu = ref 0 in
if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu
let proxy ty =
- let ty0 = repr ty in
- match ty0.desc with
+ match get_desc ty with
| Tvariant row when not (static_row row) ->
row_more row
| Tobject (ty, _) ->
let rec proxy_obj ty =
- match ty.desc with
- Tfield (_, _, _, ty) | Tlink ty -> proxy_obj ty
+ match get_desc ty with
+ Tfield (_, _, _, ty) -> proxy_obj ty
| Tvar _ | Tunivar _ | Tconstr _ -> ty
- | Tnil -> ty0
+ | Tnil -> ty
| _ -> assert false
in proxy_obj ty
- | _ -> ty0
+ | _ -> ty
(**** Utilities for fixed row private types ****)
let row_of_type t =
- match (repr t).desc with
+ match get_desc t with
Tobject(t,_) ->
let rec get_row t =
- let t = repr t in
- match t.desc with
+ match get_desc t with
Tfield(_,_,_,t) -> get_row t
| _ -> t
in get_row t
l > 4 && String.sub s (l-4) 4 = "#row"
let is_constr_row ~allow_ident t =
- match t.desc with
+ match get_desc t with
Tconstr (Path.Pident id, _, _) when allow_ident ->
is_row_name (Ident.name id)
| Tconstr (Path.Pdot (_, s), _, _) -> is_row_name s
(* TODO: where should this really be *)
(* Set row_name in Env, cf. GPR#1204/1329 *)
-let set_row_name decl path =
+let set_static_row_name decl path =
match decl.type_manifest with
None -> ()
| Some ty ->
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tvariant row when static_row row ->
- let row = {(row_repr row) with
- row_name = Some (path, decl.type_params)} in
- Private_type_expr.set_desc ty (Tvariant row)
+ let row =
+ set_row_name row (Some (path, decl.type_params)) in
+ set_type_desc ty (Tvariant row)
| _ -> ()
(* Utilities for type traversal *)
(**********************************)
-let rec fold_row f init row =
+let fold_row f init row =
let result =
List.fold_left
(fun init (_, fi) ->
match row_field_repr fi with
| Rpresent(Some ty) -> f init ty
- | Reither(_, tl, _, _) -> List.fold_left f init tl
+ | Reither(_, tl, _) -> List.fold_left f init tl
| _ -> init)
init
- row.row_fields
+ (row_fields row)
in
- match (repr row.row_more).desc with
- Tvariant row -> fold_row f result row
+ match get_desc (row_more row) with
| Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
begin match
- Option.map (fun (_,l) -> List.fold_left f result l) row.row_name
+ Option.map (fun (_,l) -> List.fold_left f result l) (row_name row)
with
| None -> result
| Some result -> result
let iter_row f row =
fold_row (fun () v -> f v) () row
-let rec fold_type_expr f init ty =
- match ty.desc with
+let fold_type_expr f init ty =
+ match get_desc ty with
Tvar _ -> init
| Tarrow (_, ty1, ty2, _) ->
- let result = f init ty1 in
- f result ty2
+ let result = f init ty1 in
+ f result ty2
| Ttuple l -> List.fold_left f init l
| Tconstr (_, l, _) -> List.fold_left f init l
- | Tobject(ty, {contents = Some (_, p)})
- ->
- let result = f init ty in
- List.fold_left f result p
+ | Tobject(ty, {contents = Some (_, p)}) ->
+ let result = f init ty in
+ List.fold_left f result p
| Tobject (ty, _) -> f init ty
| Tvariant row ->
- let result = fold_row f init row in
- f result (row_more row)
+ let result = fold_row f init row in
+ f result (row_more row)
| Tfield (_, _, ty1, ty2) ->
- let result = f init ty1 in
- f result ty2
+ let result = f init ty1 in
+ f result ty2
| Tnil -> init
- | Tlink ty -> fold_type_expr f init ty
+ | Tlink _
| Tsubst _ -> assert false
| Tunivar _ -> init
| Tpoly (ty, tyl) ->
it.it_class_type it cty
| Cty_signature cs ->
it.it_type_expr it cs.csig_self;
+ it.it_type_expr it cs.csig_self_row;
Vars.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_vars;
- List.iter
- (fun (p, tl) -> it.it_path p; List.iter (it.it_type_expr it) tl)
- cs.csig_inher
+ Meths.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_meths
| Cty_arrow (_, ty, cty) ->
it.it_type_expr it ty;
it.it_class_type it cty
iter_type_expr_kind (it.it_type_expr it) kind
and it_do_type_expr it ty =
iter_type_expr (it.it_type_expr it) ty;
- match ty.desc with
+ match get_desc ty with
Tconstr (p, _, _)
| Tobject (_, {contents=Some (p, _)})
| Tpackage (p, _) ->
it.it_path p
| Tvariant row ->
- Option.iter (fun (p,_) -> it.it_path p) (row_repr row).row_name
+ Option.iter (fun (p,_) -> it.it_path p) (row_name row)
| _ -> ()
and it_path _p = ()
in
it_type_declaration; it_value_description; it_signature_item; }
let copy_row f fixed row keep more =
+ let Row {fields = orig_fields; fixed = orig_fixed; closed; name = orig_name} =
+ row_repr row in
let fields = List.map
(fun (l, fi) -> l,
match row_field_repr fi with
- | Rpresent(Some ty) -> Rpresent(Some(f ty))
- | Reither(c, tl, m, e) ->
- let e = if keep then e else ref None in
+ | Rpresent oty -> rf_present (Option.map f oty)
+ | Reither(c, tl, m) ->
+ let use_ext_of = if keep then Some fi else None in
let m = if is_fixed row then fixed else m in
let tl = List.map f tl in
- Reither(c, tl, m, e)
- | _ -> fi)
- row.row_fields in
+ rf_either tl ?use_ext_of ~no_arg:c ~matched:m
+ | Rabsent -> rf_absent)
+ orig_fields in
let name =
- match row.row_name with
+ match orig_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_closed = row.row_closed; row_name = name; }
-
-let rec copy_kind = function
- Fvar{contents = Some k} -> copy_kind k
- | Fvar _ -> Fvar (ref None)
- | Fpresent -> Fpresent
- | Fabsent -> assert false
+ let fixed = if fixed then orig_fixed else None in
+ create_row ~fields ~more ~fixed ~closed ~name
-let copy_commu c =
- if commu_repr c = Cok then Cok else Clink (ref Cunknown)
+let copy_commu c = if is_commu_ok c then commu_ok else commu_var ()
let rec copy_type_desc ?(keep_names=false) f = function
Tvar _ as ty -> if keep_names then ty else Tvar None
-> Tobject (f ty, ref (Some(p, List.map f tl)))
| Tobject (ty, _) -> Tobject (f ty, ref None)
| Tvariant _ -> assert false (* too ambiguous *)
- | Tfield (p, k, ty1, ty2) -> (* the kind is kept shared *)
- Tfield (p, field_kind_repr k, f ty1, f ty2)
+ | Tfield (p, k, ty1, ty2) ->
+ Tfield (p, field_kind_internal_repr k, f ty1, f ty2)
+ (* the kind is kept shared, with indirections removed for performance *)
| Tnil -> Tnil
- | Tlink ty -> copy_type_desc f ty.desc
+ | Tlink ty -> copy_type_desc f (get_desc ty)
| Tsubst _ -> assert false
| Tunivar _ as ty -> ty (* always keep the name *)
| Tpoly (ty, tyl) ->
module For_copy : sig
type copy_scope
- val save_desc: copy_scope -> type_expr -> type_desc -> unit
-
- val dup_kind: copy_scope -> field_kind option ref -> unit
+ val redirect_desc: copy_scope -> type_expr -> type_desc -> unit
val with_scope: (copy_scope -> 'a) -> 'a
end = struct
type copy_scope = {
- mutable saved_desc : (type_expr * type_desc) list;
+ mutable saved_desc : (transient_expr * type_desc) list;
(* Save association of generic nodes with their description. *)
-
- mutable saved_kinds: field_kind option ref list;
- (* duplicated kind variables *)
-
- mutable new_kinds : field_kind option ref list;
- (* new kind variables *)
}
- let save_desc copy_scope ty desc =
- copy_scope.saved_desc <- (ty, desc) :: copy_scope.saved_desc
-
- let dup_kind copy_scope r =
- assert (Option.is_none !r);
- if not (List.memq r copy_scope.new_kinds) then begin
- copy_scope.saved_kinds <- r :: copy_scope.saved_kinds;
- let r' = ref None in
- copy_scope.new_kinds <- r' :: copy_scope.new_kinds;
- r := Some (Fvar r')
- end
+ let redirect_desc copy_scope ty desc =
+ let ty = Transient_expr.repr ty in
+ copy_scope.saved_desc <- (ty, ty.desc) :: copy_scope.saved_desc;
+ Transient_expr.set_desc ty desc
(* Restore type descriptions. *)
- let cleanup { saved_desc; saved_kinds; _ } =
- List.iter (fun (ty, desc) -> Private_type_expr.set_desc ty desc) saved_desc;
- List.iter (fun r -> r := None) saved_kinds
+ let cleanup { saved_desc; _ } =
+ List.iter (fun (ty, desc) -> Transient_expr.set_desc ty desc) saved_desc
let with_scope f =
- let scope = { saved_desc = []; saved_kinds = []; new_kinds = [] } in
+ let scope = { saved_desc = [] } in
let res = f scope in
cleanup scope;
res
end
-
(*******************************************)
(* Memorization of abbreviation expansion *)
(*******************************************)
List.for_all (fun mem -> check_abbrev_rec !mem) !memo
*)
+(* Re-export backtrack *)
+
+let snapshot = snapshot
+let backtrack = backtrack ~cleanup_abbrev
+
(**********************************)
(* Utilities for labels *)
(**********************************)
let extract_label l ls = extract_label_aux [] l ls
+ (*******************************)
+ (* Operations on class types *)
+ (*******************************)
- (**********************************)
- (* Utilities for backtracking *)
- (**********************************)
+let rec signature_of_class_type =
+ function
+ Cty_constr (_, _, cty) -> signature_of_class_type cty
+ | Cty_signature sign -> sign
+ | Cty_arrow (_, _, cty) -> signature_of_class_type cty
+
+let rec class_body cty =
+ match cty with
+ Cty_constr _ ->
+ cty (* Only class bodies can be abbreviated *)
+ | Cty_signature _ ->
+ cty
+ | Cty_arrow (_, _, cty) ->
+ class_body cty
+
+(* Fully expand the head of a class type *)
+let rec scrape_class_type =
+ function
+ Cty_constr (_, _, cty) -> scrape_class_type cty
+ | cty -> cty
-let undo_change = function
- Ctype (ty, desc) -> Private_type_expr.set_desc ty desc
- | Ccompress (ty, desc, _) -> Private_type_expr.set_desc ty desc
- | Clevel (ty, level) -> Private_type_expr.set_level ty level
- | Cscope (ty, scope) -> Private_type_expr.set_scope ty scope
- | Cname (r, v) -> r := v
- | Crow (r, v) -> r := v
- | Ckind (r, v) -> r := v
- | Ccommu (r, v) -> r := v
- | Cuniv (r, v) -> r := v
-
-type snapshot = changes ref * int
-let last_snapshot = s_ref 0
-
-let log_type ty =
- if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
-let link_type ty ty' =
- log_type ty;
- let desc = ty.desc in
- Private_type_expr.set_desc ty (Tlink ty');
- (* Name is a user-supplied name for this unification variable (obtained
- * through a type annotation for instance). *)
- match desc, ty'.desc with
- Tvar name, Tvar name' ->
- begin match name, name' with
- | Some _, None -> log_type ty'; Private_type_expr.set_desc ty' (Tvar name)
- | None, Some _ -> ()
- | Some _, Some _ ->
- if ty.level < ty'.level then
- (log_type ty'; Private_type_expr.set_desc ty' (Tvar name))
- | None, None -> ()
- end
- | _ -> ()
- (* ; assert (check_memorized_abbrevs ()) *)
- (* ; check_expans [] ty' *)
-(* TODO: consider eliminating set_type_desc, replacing it with link types *)
-let set_type_desc ty td =
- if td != ty.desc then begin
- log_type ty;
- Private_type_expr.set_desc ty td
- end
-(* TODO: separate set_level into two specific functions: *)
-(* set_lower_level and set_generic_level *)
- let set_level ty level =
- if level <> ty.level then begin
- if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
- Private_type_expr.set_level ty level
- end
-(* TODO: introduce a guard and rename it to set_higher_scope? *)
-let set_scope ty scope =
- if scope <> ty.scope then begin
- if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
- Private_type_expr.set_scope ty scope
- end
-let set_univar rty ty =
- log_change (Cuniv (rty, !rty)); rty := Some ty
-let set_name nm v =
- log_change (Cname (nm, !nm)); nm := v
-let set_row_field e v =
- log_change (Crow (e, !e)); e := Some v
-let set_kind rk k =
- log_change (Ckind (rk, !rk)); rk := Some k
-let set_commu rc c =
- log_change (Ccommu (rc, !rc)); rc := c
-
-let snapshot () =
- let old = !last_snapshot in
- last_snapshot := !new_id;
- (!trail, old)
-
-let rec rev_log accu = function
- Unchanged -> accu
- | Invalid -> assert false
- | Change (ch, next) ->
- let d = !next in
- next := Invalid;
- rev_log (ch::accu) d
-
-let backtrack (changes, old) =
- match !changes with
- Unchanged -> last_snapshot := old
- | Invalid -> failwith "Btype.backtrack"
- | Change _ as change ->
- cleanup_abbrev ();
- let backlog = rev_log [] change in
- List.iter undo_change backlog;
- changes := Unchanged;
- last_snapshot := old;
- trail := changes
-
-let rec rev_compress_log log r =
- match !r with
- Unchanged | Invalid ->
- log
- | Change (Ccompress _, next) ->
- rev_compress_log (r::log) next
- | Change (_, next) ->
- rev_compress_log log next
-
-let undo_compress (changes, _old) =
- match !changes with
- Unchanged
- | Invalid -> ()
- | Change _ ->
- let log = rev_compress_log [] changes in
- List.iter
- (fun r -> match !r with
- Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
- Private_type_expr.set_desc ty desc; r := !next
- | _ -> ())
- log
+let rec class_type_arity =
+ function
+ Cty_constr (_, _, cty) -> class_type_arity cty
+ | Cty_signature _ -> 0
+ | Cty_arrow (_, _, cty) -> 1 + class_type_arity cty
+
+let rec abbreviate_class_type path params cty =
+ match cty with
+ Cty_constr (_, _, _) | Cty_signature _ ->
+ Cty_constr (path, params, cty)
+ | Cty_arrow (l, ty, cty) ->
+ Cty_arrow (l, ty, abbreviate_class_type path params cty)
+
+let self_type cty =
+ (signature_of_class_type cty).csig_self
+
+let self_type_row cty =
+ (signature_of_class_type cty).csig_self_row
+
+(* Return the methods of a class signature *)
+let methods sign =
+ Meths.fold
+ (fun name _ l -> name :: l)
+ sign.csig_meths []
+
+(* Return the virtual methods of a class signature *)
+let virtual_methods sign =
+ Meths.fold
+ (fun name (_priv, vr, _ty) l ->
+ match vr with
+ | Virtual -> name :: l
+ | Concrete -> l)
+ sign.csig_meths []
+
+(* Return the concrete methods of a class signature *)
+let concrete_methods sign =
+ Meths.fold
+ (fun name (_priv, vr, _ty) s ->
+ match vr with
+ | Virtual -> s
+ | Concrete -> MethSet.add name s)
+ sign.csig_meths MethSet.empty
+
+(* Return the public methods of a class signature *)
+let public_methods sign =
+ Meths.fold
+ (fun name (priv, _vr, _ty) l ->
+ match priv with
+ | Mprivate _ -> l
+ | Mpublic -> name :: l)
+ sign.csig_meths []
+
+(* Return the instance variables of a class signature *)
+let instance_vars sign =
+ Vars.fold
+ (fun name _ l -> name :: l)
+ sign.csig_vars []
+
+(* Return the virtual instance variables of a class signature *)
+let virtual_instance_vars sign =
+ Vars.fold
+ (fun name (_mut, vr, _ty) l ->
+ match vr with
+ | Virtual -> name :: l
+ | Concrete -> l)
+ sign.csig_vars []
+
+(* Return the concrete instance variables of a class signature *)
+let concrete_instance_vars sign =
+ Vars.fold
+ (fun name (_mut, vr, _ty) s ->
+ match vr with
+ | Virtual -> s
+ | Concrete -> VarSet.add name s)
+ sign.csig_vars VarSet.empty
+
+let method_type label sign =
+ match Meths.find label sign.csig_meths with
+ | (_, _, ty) -> ty
+ | exception Not_found -> assert false
+
+let instance_variable_type label sign =
+ match Vars.find label sign.csig_vars with
+ | (_, _, ty) -> ty
+ | exception Not_found -> assert false
-(* Mark a type. *)
+ (**********************************)
+ (* Utilities for level-marking *)
+ (**********************************)
-let not_marked_node ty = ty.level >= lowest_level
+let not_marked_node ty = get_level ty >= lowest_level
(* type nodes with negative levels are "marked" *)
-let flip_mark_node ty = Private_type_expr.set_level ty (pivot_level - ty.level)
-let logged_mark_node ty = set_level ty (pivot_level - ty.level)
+let flip_mark_node ty =
+ let ty = Transient_expr.repr ty in
+ Transient_expr.set_level ty (pivot_level - ty.level)
+let logged_mark_node ty =
+ set_level ty (pivot_level - get_level ty)
let try_mark_node ty = not_marked_node ty && (flip_mark_node ty; true)
let try_logged_mark_node ty = not_marked_node ty && (logged_mark_node ty; true)
let rec mark_type ty =
- let ty = repr ty in
if not_marked_node ty then begin
flip_mark_node ty;
iter_type_expr mark_type ty
let type_iterators =
let it_type_expr it ty =
- let ty = repr ty in
if try_mark_node ty then it.it_do_type_expr it ty
in
{type_iterators with it_type_expr}
(* Remove marks from a type. *)
let rec unmark_type ty =
- let ty = repr ty in
- if ty.level < lowest_level then begin
+ if get_level ty < lowest_level then begin
(* flip back the marked level *)
flip_mark_node ty;
iter_type_expr unmark_type ty
let unmark_class_signature sign =
unmark_type sign.csig_self;
- Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars
+ unmark_type sign.csig_self_row;
+ Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars;
+ Meths.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_meths
let unmark_class_type cty =
unmark_iterators.it_class_type unmark_iterators cty
+
+(**** Type information getter ****)
+
+let cstr_type_path cstr =
+ match get_desc cstr.cstr_res with
+ | Tconstr (p, _, _) -> p
+ | _ -> assert false
(**** Sets, maps and hashtables of types ****)
-module TypeSet : Set.S with type elt = type_expr
-module TypeMap : Map.S with type key = type_expr
-module TypeHash : Hashtbl.S with type key = type_expr
+module TypeSet : sig
+ include Set.S with type elt = transient_expr
+ val add: type_expr -> t -> t
+ val mem: type_expr -> t -> bool
+ val singleton: type_expr -> t
+ val exists: (type_expr -> bool) -> t -> bool
+ val elements: t -> type_expr list
+end
+module TransientTypeMap : Map.S with type key = transient_expr
+module TypeMap : sig
+ include Map.S with type key = transient_expr
+ and type 'a t = 'a TransientTypeMap.t
+ val add: type_expr -> 'a -> 'a t -> 'a t
+ val find: type_expr -> 'a t -> 'a
+ val singleton: type_expr -> 'a -> 'a t
+ val fold: (type_expr -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+end
+module TypeHash : sig
+ include Hashtbl.S with type key = transient_expr
+ val add: 'a t -> type_expr -> 'a -> unit
+ val find: 'a t -> type_expr -> 'a
+ val iter: (type_expr -> 'a -> unit) -> 'a t -> unit
+end
+module TypePairs : sig
+ type t
+ val create: int -> t
+ val clear: t -> unit
+ val add: t -> type_expr * type_expr -> unit
+ val mem: t -> type_expr * type_expr -> bool
+ val iter: (type_expr * type_expr -> unit) -> t -> unit
+end
(**** Levels ****)
val generic_level: int
-val newty2: int -> type_desc -> type_expr
- (* Create a type *)
val newgenty: type_desc -> type_expr
(* Create a generic type *)
val newgenvar: ?name:string -> unit -> type_expr
(* Return a fresh generic variable *)
+val newgenstub: scope:int -> type_expr
+ (* Return a fresh generic node, to be instantiated
+ by [Transient_expr.set_stub_desc] *)
(* Use Tsubst instead
val newmarkedvar: int -> type_expr
val is_Tconstr: type_expr -> bool
val dummy_method: label
-val repr: type_expr -> type_expr
- (* Return the canonical representative of a type. *)
-
-val field_kind_repr: field_kind -> field_kind
- (* Return the canonical representative of an object field
- kind. *)
-
-val commu_repr: commutable -> commutable
- (* Return the canonical representative of a commutation lock *)
-
(**** polymorphic variants ****)
-val row_repr: row_desc -> row_desc
- (* Return the canonical representative of a row description *)
-val row_field_repr: row_field -> row_field
-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
+val has_fixed_explanation: row_desc -> bool
(* Return whether the row should be treated as fixed or not.
- In particular, [is_fixed row] implies [row_fixed row].
+ In particular, [is_fixed row] implies [has_fixed_explanation row].
*)
val fixed_explanation: row_desc -> fixed_explanation option
val is_constr_row: allow_ident:bool -> type_expr -> bool
(* Set the polymorphic variant row_name field *)
-val set_row_name : type_declaration -> Path.t -> unit
+val set_static_row_name: type_declaration -> Path.t -> unit
(**** Utilities for type traversal ****)
val fold_row: ('a -> type_expr -> 'a) -> 'a -> row_desc -> 'a
val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit
(* Iteration on types in an abbreviation list *)
+val iter_type_expr_kind: (type_expr -> unit) -> (type_decl_kind -> unit)
+
+val iter_type_expr_cstr_args: (type_expr -> unit) ->
+ (constructor_arguments -> unit)
+val map_type_expr_cstr_args: (type_expr -> type_expr) ->
+ (constructor_arguments -> constructor_arguments)
+
type type_iterators =
{ it_signature: type_iterators -> signature -> unit;
val copy_row:
(type_expr -> type_expr) ->
bool -> row_desc -> bool -> type_expr -> row_desc
-val copy_kind: field_kind -> field_kind
module For_copy : sig
While it is possible to circumvent that discipline in various
ways, you should NOT do that. *)
- val save_desc: copy_scope -> type_expr -> type_desc -> unit
- (* Save a type description *)
-
- val dup_kind: copy_scope -> field_kind option ref -> unit
- (* Save a None field_kind, and make it point to a fresh Fvar *)
+ val redirect_desc: copy_scope -> type_expr -> type_desc -> unit
+ (* Temporarily change a type description *)
val with_scope: (copy_scope -> 'a) -> 'a
(* [with_scope f] calls [f] and restores saved type descriptions
(* Return true if a type node is not yet marked *)
val logged_mark_node: type_expr -> unit
- (* Mark a type node, logging the marking so it can be backtracked.
- No [repr]'ing *)
+ (* Mark a type node, logging the marking so it can be backtracked *)
val try_logged_mark_node: type_expr -> bool
(* Mark a type node if it is not yet marked, logging the marking so it
can be backtracked.
Return false if it was already marked *)
val flip_mark_node: type_expr -> unit
- (* Mark a type node. No [repr]'ing.
+ (* Mark a type node.
The marking is not logged and will have to be manually undone using
one of the various [unmark]'ing functions below. *)
val try_mark_node: type_expr -> bool
abbrev_memo ref -> Path.t -> unit
(* Remove an abbreviation from the cache *)
+(**** Backtracking ****)
+
+val snapshot: unit -> snapshot
+val backtrack: snapshot -> unit
+ (* Backtrack to a given snapshot. Only possible if you have
+ not already backtracked to a previous snapshot.
+ Calls [cleanup_abbrev] internally *)
+
(**** Utilities for labels ****)
val is_optional : arg_label -> bool
whether (label, value) was at the head of the list,
list without the extracted (label, value) *)
-(**** Utilities for backtracking ****)
+(**** Utilities for class types ****)
-type snapshot
- (* A snapshot for backtracking *)
-val snapshot: unit -> snapshot
- (* Make a snapshot for later backtracking. Costs nothing *)
-val backtrack: snapshot -> unit
- (* Backtrack to a given snapshot. Only possible if you have
- not already backtracked to a previous snapshot.
- Calls [cleanup_abbrev] internally *)
-val undo_compress: snapshot -> unit
- (* Backtrack only path compression. Only meaningful if you have
- not already backtracked to a previous snapshot.
- Does not call [cleanup_abbrev] *)
-
-(* Functions to use when modifying a type (only Ctype?) *)
-val link_type: type_expr -> type_expr -> unit
- (* Set the desc field of [t1] to [Tlink t2], logging the old
- value if there is an active snapshot *)
-val set_type_desc: type_expr -> type_desc -> unit
- (* Set directly the desc field, without sharing *)
-val set_level: type_expr -> int -> unit
-val set_scope: type_expr -> int -> unit
-val set_name:
- (Path.t * type_expr list) option ref ->
- (Path.t * type_expr list) option -> unit
-val set_row_field: row_field option ref -> row_field -> unit
-val set_univar: type_expr option ref -> type_expr -> unit
-val set_kind: field_kind option ref -> field_kind -> unit
-val set_commu: commutable ref -> commutable -> unit
- (* Set references, logging the old value *)
+(* Get the class signature within a class type *)
+val signature_of_class_type : class_type -> class_signature
+
+(* Get the body of a class type (i.e. without parameters) *)
+val class_body : class_type -> class_type
+
+(* Fully expand the head of a class type *)
+val scrape_class_type : class_type -> class_type
+
+(* Return the number of parameters of a class type *)
+val class_type_arity : class_type -> int
+
+(* Given a path and type parameters, add an abbreviation to a class type *)
+val abbreviate_class_type :
+ Path.t -> type_expr list -> class_type -> class_type
+
+(* Get the self type of a class *)
+val self_type : class_type -> type_expr
+
+(* Get the row variable of the self type of a class *)
+val self_type_row : class_type -> type_expr
+
+(* Return the methods of a class signature *)
+val methods : class_signature -> string list
+
+(* Return the virtual methods of a class signature *)
+val virtual_methods : class_signature -> string list
+
+(* Return the concrete methods of a class signature *)
+val concrete_methods : class_signature -> MethSet.t
+
+(* Return the public methods of a class signature *)
+val public_methods : class_signature -> string list
+
+(* Return the instance variables of a class signature *)
+val instance_vars : class_signature -> string list
+
+(* Return the virtual instance variables of a class signature *)
+val virtual_instance_vars : class_signature -> string list
+
+(* Return the concrete instance variables of a class signature *)
+val concrete_instance_vars : class_signature -> VarSet.t
+
+(* Return the type of a method.
+ @raises [Assert_failure] if the class has no such method. *)
+val method_type : label -> class_signature -> type_expr
+
+(* Return the type of an instance variable.
+ @raises [Assert_failure] if the class has no such method. *)
+val instance_variable_type : label -> class_signature -> type_expr
(**** Forward declarations ****)
val print_raw: (Format.formatter -> type_expr -> unit) ref
-val iter_type_expr_kind: (type_expr -> unit) -> (type_decl_kind -> unit)
+(**** Type information getter ****)
-val iter_type_expr_cstr_args: (type_expr -> unit) ->
- (constructor_arguments -> unit)
-val map_type_expr_cstr_args: (type_expr -> type_expr) ->
- (constructor_arguments -> constructor_arguments)
+val cstr_type_path : constructor_description -> Path.t
class do not depend on sharing thanks to constrained
abbreviations. (Of course, even if some sharing is lost, typing
will still be correct.)
- - All nodes of a type have a level : that way, one know whether a
+ - All nodes of a type have a level : that way, one knows whether a
node need to be duplicated or not when instantiating a type.
- Levels of a type are decreasing (generic level being considered
as greatest).
(**** Errors ****)
-exception Unify of unification Errortrace.t
-exception Equality of comparison Errortrace.t
-exception Moregen of comparison Errortrace.t
-exception Subtype of Errortrace.Subtype.t * unification Errortrace.t
-
-exception Escape of desc Errortrace.escape
+(* There are two classes of errortrace-related exceptions: *traces* and
+ *errors*. The former, whose names end with [_trace], contain
+ [Errortrace.trace]s, representing traces that are currently being built; they
+ are local to this file. All the internal functions that implement
+ unification, type equality, and moregen raise trace exceptions. Once we are
+ done, in the top level functions such as [unify], [equal], and [moregen], we
+ catch the trace exceptions and transform them into the analogous error
+ exception. This indicates that we are done building the trace, and expect
+ the error to flow out of unification, type equality, or moregen into
+ surrounding code (with some few exceptions when these top-level functions are
+ used as building blocks elsewhere.) Only the error exceptions are exposed in
+ [ctype.mli]; the trace exceptions are an implementation detail. Any trace
+ exception that escapes from a function in this file is a bug. *)
+
+exception Unify_trace of unification trace
+exception Equality_trace of comparison trace
+exception Moregen_trace of comparison trace
+
+exception Unify of unification_error
+exception Equality of equality_error
+exception Moregen of moregen_error
+exception Subtype of Subtype.error
+
+exception Escape of type_expr escape
(* For local use: throw the appropriate exception. Can be passed into local
functions as a parameter *)
let raise_trace_for
(type variant)
(tr_exn : variant trace_exn)
- (tr : variant Errortrace.t) : 'a =
+ (tr : variant trace) : 'a =
match tr_exn with
- | Unify -> raise (Unify tr)
- | Equality -> raise (Equality tr)
- | Moregen -> raise (Moregen tr)
+ | Unify -> raise (Unify_trace tr)
+ | Equality -> raise (Equality_trace tr)
+ | Moregen -> raise (Moregen_trace tr)
(* Uses of this function are a bit suspicious, as we usually want to maintain
trace information; sometimes it makes sense, however, since we're maintaining
let escape kind = {kind; context = None}
let escape_exn kind = Escape (escape kind)
-let scope_escape_exn ty = escape_exn (Equation (short ty))
+let scope_escape_exn ty = escape_exn (Equation ty)
let raise_escape_exn kind = raise (escape_exn kind)
let raise_scope_escape_exn ty = raise (scope_escape_exn ty)
exception Cannot_unify_universal_variables
-exception Matches_failure of Env.t * unification Errortrace.t
+exception Matches_failure of Env.t * unification_error
exception Incompatible
(* Re-export generic type creators *)
-let newty2 = Btype.newty2
-let newty desc = newty2 !current_level desc
+let newty desc = newty2 ~level:!current_level desc
+let new_scoped_ty scope desc = newty3 ~level:!current_level ~scope desc
-let newvar ?name () = newty2 !current_level (Tvar name)
-let newvar2 ?name level = newty2 level (Tvar name)
-let new_global_var ?name () = newty2 !global_level (Tvar name)
+let newvar ?name () = newty2 ~level:!current_level (Tvar name)
+let newvar2 ?name level = newty2 ~level:level (Tvar name)
+let new_global_var ?name () = newty2 ~level:!global_level (Tvar name)
+let newstub ~scope = newty3 ~level:!current_level ~scope (Tvar None)
let newobj fields = newty (Tobject (fields, ref None))
let none = newty (Ttuple []) (* Clearly ill-formed type *)
-(**** Representative of a type ****)
-
-(* Re-export repr *)
-let repr = repr
-
-(**** Type maps ****)
-
-module TypePairs =
- Hashtbl.Make (struct
- type t = type_expr * type_expr
- let equal (t1, t1') (t2, t2') = (t1 == t2) && (t1' == t2')
- let hash (t, t') = t.id + 93 * t'.id
- end)
-
-
(**** unification mode ****)
type unification_mode =
type equations_generation =
| Forbidden
- | Allowed of { equated_types : unit TypePairs.t }
+ | Allowed of { equated_types : TypePairs.t }
let umode = ref Expression
let equations_generation = ref Forbidden
(**** Object field manipulation. ****)
let object_fields ty =
- match (repr ty).desc with
+ match get_desc ty with
Tobject (fields, _) -> fields
| _ -> assert false
let flatten_fields ty =
let rec flatten l ty =
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tfield(s, k, ty1, ty2) ->
flatten ((s, k, ty1)::l) ty2
| _ ->
let build_fields level =
List.fold_right
- (fun (s, k, ty1) ty2 -> newty2 level (Tfield(s, k, ty1, ty2)))
+ (fun (s, k, ty1) ty2 -> newty2 ~level (Tfield(s, k, ty1, ty2)))
let associate_fields fields1 fields2 =
let rec associate p s s' =
in
associate [] [] [] (fields1, fields2)
-let rec has_dummy_method ty =
- match repr ty with
- {desc = Tfield (m, _, _, ty2)} ->
- m = dummy_method || has_dummy_method ty2
- | _ -> false
-
-let is_self_type = function
- | Tobject (ty, _) -> has_dummy_method ty
- | _ -> false
-
(**** Check whether an object is open ****)
(* +++ The abbreviation should eventually be expanded *)
let rec object_row ty =
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tobject (t, _) -> object_row t
| Tfield(_, _, _, t) -> object_row t
| _ -> ty
let opened_object ty =
- match (object_row ty).desc with
+ match get_desc (object_row ty) with
| Tvar _ | Tunivar _ | Tconstr _ -> true
| _ -> false
let concrete_object ty =
- match (object_row ty).desc with
+ match get_desc (object_row ty) with
| Tvar _ -> false
| _ -> true
-(**** Close an object ****)
-
-let close_object ty =
- let rec close ty =
- let ty = repr ty in
- match ty.desc with
- Tvar _ ->
- link_type ty (newty2 ty.level Tnil); true
- | Tfield(lab, _, _, _) when lab = dummy_method ->
- false
- | Tfield(_, _, _, ty') -> close ty'
- | _ -> assert false
- in
- match (repr ty).desc with
- Tobject (ty, _) -> close ty
- | _ -> assert false
-
(**** Row variable of an object type ****)
-let row_variable ty =
- let rec find ty =
- let ty = repr ty in
- match ty.desc with
- Tfield (_, _, _, ty) -> find ty
- | Tvar _ -> ty
- | _ -> assert false
- in
- match (repr ty).desc with
- Tobject (fi, _) -> find fi
- | _ -> assert false
+let rec fields_row_variable ty =
+ match get_desc ty with
+ | Tfield (_, _, _, ty) -> fields_row_variable ty
+ | Tvar _ -> ty
+ | _ -> assert false
(**** Object name manipulation ****)
(* +++ Bientot obsolete *)
-let set_object_name id rv params ty =
- match (repr ty).desc with
- Tobject (_fi, nm) ->
+let set_object_name id params ty =
+ match get_desc ty with
+ | Tobject (fi, nm) ->
+ let rv = fields_row_variable fi in
set_name nm (Some (Path.Pident id, rv::params))
- | _ ->
- assert false
+ | Tconstr (_, _, _) -> ()
+ | _ -> fatal_error "Ctype.set_object_name"
let remove_object_name ty =
- match (repr ty).desc with
+ match get_desc ty with
Tobject (_, nm) -> set_name nm None
| Tconstr (_, _, _) -> ()
| _ -> fatal_error "Ctype.remove_object_name"
-(**** Hiding of private methods ****)
-
-let hide_private_methods ty =
- match (repr ty).desc with
- Tobject (fi, nm) ->
- nm := None;
- let (fl, _) = flatten_fields fi in
- List.iter
- (function (_, k, _) ->
- match field_kind_repr k with
- Fvar r -> set_kind r Fabsent
- | _ -> ())
- fl
- | _ ->
- assert false
-
-
- (*******************************)
- (* Operations on class types *)
- (*******************************)
-
-
-let rec signature_of_class_type =
- function
- Cty_constr (_, _, cty) -> signature_of_class_type cty
- | Cty_signature sign -> sign
- | Cty_arrow (_, _, cty) -> signature_of_class_type cty
-
-let self_type cty =
- repr (signature_of_class_type cty).csig_self
-
-let rec class_type_arity =
- function
- Cty_constr (_, _, cty) -> class_type_arity cty
- | Cty_signature _ -> 0
- | Cty_arrow (_, _, cty) -> 1 + class_type_arity cty
-
-
(*******************************************)
(* Miscellaneous operations on row types *)
(*******************************************)
let fi = filter_row_fields erase fi in
match row_field_repr f with
Rabsent -> fi
- | Reither(_,_,false,e) when erase -> set_row_field e Rabsent; fi
+ | Reither(_,_,false) when erase ->
+ link_row_field_ext ~inside:f rf_absent; fi
| _ -> p :: fi
(**************************************)
and only returns a [variable list].
*)
let rec free_vars_rec real ty =
- let ty = repr ty in
if try_mark_node ty then
- match ty.desc, !really_closed with
+ match get_desc ty, !really_closed with
Tvar _, _ ->
free_variables := (ty, real) :: !free_variables
| Tconstr (path, tl, _), Some env ->
begin try
let (_, body, _) = Env.find_type_expansion path env in
- if (repr body).level <> generic_level then
+ if get_level body <> generic_level then
free_variables := (ty, real) :: !free_variables
with Not_found -> ()
end;
| Tfield (_, _, ty1, ty2), _ ->
free_vars_rec true ty1; free_vars_rec false ty2
| Tvariant row, _ ->
- let row = row_repr row in
iter_row (free_vars_rec true) row;
- if not (static_row row) then free_vars_rec false row.row_more
+ if not (static_row row) then free_vars_rec false (row_more row)
| _ ->
iter_type_expr (free_vars_rec true) ty
unmark_extension_constructor ext;
Some ty
-type closed_class_failure =
- CC_Method of type_expr * bool * string * type_expr
- | CC_Value of type_expr * bool * string * type_expr
-
-exception CCFailure of closed_class_failure
+exception CCFailure of (type_expr * bool * string * type_expr)
let closed_class params sign =
- let ty = object_fields (repr sign.csig_self) in
- let (fields, rest) = flatten_fields ty in
List.iter mark_type params;
- mark_type rest;
- List.iter
- (fun (lab, _, ty) -> if lab = dummy_method then mark_type ty)
- fields;
+ ignore (try_mark_node sign.csig_self_row);
try
- ignore (try_mark_node (repr sign.csig_self));
- List.iter
- (fun (lab, kind, ty) ->
- if field_kind_repr kind = Fpresent then
- try closed_type ty with Non_closed (ty0, real) ->
- raise (CCFailure (CC_Method (ty0, real, lab, ty))))
- fields;
- mark_type_params (repr sign.csig_self);
+ Meths.iter
+ (fun lab (priv, _, ty) ->
+ if priv = Mpublic then begin
+ try closed_type ty with Non_closed (ty0, real) ->
+ raise (CCFailure (ty0, real, lab, ty))
+ end)
+ sign.csig_meths;
List.iter unmark_type params;
unmark_class_signature sign;
None
with CCFailure reason ->
- mark_type_params (repr sign.csig_self);
List.iter unmark_type params;
unmark_class_signature sign;
Some reason
preserved. Does it worth duplicating this code ?
*)
let rec generalize ty =
- let ty = repr ty in
- if (ty.level > !current_level) && (ty.level <> generic_level) then begin
+ let level = get_level ty in
+ if (level > !current_level) && (level <> generic_level) then begin
set_level ty generic_level;
(* recur into abbrev for the speed *)
- begin match ty.desc with
+ begin match get_desc ty with
Tconstr (_, _, abbrev) ->
iter_abbrev generalize !abbrev
| _ -> ()
(* Generalize the structure and lower the variables *)
let rec generalize_structure ty =
- let ty = repr ty in
- if ty.level <> generic_level then begin
- if is_Tvar ty && ty.level > !current_level then
+ let level = get_level ty in
+ if level <> generic_level then begin
+ if is_Tvar ty && level > !current_level then
set_level ty !current_level
else if
- ty.level > !current_level &&
- match ty.desc with
+ level > !current_level &&
+ match get_desc ty with
Tconstr (p, _, abbrev) ->
not (is_object_type p) && (abbrev := Mnil; true)
| _ -> true
(* Generalize the spine of a function, if the level >= !current_level *)
let rec generalize_spine ty =
- let ty = repr ty in
- if ty.level < !current_level || ty.level = generic_level then () else
- match ty.desc with
+ let level = get_level ty in
+ if level < !current_level || level = generic_level then () else
+ match get_desc ty with
Tarrow (_, ty1, ty2, _) ->
set_level ty generic_level;
generalize_spine ty1;
| _ -> p
let rec check_scope_escape env level ty =
- let ty = repr ty in
- let orig_level = ty.level in
+ let orig_level = get_level ty in
if try_logged_mark_node ty then begin
- if level < ty.scope then
+ if level < get_scope ty then
raise_scope_escape_exn ty;
- begin match ty.desc with
+ begin match get_desc ty with
| Tconstr (p, _, _) when level < Path.scope p ->
begin match !forward_try_expand_safe env ty with
| ty' ->
let p' = normalize_package_path env p in
if Path.same p p' then raise_escape_exn (Module_type p);
check_scope_escape env level
- (Btype.newty2 orig_level (Tpackage (p', fl)))
+ (newty2 ~level:orig_level (Tpackage (p', fl)))
| _ ->
- iter_type_expr (check_scope_escape env level) ty
+ iter_type_expr (check_scope_escape env level) ty
end;
end
raise (Escape { e with context = Some ty })
let rec update_scope scope ty =
- let ty = repr ty in
- if ty.scope < scope then begin
- if ty.level < scope then raise_scope_escape_exn ty;
+ if get_scope ty < scope then begin
+ if get_level ty < scope then raise_scope_escape_exn ty;
set_scope ty scope;
(* Only recurse in principal mode as this is not necessary for soundness *)
if !Clflags.principal then iter_type_expr (update_scope scope) ty
*)
let rec update_level env level expand ty =
- let ty = repr ty in
- if ty.level > level then begin
- if level < ty.scope then raise_scope_escape_exn ty;
- match ty.desc with
+ if get_level ty > level then begin
+ if level < get_scope ty then raise_scope_escape_exn ty;
+ match get_desc ty with
Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
(* Try first to replace an abbreviation by its expansion. *)
begin try
- link_type ty (!forward_try_expand_safe env ty);
- update_level env level expand ty
+ let ty' = !forward_try_expand_safe env ty in
+ link_type ty ty';
+ update_level env level expand ty'
with Cannot_expand ->
raise_escape_exn (Constructor p)
end
let needs_expand =
expand ||
List.exists2
- (fun var ty -> var = Variance.null && (repr ty).level > level)
+ (fun var ty -> var = Variance.null && get_level ty > level)
variance tl
in
begin try
if not needs_expand then raise Cannot_expand;
- link_type ty (!forward_try_expand_safe env ty);
- update_level env level expand ty
+ let ty' = !forward_try_expand_safe env ty in
+ link_type ty ty';
+ update_level env level expand ty'
with Cannot_expand ->
set_level ty level;
iter_type_expr (update_level env level expand) ty
if Path.same p p' then raise_escape_exn (Module_type p);
set_type_desc ty (Tpackage (p', fl));
update_level env level expand ty
- | Tobject(_, ({contents=Some(p, _tl)} as nm))
+ | Tobject (_, ({contents=Some(p, _tl)} as nm))
when level < Path.scope p ->
set_name nm None;
update_level env level expand ty
| Tvariant row ->
- let row = row_repr row in
- begin match row.row_name with
+ begin match row_name row with
| Some (p, _tl) when level < Path.scope p ->
- set_type_desc ty (Tvariant {row with row_name = None})
+ set_type_desc ty (Tvariant (set_row_name row None))
| _ -> ()
end;
set_level ty level;
iter_type_expr (update_level env level expand) ty
| Tfield(lab, _, ty1, _)
- when lab = dummy_method && (repr ty1).level > level ->
+ when lab = dummy_method && level < get_scope ty1 ->
raise_escape_exn Self
| _ ->
set_level ty level;
(* First try without expanding, then expand everything,
to avoid combinatorial blow-up *)
let update_level env level ty =
- let ty = repr ty in
- if ty.level > level then begin
+ if get_level ty > level then begin
let snap = snapshot () in
try
update_level env level false ty
(* Lower level of type variables inside contravariant branches *)
let rec lower_contravariant env var_level visited contra ty =
- let ty = repr ty in
let must_visit =
- ty.level > var_level &&
- match Hashtbl.find visited ty.id with
+ get_level ty > var_level &&
+ match Hashtbl.find visited (get_id ty) with
| done_contra -> contra && not done_contra
| exception Not_found -> true
in
if must_visit then begin
- Hashtbl.add visited ty.id contra;
+ Hashtbl.add visited (get_id ty) contra;
let lower_rec = lower_contravariant env var_level visited in
- match ty.desc with
+ match get_desc ty with
Tvar _ -> if contra then set_level ty var_level
| Tconstr (_, [], _) -> ()
| Tconstr (path, tyl, _abbrev) ->
iter_type_expr (lower_rec contra) ty
end
+let lower_variables_only env level ty =
+ simple_abbrevs := Mnil;
+ lower_contravariant env level (Hashtbl.create 7) true ty
+
let lower_contravariant env ty =
simple_abbrevs := Mnil;
lower_contravariant env !nongen_level (Hashtbl.create 7) false ty
+let rec generalize_class_type' gen =
+ function
+ Cty_constr (_, params, cty) ->
+ List.iter gen params;
+ generalize_class_type' gen cty
+ | Cty_signature csig ->
+ gen csig.csig_self;
+ gen csig.csig_self_row;
+ Vars.iter (fun _ (_, _, ty) -> gen ty) csig.csig_vars;
+ Meths.iter (fun _ (_, _, ty) -> gen ty) csig.csig_meths
+ | Cty_arrow (_, ty, cty) ->
+ gen ty;
+ generalize_class_type' gen cty
+
+let generalize_class_type cty =
+ generalize_class_type' generalize cty
+
+let generalize_class_type_structure cty =
+ generalize_class_type' generalize_structure cty
+
(* Correct the levels of type [ty]. *)
let correct_levels ty =
duplicate_type ty
(* Only generalize the type ty0 in ty *)
let limited_generalize ty0 ty =
- let ty0 = repr ty0 in
-
let graph = Hashtbl.create 17 in
let idx = ref lowest_level in
let roots = ref [] in
let rec inverse pty ty =
- let ty = repr ty in
- if (ty.level > !current_level) || (ty.level = generic_level) then begin
+ let level = get_level ty in
+ if (level > !current_level) || (level = generic_level) then begin
decr idx;
Hashtbl.add graph !idx (ty, ref pty);
- if (ty.level = generic_level) || (ty == ty0) then
+ if (level = generic_level) || eq_type ty ty0 then
roots := ty :: !roots;
set_level ty !idx;
iter_type_expr (inverse [ty]) ty
- end else if ty.level < lowest_level then begin
- let (_, parents) = Hashtbl.find graph ty.level in
+ end else if level < lowest_level then begin
+ let (_, parents) = Hashtbl.find graph level in
parents := pty @ !parents
end
and generalize_parents ty =
- let idx = ty.level in
+ let idx = get_level ty in
if idx <> generic_level then begin
set_level ty generic_level;
List.iter generalize_parents !(snd (Hashtbl.find graph idx));
(* Special case for rows: must generalize the row variable *)
- match ty.desc with
+ match get_desc ty with
Tvariant row ->
let more = row_more row in
- let lv = more.level in
+ let lv = get_level more in
if (lv < lowest_level || lv > !current_level)
&& lv <> generic_level then set_level more generic_level
| _ -> ()
in
inverse [] ty;
- if ty0.level < lowest_level then
+ if get_level ty0 < lowest_level then
iter_type_expr (inverse []) ty0;
List.iter generalize_parents !roots;
Hashtbl.iter
(fun _ (ty, _) ->
- if ty.level <> generic_level then set_level ty !current_level)
+ if get_level ty <> generic_level then set_level ty !current_level)
graph
+let limited_generalize_class_type rv cty =
+ generalize_class_type' (limited_generalize rv) cty
(* Compute statically the free univars of all nodes in a type *)
(* This avoids doing it repeatedly during instantiation *)
mutable inv_parents : inv_type_expr list }
let rec inv_type hash pty ty =
- let ty = repr ty in
try
let inv = TypeHash.find hash ty in
inv.inv_parents <- pty @ inv.inv_parents
inv_type inverted [] ty;
let node_univars = TypeHash.create 17 in
let rec add_univar univ inv =
- match inv.inv_type.desc with
- Tpoly (_ty, tl) when List.memq univ (List.map repr tl) -> ()
+ match get_desc inv.inv_type with
+ Tpoly (_ty, tl) when List.memq (get_id univ) (List.map get_id tl) -> ()
| _ ->
try
let univs = TypeHash.find node_univars inv.inv_type in
let fully_generic ty =
let rec aux ty =
- let ty = repr ty in
if not_marked_node ty then
- if ty.level = generic_level then
+ if get_level ty = generic_level then
(flip_mark_node ty; iter_type_expr aux ty)
else raise Exit
in
before we call type_pat *)
let rec copy ?partial ?keep_names scope ty =
let copy = copy ?partial ?keep_names scope in
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tsubst (ty, _) -> ty
- | _ ->
- if ty.level <> generic_level && partial = None then ty else
+ | desc ->
+ let level = get_level ty in
+ if level <> generic_level && partial = None then ty else
(* We only forget types that are non generic and do not contain
free univars *)
let forget =
- if ty.level = generic_level then generic_level else
+ if level = generic_level then generic_level else
match partial with
None -> assert false
| Some (free_univars, keep) ->
if TypeSet.is_empty (free_univars ty) then
- if keep then ty.level else !current_level
+ if keep then level else !current_level
else generic_level
in
- if forget <> generic_level then newty2 forget (Tvar None) else
- let desc = ty.desc in
- For_copy.save_desc scope ty desc;
- let t = newvar() in (* Stub *)
- set_scope t ty.scope;
- Private_type_expr.set_desc ty (Tsubst (t, None));
- Private_type_expr.set_desc t
- begin match desc with
+ if forget <> generic_level then newty2 ~level:forget (Tvar None) else
+ let t = newstub ~scope:(get_scope ty) in
+ For_copy.redirect_desc scope ty (Tsubst (t, None));
+ let desc' =
+ match desc with
| Tconstr (p, tl, _) ->
let abbrevs = proper_abbrevs p tl !abbreviations in
begin match find_repr p !abbrevs with
- Some ty when repr ty != t ->
+ Some ty when not (eq_type ty t) ->
Tlink ty
| _ ->
(*
Mcons _ -> Mlink !abbreviations
| abbrev -> abbrev))
end
- | Tvariant row0 ->
- let row = row_repr row0 in
- let more = repr row.row_more in
+ | Tvariant row ->
+ let more = row_more row in
+ let mored = get_desc more in
(* We must substitute in a subtle way *)
(* Tsubst takes a tuple containing the row var and the variant *)
- begin match more.desc with
+ begin match mored with
Tsubst (_, Some ty2) ->
(* This variant type has been already copied *)
- Private_type_expr.set_desc ty (Tsubst (ty2, None));
- (* avoid Tlink in the new type *)
+ (* Change the stub to avoid Tlink in the new type *)
+ For_copy.redirect_desc scope ty (Tsubst (ty2, None));
Tlink ty2
| _ ->
(* If the row variable is not generic, we must keep it *)
- let keep = more.level <> generic_level && partial = None in
+ let keep = get_level more <> generic_level && partial = None in
let more' =
- match more.desc with
+ match mored with
Tsubst (ty, None) -> ty
(* TODO: is this case possible?
possibly an interaction with (copy more) below? *)
| Tconstr _ | Tnil ->
- For_copy.save_desc scope more more.desc;
copy more
| Tvar _ | Tunivar _ ->
- For_copy.save_desc scope more more.desc;
- if keep then more else newty more.desc
+ if keep then more else newty mored
| _ -> assert false
in
let row =
- match repr more' with (* PR#6163 *)
- {desc=Tconstr (x,_,_)} when not (is_fixed row) ->
- {row with row_fixed = Some (Reified x)}
+ match get_desc more' with (* PR#6163 *)
+ Tconstr (x,_,_) when not (is_fixed row) ->
+ let Row {fields; more; closed; name} = row_repr row in
+ create_row ~fields ~more ~closed ~name
+ ~fixed:(Some (Reified x))
| _ -> row
in
(* Open row if partial for pattern and contains Reither *)
match partial with
Some (free_univars, false) ->
let more' =
- if more.id <> more'.id then
+ if not (eq_type more more') then
more' (* we've already made a copy *)
else
newvar ()
Reither _ -> false
| _ -> true
in
- if row.row_closed && not (is_fixed row)
+ let fields = row_fields row in
+ if row_closed row && not (is_fixed row)
&& TypeSet.is_empty (free_univars ty)
- && not (List.for_all not_reither row.row_fields) then
+ && not (List.for_all not_reither fields) then
(more',
- {row_fields = List.filter not_reither row.row_fields;
- row_more = more'; row_bound = ();
- row_closed = false; row_fixed = None; row_name = None})
+ create_row ~fields:(List.filter not_reither fields)
+ ~more:more' ~closed:false ~fixed:None ~name:None)
else (more', row)
| _ -> (more', row)
in
(* Register new type first for recursion *)
- Private_type_expr.set_desc
- more (Tsubst (more', Some t));
+ For_copy.redirect_desc scope more
+ (Tsubst(more', Some t));
(* Return a new copy *)
Tvariant (copy_row copy true row keep more')
end
- | Tfield (_p, k, _ty1, ty2) ->
- begin match field_kind_repr k with
- Fabsent -> Tlink (copy ty2)
- | Fpresent -> copy_type_desc copy desc
- | Fvar r ->
- For_copy.dup_kind scope r;
- copy_type_desc copy desc
- end
| Tobject (ty1, _) when partial <> None ->
Tobject (copy ty1, ref None)
| _ -> copy_type_desc ?keep_names copy desc
- end;
+ in
+ Transient_expr.set_stub_desc t desc';
t
(**** Variants of instantiations ****)
type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
}
-let existential_name cstr ty = match repr ty with
- | {desc = Tvar (Some name)} -> "$" ^ cstr.cstr_name ^ "_'" ^ name
+let existential_name cstr ty =
+ match get_desc ty with
+ | Tvar (Some name) -> "$" ^ cstr.cstr_name ^ "_'" ^ name
| _ -> "$" ^ cstr.cstr_name
let instance_constructor ?in_pattern cstr =
| Cty_signature sign ->
Cty_signature
{csig_self = copy scope sign.csig_self;
+ csig_self_row = copy scope sign.csig_self_row;
csig_vars =
- Vars.map (function (m, v, ty) -> (m, v, copy scope ty))
+ Vars.map
+ (function (m, v, ty) -> (m, v, copy scope ty))
sign.csig_vars;
- csig_concr = sign.csig_concr;
- csig_inher =
- List.map (fun (p,tl) -> (p, List.map (copy scope) tl))
- sign.csig_inher}
+ csig_meths =
+ Meths.map
+ (function (p, v, ty) -> (p, v, copy scope ty))
+ sign.csig_meths}
| Cty_arrow (l, ty, cty) ->
Cty_arrow (l, copy scope ty, copy_class_type scope cty)
in
| a :: l1 -> a :: diff_list l1 l2
let conflicts free bound =
- let bound = List.map repr bound in
- TypeSet.exists (fun t -> List.memq (repr t) bound) free
+ let bound = List.map get_id bound in
+ TypeSet.exists (fun t -> List.memq (get_id t) bound) free
let delayed_copy = ref []
(* copying to do later *)
(* Copy without sharing until there are no free univars left *)
(* all free univars must be included in [visited] *)
-let rec copy_sep cleanup_scope fixed free bound visited ty =
- let ty = repr ty in
+let rec copy_sep ~cleanup_scope ~fixed ~free ~bound ~may_share
+ (visited : (int * (type_expr * type_expr list)) list) (ty : type_expr) =
let univars = free ty in
- if TypeSet.is_empty univars then
- if ty.level <> generic_level then ty else
- let t = newvar () in
+ if is_Tvar ty || may_share && TypeSet.is_empty univars then
+ if get_level ty <> generic_level then ty else
+ let t = newstub ~scope:(get_scope ty) in
delayed_copy :=
- lazy (Private_type_expr.set_desc t (Tlink (copy cleanup_scope ty)))
+ lazy (Transient_expr.set_stub_desc t (Tlink (copy cleanup_scope ty)))
:: !delayed_copy;
t
else try
- let t, bound_t = List.assq ty visited in
+ let t, bound_t = List.assq (get_id ty) visited in
let dl = if is_Tunivar ty then [] else diff_list bound bound_t in
if dl <> [] && conflicts univars dl then raise Not_found;
t
with Not_found -> begin
- let t = newvar() in (* Stub *)
+ let t = newstub ~scope:(get_scope ty) in
+ let desc = get_desc ty in
let visited =
- match ty.desc with
+ match desc with
Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ | Tpackage _ ->
- (ty,(t,bound)) :: visited
+ (get_id ty, (t, bound)) :: visited
| Tvar _ | Tfield _ | Tnil | Tpoly _ | Tunivar _ ->
visited
| Tlink _ | Tsubst _ ->
assert false
in
- let copy_rec = copy_sep cleanup_scope fixed free bound visited in
- Private_type_expr.set_desc t
- begin match ty.desc with
- | Tvariant row0 ->
- let row = row_repr row0 in
- let more = repr row.row_more in
+ let copy_rec = copy_sep ~cleanup_scope ~fixed ~free ~bound visited in
+ let desc' =
+ match desc with
+ | Tvariant row ->
+ let more = row_more row in
(* We shall really check the level on the row variable *)
- let keep = is_Tvar more && more.level <> generic_level in
- let more' = copy_rec more in
+ let keep = is_Tvar more && get_level more <> generic_level in
+ let more' = copy_rec ~may_share:false more in
let fixed' = fixed && (is_Tvar more || is_Tunivar more) in
- let row = copy_row copy_rec fixed' row keep more' in
+ let row =
+ copy_row (copy_rec ~may_share:true) fixed' row keep more' in
Tvariant row
| Tpoly (t1, tl) ->
- let tl = List.map repr tl in
- let tl' = List.map (fun t -> newty t.desc) tl in
+ let tl' = List.map (fun t -> newty (get_desc t)) tl in
let bound = tl @ bound in
let visited =
- List.map2 (fun ty t -> ty,(t,bound)) tl tl' @ visited in
- Tpoly (copy_sep cleanup_scope fixed free bound visited t1, tl')
- | _ -> copy_type_desc copy_rec ty.desc
- end;
+ List.map2 (fun ty t -> get_id ty, (t, bound)) tl tl' @ visited in
+ let body =
+ copy_sep ~cleanup_scope ~fixed ~free ~bound ~may_share:true
+ visited t1 in
+ Tpoly (body, tl')
+ | Tfield (p, k, ty1, ty2) ->
+ (* the kind is kept shared, see Btype.copy_type_desc *)
+ Tfield (p, field_kind_internal_repr k, copy_rec ~may_share:true ty1,
+ copy_rec ~may_share:false ty2)
+ | _ -> copy_type_desc (copy_rec ~may_share:true) desc
+ in
+ Transient_expr.set_stub_desc t desc';
t
end
let instance_poly' cleanup_scope ~keep_names fixed univars sch =
- (* In order to compute univars below, [sch] schould not contain [Tsubst] *)
- let univars = List.map repr univars in
+ (* In order to compute univars below, [sch] should not contain [Tsubst] *)
let copy_var ty =
- match ty.desc with
+ match get_desc ty with
Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
| _ -> assert false
in
let vars = List.map copy_var univars in
- let pairs = List.map2 (fun u v -> u, (v, [])) univars vars in
+ let pairs = List.map2 (fun u v -> get_id u, (v, [])) univars vars in
delayed_copy := [];
- let ty = copy_sep cleanup_scope fixed (compute_univars sch) [] pairs sch in
+ let ty =
+ copy_sep ~cleanup_scope ~fixed ~free:(compute_univars sch) ~bound:[]
+ ~may_share:true pairs sch in
List.iter Lazy.force !delayed_copy;
delayed_copy := [];
vars, ty
let instance_label fixed lbl =
For_copy.with_scope (fun scope ->
let vars, ty_arg =
- match repr lbl.lbl_arg with
- {desc = Tpoly (ty, tl)} ->
+ match get_desc lbl.lbl_arg with
+ Tpoly (ty, tl) ->
instance_poly' scope ~keep_names:false fixed tl ty
| _ ->
[], copy scope lbl.lbl_arg
(**** Instantiation with parameter substitution ****)
-let unify' = (* Forward declaration *)
+(* NB: since this is [unify_var], it raises [Unify], not [Unify_trace] *)
+let unify_var' = (* Forward declaration *)
ref (fun _env _ty1 _ty2 -> assert false)
-
-let subst env level priv abbrev ty params args body =
+let subst env level priv abbrev oty params args body =
if List.length params <> List.length args then raise Cannot_subst;
let old_level = !current_level in
current_level := level;
let body0 = newvar () in (* Stub *)
let undo_abbrev =
- match ty with
+ match oty with
| None -> fun () -> () (* No abbreviation added *)
- | Some ({desc = Tconstr (path, tl, _)} as ty) ->
- let abbrev = proper_abbrevs path tl abbrev in
- memorize_abbrev abbrev priv path ty body0;
- fun () -> forget_abbrev abbrev path
- | _ ->
- assert false
+ | Some ty ->
+ match get_desc ty with
+ Tconstr (path, tl, _) ->
+ let abbrev = proper_abbrevs path tl abbrev in
+ memorize_abbrev abbrev priv path ty body0;
+ fun () -> forget_abbrev abbrev path
+ | _ -> assert false
in
abbreviations := abbrev;
let (params', body') = instance_parameterized_type params body in
abbreviations := ref Mnil;
try
- !unify' env body0 body';
- List.iter2 (!unify' env) params' args;
+ !unify_var' env body0 body';
+ List.iter2 (!unify_var' env) params' args;
current_level := old_level;
body'
with Unify _ ->
*)
let expand_abbrev_gen kind find_type_expansion env ty =
check_abbrev_env env;
- match ty with
- {desc = Tconstr (path, args, abbrev); level = level; scope} ->
+ match get_desc ty with
+ Tconstr (path, args, abbrev) ->
+ let level = get_level ty in
+ let scope = get_scope ty in
let lookup_abbrev = proper_abbrevs path args abbrev in
begin match find_expans kind path !lookup_abbrev with
Some ty' ->
typing error *)
()
end;
- let ty' = repr ty' in
- (* assert (ty != ty'); *) (* PR#7324 *)
ty'
| None ->
match find_type_expansion path env with
(* another way to expand is to normalize the path itself *)
let path' = Env.normalize_type_path None env path in
if Path.same path path' then raise Cannot_expand
- else newty2 level (Tconstr (path', args, abbrev))
+ else newty2 ~level (Tconstr (path', args, abbrev))
| (params, body, lv) ->
(* prerr_endline
("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
(* For gadts, remember type as non exportable *)
(* The ambiguous level registered for ty' should be the highest *)
(* if !trace_gadt_instances then begin *)
- let scope = Int.max lv ty.scope in
+ let scope = Int.max lv (get_scope ty) in
update_scope scope ty;
update_scope scope ty';
ty'
(* Expand once the head of a type *)
let expand_head_once env ty =
try
- expand_abbrev env (repr ty)
+ expand_abbrev env ty
with Cannot_expand | Escape _ -> assert false
(* Check whether a type can be expanded *)
Raise Cannot_expand if the type cannot be expanded.
May raise Escape, if a recursion was hidden in the type. *)
let try_expand_once env ty =
- let ty = repr ty in
- match ty.desc with
- Tconstr _ -> repr (expand_abbrev env ty)
+ match get_desc ty with
+ Tconstr _ -> expand_abbrev env ty
| _ -> raise Cannot_expand
(* This one only raises Cannot_expand *)
Btype.backtrack snap; cleanup_abbrev (); raise Cannot_expand
(* Fully expand the head of a type. *)
-let rec try_expand_head try_once env ty =
+let rec try_expand_head
+ (try_once : Env.t -> type_expr -> type_expr) env ty =
let ty' = try_once env ty in
try try_expand_head try_once env ty'
with Cannot_expand -> ty'
try
try_expand_head try_expand_once env ty
with
- | Cannot_expand -> repr ty
+ | Cannot_expand -> ty
| Escape e -> raise_for Unify (Escape e)
(* Safe version of expand_head, never fails *)
let expand_head env ty =
- try try_expand_head try_expand_safe env ty with Cannot_expand -> repr ty
+ try try_expand_head try_expand_safe env ty
+ with Cannot_expand -> ty
let _ = forward_try_expand_safe := try_expand_safe
called on recursive types
*)
+type typedecl_extraction_result =
+ | Typedecl of Path.t * Path.t * type_declaration
+ | Has_no_typedecl
+ | May_have_typedecl
+
let rec extract_concrete_typedecl env ty =
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tconstr (p, _, _) ->
- let decl = Env.find_type p env in
- if decl.type_kind <> Type_abstract then (p, p, decl) else
- let ty =
- try try_expand_safe env ty with Cannot_expand -> raise Not_found
- in
- let (_, p', decl) = extract_concrete_typedecl env ty in
- (p, p', decl)
- | _ -> raise Not_found
+ begin match Env.find_type p env with
+ | exception Not_found -> May_have_typedecl
+ | decl ->
+ if decl.type_kind <> Type_abstract then Typedecl(p, p, decl)
+ else begin
+ match try_expand_safe env ty with
+ | exception Cannot_expand -> May_have_typedecl
+ | ty ->
+ match extract_concrete_typedecl env ty with
+ | Typedecl(_, p', decl) -> Typedecl(p, p', decl)
+ | Has_no_typedecl -> Has_no_typedecl
+ | May_have_typedecl -> May_have_typedecl
+ end
+ end
+ | Tpoly(ty, _) -> extract_concrete_typedecl env ty
+ | Tarrow _ | Ttuple _ | Tobject _ | Tfield _ | Tnil
+ | Tvariant _ | Tpackage _ -> Has_no_typedecl
+ | Tvar _ | Tunivar _ -> May_have_typedecl
+ | Tlink _ | Tsubst _ -> assert false
(* Implementing function [expand_head_opt], the compiler's own version of
[expand_head] used for type-based optimisations.
false
let try_expand_once_opt env ty =
- let ty = repr ty in
- match ty.desc with
- Tconstr _ -> repr (expand_abbrev_opt env ty)
+ match get_desc ty with
+ Tconstr _ -> expand_abbrev_opt env ty
| _ -> raise Cannot_expand
let try_expand_safe_opt env ty =
Btype.backtrack snap; raise Cannot_expand
let expand_head_opt env ty =
- try try_expand_head try_expand_safe_opt env ty with Cannot_expand -> repr ty
+ try try_expand_head try_expand_safe_opt env ty with Cannot_expand -> ty
(* Recursively expand the head of a type.
Also expand #-types.
let full_expand ~may_forget_scope env ty =
let ty =
if may_forget_scope then
- let ty = repr ty in
- try expand_head_unif env ty with Unify _ ->
+ try expand_head_unif env ty with Unify_trace _ ->
(* #10277: forget scopes when printing trace *)
begin_def ();
- init_def ty.level;
+ init_def (get_level ty);
let ty =
(* The same as [expand_head], except in the failing case we return the
*original* type, not [correct_levels ty].*)
try try_expand_head try_expand_safe env (correct_levels ty) with
- | Cannot_expand -> repr ty
+ | Cannot_expand -> ty
in
end_def ();
ty
else expand_head env ty
in
- let ty = repr ty in
- match ty.desc with
- Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar (repr v) ->
- newty2 ty.level (Tobject (fi, ref None))
+ match get_desc ty with
+ Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar v ->
+ newty2 ~level:(get_level ty) (Tobject (fi, ref None))
| _ ->
ty
let generic_abbrev env path =
try
let (_, body, _) = Env.find_type_expansion path env in
- (repr body).level = generic_level
+ get_level body = generic_level
with
Not_found ->
false
{type_kind = Type_abstract;
type_private = Private;
type_manifest = Some body} ->
- (repr body).level = generic_level
+ get_level body = generic_level
| _ -> false
with Not_found -> false
exception Occur
-let rec occur_rec env allow_recursive visited ty0 = function
- | {desc=Tlink ty} ->
- occur_rec env allow_recursive visited ty0 ty
- | ty ->
- if ty == ty0 then raise Occur;
- match ty.desc with
+let rec occur_rec env allow_recursive visited ty0 ty =
+ if eq_type ty ty0 then raise Occur;
+ match get_desc ty with
Tconstr(p, _tl, _abbrev) ->
if allow_recursive && is_contractive env p then () else
begin try
try
while
type_changed := false;
- occur_rec env allow_recursive TypeSet.empty ty0 ty;
+ if not (eq_type ty0 ty) then
+ occur_rec env allow_recursive TypeSet.empty ty0 ty;
!type_changed
do () (* prerr_endline "changed" *) done;
merge type_changed old
let rec local_non_recursive_abbrev ~allow_rec strict visited env p ty =
(*Format.eprintf "@[Check %s =@ %a@]@." (Path.name p) !Btype.print_raw ty;*)
- let ty = repr ty in
- if not (List.memq ty visited) then begin
- match ty.desc with
+ if not (List.memq (get_id ty) visited) then begin
+ match get_desc ty with
Tconstr(p', args, _abbrev) ->
if Path.same p p' then raise Occur;
if allow_rec && not strict && is_contractive env p' then () else
- let visited = ty :: visited in
+ let visited = get_id ty :: visited in
begin try
(* try expanding, since [p] could be hidden *)
local_non_recursive_abbrev ~allow_rec strict visited env p
in
List.iter2
(fun tv ty ->
- let strict = strict || not (is_Tvar (repr tv)) in
+ let strict = strict || not (is_Tvar tv) in
local_non_recursive_abbrev ~allow_rec strict visited env p ty)
params args
end
()
| _ ->
if strict || not allow_rec then (* PR#7374 *)
- let visited = ty :: visited in
+ let visited = get_id ty :: visited in
iter_type_expr
(local_non_recursive_abbrev ~allow_rec true visited env p) ty
end
(cl1, cl2) :: rem ->
let find_univ t cl =
try
- let (_, r) = List.find (fun (t',_) -> t == repr t') cl in
+ let (_, r) = List.find (fun (t',_) -> eq_type t t') cl in
Some r
with Not_found -> None
in
begin match find_univ t1 cl1, find_univ t2 cl2 with
- Some {contents=Some t'2}, Some _ when t2 == repr t'2 ->
+ Some {contents=Some t'2}, Some _ when eq_type t2 t'2 ->
()
| Some({contents=None} as r1), Some({contents=None} as r2) ->
set_univar r1 t2; set_univar r2 t1
let occur_univar ?(inj_only=false) env ty =
let visited = ref TypeMap.empty in
let rec occur_rec bound ty =
- let ty = repr ty in
if not_marked_node ty then
if TypeSet.is_empty bound then
(flip_mark_node ty; occur_desc bound ty)
visited := TypeMap.add ty bound !visited;
occur_desc bound ty
and occur_desc bound ty =
- match ty.desc with
+ match get_desc ty with
Tunivar _ ->
if not (TypeSet.mem ty bound) then
raise_escape_exn (Univ ty)
| Tpoly (ty, tyl) ->
- let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
+ let bound = List.fold_right TypeSet.add tyl bound in
occur_rec bound ty
| Tconstr (_, [], _) -> ()
| Tconstr (p, tl, _) ->
(* Grouping univars by families according to their binders *)
let add_univars =
- List.fold_left (fun s (t,_) -> TypeSet.add (repr t) s)
+ List.fold_left (fun s (t,_) -> TypeSet.add t s)
let get_univar_family univar_pairs univars =
if univars = [] then TypeSet.empty else
let insert s = function
cl1, (_::_ as cl2) ->
- if List.exists (fun (t1,_) -> TypeSet.mem (repr t1) s) cl1 then
+ if List.exists (fun (t1,_) -> TypeSet.mem t1 s) cl1 then
add_univars s cl2
else s
| _ -> s
let family = get_univar_family univar_pairs vl in
let visited = ref TypeSet.empty in
let rec occur t =
- let t = repr t in
if TypeSet.mem t !visited then () else begin
visited := TypeSet.add t !visited;
- match t.desc with
+ match get_desc t with
Tpoly (t, tl) ->
- if List.exists (fun t -> TypeSet.mem (repr t) family) tl then ()
+ if List.exists (fun t -> TypeSet.mem t family) tl then ()
else occur t
| Tunivar _ -> if TypeSet.mem t family then raise_escape_exn (Univ t)
| Tconstr (_, [], _) -> ()
List.fold_left (fun s (cl,_) -> add_univars s cl)
TypeSet.empty old_univars
in
- let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
if List.exists (fun t -> TypeSet.mem t known_univars) tl1 then
univars_escape env old_univars tl1 (newty(Tpoly(t2,tl2)));
if List.exists (fun t -> TypeSet.mem t known_univars) tl2 then
let polyfy env ty vars =
let subst_univar scope ty =
- let ty = repr ty in
- match ty.desc with
- | Tvar name when ty.level = generic_level ->
- For_copy.save_desc scope ty ty.desc;
+ match get_desc ty with
+ | Tvar name when get_level ty = generic_level ->
let t = newty (Tunivar name) in
- Private_type_expr.set_desc ty (Tsubst (t, None));
+ For_copy.redirect_desc scope ty (Tsubst (t, None));
Some t
| _ -> None
in
For_copy.with_scope (fun scope ->
let vars' = List.filter_map (subst_univar scope) vars in
let ty = copy scope ty in
- let ty = newty2 ty.level (Tpoly(repr ty, vars')) in
+ let ty = newty2 ~level:(get_level ty) (Tpoly(ty, vars')) in
let complete = List.length vars = List.length vars' in
ty, complete
)
let rec has_cached_expansion p abbrev =
match abbrev with
- Mnil -> false
- | Mcons(_, p', _, _, rem) -> Path.same p p' || has_cached_expansion p rem
- | Mlink rem -> has_cached_expansion p !rem
+ Mnil -> false
+ | Mcons(_, p', _, _, rem) -> Path.same p p' || has_cached_expansion p rem
+ | Mlink rem -> has_cached_expansion p !rem
(**** Transform error trace ****)
(* +++ Move it to some other place ? *)
+(* That's hard to do because it relies on the expansion machinery in Ctype,
+ but still might be nice. *)
+
+let expand_type env ty =
+ { ty = ty;
+ expanded = full_expand ~may_forget_scope:true env ty }
let expand_any_trace map env trace =
- let expand_desc x = match x.Errortrace.expanded with
- | None ->
- let expanded = full_expand ~may_forget_scope:true env x.t in
- Errortrace.{ t = repr x.t; expanded = Some expanded }
- | Some _ -> x in
- map expand_desc trace
+ map (expand_type env) trace
let expand_trace env trace =
expand_any_trace Errortrace.map env trace
let expand_subtype_trace env trace =
expand_any_trace Subtype.map env trace
+let expand_to_unification_error env trace =
+ unification_error ~trace:(expand_trace env trace)
+
+let expand_to_equality_error env trace subst =
+ equality_error ~trace:(expand_trace env trace) ~subst
+
+let expand_to_moregen_error env trace =
+ moregen_error ~trace:(expand_trace env trace)
+
+(* [expand_trace] and the [expand_to_*_error] functions take care of most of the
+ expansion in this file, but we occasionally need to build [Errortrace.error]s
+ in other ways/elsewhere, so we expose some machinery for doing so
+*)
+
+(* Equivalent to [expand_trace env [Diff {got; expected}]] for a single
+ element *)
+let expanded_diff env ~got ~expected =
+ Diff (map_diff (expand_type env) {got; expected})
+
+(* Diff while transforming a [type_expr] into an [expanded_type] without
+ expanding *)
+let unexpanded_diff ~got ~expected =
+ Diff (map_diff trivial_expansion {got; expected})
+
(**** Unification ****)
(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
let deep_occur t0 ty =
let rec occur_rec ty =
- let ty = repr ty in
- if ty.level >= t0.level && try_mark_node ty then begin
- if ty == t0 then raise Occur;
+ if get_level ty >= get_level t0 && try_mark_node ty then begin
+ if eq_type ty t0 then raise Occur;
iter_type_expr occur_rec ty
end
in
Env.enter_type (get_new_abstract_name name) decl !env
~scope:fresh_constr_scope in
let path = Path.Pident id in
- let t = newty2 lev (Tconstr (path,[],ref Mnil)) in
+ let t = newty2 ~level:lev (Tconstr (path,[],ref Mnil)) in
env := new_env;
path, t
in
let visited = ref TypeSet.empty in
let rec iterator ty =
- let ty = repr ty in
if TypeSet.mem ty !visited then () else begin
visited := TypeSet.add ty !visited;
- match ty.desc with
+ match get_desc ty with
Tvar o ->
- let path, t = create_fresh_constr ty.level o in
+ let level = get_level ty in
+ let path, t = create_fresh_constr level o in
link_type ty t;
- if ty.level < fresh_constr_scope then
+ if level < fresh_constr_scope then
raise_for Unify (Escape (escape (Constructor path)))
| Tvariant r ->
- let r = row_repr r in
if not (static_row r) then begin
if is_fixed r then iterator (row_more r) else
- let m = r.row_more in
- match m.desc with
+ let m = row_more r in
+ match get_desc m with
Tvar o ->
- let path, t = create_fresh_constr m.level o in
+ let level = get_level m in
+ let path, t = create_fresh_constr level o in
let row =
- 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
+ let fixed = Some (Reified path) in
+ create_row ~fields:[] ~more:t ~fixed
+ ~name:(row_name r) ~closed:(row_closed r) in
+ link_type m (newty2 ~level (Tvariant row));
+ if level < fresh_constr_scope then
raise_for Unify (Escape (escape (Constructor path)))
| _ -> assert false
end;
(* Check for datatypes carefully; see PR#6348 *)
let rec expands_to_datatype env ty =
- let ty = repr ty in
- match ty.desc with
+ match get_desc ty with
Tconstr (p, _, _) ->
begin try
is_datatype (Env.find_type p env) ||
*)
let rec mcomp type_pairs env t1 t2 =
- if t1 == t2 then () else
- let t1 = repr t1 in
- let t2 = repr t2 in
- if t1 == t2 then () else
- match (t1.desc, t2.desc) with
+ if eq_type t1 t2 then () else
+ match (get_desc t1, get_desc t2) with
| (Tvar _, _)
| (_, Tvar _) ->
()
let t1' = expand_head_opt env t1 in
let t2' = expand_head_opt env t2 in
(* Expansion may have changed the representative of the types... *)
- let t1' = repr t1' and t2' = repr t2' in
- if t1' == t2' then () else
- begin try TypePairs.find type_pairs (t1', t2')
- with Not_found ->
- TypePairs.add type_pairs (t1', t2') ();
- match (t1'.desc, t2'.desc) with
+ if eq_type t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
| (Tvar _, _)
| (_, Tvar _) ->
()
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) ->
mcomp_type_decl type_pairs env p1 p2 tl1 tl2
| (Tconstr (_, [], _), _) when has_injective_univars env t2' ->
- raise (Unify [])
+ raise_unexplained_for Unify
| (_, Tconstr (_, [], _)) when has_injective_univars env t1' ->
- raise (Unify [])
+ raise_unexplained_for Unify
| (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) ->
begin try
let decl = Env.find_type p env in
let (fields1, rest1) = flatten_fields ty1 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
let has_present =
- List.exists (fun (_, k, _) -> field_kind_repr k = Fpresent) in
+ List.exists (fun (_, k, _) -> field_kind_repr k = Fpublic) in
mcomp type_pairs env rest1 rest2;
- if has_present miss1 && (object_row ty2).desc = Tnil
- || has_present miss2 && (object_row ty1).desc = Tnil then raise Incompatible;
+ if has_present miss1 && get_desc (object_row ty2) = Tnil
+ || has_present miss2 && get_desc (object_row ty1) = Tnil
+ then raise Incompatible;
List.iter
(function (_n, k1, t1, k2, t2) ->
mcomp_kind k1 k2;
let k1 = field_kind_repr k1 in
let k2 = field_kind_repr k2 in
match k1, k2 with
- (Fpresent, Fabsent)
- | (Fabsent, Fpresent) -> raise Incompatible
- | _ -> ()
+ (Fpublic, Fabsent)
+ | (Fabsent, Fpublic) -> raise Incompatible
+ | _ -> ()
and mcomp_row type_pairs env row1 row2 =
- let row1 = row_repr row1 and row2 = row_repr row2 in
- let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+ let r1, r2, pairs = merge_row_fields (row_fields row1) (row_fields row2) in
let cannot_erase (_,f) =
match row_field_repr f with
Rpresent _ -> true
| Rabsent | Reither _ -> false
in
- if row1.row_closed && List.exists cannot_erase r2
- || row2.row_closed && List.exists cannot_erase r1 then raise Incompatible;
+ if row_closed row1 && List.exists cannot_erase r2
+ || row_closed row2 && List.exists cannot_erase r1 then raise Incompatible;
List.iter
(fun (_,f1,f2) ->
match row_field_repr f1, row_field_repr f2 with
- | Rpresent None, (Rpresent (Some _) | Reither (_, _::_, _, _) | Rabsent)
- | Rpresent (Some _), (Rpresent None | Reither (true, _, _, _) | Rabsent)
- | (Reither (_, _::_, _, _) | Rabsent), Rpresent None
- | (Reither (true, _, _, _) | Rabsent), Rpresent (Some _) ->
+ | Rpresent None, (Rpresent (Some _) | Reither (_, _::_, _) | Rabsent)
+ | Rpresent (Some _), (Rpresent None | Reither (true, _, _) | Rabsent)
+ | (Reither (_, _::_, _) | Rabsent), Rpresent None
+ | (Reither (true, _, _) | Rabsent), Rpresent (Some _) ->
raise Incompatible
| Rpresent(Some t1), Rpresent(Some t2) ->
mcomp type_pairs env t1 t2
- | Rpresent(Some t1), Reither(false, tl2, _, _) ->
+ | Rpresent(Some t1), Reither(false, tl2, _) ->
List.iter (mcomp type_pairs env t1) tl2
- | Reither(false, tl1, _, _), Rpresent(Some t2) ->
+ | Reither(false, tl1, _), Rpresent(Some t2) ->
List.iter (mcomp type_pairs env t2) tl1
| _ -> ())
pairs
let find_lowest_level ty =
let lowest = ref generic_level in
let rec find ty =
- let ty = repr ty in
if not_marked_node ty then begin
- if ty.level < !lowest then lowest := ty.level;
+ let level = get_level ty in
+ if level < !lowest then lowest := level;
flip_mark_node ty;
iter_type_expr find ty
end
let unify_eq_set = TypePairs.create 11
let order_type_pair t1 t2 =
- if t1.id <= t2.id then (t1, t2) else (t2, t1)
+ if get_id t1 <= get_id t2 then (t1, t2) else (t2, t1)
let add_type_equality t1 t2 =
- TypePairs.add unify_eq_set (order_type_pair t1 t2) ()
+ TypePairs.add unify_eq_set (order_type_pair t1 t2)
let eq_package_path env p1 p2 =
Path.same p1 p2 ||
let rigid_variants = ref false
let unify_eq t1 t2 =
- t1 == t2 ||
+ eq_type t1 t2 ||
match !umode with
| Expression -> false
| Pattern ->
- try TypePairs.find unify_eq_set (order_type_pair t1 t2); true
- with Not_found -> false
+ TypePairs.mem unify_eq_set (order_type_pair t1 t2)
let unify1_var env t1 t2 =
assert (is_Tvar t1);
| () ->
begin
try
- update_level env t1.level t2;
- update_scope t1.scope t2
+ update_level env (get_level t1) t2;
+ update_scope (get_scope t1) t2;
with Escape e ->
raise_for Unify (Escape e)
end;
link_type t1 t2;
true
- | exception Unify _ when !umode = Pattern ->
+ | exception Unify_trace _ when !umode = Pattern ->
false
(* Can only be called when generate_equations is true *)
let record_equation t1 t2 =
match !equations_generation with
| Forbidden -> assert false
- | Allowed { equated_types } -> TypePairs.add equated_types (t1, t2) ()
+ | Allowed { equated_types } ->
+ TypePairs.add equated_types (t1, t2)
(* Called from unify3 *)
let unify3_var env t1' t2 t2' =
occur_for Unify !env t1' t2;
match occur_univar_for Unify !env t2 with
| () -> link_type t1' t2
- | exception Unify _ when !umode = Pattern ->
+ | exception Unify_trace _ when !umode = Pattern ->
reify env t1';
reify env t2';
if can_generate_equations () then begin
let rec unify (env:Env.t ref) t1 t2 =
(* First step: special cases (optimizations) *)
- if t1 == t2 then () else
- let t1 = repr t1 in
- let t2 = repr t2 in
if unify_eq t1 t2 then () else
let reset_tracing = check_trace_gadt_instances !env in
try
type_changed := true;
- begin match (t1.desc, t2.desc) with
+ begin match (get_desc t1, get_desc t2) with
(Tvar _, Tconstr _) when deep_occur t1 t2 ->
unify2 env t1 t2
| (Tconstr _, Tvar _) when deep_occur t2 t1 ->
if unify1_var !env t2 t1 then () else unify2 env t1 t2
| (Tunivar _, Tunivar _) ->
unify_univar_for Unify t1 t2 !univar_pairs;
- update_level_for Unify !env t1.level t2;
- update_scope_for Unify t1.scope t2;
+ update_level_for Unify !env (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
link_type t1 t2
| (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
when Path.same p1 p2 (* && actual_mode !env = Old *)
when any of the types has a cached expansion. *)
&& not (has_cached_expansion p1 !a1
|| has_cached_expansion p2 !a2) ->
- update_level_for Unify !env t1.level t2;
- update_scope_for Unify t1.scope t2;
+ update_level_for Unify !env (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
link_type t1 t2
| (Tconstr (p1, [], _), Tconstr (p2, [], _))
when Env.has_local_constraints !env
unify2 env t1 t2
end;
reset_trace_gadt_instances reset_tracing;
- with Unify trace ->
+ with Unify_trace trace ->
reset_trace_gadt_instances reset_tracing;
- raise( Unify (Errortrace.diff t1 t2 :: trace) )
+ raise_trace_for Unify (Diff {got = t1; expected = t2} :: trace)
and unify2 env t1 t2 =
(* Second step: expansion of abbreviations *)
ignore (expand_head_unif !env t2);
let t1' = expand_head_unif !env t1 in
let t2' = expand_head_unif !env t2 in
- let lv = Int.min t1'.level t2'.level in
- let scope = Int.max t1'.scope t2'.scope in
+ let lv = Int.min (get_level t1') (get_level t2') in
+ let scope = Int.max (get_scope t1') (get_scope t2') in
update_level_for Unify !env lv t2;
update_level_for Unify !env lv t1;
update_scope_for Unify scope t2;
update_scope_for Unify scope t1;
if unify_eq t1' t2' then () else
- let t1 = repr t1 and t2 = repr t2 in
let t1, t2 =
if !Clflags.principal
&& (find_lowest_level t1' < lv || find_lowest_level t2' < lv) then
(* Expand abbreviations hiding a lower level *)
(* Should also do it for parameterized types, after unification... *)
- (match t1.desc with Tconstr (_, [], _) -> t1' | _ -> t1),
- (match t2.desc with Tconstr (_, [], _) -> t2' | _ -> t2)
+ (match get_desc t1 with Tconstr (_, [], _) -> t1' | _ -> t1),
+ (match get_desc t2 with Tconstr (_, [], _) -> t2' | _ -> t2)
else (t1, t2)
in
if unify_eq t1 t1' || not (unify_eq t2 t2') then
unify3 env t1 t1' t2 t2'
else
- try unify3 env t2 t2' t1 t1' with Unify trace ->
+ try unify3 env t2 t2' t1 t1' with Unify_trace trace ->
raise_trace_for Unify (swap_trace trace)
and unify3 env t1 t1' t2 t2' =
(* Third step: truly unification *)
(* Assumes either [t1 == t1'] or [t2 != t2'] *)
- let d1 = t1'.desc and d2 = t2'.desc in
- let create_recursion = (t2 != t2') && (deep_occur t1' t2) in
+ let tt1' = Transient_expr.repr t1' in
+ let d1 = tt1'.desc and d2 = get_desc t2' in
+ let create_recursion =
+ (not (eq_type t2 t2')) && (deep_occur t1' t2) in
begin match (d1, d2) with (* handle vars and univars specially *)
(Tunivar _, Tunivar _) ->
| _ ->
begin match !umode with
| Expression ->
- occur_for Unify !env t1' t2';
- if is_self_type d1 (* PR#7711: do not abbreviate self type *)
- then link_type t1' t2'
- else link_type t1' t2
+ occur_for Unify !env t1' t2;
+ link_type t1' t2
| Pattern ->
add_type_equality t1' t2'
end;
(!Clflags.classic || !umode = Pattern) &&
not (is_optional l1 || is_optional l2) ->
unify env t1 t2; unify env u1 u2;
- begin match commu_repr c1, commu_repr c2 with
- Clink r, c2 -> set_commu r c2
- | c1, Clink r -> set_commu r c1
- | _ -> ()
+ begin match is_commu_ok c1, is_commu_ok c2 with
+ | false, true -> set_commu_ok c1
+ | true, false -> set_commu_ok c2
+ | false, false -> link_commu ~inside:c1 c2
+ | true, true -> ()
end
| (Ttuple tl1, Ttuple tl2) ->
unify_list env tl1 tl2
~allow_recursive:!allow_recursive_equation
begin fun () ->
let snap = snapshot () in
- try unify env t1 t2 with Unify _ ->
+ try unify env t1 t2 with Unify_trace _ ->
backtrack snap;
reify env t1;
reify env t2
unify_fields env fi1 fi2;
(* Type [t2'] may have been instantiated by [unify_fields] *)
(* XXX One should do some kind of unification... *)
- begin match (repr t2').desc with
+ begin match get_desc t2' with
Tobject (_, {contents = Some (_, va::_)}) when
- (match (repr va).desc with
+ (match get_desc va with
Tvar _|Tunivar _|Tnil -> true | _ -> false) -> ()
| Tobject (_, nm2) -> set_name nm2 !nm1
| _ -> ()
else begin
let snap = snapshot () in
try unify_row env row1 row2
- with Unify _ ->
+ with Unify_trace _ ->
backtrack snap;
reify env t1';
reify env t2';
end
| (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
begin match field_kind_repr kind with
- Fvar r when f <> dummy_method ->
- set_kind r Fabsent;
+ Fprivate when f <> dummy_method ->
+ link_kind ~inside:kind field_absent;
if d2 = Tnil then unify env rem t2'
- else unify env (newty2 rem.level Tnil) rem
+ else unify env (newgenty Tnil) rem
| _ ->
if f = dummy_method then
raise_for Unify (Obj Self_cannot_be_closed)
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package !env (unify_list env)
- t1.level p1 fl1 t2.level p2 fl2
+ (get_level t1) p1 fl1 (get_level t2) p2 fl2
with Not_found ->
if !umode = Expression then raise_unexplained_for Unify;
List.iter (fun (_n, ty) -> reify env ty) (fl1 @ fl2);
(* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
end
| (Tnil, Tconstr _ ) ->
- raise (Unify Errortrace.[Obj(Abstract_row Second)])
+ raise_for Unify (Obj (Abstract_row Second))
| (Tconstr _, Tnil ) ->
- raise (Unify Errortrace.[Obj(Abstract_row First)])
+ raise_for Unify (Obj (Abstract_row First))
| (_, _) -> raise_unexplained_for Unify
end;
(* XXX Commentaires + changer "create_recursion"
||| Comments + change "create_recursion" *)
if create_recursion then
- match t2.desc with
+ match get_desc t2 with
Tconstr (p, tl, abbrev) ->
forget_abbrev abbrev p;
let t2'' = expand_head_unif !env t2 in
if not (closed_parameterized_type tl t2'') then
- link_type (repr t2) (repr t2')
+ link_type t2 t2'
| _ ->
() (* t2 has already been expanded by update_level *)
- with Unify trace ->
- Private_type_expr.set_desc t1' d1;
+ with Unify_trace trace ->
+ Transient_expr.set_desc tt1' d1;
raise_trace_for Unify trace
end
(* Build a fresh row variable for unification *)
and make_rowvar level use1 rest1 use2 rest2 =
let set_name ty name =
- match ty.desc with
+ match get_desc ty with
Tvar None -> set_type_desc ty (Tvar name)
| _ -> ()
in
let name =
- match rest1.desc, rest2.desc with
+ match get_desc rest1, get_desc rest2 with
Tvar (Some _ as name1), Tvar (Some _ as name2) ->
- if rest1.level <= rest2.level then name1 else name2
+ if get_level rest1 <= get_level rest2 then name1 else name2
| Tvar (Some _ as name), _ ->
if use2 then set_name rest2 name; name
| _, Tvar (Some _ as name) ->
| _ -> None
in
if use1 then rest1 else
- if use2 then rest2 else newvar2 ?name level
+ if use2 then rest2 else newty2 ~level (Tvar name)
and unify_fields env ty1 ty2 = (* Optimization *)
let (fields1, rest1) = flatten_fields ty1
and (fields2, rest2) = flatten_fields ty2 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
- let l1 = (repr ty1).level and l2 = (repr ty2).level in
+ let l1 = get_level ty1 and l2 = get_level ty2 in
let va = make_rowvar (Int.min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
- let d1 = rest1.desc and d2 = rest2.desc in
+ let tr1 = Transient_expr.repr rest1 and tr2 = Transient_expr.repr rest2 in
+ let d1 = tr1.desc and d2 = tr2.desc in
try
unify env (build_fields l1 miss1 va) rest2;
unify env rest1 (build_fields l2 miss2 va);
List.iter
- (fun (n, k1, t1, k2, t2) ->
+ (fun (name, k1, t1, k2, t2) ->
unify_kind k1 k2;
try
if !trace_gadt_instances then begin
- update_level_for Unify !env va.level t1;
- update_scope_for Unify va.scope t1
+ update_level_for Unify !env (get_level va) t1;
+ update_scope_for Unify (get_scope va) t1
end;
unify env t1 t2
- with Unify trace ->
- raise( Unify (Errortrace.incompatible_fields n t1 t2 :: trace) )
+ with Unify_trace trace ->
+ raise_trace_for Unify
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace)
)
pairs
with exn ->
- set_type_desc rest1 d1;
- set_type_desc rest2 d2;
+ Transient_expr.set_desc tr1 d1;
+ Transient_expr.set_desc tr2 d2;
raise exn
and unify_kind k1 k2 =
- let k1 = field_kind_repr k1 in
- let k2 = field_kind_repr k2 in
- if k1 == k2 then () else
- match k1, k2 with
- (Fvar r, (Fvar _ | Fpresent)) -> set_kind r k2
- | (Fpresent, Fvar r) -> set_kind r k1
- | (Fpresent, Fpresent) -> ()
- | _ -> assert false
+ match field_kind_repr k1, field_kind_repr k2 with
+ (Fprivate, (Fprivate | Fpublic)) -> link_kind ~inside:k1 k2
+ | (Fpublic, Fprivate) -> link_kind ~inside:k2 k1
+ | (Fpublic, Fpublic) -> ()
+ | _ -> assert false
and unify_row env row1 row2 =
- let row1 = row_repr row1 and row2 = row_repr row2 in
- let rm1 = row_more row1 and rm2 = row_more row2 in
+ let Row {fields = row1_fields; more = rm1;
+ closed = row1_closed; name = row1_name} = row_repr row1 in
+ let Row {fields = row2_fields; more = rm2;
+ closed = row2_closed; name = row2_name} = row_repr row2 in
if unify_eq rm1 rm2 then () else
- let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+ let r1, r2, pairs = merge_row_fields row1_fields row2_fields in
if r1 <> [] && r2 <> [] then begin
let ht = Hashtbl.create (List.length r1) in
List.iter (fun (l,_) -> Hashtbl.add ht (hash_variant l) l) r1;
end;
let fixed1 = fixed_explanation row1 and fixed2 = fixed_explanation row2 in
let more = match fixed1, fixed2 with
- | Some _, Some _ -> if rm2.level < rm1.level then rm2 else rm1
+ | Some _, Some _ -> if get_level rm2 < get_level rm1 then rm2 else rm1
| Some _, None -> rm1
| None, Some _ -> rm2
- | None, None -> newty2 (Int.min rm1.level rm2.level) (Tvar None)
+ | None, None ->
+ newty2 ~level:(Int.min (get_level rm1) (get_level rm2)) (Tvar None)
in
let fixed = merge_fixed_explanation fixed1 fixed2
- and closed = row1.row_closed || row2.row_closed in
+ and closed = row1_closed || row2_closed in
let keep switch =
List.for_all
(fun (_,f1,f2) ->
let empty fields =
List.for_all (fun (_,f) -> row_field_repr f = Rabsent) fields in
(* Check whether we are going to build an empty type *)
- if closed && (empty r1 || row2.row_closed) && (empty r2 || row1.row_closed)
+ if closed && (empty r1 || row2_closed) && (empty r2 || row1_closed)
&& List.for_all
(fun (_,f1,f2) ->
row_field_repr f1 = Rabsent || row_field_repr f2 = Rabsent)
pairs
then raise_for Unify (Variant No_intersection);
let name =
- if row1.row_name <> None && (row1.row_closed || empty r2) &&
- (not row2.row_closed || keep (fun f1 f2 -> f1, f2) && empty r1)
- then row1.row_name
- else if row2.row_name <> None && (row2.row_closed || empty r1) &&
- (not row1.row_closed || keep (fun f1 f2 -> f2, f1) && empty r2)
- then row2.row_name
+ if row1_name <> None && (row1_closed || empty r2) &&
+ (not row2_closed || keep (fun f1 f2 -> f1, f2) && empty r1)
+ then row1_name
+ else if row2_name <> None && (row2_closed || empty r1) &&
+ (not row1_closed || keep (fun f1 f2 -> f2, f1) && empty r2)
+ then row2_name
else None
in
- let row0 = {row_fields = []; row_more = more; row_bound = ();
- row_closed = closed; row_fixed = fixed; row_name = name} in
- let set_more row rest =
+ let set_more pos row rest =
let rest =
if closed then
- filter_row_fields row.row_closed rest
+ filter_row_fields (row_closed row) rest
else rest in
begin match fixed_explanation row with
| None ->
- if rest <> [] && row.row_closed then
- let pos = if row == row1 then First else Second in
+ if rest <> [] && row_closed row then
raise_for Unify (Variant (No_tags(pos,rest)))
| Some fixed ->
- let pos = if row == row1 then First else Second in
- if closed && not row.row_closed then
+ if closed && not (row_closed row) then
raise_for Unify (Variant (Fixed_row(pos,Cannot_be_closed,fixed)))
else if rest <> [] then
let case = Cannot_add_tags (List.map fst rest) in
let rm = row_more row in
(*if !trace_gadt_instances && rm.desc = Tnil then () else*)
if !trace_gadt_instances then
- update_level_for Unify !env rm.level (newgenty (Tvariant row));
- if row_fixed row then
- if more == rm then () else
+ update_level_for Unify !env (get_level rm) (newgenty (Tvariant row));
+ if has_fixed_explanation row then
+ if eq_type more rm then () else
if is_Tvar rm then link_type rm more else unify env rm more
else
- let ty = newgenty (Tvariant {row0 with row_fields = rest}) in
- update_level_for Unify !env rm.level ty;
- update_scope_for Unify rm.scope ty;
+ let ty =
+ newgenty (Tvariant
+ (create_row ~fields:rest ~more ~closed ~fixed ~name))
+ in
+ update_level_for Unify !env (get_level rm) ty;
+ update_scope_for Unify (get_scope rm) ty;
link_type rm ty
in
- let md1 = rm1.desc and md2 = rm2.desc in
+ let tm1 = Transient_expr.repr rm1 and tm2 = Transient_expr.repr rm2 in
+ let md1 = tm1.desc and md2 = tm2.desc in
begin try
- set_more row2 r1;
- set_more row1 r2;
+ set_more Second row2 r1;
+ set_more First row1 r2;
List.iter
(fun (l,f1,f2) ->
try unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2
- with Unify trace ->
+ with Unify_trace trace ->
raise_trace_for Unify (Variant (Incompatible_types_for l) :: trace)
)
pairs;
if static_row row1 then begin
let rm = row_more row1 in
- if is_Tvar rm then link_type rm (newty2 rm.level Tnil)
+ if is_Tvar rm then link_type rm (newty2 ~level:(get_level rm) Tnil)
end
with exn ->
- set_type_desc rm1 md1; set_type_desc rm2 md2; raise exn
+ Transient_expr.set_desc tm1 md1;
+ Transient_expr.set_desc tm2 md2;
+ raise exn
end
and unify_row_field env fixed1 fixed2 rm1 rm2 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 ()
| None, None -> false
| _ -> true in
if f1 == f2 then () else
- match f1, f2 with
+ match row_field_repr f1, row_field_repr 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 either_fixed && not (c1 || c2)
+ | Reither(c1, tl1, m1), Reither(c2, tl2, m2) ->
+ if eq_row_field_ext f1 f2 then () else
+ let no_arg = c1 || c2 and matched = m1 || m2 in
+ if either_fixed && not no_arg
&& List.length tl1 = List.length tl2 then begin
(* PR#7496 *)
- let f = Reither (c1 || c2, [], m1 || m2, ref None) in
- set_row_field e1 f; set_row_field e2 f;
+ let f = rf_either [] ~no_arg ~matched in
+ link_row_field_ext ~inside:f1 f; link_row_field_ext ~inside:f2 f;
List.iter2 (unify env) tl1 tl2
end
else let redo =
!rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
begin match tl1 @ tl2 with [] -> false
| t1 :: tl ->
- if c1 || c2 then raise_unexplained_for Unify;
- List.iter (unify env t1) tl;
- !e1 <> None || !e2 <> None
+ if no_arg then raise_unexplained_for Unify;
+ Types.changed_row_field_exts [f1;f2] (fun () ->
+ List.iter (unify env t1) tl
+ )
end in
if redo then unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2 else
- let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
- let rec remq tl = function [] -> []
- | ty :: tl' ->
- if List.memq ty tl then remq tl tl' else ty :: remq tl tl'
- in
+ let remq tl =
+ List.filter (fun ty -> not (List.exists (eq_type ty) tl)) in
let tl1' = remq tl2 tl1 and tl2' = remq tl1 tl2 in
(* PR#6744 *)
let (tlu1,tl1') = List.partition (has_free_univars !env) tl1'
occur_univar_for Unify !env tu
end;
(* Is this handling of levels really principal? *)
- List.iter (fun ty ->
- let rm = repr rm2 in
- update_level_for Unify !env rm.level ty;
- update_scope_for Unify rm.scope ty;
- ) tl1';
- List.iter (fun ty ->
- let rm = repr rm1 in
- update_level_for Unify !env rm.level ty;
- update_scope_for Unify rm.scope ty;
- ) tl2';
- let e = ref None in
- let f1' = Reither(c1 || c2, tl2', m1 || m2, e)
- and f2' = Reither(c1 || c2, tl1', m1 || m2, e) in
- set_row_field e1 f1'; set_row_field e2 f2';
- | 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)
+ let update_levels rm =
+ List.iter
+ (fun ty ->
+ update_level_for Unify !env (get_level rm) ty;
+ update_scope_for Unify (get_scope rm) ty)
+ in
+ update_levels rm2 tl1';
+ update_levels rm1 tl2';
+ let f1' = rf_either tl2' ~no_arg ~matched in
+ let f2' = rf_either tl1' ~use_ext_of:f1' ~no_arg ~matched in
+ link_row_field_ext ~inside:f1 f1'; link_row_field_ext ~inside:f2 f2';
+ | Reither(_, _, false), Rabsent ->
+ if_not_fixed first (fun () -> link_row_field_ext ~inside:f1 f2)
+ | Rabsent, Reither(_, _, false) ->
+ if_not_fixed second (fun () -> link_row_field_ext ~inside:f2 f1)
| Rabsent, Rabsent -> ()
- | Reither(false, tl, _, e1), Rpresent(Some t2) ->
+ | Reither(false, tl, _), Rpresent(Some t2) ->
if_not_fixed first (fun () ->
- set_row_field e1 f2;
- let rm = repr rm1 in
- update_level_for Unify !env rm.level t2;
- update_scope_for Unify rm.scope t2;
+ let s = snapshot () in
+ link_row_field_ext ~inside:f1 f2;
+ update_level_for Unify !env (get_level rm1) t2;
+ update_scope_for Unify (get_scope rm1) t2;
(try List.iter (fun t1 -> unify env t1 t2) tl
- with exn -> e1 := None; raise exn)
+ with exn -> undo_first_change_after s; raise exn)
)
- | Rpresent(Some t1), Reither(false, tl, _, e2) ->
+ | Rpresent(Some t1), Reither(false, tl, _) ->
if_not_fixed second (fun () ->
- set_row_field e2 f1;
- let rm = repr rm2 in
- update_level_for Unify !env rm.level t1;
- update_scope_for Unify rm.scope t1;
+ let s = snapshot () in
+ link_row_field_ext ~inside:f2 f1;
+ update_level_for Unify !env (get_level rm2) t1;
+ update_scope_for Unify (get_scope rm2) t1;
(try List.iter (unify env t1) tl
- with exn -> e2 := None; raise exn)
+ with exn -> undo_first_change_after s; 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)
+ | Reither(true, [], _), Rpresent None ->
+ if_not_fixed first (fun () -> link_row_field_ext ~inside:f1 f2)
+ | Rpresent None, Reither(true, [], _) ->
+ if_not_fixed second (fun () -> link_row_field_ext ~inside:f2 f1)
| _ -> raise_unexplained_for Unify
let unify env ty1 ty2 =
try
unify env ty1 ty2
with
- Unify trace ->
+ Unify_trace trace ->
undo_compress snap;
- raise (Unify (expand_trace !env trace))
+ raise (Unify (expand_to_unification_error !env trace))
let unify_gadt ~equations_level:lev ~allow_recursive (env:Env.t ref) ty1 ty2 =
try
raise e
let unify_var env t1 t2 =
- let t1 = repr t1 and t2 = repr t2 in
- if t1 == t2 then () else
- match t1.desc, t2.desc with
+ if eq_type t1 t2 then () else
+ match get_desc t1, get_desc t2 with
Tvar _, Tconstr _ when deep_occur t1 t2 ->
unify (ref env) t1 t2
| Tvar _, _ ->
let reset_tracing = check_trace_gadt_instances env in
begin try
occur_for Unify env t1 t2;
- update_level_for Unify env t1.level t2;
- update_scope_for Unify t1.scope t2;
+ update_level_for Unify env (get_level t1) t2;
+ update_scope_for Unify (get_scope t1) t2;
link_type t1 t2;
reset_trace_gadt_instances reset_tracing;
- with Unify trace ->
+ with Unify_trace trace ->
reset_trace_gadt_instances reset_tracing;
- let expanded_trace =
- expand_trace env @@ Errortrace.diff t1 t2 :: trace
- in
- raise_trace_for Unify expanded_trace
+ raise (Unify (expand_to_unification_error
+ env
+ (Diff { got = t1; expected = t2 } :: trace)))
end
| _ ->
unify (ref env) t1 t2
-let _ = unify' := unify_var
+let _ = unify_var' := unify_var
let unify_pairs env ty1 ty2 pairs =
univar_pairs := pairs;
(2) the original label is not optional
*)
+type filter_arrow_failure =
+ | Unification_error of unification_error
+ | Label_mismatch of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ }
+ | Not_a_function
+
+exception Filter_arrow_failed of filter_arrow_failure
+
let filter_arrow env t l =
- let t = expand_head_trace env t in
- match t.desc with
- Tvar _ ->
- let lv = t.level in
- let t1 = newvar2 lv and t2 = newvar2 lv in
- let t' = newty2 lv (Tarrow (l, t1, t2, Cok)) in
+ let function_type level =
+ let t1 = newvar2 level and t2 = newvar2 level in
+ let t' = newty2 ~level (Tarrow (l, t1, t2, commu_ok)) in
+ t', t1, t2
+ in
+ let t =
+ try expand_head_trace env t
+ with Unify_trace trace ->
+ let t', _, _ = function_type (get_level t) in
+ raise (Filter_arrow_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = t'; expected = t } :: trace))))
+ in
+ match get_desc t with
+ | Tvar _ ->
+ let t', t1, t2 = function_type (get_level t) in
link_type t t';
(t1, t2)
- | Tarrow(l', t1, t2, _)
- when l = l' || !Clflags.classic && l = Nolabel && not (is_optional l') ->
- (t1, t2)
+ | Tarrow(l', t1, t2, _) ->
+ if l = l' || !Clflags.classic && l = Nolabel && not (is_optional l')
+ then (t1, t2)
+ else raise (Filter_arrow_failed
+ (Label_mismatch
+ { got = l; expected = l'; expected_type = t }))
| _ ->
- raise_unexplained_for Unify
+ raise (Filter_arrow_failed Not_a_function)
+
+type filter_method_failure =
+ | Unification_error of unification_error
+ | Not_a_method
+ | Not_an_object of type_expr
+
+exception Filter_method_failed of filter_method_failure
(* Used by [filter_method]. *)
-let rec filter_method_field env name priv ty =
- let ty = expand_head_trace env ty in
- match ty.desc with
- Tvar _ ->
- let level = ty.level in
+let rec filter_method_field env name ty =
+ let method_type ~level =
let ty1 = newvar2 level and ty2 = newvar2 level in
- let ty' = newty2 level (Tfield (name,
- begin match priv with
- Private -> Fvar (ref None)
- | Public -> Fpresent
- end,
- ty1, ty2))
- in
+ let ty' = newty2 ~level (Tfield (name, field_public, ty1, ty2)) in
+ ty', ty1
+ in
+ let ty =
+ try expand_head_trace env ty
+ with Unify_trace trace ->
+ let level = get_level ty in
+ let ty', _ = method_type ~level in
+ raise (Filter_method_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = ty; expected = ty' } :: trace))))
+ in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let ty', ty1 = method_type ~level in
link_type ty ty';
ty1
| Tfield(n, kind, ty1, ty2) ->
- let kind = field_kind_repr kind in
- if (n = name) && (kind <> Fabsent) then begin
- if priv = Public then
- unify_kind kind Fpresent;
+ if n = name then begin
+ unify_kind kind field_public;
ty1
end else
- filter_method_field env name priv ty2
+ filter_method_field env name ty2
| _ ->
- raise_unexplained_for Unify
+ raise (Filter_method_failed Not_a_method)
(* Unify [ty] and [< name : 'a; .. >]. Return ['a]. *)
-let filter_method env name priv ty =
- let ty = expand_head_trace env ty in
- match ty.desc with
- Tvar _ ->
- let ty1 = newvar () in
- let ty' = newobj ty1 in
- update_level_for Unify env ty.level ty';
- update_scope_for Unify ty.scope ty';
+let filter_method env name ty =
+ let object_type ~level ~scope =
+ let ty1 = newvar2 level in
+ let ty' = newty3 ~level ~scope (Tobject (ty1, ref None)) in
+ let ty_meth = filter_method_field env name ty1 in
+ (ty', ty_meth)
+ in
+ let ty =
+ try expand_head_trace env ty
+ with Unify_trace trace ->
+ let level = get_level ty in
+ let scope = get_scope ty in
+ let ty', _ = object_type ~level ~scope in
+ raise (Filter_method_failed
+ (Unification_error
+ (expand_to_unification_error
+ env
+ (Diff { got = ty; expected = ty' } :: trace))))
+ in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let scope = get_scope ty in
+ let ty', ty_meth = object_type ~level ~scope in
link_type ty ty';
- filter_method_field env name priv ty1
+ ty_meth
| Tobject(f, _) ->
- filter_method_field env name priv f
+ filter_method_field env name f
+ | _ ->
+ raise (Filter_method_failed (Not_an_object ty))
+
+exception Filter_method_row_failed
+
+let rec filter_method_row env name priv ty =
+ let ty = expand_head env ty in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ let field = newvar2 level in
+ let row = newvar2 level in
+ let kind, priv =
+ match priv with
+ | Private ->
+ let kind = field_private () in
+ kind, Mprivate kind
+ | Public ->
+ field_public, Mpublic
+ in
+ let ty' = newty2 ~level (Tfield (name, kind, field, row)) in
+ link_type ty ty';
+ priv, field, row
+ | Tfield(n, kind, ty1, ty2) ->
+ if n = name then begin
+ let priv =
+ match priv with
+ | Public ->
+ unify_kind kind field_public;
+ Mpublic
+ | Private -> Mprivate kind
+ in
+ priv, ty1, ty2
+ end else begin
+ let level = get_level ty in
+ let priv, field, row = filter_method_row env name priv ty2 in
+ let row = newty2 ~level (Tfield (n, kind, ty1, row)) in
+ priv, field, row
+ end
+ | Tnil ->
+ if name = Btype.dummy_method then raise Filter_method_row_failed
+ else begin
+ match priv with
+ | Public -> raise Filter_method_row_failed
+ | Private ->
+ let level = get_level ty in
+ let kind = field_absent in
+ Mprivate kind, newvar2 level, ty
+ end
| _ ->
- raise_unexplained_for Unify
+ raise Filter_method_row_failed
-let check_filter_method env name priv ty =
- ignore(filter_method env name priv ty)
+(* Operations on class signatures *)
-let filter_self_method env lab priv meths ty =
- let ty' = filter_method env lab priv ty in
- try
- Meths.find lab !meths
- with Not_found ->
- let pair = (Ident.create_local lab, ty') in
- meths := Meths.add lab pair !meths;
- pair
+let new_class_signature () =
+ let row = newvar () in
+ let self = newobj row in
+ { csig_self = self;
+ csig_self_row = row;
+ csig_vars = Vars.empty;
+ csig_meths = Meths.empty; }
+
+let add_dummy_method env ~scope sign =
+ let _, ty, row =
+ filter_method_row env dummy_method Private sign.csig_self_row
+ in
+ unify env ty (new_scoped_ty scope (Ttuple []));
+ sign.csig_self_row <- row
+
+type add_method_failure =
+ | Unexpected_method
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_method_failed of add_method_failure
+
+let add_method env label priv virt ty sign =
+ let meths = sign.csig_meths in
+ let priv, virt =
+ match Meths.find label meths with
+ | (priv', virt', ty') -> begin
+ let priv =
+ match priv' with
+ | Mpublic -> Mpublic
+ | Mprivate k ->
+ match priv with
+ | Public ->
+ begin match field_kind_repr k with
+ | Fpublic -> ()
+ | Fprivate -> link_kind ~inside:k field_public
+ | Fabsent -> assert false
+ end;
+ Mpublic
+ | Private -> priv'
+ in
+ let virt =
+ match virt' with
+ | Concrete -> Concrete
+ | Virtual -> virt
+ in
+ match unify env ty ty' with
+ | () -> priv, virt
+ | exception Unify trace ->
+ raise (Add_method_failed (Type_mismatch trace))
+ end
+ | exception Not_found -> begin
+ let priv, ty', row =
+ match filter_method_row env label priv sign.csig_self_row with
+ | priv, ty', row ->
+ priv, ty', row
+ | exception Filter_method_row_failed ->
+ raise (Add_method_failed Unexpected_method)
+ in
+ match unify env ty ty' with
+ | () ->
+ sign.csig_self_row <- row;
+ priv, virt
+ | exception Unify trace ->
+ raise (Add_method_failed (Type_mismatch trace))
+ end
+ in
+ let meths = Meths.add label (priv, virt, ty) meths in
+ sign.csig_meths <- meths
+
+type add_instance_variable_failure =
+ | Mutability_mismatch of mutable_flag
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_instance_variable_failed of add_instance_variable_failure
+
+let check_mutability mut mut' =
+ match mut, mut' with
+ | Mutable, Mutable -> ()
+ | Immutable, Immutable -> ()
+ | Mutable, Immutable | Immutable, Mutable ->
+ raise (Add_instance_variable_failed (Mutability_mismatch mut))
+
+let add_instance_variable ~strict env label mut virt ty sign =
+ let vars = sign.csig_vars in
+ let virt =
+ match Vars.find label vars with
+ | (mut', virt', ty') ->
+ let virt =
+ match virt' with
+ | Concrete -> Concrete
+ | Virtual -> virt
+ in
+ if strict then begin
+ check_mutability mut mut';
+ match unify env ty ty' with
+ | () -> ()
+ | exception Unify trace ->
+ raise (Add_instance_variable_failed (Type_mismatch trace))
+ end;
+ virt
+ | exception Not_found -> virt
+ in
+ let vars = Vars.add label (mut, virt, ty) vars in
+ sign.csig_vars <- vars
+
+type inherit_class_signature_failure =
+ | Self_type_mismatch of Errortrace.unification_error
+ | Method of label * add_method_failure
+ | Instance_variable of label * add_instance_variable_failure
+
+exception Inherit_class_signature_failed of inherit_class_signature_failure
+
+let unify_self_types env sign1 sign2 =
+ let self_type1 = sign1.csig_self in
+ let self_type2 = sign2.csig_self in
+ match unify env self_type1 self_type2 with
+ | () -> ()
+ | exception Unify err -> begin
+ match err.trace with
+ | Errortrace.Diff _ :: Errortrace.Incompatible_fields {name; _} :: rem ->
+ let err = Errortrace.unification_error ~trace:rem in
+ let failure = Method (name, Type_mismatch err) in
+ raise (Inherit_class_signature_failed failure)
+ | _ ->
+ raise (Inherit_class_signature_failed (Self_type_mismatch err))
+ end
+(* Unify components of sign2 into sign1 *)
+let inherit_class_signature ~strict env sign1 sign2 =
+ unify_self_types env sign1 sign2;
+ Meths.iter
+ (fun label (priv, virt, ty) ->
+ let priv =
+ match priv with
+ | Mpublic -> Public
+ | Mprivate kind ->
+ assert (field_kind_repr kind = Fabsent);
+ Private
+ in
+ match add_method env label priv virt ty sign1 with
+ | () -> ()
+ | exception Add_method_failed failure ->
+ let failure = Method(label, failure) in
+ raise (Inherit_class_signature_failed failure))
+ sign2.csig_meths;
+ Vars.iter
+ (fun label (mut, virt, ty) ->
+ match add_instance_variable ~strict env label mut virt ty sign1 with
+ | () -> ()
+ | exception Add_instance_variable_failed failure ->
+ let failure = Instance_variable(label, failure) in
+ raise (Inherit_class_signature_failed failure))
+ sign2.csig_vars
+
+let update_class_signature env sign =
+ let self = expand_head env sign.Types.csig_self in
+ let fields, row = flatten_fields (object_fields self) in
+ let meths, implicitly_public, implicitly_declared =
+ List.fold_left
+ (fun (meths, implicitly_public, implicitly_declared) (lab, k, ty) ->
+ if lab = dummy_method then
+ meths, implicitly_public, implicitly_declared
+ else begin
+ match Meths.find lab meths with
+ | priv, virt, ty' ->
+ let meths, implicitly_public =
+ match priv, field_kind_repr k with
+ | Mpublic, _ -> meths, implicitly_public
+ | Mprivate _, Fpublic ->
+ let meths = Meths.add lab (Mpublic, virt, ty') meths in
+ let implicitly_public = lab :: implicitly_public in
+ meths, implicitly_public
+ | Mprivate _, _ -> meths, implicitly_public
+ in
+ meths, implicitly_public, implicitly_declared
+ | exception Not_found ->
+ let meths, implicitly_declared =
+ match field_kind_repr k with
+ | Fpublic ->
+ let meths = Meths.add lab (Mpublic, Virtual, ty) meths in
+ let implicitly_declared = lab :: implicitly_declared in
+ meths, implicitly_declared
+ | Fprivate ->
+ let meths =
+ Meths.add lab (Mprivate k, Virtual, ty) meths
+ in
+ let implicitly_declared = lab :: implicitly_declared in
+ meths, implicitly_declared
+ | Fabsent -> meths, implicitly_declared
+ in
+ meths, implicitly_public, implicitly_declared
+ end)
+ (sign.csig_meths, [], []) fields
+ in
+ sign.csig_meths <- meths;
+ sign.csig_self_row <- row;
+ implicitly_public, implicitly_declared
+
+let hide_private_methods env sign =
+ let self = expand_head env sign.Types.csig_self in
+ let fields, _ = flatten_fields (object_fields self) in
+ List.iter
+ (fun (_, k, _) ->
+ match field_kind_repr k with
+ | Fprivate -> link_kind ~inside:k field_absent
+ | _ -> ())
+ fields
+
+let close_class_signature env sign =
+ let rec close env ty =
+ let ty = expand_head env ty in
+ match get_desc ty with
+ | Tvar _ ->
+ let level = get_level ty in
+ link_type ty (newty2 ~level Tnil); true
+ | Tfield(lab, _, _, _) when lab = dummy_method ->
+ false
+ | Tfield(_, _, _, ty') -> close env ty'
+ | Tnil -> true
+ | _ -> assert false
+ in
+ let self = expand_head env sign.csig_self in
+ close env (object_fields self)
+
+let generalize_class_signature_spine env sign =
+ (* Generalize the spine of methods *)
+ let meths = sign.csig_meths in
+ Meths.iter (fun _ (_, _, ty) -> generalize_spine ty) meths;
+ let new_meths =
+ Meths.map
+ (fun (priv, virt, ty) -> (priv, virt, generic_instance ty))
+ meths
+ in
+ (* But keep levels correct on the type of self *)
+ Meths.iter
+ (fun _ (_, _, ty) -> unify_var env (newvar ()) ty)
+ meths;
+ sign.csig_meths <- new_meths
(***********************************)
(* Matching between type schemes *)
*)
let moregen_occur env level ty =
let rec occur ty =
- let ty = repr ty in
- if ty.level <= level then () else
- if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur else
+ let lv = get_level ty in
+ if lv <= level then () else
+ if is_Tvar ty && lv >= generic_level - 1 then raise Occur else
if try_mark_node ty then iter_type_expr occur ty
in
begin try
update_level_for Moregen env level ty
let may_instantiate inst_nongen t1 =
- if inst_nongen then t1.level <> generic_level - 1
- else t1.level = generic_level
+ let level = get_level t1 in
+ if inst_nongen then level <> generic_level - 1
+ else level = generic_level
let rec moregen inst_nongen type_pairs env t1 t2 =
- if t1 == t2 then () else
- let t1 = repr t1 in
- let t2 = repr t2 in
- if t1 == t2 then () else
+ if eq_type t1 t2 then () else
+
try
- match (t1.desc, t2.desc) with
- | (Tvar _, _) when may_instantiate inst_nongen t1 ->
- moregen_occur env t1.level t2;
- update_scope_for Moregen t1.scope t2;
+ match (get_desc t1, get_desc t2) with
+ (Tvar _, _) when may_instantiate inst_nongen t1 ->
+ moregen_occur env (get_level t1) t2;
+ update_scope_for Moregen (get_scope t1) t2;
occur_for Moregen env t1 t2;
link_type t1 t2
| (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
let t1' = expand_head env t1 in
let t2' = expand_head env t2 in
(* Expansion may have changed the representative of the types... *)
- let t1' = repr t1' and t2' = repr t2' in
- if t1' == t2' then () else
- begin try
- TypePairs.find type_pairs (t1', t2')
- with Not_found ->
- TypePairs.add type_pairs (t1', t2') ();
- match (t1'.desc, t2'.desc) with
+ if eq_type t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
(Tvar _, _) when may_instantiate inst_nongen t1' ->
- moregen_occur env t1'.level t2;
- update_scope_for Moregen t1'.scope t2;
+ moregen_occur env (get_level t1') t2;
+ update_scope_for Moregen (get_scope t1') t2;
link_type t1' t2
| (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
|| !Clflags.classic && not (is_optional l1 || is_optional l2) ->
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package env (moregen_list inst_nongen type_pairs env)
- t1'.level p1 fl1 t2'.level p2 fl2
+ (get_level t1') p1 fl1 (get_level t2') p2 fl2
with Not_found -> raise_unexplained_for Moregen
end
| (Tnil, Tconstr _ ) -> raise_for Moregen (Obj (Abstract_row Second))
| (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
moregen_fields inst_nongen type_pairs env fi1 fi2
| (Tfield _, Tfield _) -> (* Actually unused *)
- moregen_fields inst_nongen type_pairs env t1' t2'
+ moregen_fields inst_nongen type_pairs env
+ t1' t2'
| (Tnil, Tnil) ->
()
| (Tpoly (t1, []), Tpoly (t2, [])) ->
| (_, _) ->
raise_unexplained_for Moregen
end
- with Moregen trace -> raise ( Moregen ( Errortrace.diff t1 t2 :: trace ) );
+ with Moregen_trace trace ->
+ raise_trace_for Moregen (Diff {got = t1; expected = t2} :: trace)
and moregen_list inst_nongen type_pairs env tl1 tl2 =
| [] -> ()
end;
moregen inst_nongen type_pairs env rest1
- (build_fields (repr ty2).level miss2 rest2);
-
+ (build_fields (get_level ty2) miss2 rest2);
List.iter
- (fun (n, k1, t1, k2, t2) ->
+ (fun (name, k1, t1, k2, t2) ->
(* The below call should never throw [Public_method_to_private_method] *)
moregen_kind k1 k2;
- try moregen inst_nongen type_pairs env t1 t2 with Moregen trace ->
- raise( Moregen ( Errortrace.incompatible_fields n t1 t2 :: trace ) )
+ try moregen inst_nongen type_pairs env t1 t2 with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace)
)
pairs
and moregen_kind k1 k2 =
- let k1 = field_kind_repr k1 in
- let k2 = field_kind_repr k2 in
- if k1 == k2 then () else
- match k1, k2 with
- (Fvar r, (Fvar _ | Fpresent)) -> set_kind r k2
- | (Fpresent, Fpresent) -> ()
- | (Fpresent, Fvar _) -> raise Public_method_to_private_method
- | (Fabsent, _) | (_, Fabsent) -> assert false
+ match field_kind_repr k1, field_kind_repr k2 with
+ (Fprivate, (Fprivate | Fpublic)) -> link_kind ~inside:k1 k2
+ | (Fpublic, Fpublic) -> ()
+ | (Fpublic, Fprivate) -> raise Public_method_to_private_method
+ | (Fabsent, _) | (_, Fabsent) -> assert false
and moregen_row inst_nongen type_pairs env row1 row2 =
- let row1 = row_repr row1 and row2 = row_repr row2 in
- let rm1 = repr row1.row_more and rm2 = repr row2.row_more in
- if rm1 == rm2 then () else
+ let Row {fields = row1_fields; more = rm1; closed = row1_closed} =
+ row_repr row1 in
+ let Row {fields = row2_fields; more = rm2; closed = row2_closed;
+ fixed = row2_fixed} = row_repr row2 in
+ if eq_type rm1 rm2 then () else
let may_inst =
- is_Tvar rm1 && may_instantiate inst_nongen rm1 || rm1.desc = Tnil in
- let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+ is_Tvar rm1 && may_instantiate inst_nongen rm1 || get_desc rm1 = Tnil in
+ let r1, r2, pairs = merge_row_fields row1_fields row2_fields in
let r1, r2 =
- if row2.row_closed then
+ if row2_closed then
filter_row_fields may_inst r1, filter_row_fields false r2
else r1, r2
in
begin
if r1 <> [] then raise_for Moregen (Variant (No_tags (Second, r1)))
end;
- if row1.row_closed then begin
- match row2.row_closed, r2 with
+ if row1_closed then begin
+ match row2_closed, r2 with
| false, _ -> raise_for Moregen (Variant (Openness Second))
| _, _ :: _ -> raise_for Moregen (Variant (No_tags (First, r2)))
| _, [] -> ()
end;
- begin match rm1.desc, rm2.desc with
+ let md1 = get_desc rm1 (* This lets us undo a following [link_type] *) in
+ begin match md1, get_desc rm2 with
Tunivar _, Tunivar _ ->
unify_univar_for Moregen rm1 rm2 !univar_pairs
| Tunivar _, _ | _, Tunivar _ ->
| _ when static_row row1 -> ()
| _ when may_inst ->
let ext =
- newgenty (Tvariant {row2 with row_fields = r2; row_name = None})
+ newgenty (Tvariant
+ (create_row ~fields:r2 ~more:rm2 ~name:None
+ ~fixed:row2_fixed ~closed:row2_closed))
in
- moregen_occur env rm1.level ext;
- update_scope_for Moregen rm1.scope ext;
+ moregen_occur env (get_level rm1) ext;
+ update_scope_for Moregen (get_scope rm1) ext;
+ (* This [link_type] has to be undone if the rest of the function fails *)
link_type rm1 ext
| Tconstr _, Tconstr _ ->
moregen inst_nongen type_pairs env rm1 rm2
| _ -> raise_unexplained_for Moregen
end;
- List.iter
- (fun (l,f1,f2) ->
- try
- let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
+ try
+ List.iter
+ (fun (l,f1,f2) ->
if f1 == f2 then () else
- match f1, f2 with
- | Rpresent(Some t1), Rpresent(Some t2) ->
- moregen inst_nongen type_pairs env t1 t2
+ match row_field_repr f1, row_field_repr f2 with
+ (* Both matching [Rpresent]s *)
+ | Rpresent(Some t1), Rpresent(Some t2) -> begin
+ try
+ moregen inst_nongen type_pairs env t1 t2
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
| Rpresent None, Rpresent None -> ()
- | Reither(false, tl1, _, e1), Rpresent(Some t2) when may_inst ->
- set_row_field e1 f2;
- List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
- | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
- if e1 != e2 then begin
- if c1 && not c2 then raise_unexplained_for Moregen;
- set_row_field e1 (Reither (c2, [], m2, e2));
- if List.length tl1 = List.length tl2 then
- List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
- else match tl2 with
- | t2 :: _ ->
+ (* Both [Reither] *)
+ | Reither(c1, tl1, _), Reither(c2, tl2, m2) -> begin
+ try
+ if not (eq_row_field_ext f1 f2) then begin
+ if c1 && not c2 then raise_unexplained_for Moregen;
+ let f2' =
+ rf_either [] ~use_ext_of:f2 ~no_arg:c2 ~matched:m2 in
+ link_row_field_ext ~inside:f1 f2';
+ if List.length tl1 = List.length tl2 then
+ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+ else match tl2 with
+ | t2 :: _ ->
List.iter
(fun t1 -> moregen inst_nongen type_pairs env t1 t2)
tl1
- | [] -> if tl1 <> [] then raise_unexplained_for Moregen
- end
- | Reither(true, [], _, e1), Rpresent None when may_inst ->
- set_row_field e1 f2
- | Reither(_, _, _, e1), Rabsent when may_inst -> set_row_field e1 f2
+ | [] -> if tl1 <> [] then raise_unexplained_for Moregen
+ end
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ (* Generalizing [Reither] *)
+ | Reither(false, tl1, _), Rpresent(Some t2) when may_inst -> begin
+ try
+ link_row_field_ext ~inside:f1 f2;
+ List.iter
+ (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
+ tl1
+ with Moregen_trace trace ->
+ raise_trace_for Moregen
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ | Reither(true, [], _), Rpresent None when may_inst ->
+ link_row_field_ext ~inside:f1 f2
+ | Reither(_, _, _), Rabsent when may_inst ->
+ link_row_field_ext ~inside:f1 f2
+ (* Both [Rabsent]s *)
| Rabsent, Rabsent -> ()
- | Rpresent (Some _), Rpresent None -> raise_unexplained_for Moregen
- | Rpresent None, Rpresent (Some _) -> raise_unexplained_for Moregen
- | Rpresent _, Reither _ -> raise_unexplained_for Moregen
- | _ -> raise_unexplained_for Moregen
- with Moregen err ->
- raise (Moregen (Variant (Incompatible_types_for l) :: err)))
- pairs
+ (* Mismatched constructor arguments *)
+ | Rpresent (Some _), Rpresent None
+ | Rpresent None, Rpresent (Some _) ->
+ raise_for Moregen (Variant (Incompatible_types_for l))
+ (* Mismatched presence *)
+ | Reither _, Rpresent _ ->
+ raise_for Moregen
+ (Variant (Presence_not_guaranteed_for (First, l)))
+ | Rpresent _, Reither _ ->
+ raise_for Moregen
+ (Variant (Presence_not_guaranteed_for (Second, l)))
+ (* Missing tags *)
+ | Rabsent, (Rpresent _ | Reither _) ->
+ raise_for Moregen (Variant (No_tags (First, [l, f2])))
+ | (Rpresent _ | Reither _), Rabsent ->
+ raise_for Moregen (Variant (No_tags (Second, [l, f1]))))
+ pairs
+ with exn ->
+ (* Undo [link_type] if we failed *)
+ set_type_desc rm1 md1; raise exn
(* Must empty univar_pairs first *)
let moregen inst_nongen type_pairs env patt subj =
then copied with [duplicate_type]. That way, its levels won't be
changed.
*)
- let subj = duplicate_type (instance subj_sch) in
+ let subj_inst = instance subj_sch in
+ let subj = duplicate_type subj_inst in
current_level := generic_level;
(* Duplicate generic variables *)
let patt = instance pat_sch in
Misc.try_finally
- (fun () -> moregen inst_nongen (TypePairs.create 13) env patt subj)
+ (fun () ->
+ try
+ moregen inst_nongen (TypePairs.create 13) env patt subj
+ with Moregen_trace trace ->
+ (* Moregen splits the generic level into two finer levels:
+ [generic_level] and [generic_level - 1]. In order to properly
+ detect and print weak variables when printing this error, we need to
+ merge them back together, by regeneralizing the levels of the types
+ after they were instantiated at [generic_level - 1] above. Because
+ [moregen] does some unification that we need to preserve for more
+ legible error messages, we have to manually perform the
+ regeneralization rather than backtracking. *)
+ current_level := generic_level - 2;
+ generalize subj_inst;
+ raise (Moregen (expand_to_moregen_error env trace)))
~always:(fun () -> current_level := old_level)
let is_moregeneral env inst_nongen pat_sch subj_sch =
(* Simpler, no? *)
let rec rigidify_rec vars ty =
- let ty = repr ty in
if try_mark_node ty then
- begin match ty.desc with
+ begin match get_desc ty with
| Tvar _ ->
- if not (List.memq ty !vars) then vars := ty :: !vars
+ if not (TypeSet.mem ty !vars) then vars := TypeSet.add ty !vars
| Tvariant row ->
- let row = row_repr row in
- 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 {more; name; closed} = row_repr row in
+ if is_Tvar more && not (has_fixed_explanation row) then begin
+ let more' = newty2 ~level:(get_level more) (get_desc more) in
let row' =
- {row with row_fixed=Some Rigid; row_fields=[]; row_more=more'}
- in link_type more (newty2 ty.level (Tvariant row'))
+ create_row ~fixed:(Some Rigid) ~fields:[] ~more:more'
+ ~name ~closed
+ in link_type more (newty2 ~level:(get_level ty) (Tvariant row'))
end;
iter_row (rigidify_rec vars) row;
(* only consider the row variable if the variant is not static *)
- if not (static_row row) then rigidify_rec vars (row_more row)
+ if not (static_row row) then
+ rigidify_rec vars (row_more row)
| _ ->
iter_type_expr (rigidify_rec vars) ty
end
let rigidify ty =
- let vars = ref [] in
+ let vars = ref TypeSet.empty in
rigidify_rec vars ty;
unmark_type ty;
- !vars
+ TypeSet.elements !vars
let all_distinct_vars env vars =
- let tyl = ref [] in
+ let tys = ref TypeSet.empty in
List.for_all
(fun ty ->
let ty = expand_head env ty in
- if List.memq ty !tyl then false else
- (tyl := ty :: !tyl; is_Tvar ty))
+ if TypeSet.mem ty !tys then false else
+ (tys := TypeSet.add ty !tys; is_Tvar ty))
vars
-let matches env ty ty' =
+let matches ~expand_error_trace env ty ty' =
let snap = snapshot () in
let vars = rigidify ty in
cleanup_abbrev ();
| () ->
if not (all_distinct_vars env vars) then begin
backtrack snap;
- raise (Matches_failure (env, [Errortrace.diff ty ty']))
+ let diff =
+ if expand_error_trace
+ then expanded_diff env ~got:ty ~expected:ty'
+ else unexpanded_diff ~got:ty ~expected:ty'
+ in
+ raise (Matches_failure (env, unification_error ~trace:[diff]))
end;
backtrack snap
- | exception Unify trace ->
+ | exception Unify err ->
backtrack snap;
- raise (Matches_failure (env, trace))
+ raise (Matches_failure (env, err))
let does_match env ty ty' =
- match matches env ty ty' with
+ match matches ~expand_error_trace:false env ty ty' with
| () -> true
| exception Matches_failure (_, _) -> false
let ty' = expand_head env ty in
rigid_variants := old; ty'
-let normalize_subst subst =
+let eqtype_subst type_pairs subst t1 t2 =
if List.exists
- (function {desc=Tlink _}, _ | _, {desc=Tlink _} -> true | _ -> false)
+ (fun (t,t') ->
+ let found1 = eq_type t1 t in
+ let found2 = eq_type t2 t' in
+ if found1 && found2 then true else
+ if found1 || found2 then raise_unexplained_for Equality else false)
!subst
- then subst := List.map (fun (t1,t2) -> repr t1, repr t2) !subst
+ then ()
+ else begin
+ subst := (t1, t2) :: !subst;
+ TypePairs.add type_pairs (t1, t2)
+ end
let rec eqtype rename type_pairs subst env t1 t2 =
- if t1 == t2 then () else
- let t1 = repr t1 in
- let t2 = repr t2 in
- if t1 == t2 then () else
+ if eq_type t1 t2 then () else
try
- match (t1.desc, t2.desc) with
- | (Tvar _, Tvar _) when rename ->
- begin try
- normalize_subst subst;
- if List.assq t1 !subst != t2 then raise_unexplained_for Equality
- with Not_found ->
- if List.exists (fun (_, t) -> t == t2) !subst then
- raise_unexplained_for Equality;
- subst := (t1, t2) :: !subst
- end
+ match (get_desc t1, get_desc t2) with
+ (Tvar _, Tvar _) when rename ->
+ eqtype_subst type_pairs subst t1 t2
| (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
()
| _ ->
let t1' = expand_head_rigid env t1 in
let t2' = expand_head_rigid env t2 in
(* Expansion may have changed the representative of the types... *)
- let t1' = repr t1' and t2' = repr t2' in
- if t1' == t2' then () else
- begin try
- TypePairs.find type_pairs (t1', t2')
- with Not_found ->
- TypePairs.add type_pairs (t1', t2') ();
- match (t1'.desc, t2'.desc) with
- | (Tvar _, Tvar _) when rename ->
- begin try
- normalize_subst subst;
- if List.assq t1' !subst != t2' then
- raise_unexplained_for Equality
- with Not_found ->
- if List.exists (fun (_, t) -> t == t2') !subst then
- raise_unexplained_for Equality;
- subst := (t1', t2') :: !subst
- end
+ if eq_type t1' t2' then () else
+ if not (TypePairs.mem type_pairs (t1', t2')) then begin
+ TypePairs.add type_pairs (t1', t2');
+ match (get_desc t1', get_desc t2') with
+ (Tvar _, Tvar _) when rename ->
+ eqtype_subst type_pairs subst t1' t2'
| (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
|| !Clflags.classic && not (is_optional l1 || is_optional l2) ->
eqtype rename type_pairs subst env t1 t2;
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package env (eqtype_list rename type_pairs subst env)
- t1'.level p1 fl1 t2'.level p2 fl2
+ (get_level t1') p1 fl1 (get_level t2') p2 fl2
with Not_found -> raise_unexplained_for Equality
end
| (Tnil, Tconstr _ ) ->
| (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
eqtype_fields rename type_pairs subst env fi1 fi2
| (Tfield _, Tfield _) -> (* Actually unused *)
- eqtype_fields rename type_pairs subst env t1' t2'
+ eqtype_fields rename type_pairs subst env
+ t1' t2'
| (Tnil, Tnil) ->
()
| (Tpoly (t1, []), Tpoly (t2, [])) ->
| (_, _) ->
raise_unexplained_for Equality
end
- with Equality trace -> raise ( Equality (Errortrace.diff t1 t2 :: trace) )
+ with Equality_trace trace ->
+ raise_trace_for Equality (Diff {got = t1; expected = t2} :: trace)
and eqtype_list rename type_pairs subst env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
let (fields2, rest2) = flatten_fields ty2 in
(* First check if same row => already equal *)
let same_row =
- rest1 == rest2 || TypePairs.mem type_pairs (rest1,rest2) ||
- (rename && List.mem (rest1, rest2) !subst)
+ eq_type rest1 rest2 || TypePairs.mem type_pairs (rest1,rest2)
in
if same_row then () else
(* Try expansion, needed when called from Includecore.type_manifest *)
- match expand_head_rigid env rest2 with
- {desc=Tobject(ty2,_)} -> eqtype_fields rename type_pairs subst env ty1 ty2
+ match get_desc (expand_head_rigid env rest2) with
+ Tobject(ty2,_) -> eqtype_fields rename type_pairs subst env ty1 ty2
| _ ->
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
eqtype rename type_pairs subst env rest1 rest2;
| (_, (n, _, _)::_) -> raise_for Equality (Obj (Missing_field (First, n)))
| [], [] ->
List.iter
- (function (n, k1, t1, k2, t2) ->
+ (function (name, k1, t1, k2, t2) ->
eqtype_kind k1 k2;
try
eqtype rename type_pairs subst env t1 t2;
- with Equality trace ->
- raise (Equality (Errortrace.incompatible_fields n t1 t2 :: trace)))
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (incompatible_fields ~name ~got:t1 ~expected:t2 :: trace))
pairs
and eqtype_kind k1 k2 =
let k1 = field_kind_repr k1 in
let k2 = field_kind_repr k2 in
match k1, k2 with
- | (Fvar _, Fvar _)
- | (Fpresent, Fpresent) -> ()
- | _ -> raise_unexplained_for Equality
+ | (Fprivate, Fprivate)
+ | (Fpublic, Fpublic) -> ()
+ | _ -> raise_unexplained_for Unify
+ (* It's probably not possible to hit this case with
+ real OCaml code *)
and eqtype_row rename type_pairs subst env row1 row2 =
(* Try expansion, needed when called from Includecore.type_manifest *)
- match expand_head_rigid env (row_more row2) with
- {desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
+ match get_desc (expand_head_rigid env (row_more row2)) with
+ Tvariant row2 -> eqtype_row rename type_pairs subst env row1 row2
| _ ->
- let row1 = row_repr row1 and row2 = row_repr row2 in
- let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
- if row1.row_closed <> row2.row_closed then begin
+ let r1, r2, pairs = merge_row_fields (row_fields row1) (row_fields row2) in
+ if row_closed row1 <> row_closed row2 then begin
raise_for Equality
- (Variant (Openness (if row2.row_closed then First else Second)))
+ (Variant (Openness (if row_closed row2 then First else Second)))
end;
- if not row1.row_closed then begin
+ if not (row_closed row1) then begin
match r1, r2 with
| _::_, _ -> raise_for Equality (Variant (No_tags (Second, r1)))
| _, _::_ -> raise_for Equality (Variant (No_tags (First, r2)))
| _ :: _ as r2 -> raise_for Equality (Variant (No_tags (First, r2)))
end;
if not (static_row row1) then
- eqtype rename type_pairs subst env row1.row_more row2.row_more;
+ eqtype rename type_pairs subst env (row_more row1) (row_more row2);
List.iter
(fun (l,f1,f2) ->
- try
- match row_field_repr f1, row_field_repr f2 with
- | Rpresent(Some t1), Rpresent(Some t2) ->
+ if f1 == f2 then () else
+ match row_field_repr f1, row_field_repr f2 with
+ (* Both matching [Rpresent]s *)
+ | Rpresent(Some t1), Rpresent(Some t2) -> begin
+ try
eqtype rename type_pairs subst env t1 t2
- | Reither(c1, [], _, _), Reither(c2, [], _, _) when c1 = c2 -> ()
- | Reither(c1, t1::tl1, _, _), Reither(c2, t2::tl2, _, _)
- when c1 = c2 ->
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ | Rpresent None, Rpresent None -> ()
+ (* Both matching [Reither]s *)
+ | Reither(c1, [], _), Reither(c2, [], _) when c1 = c2 -> ()
+ | Reither(c1, t1::tl1, _), Reither(c2, t2::tl2, _)
+ when c1 = c2 -> begin
+ try
eqtype rename type_pairs subst env t1 t2;
if List.length tl1 = List.length tl2 then
(* if same length allow different types (meaning?) *)
List.iter
(fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
end
- | Rpresent None, Rpresent None -> ()
- | Rabsent, Rabsent -> ()
- | Rpresent (Some _), Rpresent None -> raise_unexplained_for Equality
- | Rpresent None, Rpresent (Some _) -> raise_unexplained_for Equality
- | Rpresent _, Reither _ -> raise_unexplained_for Equality
- | Reither _, Rpresent _ -> raise_unexplained_for Equality
- | _ -> raise_unexplained_for Equality
- with Equality err ->
- raise (Equality (Variant (Incompatible_types_for l):: err)))
+ with Equality_trace trace ->
+ raise_trace_for Equality
+ (Variant (Incompatible_types_for l) :: trace)
+ end
+ (* Both [Rabsent]s *)
+ | Rabsent, Rabsent -> ()
+ (* Mismatched constructor arguments *)
+ | Rpresent (Some _), Rpresent None
+ | Rpresent None, Rpresent (Some _)
+ | Reither _, Reither _ ->
+ raise_for Equality (Variant (Incompatible_types_for l))
+ (* Mismatched presence *)
+ | Reither _, Rpresent _ ->
+ raise_for Equality
+ (Variant (Presence_not_guaranteed_for (First, l)))
+ | Rpresent _, Reither _ ->
+ raise_for Equality
+ (Variant (Presence_not_guaranteed_for (Second, l)))
+ (* Missing tags *)
+ | Rabsent, (Rpresent _ | Reither _) ->
+ raise_for Equality (Variant (No_tags (First, [l, f2])))
+ | (Rpresent _ | Reither _), Rabsent ->
+ raise_for Equality (Variant (No_tags (Second, [l, f1]))))
pairs
(* Must empty univar_pairs first *)
(* Two modes: with or without renaming of variables *)
let equal env rename tyl1 tyl2 =
- eqtype_list rename (TypePairs.create 11) (ref []) env tyl1 tyl2
+ let subst = ref [] in
+ try eqtype_list rename (TypePairs.create 11) subst env tyl1 tyl2
+ with Equality_trace trace ->
+ raise (Equality (expand_to_equality_error env trace !subst))
let is_equal env rename tyl1 tyl2 =
match equal env rename tyl1 tyl2 with
(* Class type matching *)
(*************************)
-type class_match_failure_trace_type =
- | CM_Equality
- | CM_Moregen
-
type class_match_failure =
CM_Virtual_class
| CM_Parameter_arity_mismatch of int * int
- | CM_Type_parameter_mismatch of Env.t * comparison Errortrace.t (* Equality *)
+ | CM_Type_parameter_mismatch of Env.t * equality_error
| CM_Class_type_mismatch of Env.t * class_type * class_type
- | CM_Parameter_mismatch of Env.t * comparison Errortrace.t (* Moregen *)
- | CM_Val_type_mismatch of
- class_match_failure_trace_type * string * Env.t * comparison Errortrace.t
- | CM_Meth_type_mismatch of
- class_match_failure_trace_type * string * Env.t * comparison Errortrace.t
+ | CM_Parameter_mismatch of Env.t * moregen_error
+ | CM_Val_type_mismatch of string * Env.t * comparison_error
+ | CM_Meth_type_mismatch of string * Env.t * comparison_error
| CM_Non_mutable_value of string
| CM_Non_concrete_value of string
| CM_Missing_value of string
exception Failure of class_match_failure list
+let match_class_sig_shape ~strict sign1 sign2 =
+ let errors =
+ Meths.fold
+ (fun lab (priv, vr, _) err ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found -> CM_Missing_method lab::err
+ | (priv', vr', _) ->
+ match priv', priv with
+ | Mpublic, Mprivate _ -> CM_Public_method lab::err
+ | Mprivate _, Mpublic when strict -> CM_Private_method lab::err
+ | _, _ ->
+ match vr', vr with
+ | Virtual, Concrete -> CM_Virtual_method lab::err
+ | _, _ -> err)
+ sign2.csig_meths []
+ in
+ let errors =
+ Meths.fold
+ (fun lab (priv, vr, _) err ->
+ if Meths.mem lab sign2.csig_meths then err
+ else begin
+ let err =
+ match priv with
+ | Mpublic -> CM_Hide_public lab :: err
+ | Mprivate _ -> err
+ in
+ match vr with
+ | Virtual -> CM_Hide_virtual ("method", lab) :: err
+ | Concrete -> err
+ end)
+ sign1.csig_meths errors
+ in
+ let errors =
+ Vars.fold
+ (fun lab (mut, vr, _) err ->
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found -> CM_Missing_value lab::err
+ | (mut', vr', _) ->
+ match mut', mut with
+ | Immutable, Mutable -> CM_Non_mutable_value lab::err
+ | _, _ ->
+ match vr', vr with
+ | Virtual, Concrete -> CM_Non_concrete_value lab::err
+ | _, _ -> err)
+ sign2.csig_vars errors
+ in
+ Vars.fold
+ (fun lab (_,vr,_) err ->
+ if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
+ CM_Hide_virtual ("instance variable", lab) :: err
+ else err)
+ sign1.csig_vars errors
+
let rec moregen_clty trace type_pairs env cty1 cty2 =
try
match cty1, cty2 with
- Cty_constr (_, _, cty1), _ ->
+ | Cty_constr (_, _, cty1), _ ->
moregen_clty true type_pairs env cty1 cty2
| _, Cty_constr (_, _, cty2) ->
moregen_clty true type_pairs env cty1 cty2
| Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
- begin try moregen true type_pairs env ty1 ty2 with Moregen trace ->
- raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
+ begin
+ try moregen true type_pairs env ty1 ty2 with Moregen_trace trace ->
+ raise (Failure [
+ CM_Parameter_mismatch (env, expand_to_moregen_error env trace)])
end;
moregen_clty false type_pairs env cty1' cty2'
| Cty_signature sign1, Cty_signature sign2 ->
- let ty1 = object_fields (repr sign1.csig_self) in
- let ty2 = object_fields (repr sign2.csig_self) in
- let (fields1, _rest1) = flatten_fields ty1
- and (fields2, _rest2) = flatten_fields ty2 in
- let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
- List.iter
- (fun (lab, _k1, t1, _k2, t2) ->
- try moregen true type_pairs env t1 t2 with Moregen trace ->
- raise (Failure [
- CM_Meth_type_mismatch
- (CM_Moregen, lab, env, expand_trace env trace)]))
- pairs;
- Vars.iter
- (fun lab (_mut, _v, ty) ->
- let (_mut', _v', ty') = Vars.find lab sign1.csig_vars in
- try moregen true type_pairs env ty' ty with Moregen trace ->
- raise (Failure [
- CM_Val_type_mismatch
- (CM_Moregen, lab, env, expand_trace env trace)]))
- sign2.csig_vars
- | _ ->
- raise (Failure [])
+ Meths.iter
+ (fun lab (_, _, ty) ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all methods in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match moregen true type_pairs env ty' ty with
+ | () -> ()
+ | exception Moregen_trace trace ->
+ raise (Failure [
+ CM_Meth_type_mismatch
+ (lab,
+ env,
+ Moregen_error
+ (expand_to_moregen_error env trace))]))
+ sign2.csig_meths;
+ Vars.iter
+ (fun lab (_, _, ty) ->
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all instance variables in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match moregen true type_pairs env ty' ty with
+ | () -> ()
+ | exception Moregen_trace trace ->
+ raise (Failure [
+ CM_Val_type_mismatch
+ (lab,
+ env,
+ Moregen_error
+ (expand_to_moregen_error env trace))]))
+ sign2.csig_vars
+ | _ ->
+ raise (Failure [])
with
Failure error when trace || error = [] ->
raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
let match_class_types ?(trace=true) env pat_sch subj_sch =
- let type_pairs = TypePairs.create 53 in
- let old_level = !current_level in
- current_level := generic_level - 1;
- (*
- Generic variables are first duplicated with [instance]. So,
- their levels are lowered to [generic_level - 1]. The subject is
- then copied with [duplicate_type]. That way, its levels won't be
- changed.
- *)
- let (_, subj_inst) = instance_class [] subj_sch in
- let subj = duplicate_class_type subj_inst in
- current_level := generic_level;
- (* Duplicate generic variables *)
- let (_, patt) = instance_class [] pat_sch in
- let res =
- let sign1 = signature_of_class_type patt in
- let sign2 = signature_of_class_type subj in
- let t1 = repr sign1.csig_self in
- let t2 = repr sign2.csig_self in
- TypePairs.add type_pairs (t1, t2) ();
- let (fields1, rest1) = flatten_fields (object_fields t1)
- and (fields2, rest2) = flatten_fields (object_fields t2) in
- let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
- let error =
- List.fold_right
- (fun (lab, k, _) err ->
- let err =
- let k = field_kind_repr k in
- begin match k with
- Fvar r -> set_kind r Fabsent; err
- | _ -> CM_Hide_public lab::err
- end
- in
- if lab = dummy_method || Concr.mem lab sign1.csig_concr then err
- else CM_Hide_virtual ("method", lab) :: err)
- miss1 []
- in
- let missing_method = List.map (fun (m, _, _) -> m) miss2 in
- let error =
- (List.map (fun m -> CM_Missing_method m) missing_method) @ error
- in
- (* Always succeeds *)
- moregen true type_pairs env rest1 rest2;
- let error =
- List.fold_right
- (fun (lab, k1, _t1, k2, _t2) err ->
- match moregen_kind k1 k2 with
- | () -> err
- | exception Public_method_to_private_method ->
- CM_Public_method lab :: err)
- pairs error
- in
- let error =
- Vars.fold
- (fun lab (mut, vr, _ty) err ->
- try
- let (mut', vr', _ty') = Vars.find lab sign1.csig_vars in
- if mut = Mutable && mut' <> Mutable then
- CM_Non_mutable_value lab::err
- else if vr = Concrete && vr' <> Concrete then
- CM_Non_concrete_value lab::err
- else
- err
- with Not_found ->
- CM_Missing_value lab::err)
- sign2.csig_vars error
- in
- let error =
- Vars.fold
- (fun lab (_,vr,_) err ->
- if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
- CM_Hide_virtual ("instance variable", lab) :: err
- else err)
- sign1.csig_vars error
- in
- let error =
- List.fold_right
- (fun e l ->
- if List.mem e missing_method then l else CM_Virtual_method e::l)
- (Concr.elements (Concr.diff sign2.csig_concr sign1.csig_concr))
- error
- in
- match error with
- [] ->
- begin try
- moregen_clty trace type_pairs env patt subj;
- []
- with
- Failure r -> r
- end
- | error ->
- CM_Class_type_mismatch (env, patt, subj)::error
- in
- current_level := old_level;
- res
+ let sign1 = signature_of_class_type pat_sch in
+ let sign2 = signature_of_class_type subj_sch in
+ let errors = match_class_sig_shape ~strict:false sign1 sign2 in
+ match errors with
+ | [] ->
+ let old_level = !current_level in
+ current_level := generic_level - 1;
+ (*
+ Generic variables are first duplicated with [instance]. So,
+ their levels are lowered to [generic_level - 1]. The subject is
+ then copied with [duplicate_type]. That way, its levels won't be
+ changed.
+ *)
+ let (_, subj_inst) = instance_class [] subj_sch in
+ let subj = duplicate_class_type subj_inst in
+ current_level := generic_level;
+ (* Duplicate generic variables *)
+ let (_, patt) = instance_class [] pat_sch in
+ let type_pairs = TypePairs.create 53 in
+ let sign1 = signature_of_class_type patt in
+ let sign2 = signature_of_class_type subj in
+ let self1 = sign1.csig_self in
+ let self2 = sign2.csig_self in
+ let row1 = sign1.csig_self_row in
+ let row2 = sign2.csig_self_row in
+ TypePairs.add type_pairs (self1, self2);
+ (* Always succeeds *)
+ moregen true type_pairs env row1 row2;
+ let res =
+ match moregen_clty trace type_pairs env patt subj with
+ | () -> []
+ | exception Failure res ->
+ (* We've found an error. Moregen splits the generic level into two
+ finer levels: [generic_level] and [generic_level - 1]. In order
+ to properly detect and print weak variables when printing this
+ error, we need to merge them back together, by regeneralizing the
+ levels of the types after they were instantiated at
+ [generic_level - 1] above. Because [moregen] does some
+ unification that we need to preserve for more legible error
+ messages, we have to manually perform the regeneralization rather
+ than backtracking. *)
+ current_level := generic_level - 2;
+ generalize_class_type subj_inst;
+ res
+ in
+ current_level := old_level;
+ res
+ | errors ->
+ CM_Class_type_mismatch (env, pat_sch, subj_sch) :: errors
let equal_clsig trace type_pairs subst env sign1 sign2 =
try
- let ty1 = object_fields (repr sign1.csig_self) in
- let ty2 = object_fields (repr sign2.csig_self) in
- let (fields1, _rest1) = flatten_fields ty1
- and (fields2, _rest2) = flatten_fields ty2 in
- let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
- List.iter
- (fun (lab, _k1, t1, _k2, t2) ->
- begin try eqtype true type_pairs subst env t1 t2 with
- Equality trace ->
- raise (Failure [CM_Meth_type_mismatch
- (CM_Equality, lab, env, expand_trace env trace)])
- end)
- pairs;
+ Meths.iter
+ (fun lab (_, _, ty) ->
+ match Meths.find lab sign1.csig_meths with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all methods in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match eqtype true type_pairs subst env ty' ty with
+ | () -> ()
+ | exception Equality_trace trace ->
+ raise (Failure [
+ CM_Meth_type_mismatch
+ (lab,
+ env,
+ Equality_error
+ (expand_to_equality_error env trace !subst))]))
+ sign2.csig_meths;
Vars.iter
(fun lab (_, _, ty) ->
- let (_, _, ty') = Vars.find lab sign1.csig_vars in
- try eqtype true type_pairs subst env ty' ty with Equality trace ->
- raise (Failure [CM_Val_type_mismatch
- (CM_Equality, lab, env, expand_trace env trace)]))
+ match Vars.find lab sign1.csig_vars with
+ | exception Not_found ->
+ (* This function is only called after checking that
+ all instance variables in sign2 are present in sign1. *)
+ assert false
+ | (_, _, ty') ->
+ match eqtype true type_pairs subst env ty' ty with
+ | () -> ()
+ | exception Equality_trace trace ->
+ raise (Failure [
+ CM_Val_type_mismatch
+ (lab,
+ env,
+ Equality_error
+ (expand_to_equality_error env trace !subst))]))
sign2.csig_vars
with
Failure error when trace ->
(env, Cty_signature sign1, Cty_signature sign2)::error))
let match_class_declarations env patt_params patt_type subj_params subj_type =
- let type_pairs = TypePairs.create 53 in
- let subst = ref [] in
let sign1 = signature_of_class_type patt_type in
let sign2 = signature_of_class_type subj_type in
- let t1 = repr sign1.csig_self in
- let t2 = repr sign2.csig_self in
- TypePairs.add type_pairs (t1, t2) ();
- let (fields1, rest1) = flatten_fields (object_fields t1)
- and (fields2, rest2) = flatten_fields (object_fields t2) in
- let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
- let error =
- List.fold_right
- (fun (lab, k, _) err ->
- let err =
- let k = field_kind_repr k in
- begin match k with
- Fvar _ -> err
- | _ -> CM_Hide_public lab::err
- end
- in
- if Concr.mem lab sign1.csig_concr then err
- else CM_Hide_virtual ("method", lab) :: err)
- miss1 []
- in
- let missing_method = List.map (fun (m, _, _) -> m) miss2 in
- let error =
- (List.map (fun m -> CM_Missing_method m) missing_method) @ error
- in
- (* Always succeeds *)
- eqtype true type_pairs subst env rest1 rest2;
- let error =
- List.fold_right
- (fun (lab, k1, _t1, k2, _t2) err ->
- let k1 = field_kind_repr k1 in
- let k2 = field_kind_repr k2 in
- match k1, k2 with
- (Fvar _, Fvar _)
- | (Fpresent, Fpresent) -> err
- | (Fvar _, Fpresent) -> CM_Private_method lab::err
- | (Fpresent, Fvar _) -> CM_Public_method lab::err
- | _ -> assert false)
- pairs error
- in
- let error =
- Vars.fold
- (fun lab (mut, vr, _ty) err ->
- try
- let (mut', vr', _ty') = Vars.find lab sign1.csig_vars in
- if mut = Mutable && mut' <> Mutable then
- CM_Non_mutable_value lab::err
- else if vr = Concrete && vr' <> Concrete then
- CM_Non_concrete_value lab::err
- else
- err
- with Not_found ->
- CM_Missing_value lab::err)
- sign2.csig_vars error
- in
- let error =
- Vars.fold
- (fun lab (_,vr,_) err ->
- if vr = Virtual && not (Vars.mem lab sign2.csig_vars) then
- CM_Hide_virtual ("instance variable", lab) :: err
- else err)
- sign1.csig_vars error
- in
- let error =
- List.fold_right
- (fun e l ->
- if List.mem e missing_method then l else CM_Virtual_method e::l)
- (Concr.elements (Concr.diff sign2.csig_concr sign1.csig_concr))
- error
- in
- match error with
- [] ->
- begin try
+ let errors = match_class_sig_shape ~strict:true sign1 sign2 in
+ match errors with
+ | [] -> begin
+ try
+ let subst = ref [] in
+ let type_pairs = TypePairs.create 53 in
+ let self1 = sign1.csig_self in
+ let self2 = sign2.csig_self in
+ let row1 = sign1.csig_self_row in
+ let row2 = sign2.csig_self_row in
+ TypePairs.add type_pairs (self1, self2);
+ (* Always succeeds *)
+ eqtype true type_pairs subst env row1 row2;
let lp = List.length patt_params in
let ls = List.length subj_params in
if lp <> ls then
raise (Failure [CM_Parameter_arity_mismatch (lp, ls)]);
List.iter2 (fun p s ->
- try eqtype true type_pairs subst env p s with Equality trace ->
- raise (Failure [CM_Type_parameter_mismatch
- (env, expand_trace env trace)]))
+ try eqtype true type_pairs subst env p s with Equality_trace trace ->
+ raise (Failure
+ [CM_Type_parameter_mismatch
+ (env, expand_to_equality_error env trace !subst)]))
patt_params subj_params;
(* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
equal_clsig false type_pairs subst env sign1 sign2;
match_class_types ~trace:false env
(clty_params patt_params patt_type)
(clty_params subj_params subj_type)
- with
- Failure r -> r
- end
+ with Failure r -> r
+ end
| error ->
error
let cl_abbr = Env.find_hash_type p env in
match cl_abbr.type_manifest with
Some ty ->
- begin match (repr ty).desc with
+ begin match get_desc ty with
Tobject(_,{contents=Some(p',_)}) when Path.same p p' -> cl_abbr, ty
| _ -> raise Not_found
end
let has_constr_row' env t =
has_constr_row (expand_abbrev env t)
-let rec build_subtype env visited loops posi level t =
- let t = repr t in
- match t.desc with
+let rec build_subtype env (visited : transient_expr list)
+ (loops : (int * type_expr) list) posi level t =
+ match get_desc t with
Tvar _ ->
if posi then
try
- let t' = List.assq t loops in
+ let t' = List.assq (get_id t) loops in
warn := true;
(t', Equiv)
with Not_found ->
else
(t, Unchanged)
| Tarrow(l, t1, t2, _) ->
- if memq_warn t visited then (t, Unchanged) else
- let visited = t :: visited in
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
let (t1', c1) = build_subtype env visited loops (not posi) level t1 in
let (t2', c2) = build_subtype env visited loops posi level t2 in
let c = max_change c1 c2 in
- if c > Unchanged then (newty (Tarrow(l, t1', t2', Cok)), c)
+ if c > Unchanged
+ then (newty (Tarrow(l, t1', t2', commu_ok)), c)
else (t, Unchanged)
| Ttuple tlist ->
- if memq_warn t visited then (t, Unchanged) else
- let visited = t :: visited in
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
let tlist' =
List.map (build_subtype env visited loops posi level) tlist
in
| Tconstr(p, tl, abbrev)
when level > 0 && generic_abbrev env p && safe_abbrev env t
&& not (has_constr_row' env t) ->
- let t' = repr (expand_abbrev env t) in
+ let t' = expand_abbrev env t in
let level' = pred_expand level in
- begin try match t'.desc with
+ begin try match get_desc t' with
Tobject _ when posi && not (opened_object t') ->
let cl_abbr, body = find_cltype_for_path env p in
let ty =
subst env !current_level Public abbrev None
cl_abbr.type_params tl body
with Cannot_subst -> assert false in
- let ty = repr ty in
let ty1, tl1 =
- match ty.desc with
+ match get_desc ty with
Tobject(ty1,{contents=Some(p',tl1)}) when Path.same p p' ->
ty1, tl1
| _ -> raise Not_found
if List.exists (deep_occur ty) tl1 then raise Not_found;
set_type_desc ty (Tvar None);
let t'' = newvar () in
- let loops = (ty, t'') :: loops in
+ let loops = (get_id ty, t'') :: loops in
(* May discard [visited] as level is going down *)
let (ty1', c) =
- build_subtype env [t'] loops posi (pred_enlarge level') ty1 in
+ build_subtype env [Transient_expr.repr t']
+ loops posi (pred_enlarge level') ty1 in
assert (is_Tvar t'');
let nm =
if c > Equiv || deep_occur ty ty1' then None else Some(p,tl1) in
set_type_desc t'' (Tobject (ty1', ref nm));
(try unify_var env ty t with Unify _ -> assert false);
- (t'', Changed)
+ ( t'', Changed)
| _ -> raise Not_found
with Not_found ->
- let (t'',c) = build_subtype env visited loops posi level' t' in
+ let (t'',c) =
+ build_subtype env visited loops posi level' t' in
if c > Unchanged then (t'',c)
else (t, Unchanged)
end
| Tconstr(p, tl, _abbrev) ->
(* Must check recursion on constructors, since we do not always
expand them *)
- if memq_warn t visited then (t, Unchanged) else
- let visited = t :: visited in
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited then (t, Unchanged) else
+ let visited = tt :: visited in
begin try
let decl = Env.find_type p env in
if level = 0 && generic_abbrev env p && safe_abbrev env t
(t, Unchanged)
end
| Tvariant row ->
- let row = row_repr row in
- if memq_warn t visited || not (static_row row) then (t, Unchanged) else
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited || not (static_row row) then (t, Unchanged) else
let level' = pred_enlarge level in
let visited =
- t :: if level' < level then [] else filter_visited visited in
- let fields = filter_row_fields false row.row_fields in
+ tt :: if level' < level then [] else filter_visited visited in
+ let fields = filter_row_fields false (row_fields row) in
let fields =
List.map
(fun (l,f as orig) -> match row_field_repr f with
Rpresent None ->
if posi then
- (l, Reither(true, [], false, ref None)), Unchanged
+ (l, rf_either_of None), Unchanged
else
orig, Unchanged
| Rpresent(Some t) ->
let (t', c) = build_subtype env visited loops posi level' t in
let f =
if posi && level > 0
- then Reither(false, [t'], false, ref None)
- else Rpresent(Some t')
+ then rf_either_of (Some t')
+ else rf_present (Some t')
in (l, f), c
| _ -> assert false)
fields
in
let c = collect fields in
let row =
- { row_fields = List.map fst fields; row_more = newvar();
- row_bound = (); row_closed = posi; row_fixed = None;
- row_name = if c > Unchanged then None else row.row_name }
+ create_row ~fields:(List.map fst fields) ~more:(newvar ())
+ ~closed:posi ~fixed:None
+ ~name:(if c > Unchanged then None else row_name row)
in
(newty (Tvariant row), Changed)
| Tobject (t1, _) ->
- if memq_warn t visited || opened_object t1 then (t, Unchanged) else
+ let tt = Transient_expr.repr t in
+ if memq_warn tt visited || opened_object t1 then (t, Unchanged) else
let level' = pred_enlarge level in
let visited =
- t :: if level' < level then [] else filter_visited visited in
+ tt :: if level' < level then [] else filter_visited visited in
let (t1', c) = build_subtype env visited loops posi level' t1 in
if c > Unchanged then (newty (Tobject (t1', ref None)), c)
else (t, Unchanged)
let (t1', c1) = build_subtype env visited loops posi level t1 in
let (t2', c2) = build_subtype env visited loops posi level t2 in
let c = max_change c1 c2 in
- if c > Unchanged then (newty (Tfield(s, Fpresent, t1', t2')), c)
+ if c > Unchanged then (newty (Tfield(s, field_public, t1', t2')), c)
else (t, Unchanged)
| Tnil ->
if posi then
let subtypes = TypePairs.create 17
-let subtype_error env trace =
- raise (Subtype (expand_subtype_trace env (List.rev trace), []))
+let subtype_error ~env ~trace ~unification_trace =
+ raise (Subtype (Subtype.error
+ ~trace:(expand_subtype_trace env (List.rev trace))
+ ~unification_trace))
let rec subtype_rec env trace t1 t2 cstrs =
- let t1 = repr t1 in
- let t2 = repr t2 in
- if t1 == t2 then cstrs else
+ if eq_type t1 t2 then cstrs else
- begin try
- TypePairs.find subtypes (t1, t2);
+ if TypePairs.mem subtypes (t1, t2) then
cstrs
- with Not_found ->
- TypePairs.add subtypes (t1, t2) ();
- match (t1.desc, t2.desc) with
+ else begin
+ TypePairs.add subtypes (t1, t2);
+ match (get_desc t1, get_desc t2) with
(Tvar _, _) | (_, Tvar _) ->
(trace, t1, t2, !univar_pairs)::cstrs
| (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _)) when l1 = l2
|| !Clflags.classic && not (is_optional l1 || is_optional l2) ->
- let cstrs = subtype_rec env (Subtype.diff t2 t1::trace) t2 t1 cstrs in
- subtype_rec env (Subtype.diff u1 u2::trace) u1 u2 cstrs
+ let cstrs =
+ subtype_rec
+ env
+ (Subtype.Diff {got = t2; expected = t1} :: trace)
+ t2 t1
+ cstrs
+ in
+ subtype_rec
+ env
+ (Subtype.Diff {got = u1; expected = u2} :: trace)
+ u1 u2
+ cstrs
| (Ttuple tl1, Ttuple tl2) ->
subtype_list env trace tl1 tl2 cstrs
| (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 p2 ->
let (co, cn) = Variance.get_upper v in
if co then
if cn then
- (trace, newty2 t1.level (Ttuple[t1]),
- newty2 t2.level (Ttuple[t2]), !univar_pairs) :: cstrs
- else subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
+ (trace, newty2 ~level:(get_level t1) (Ttuple[t1]),
+ newty2 ~level:(get_level t2) (Ttuple[t2]), !univar_pairs)
+ :: cstrs
+ else
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
else
if cn
- then subtype_rec env (Subtype.diff t2 t1::trace) t2 t1 cstrs
+ then
+ subtype_rec
+ env
+ (Subtype.Diff {got = t2; expected = t1} :: trace)
+ t2 t1
+ cstrs
else cstrs)
cstrs decl.type_variance (List.combine tl1 tl2)
with Not_found ->
end
| (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
- let ntl1 = complete_type_list env fl2 t1.level (Mty_ident p1) fl1
- and ntl2 = complete_type_list env fl1 t2.level (Mty_ident p2) fl2
+ let ntl1 =
+ complete_type_list env fl2 (get_level t1) (Mty_ident p1) fl1
+ and ntl2 =
+ complete_type_list env fl1 (get_level t2) (Mty_ident p2) fl2
~allow_absent:true in
let cstrs' =
List.map
and subtype_list env trace tl1 tl2 cstrs =
if List.length tl1 <> List.length tl2 then
- subtype_error env trace;
+ subtype_error ~env ~trace ~unification_trace:[];
List.fold_left2
- (fun cstrs t1 t2 -> subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs)
+ (fun cstrs t1 t2 ->
+ subtype_rec
+ env
+ (Subtype.Diff { got = t1; expected = t2 } :: trace)
+ t1 t2
+ cstrs)
cstrs tl1 tl2
and subtype_fields env trace ty1 ty2 cstrs =
let (fields2, rest2) = flatten_fields ty2 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
let cstrs =
- if rest2.desc = Tnil then cstrs else
+ if get_desc rest2 = Tnil then cstrs else
if miss1 = [] then
- subtype_rec env (Subtype.diff rest1 rest2::trace) rest1 rest2 cstrs
+ subtype_rec
+ env
+ (Subtype.Diff {got = rest1; expected = rest2} :: trace)
+ rest1 rest2
+ cstrs
else
- (trace, build_fields (repr ty1).level miss1 rest1, rest2,
+ (trace, build_fields (get_level ty1) miss1 rest1, rest2,
!univar_pairs) :: cstrs
in
let cstrs =
if miss2 = [] then cstrs else
- (trace, rest1, build_fields (repr ty2).level miss2 (newvar ()),
+ (trace, rest1, build_fields (get_level ty2) miss2 (newvar ()),
!univar_pairs) :: cstrs
in
List.fold_left
(fun cstrs (_, _k1, t1, _k2, t2) ->
- (* These fields are always present *)
- subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs)
+ (* These fields are always present *)
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs)
cstrs pairs
and subtype_row env trace row1 row2 cstrs =
- let row1 = row_repr row1 and row2 = row_repr row2 in
+ let Row {fields = row1_fields; more = more1; closed = row1_closed} =
+ row_repr row1 in
+ let Row {fields = row2_fields; more = more2; closed = row2_closed} =
+ row_repr row2 in
let r1, r2, pairs =
- merge_row_fields row1.row_fields row2.row_fields in
- let r1 = if row2.row_closed then filter_row_fields false r1 else r1 in
- let r2 = if row1.row_closed then filter_row_fields false r2 else r2 in
- let more1 = repr row1.row_more
- and more2 = repr row2.row_more in
- match more1.desc, more2.desc with
+ merge_row_fields row1_fields row2_fields in
+ let r1 = if row2_closed then filter_row_fields false r1 else r1 in
+ let r2 = if row1_closed then filter_row_fields false r2 else r2 in
+ match get_desc more1, get_desc more2 with
Tconstr(p1,_,_), Tconstr(p2,_,_) when Path.same p1 p2 ->
- subtype_rec env (Subtype.diff more1 more2::trace) more1 more2 cstrs
+ subtype_rec
+ env
+ (Subtype.Diff {got = more1; expected = more2} :: trace)
+ more1 more2
+ cstrs
| (Tvar _|Tconstr _|Tnil), (Tvar _|Tconstr _|Tnil)
- when row1.row_closed && r1 = [] ->
+ when row1_closed && r1 = [] ->
List.fold_left
(fun cstrs (_,f1,f2) ->
match row_field_repr f1, row_field_repr f2 with
- (Rpresent None|Reither(true,_,_,_)), Rpresent None ->
+ (Rpresent None|Reither(true,_,_)), Rpresent None ->
cstrs
| Rpresent(Some t1), Rpresent(Some t2) ->
- subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
- | Reither(false, t1::_, _, _), Rpresent(Some t2) ->
- subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
+ | Reither(false, t1::_, _), Rpresent(Some t2) ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
| Rabsent, _ -> cstrs
| _ -> raise Exit)
cstrs pairs
| Tunivar _, Tunivar _
- when row1.row_closed = row2.row_closed && r1 = [] && r2 = [] ->
+ when row1_closed = row2_closed && r1 = [] && r2 = [] ->
let cstrs =
- subtype_rec env (Subtype.diff more1 more2::trace) more1 more2 cstrs in
+ subtype_rec
+ env
+ (Subtype.Diff {got = more1; expected = more2} :: trace)
+ more1 more2
+ cstrs
+ in
List.fold_left
(fun cstrs (_,f1,f2) ->
match row_field_repr f1, row_field_repr f2 with
Rpresent None, Rpresent None
- | Reither(true,[],_,_), Reither(true,[],_,_)
+ | Reither(true,[],_), Reither(true,[],_)
| Rabsent, Rabsent ->
cstrs
| Rpresent(Some t1), Rpresent(Some t2)
- | Reither(false,[t1],_,_), Reither(false,[t2],_,_) ->
- subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
+ | Reither(false,[t1],_), Reither(false,[t2],_) ->
+ subtype_rec
+ env
+ (Subtype.Diff {got = t1; expected = t2} :: trace)
+ t1 t2
+ cstrs
| _ -> raise Exit)
cstrs pairs
| _ ->
TypePairs.clear subtypes;
univar_pairs := [];
(* Build constraint set. *)
- let cstrs = subtype_rec env [Subtype.diff ty1 ty2] ty1 ty2 [] in
+ let cstrs =
+ subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
+ in
TypePairs.clear subtypes;
(* Enforce constraints. *)
function () ->
List.iter
(function (trace0, t1, t2, pairs) ->
- try unify_pairs (ref env) t1 t2 pairs with Unify trace ->
- raise (Subtype (expand_subtype_trace env (List.rev trace0),
- List.tl trace)))
+ try unify_pairs (ref env) t1 t2 pairs with Unify {trace} ->
+ subtype_error ~env ~trace:trace0 ~unification_trace:(List.tl trace))
(List.rev cstrs)
(*******************)
(* Utility for printing. The resulting type is not used in computation. *)
let rec unalias_object ty =
- let ty = repr ty in
- match ty.desc with
+ let level = get_level ty in
+ match get_desc ty with
Tfield (s, k, t1, t2) ->
- newty2 ty.level (Tfield (s, k, t1, unalias_object t2))
- | Tvar _ | Tnil ->
- newty2 ty.level ty.desc
+ newty2 ~level (Tfield (s, k, t1, unalias_object t2))
+ | Tvar _ | Tnil as desc ->
+ newty2 ~level desc
| Tunivar _ ->
ty
| Tconstr _ ->
- newvar2 ty.level
+ newvar2 level
| _ ->
assert false
let unalias ty =
- let ty = repr ty in
- match ty.desc with
+ let level = get_level ty in
+ match get_desc ty with
Tvar _ | Tunivar _ ->
ty
| Tvariant row ->
- let row = row_repr row in
- let more = row.row_more in
- newty2 ty.level
- (Tvariant {row with row_more = newty2 more.level more.desc})
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ newty2 ~level
+ (Tvariant
+ (create_row ~fields ~name ~fixed ~closed ~more:
+ (newty2 ~level:(get_level more) (get_desc more))))
| Tobject (ty, nm) ->
- newty2 ty.level (Tobject (unalias_object ty, nm))
- | _ ->
- newty2 ty.level ty.desc
+ newty2 ~level (Tobject (unalias_object ty, nm))
+ | desc ->
+ newty2 ~level desc
(* Return the arity (as for curried functions) of the given type. *)
let rec arity ty =
- match (repr ty).desc with
+ match get_desc ty with
Tarrow(_, _t1, t2, _) -> 1 + arity t2
| _ -> 0
(* Check for non-generalizable type variables *)
-exception Non_closed0
+exception Nongen
let visited = ref TypeSet.empty
-let rec closed_schema_rec env ty =
- let ty = repr ty in
+let rec nongen_schema_rec env ty =
if TypeSet.mem ty !visited then () else begin
visited := TypeSet.add ty !visited;
- match ty.desc with
- Tvar _ when ty.level <> generic_level ->
- raise Non_closed0
+ match get_desc ty with
+ Tvar _ when get_level ty <> generic_level ->
+ raise Nongen
| Tconstr _ ->
let old = !visited in
- begin try iter_type_expr (closed_schema_rec env) ty
- with Non_closed0 -> try
+ begin try iter_type_expr (nongen_schema_rec env) ty
+ with Nongen -> try
visited := old;
- closed_schema_rec env (try_expand_head try_expand_safe env ty)
+ nongen_schema_rec env (try_expand_head try_expand_safe env ty)
with Cannot_expand ->
- raise Non_closed0
+ raise Nongen
end
| Tfield(_, kind, t1, t2) ->
- if field_kind_repr kind = Fpresent then
- closed_schema_rec env t1;
- closed_schema_rec env t2
+ if field_kind_repr kind = Fpublic then
+ nongen_schema_rec env t1;
+ nongen_schema_rec env t2
| Tvariant row ->
- let row = row_repr row in
- iter_row (closed_schema_rec env) row;
- if not (static_row row) then closed_schema_rec env row.row_more
+ iter_row (nongen_schema_rec env) row;
+ if not (static_row row) then nongen_schema_rec env (row_more row)
| _ ->
- iter_type_expr (closed_schema_rec env) ty
+ iter_type_expr (nongen_schema_rec env) ty
end
(* Return whether all variables of type [ty] are generic. *)
-let closed_schema env ty =
+let nongen_schema env ty =
visited := TypeSet.empty;
try
- closed_schema_rec env ty;
- visited := TypeSet.empty;
- true
- with Non_closed0 ->
+ nongen_schema_rec env ty;
visited := TypeSet.empty;
false
+ with Nongen ->
+ visited := TypeSet.empty;
+ true
+
+(* Check that all type variables are generalizable *)
+(* Use Env.empty to prevent expansion of recursively defined object types;
+ cf. typing-poly/poly.ml *)
+let rec nongen_class_type = function
+ | Cty_constr (_, params, _) ->
+ List.exists (nongen_schema Env.empty) params
+ | Cty_signature sign ->
+ nongen_schema Env.empty sign.csig_self
+ || nongen_schema Env.empty sign.csig_self_row
+ || Meths.exists
+ (fun _ (_, _, ty) -> nongen_schema Env.empty ty)
+ sign.csig_meths
+ || Vars.exists
+ (fun _ (_, _, ty) -> nongen_schema Env.empty ty)
+ sign.csig_vars
+ | Cty_arrow (_, ty, cty) ->
+ nongen_schema Env.empty ty
+ || nongen_class_type cty
+
+let nongen_class_declaration cty =
+ List.exists (nongen_schema Env.empty) cty.cty_params
+ || nongen_class_type cty.cty_type
+
(* Normalize a type before printing, saving... *)
(* Cannot use mark_type because deep_occur uses it too *)
let rec normalize_type_rec visited ty =
- let ty = repr ty in
if not (TypeSet.mem ty !visited) then begin
visited := TypeSet.add ty !visited;
let tm = row_of_type ty in
begin if not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm then
- match tm.desc with (* PR#7348 *)
+ match get_desc tm with (* PR#7348 *)
Tconstr (Path.Pdot(m,i), tl, _abbrev) ->
let i' = String.sub i 0 (String.length i - 4) in
set_type_desc ty (Tconstr(Path.Pdot(m,i'), tl, ref Mnil))
| _ -> assert false
- else match ty.desc with
+ else match get_desc ty with
| Tvariant row ->
- let row = row_repr row in
+ let Row {fields = orig_fields; more; name; fixed; closed} =
+ row_repr row in
let fields = List.map
- (fun (l,f0) ->
- let f = row_field_repr f0 in l,
- match f with Reither(b, ty::(_::_ as tyl), m, e) ->
+ (fun (l,f) ->
+ l,
+ match row_field_repr f with Reither(b, ty::(_::_ as tyl), m) ->
let tyl' =
List.fold_left
(fun tyl ty ->
- if List.exists
- (fun ty' ->
- match equal Env.empty false [ty] [ty'] with
- | () -> true
- | exception Equality _ -> false)
+ if List.exists
+ (fun ty' -> is_equal Env.empty false [ty] [ty'])
tyl
- then tyl else ty::tyl)
+ then tyl
+ else ty::tyl)
[ty] tyl
in
- if f != f0 || List.length tyl' < List.length tyl then
- Reither(b, List.rev tyl', m, e)
+ if List.length tyl' <= List.length tyl then
+ rf_either (List.rev tyl') ~use_ext_of:f ~no_arg:b ~matched:m
else f
| _ -> f)
- row.row_fields in
+ orig_fields in
let fields =
List.sort (fun (p,_) (q,_) -> compare p q)
- (List.filter (fun (_,fi) -> fi <> Rabsent) fields) in
- set_type_desc ty (Tvariant {row with row_fields = fields})
+ (List.filter (fun (_,fi) -> row_field_repr fi <> Rabsent) fields) in
+ set_type_desc ty (Tvariant
+ (create_row ~fields ~more ~name ~fixed ~closed))
| Tobject (fi, nm) ->
begin match !nm with
| None -> ()
if deep_occur ty (newgenty (Ttuple l)) then
(* The abbreviation may be hiding something, so remove it *)
set_name nm None
- else let v' = repr v in
- begin match v'.desc with
- | Tvar _ | Tunivar _ ->
- if v' != v then set_name nm (Some (n, v' :: l))
- | Tnil ->
- set_type_desc ty (Tconstr (n, l, ref Mnil))
- | _ -> set_name nm None
+ else
+ begin match get_desc v with
+ | Tvar _ | Tunivar _ -> ()
+ | Tnil -> set_type_desc ty (Tconstr (n, l, ref Mnil))
+ | _ -> set_name nm None
end
| _ ->
fatal_error "Ctype.normalize_type_rec"
end;
- let fi = repr fi in
- if fi.level < lowest_level then () else
+ let level = get_level fi in
+ if level < lowest_level then () else
let fields, row = flatten_fields fi in
- let fi' = build_fields fi.level fields row in
- set_type_desc fi fi'.desc
+ let fi' = build_fields level fields row in
+ set_type_desc fi (get_desc fi')
| _ -> ()
end;
- iter_type_expr (normalize_type_rec visited) ty
+ iter_type_expr (normalize_type_rec visited) ty;
end
let normalize_type ty =
if expand_private then try_expand_safe_opt env t
else try_expand_safe env t
in
- match ty.desc with
+ match get_desc ty with
Tvar _ | Tunivar _ -> ty
- | Tlink ty -> nondep_type_rec env ids ty
| _ -> try TypeHash.find nondep_hash ty
with Not_found ->
- let ty' = newgenvar () in (* Stub *)
+ let ty' = newgenstub ~scope:(get_scope ty) in
TypeHash.add nondep_hash ty ty';
- set_type_desc ty'
- begin match ty.desc with
- | Tconstr(p, tl, _abbrev) ->
+ let desc =
+ match get_desc ty with
+ | Tconstr(p, tl, _abbrev) as desc ->
begin try
(* First, try keeping the same type constructor p *)
match Path.find_free_opt ids p with
with (Nondep_cannot_erase _) as exn ->
(* If that doesn't work, try expanding abbrevs *)
try Tlink (nondep_type_rec ~expand_private env ids
- (try_expand env (newty2 ty.level ty.desc)))
+ (try_expand env (newty2 ~level:(get_level ty) desc)))
(*
The [Tlink] is important. The expanded type may be a
variable, or may not be completely copied yet
if Path.exists_free ids p then None
else Some (p, List.map (nondep_type_rec env ids) tl)))
| Tvariant row ->
- let row = row_repr row in
- let more = repr row.row_more in
+ let more = row_more row in
(* We must keep sharing according to the row variable *)
begin try
let ty2 = TypeHash.find nondep_variants more in
(* Return a new copy *)
let row =
copy_row (nondep_type_rec env ids) true row true more' in
- match row.row_name with
+ match row_name row with
Some (p, _tl) when Path.exists_free ids p ->
- Tvariant {row with row_name = None}
+ Tvariant (set_row_name row None)
| _ -> Tvariant row
end
- | _ -> copy_type_desc (nondep_type_rec env ids) ty.desc
- end;
+ | desc -> copy_type_desc (nondep_type_rec env ids) desc
+ in
+ Transient_expr.set_stub_desc ty' desc;
ty'
let nondep_type env id ty =
newgenty (Tconstr(ext.ext_type_path, ext.ext_type_params, ref Mnil))
in
let ty' = nondep_type_rec env ids ty in
- match (repr ty').desc with
+ match get_desc ty' with
Tconstr(p, tl, _) -> p, tl
| _ -> raise (Nondep_cannot_erase id)
end
(* Preserve sharing inside class types. *)
let nondep_class_signature env id sign =
{ csig_self = nondep_type_rec env id sign.csig_self;
+ csig_self_row = nondep_type_rec env id sign.csig_self_row;
csig_vars =
Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t))
sign.csig_vars;
- csig_concr = sign.csig_concr;
- csig_inher =
- List.map (fun (p,tl) -> (p, List.map (nondep_type_rec env id) tl))
- sign.csig_inher }
+ csig_meths =
+ Meths.map (function (p, v, t) -> (p, v, nondep_type_rec env id t))
+ sign.csig_meths }
let rec nondep_class_type env ids =
function
(* collapse conjunctive types in class parameters *)
let rec collapse_conj env visited ty =
- let ty = repr ty in
- if List.memq ty visited then () else
- let visited = ty :: visited in
- match ty.desc with
+ let id = get_id ty in
+ if List.memq id visited then () else
+ let visited = id :: visited in
+ match get_desc ty with
Tvariant row ->
- let row = row_repr row in
List.iter
(fun (_l,fi) ->
match row_field_repr fi with
- Reither (c, t1::(_::_ as tl), m, e) ->
- List.iter (unify env t1) tl;
- set_row_field e (Reither (c, [t1], m, ref None))
+ Reither (_c, t1::(_::_ as tl), _m) ->
+ List.iter (unify env t1) tl
| _ ->
())
- row.row_fields;
+ (row_fields row);
iter_row (collapse_conj env visited) row
| _ ->
iter_type_expr (collapse_conj env visited) ty
let same_constr env t1 t2 =
let t1 = expand_head env t1 in
let t2 = expand_head env t2 in
- match t1.desc, t2.desc with
+ match get_desc t1, get_desc t2 with
| Tconstr (p1, _, _), Tconstr (p2, _, _) -> Path.same p1 p2
| _ -> false
let () =
Env.same_constr := same_constr
-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
+ match get_desc typ with
| Tconstr(p, _args, _abbrev) ->
begin try
let type_decl = Env.find_type p env in
Maybe we should emit a warning. *)
end
| Tvariant row ->
- let row = Btype.row_repr row in
(* if all labels are devoid of arguments, not a pointer *)
if
- not row.row_closed
+ not (row_closed row)
|| List.exists
- (function
- | _, (Rpresent (Some _) | Reither (false, _, _, _)) -> true
- | _ -> false)
- row.row_fields
+ (fun (_, f) -> match row_field_repr f with
+ | Rpresent (Some _) | Reither (false, _, _) -> true
+ | _ -> false)
+ (row_fields row)
then
Type_immediacy.Unknown
else
Type_immediacy.Always
| _ -> Type_immediacy.Unknown
-
-let maybe_pointer_type env typ = not (is_immediate (immediacy env typ))
open Asttypes
open Types
-module TypePairs : Hashtbl.S with type key = type_expr * type_expr
+exception Unify of Errortrace.unification_error
+exception Equality of Errortrace.equality_error
+exception Moregen of Errortrace.moregen_error
+exception Subtype of Errortrace.Subtype.error
-exception Unify of Errortrace.unification Errortrace.t
-exception Equality of Errortrace.comparison Errortrace.t
-exception Moregen of Errortrace.comparison Errortrace.t
-exception Subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
-exception Escape of Errortrace.desc Errortrace.escape
+exception Escape of type_expr Errortrace.escape
exception Tags of label * label
exception Cannot_expand
exception Cannot_apply
-exception Matches_failure of Env.t * Errortrace.unification Errortrace.t
+exception Matches_failure of Env.t * Errortrace.unification_error
(* Raised from [matches], hence the odd name *)
exception Incompatible
(* Raised from [mcomp] *)
val create_scope : unit -> int
val newty: type_desc -> type_expr
+val new_scoped_ty: int -> type_desc -> type_expr
val newvar: ?name:string -> unit -> type_expr
val newvar2: ?name:string -> int -> type_expr
(* Return a fresh variable *)
val none: type_expr
(* A dummy type expression *)
-val repr: type_expr -> type_expr
- (* Return the canonical representative of a type. *)
-
val object_fields: type_expr -> type_expr
val flatten_fields:
type_expr -> (string * field_kind * type_expr) list * type_expr
(string * field_kind * type_expr) list *
(string * field_kind * type_expr) list
val opened_object: type_expr -> bool
-val close_object: type_expr -> bool
-val row_variable: type_expr -> type_expr
- (* Return the row variable of an open object type *)
val set_object_name:
- Ident.t -> type_expr -> type_expr list -> type_expr -> unit
+ Ident.t -> type_expr list -> type_expr -> unit
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 sort_row_fields: (label * row_field) list -> (label * row_field) list
val lower_contravariant: Env.t -> type_expr -> unit
(* Lower level of type variables inside contravariant branches;
to be used before generalize for expansive expressions *)
+val lower_variables_only: Env.t -> int -> type_expr -> unit
+ (* Lower all variables to the given level *)
val generalize_structure: type_expr -> unit
(* Generalize the structure of a type, lowering variables
to !current_level *)
-val generalize_spine: type_expr -> unit
- (* Special function to generalize a method during inference *)
+val generalize_class_type : class_type -> unit
+ (* Generalize the components of a class type *)
+val generalize_class_type_structure : class_type -> unit
+ (* Generalize the structure of the components of a class type *)
+val generalize_class_signature_spine : Env.t -> class_signature -> unit
+ (* Special function to generalize methods during inference *)
val correct_levels: type_expr -> type_expr
(* Returns a copy with decreasing levels *)
val limited_generalize: type_expr -> type_expr -> unit
(* Only generalize some part of the type
Make the remaining of the type non-generalizable *)
+val limited_generalize_class_type: type_expr -> class_type -> unit
+ (* Same, but for class types *)
val fully_generic: type_expr -> bool
(* Same as instance_declaration, but new nodes at generic_level *)
val instance_class:
type_expr list -> class_type -> type_expr list * class_type
+
val instance_poly:
?keep_names:bool ->
bool -> type_expr list -> type_expr -> type_expr list * type_expr
(** The compiler's own version of [expand_head] necessary for type-based
optimisations. *)
+(** Expansion of types for error traces; lives here instead of in [Errortrace]
+ because the expansion machinery lives here. *)
+
+(** Create an [Errortrace.Diff] by expanding the two types *)
+val expanded_diff :
+ Env.t ->
+ got:type_expr -> expected:type_expr ->
+ (Errortrace.expanded_type, 'variant) Errortrace.elt
+
+(** Create an [Errortrace.Diff] by *duplicating* the two types, so that each
+ one's expansion is identical to itself. Despite the name, does create
+ [Errortrace.expanded_type]s. *)
+val unexpanded_diff :
+ got:type_expr -> expected:type_expr ->
+ (Errortrace.expanded_type, 'variant) Errortrace.elt
+
val full_expand: may_forget_scope:bool -> Env.t -> type_expr -> type_expr
+
+type typedecl_extraction_result =
+ | Typedecl of Path.t * Path.t * type_declaration
+ (* The original path of the types, and the first concrete
+ type declaration found expanding it. *)
+ | Has_no_typedecl
+ | May_have_typedecl
+
val extract_concrete_typedecl:
- Env.t -> type_expr -> Path.t * Path.t * type_declaration
- (* Return the original path of the types, and the first concrete
- type declaration found expanding it.
- Raise [Not_found] if none appears or not a type constructor. *)
+ Env.t -> type_expr -> typedecl_extraction_result
val unify: Env.t -> type_expr -> type_expr -> unit
(* Unify the two types given. Raise [Unify] if not possible. *)
val unify_gadt:
equations_level:int -> allow_recursive:bool ->
- Env.t ref -> type_expr -> type_expr -> unit TypePairs.t
+ Env.t ref -> type_expr -> type_expr -> Btype.TypePairs.t
(* Unify the two types given and update the environment with the
local constraints. Raise [Unify] if not possible.
Returns the pairs of types that have been equated. *)
(* Same as [unify], but allow free univars when first type
is a variable. *)
val filter_arrow: Env.t -> type_expr -> arg_label -> type_expr * type_expr
- (* A special case of unification (with l:'a -> 'b). *)
-val filter_method: Env.t -> string -> private_flag -> type_expr -> type_expr
- (* A special case of unification (with {m : 'a; 'b}). *)
-val check_filter_method: Env.t -> string -> private_flag -> type_expr -> unit
- (* A special case of unification (with {m : 'a; 'b}), returning unit. *)
+ (* A special case of unification with [l:'a -> 'b]. Raises
+ [Filter_arrow_failed] instead of [Unify]. *)
+val filter_method: Env.t -> string -> type_expr -> type_expr
+ (* A special case of unification (with {m : 'a; 'b}). Raises
+ [Filter_method_failed] instead of [Unify]. *)
val occur_in: Env.t -> type_expr -> type_expr -> bool
val deep_occur: type_expr -> type_expr -> bool
-val filter_self_method:
- Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
- type_expr -> Ident.t * type_expr
val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
(* Check if the first type scheme is more general than the second. *)
val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
(* "Rigidify" a type and return its type variable *)
val all_distinct_vars: Env.t -> type_expr list -> bool
(* Check those types are all distinct type variables *)
-val matches: Env.t -> type_expr -> type_expr -> unit
+val matches: expand_error_trace:bool -> Env.t -> type_expr -> type_expr -> unit
(* Same as [moregeneral false], implemented using the two above
- functions and backtracking. Ignore levels *)
+ functions and backtracking. Ignore levels. The [expand_error_trace]
+ flag controls whether the error raised performs expansion; this
+ should almost always be [true]. *)
val does_match: Env.t -> type_expr -> type_expr -> bool
(* Same as [matches], but returns a [bool] *)
val reify_univars : Env.t -> Types.type_expr -> Types.type_expr
(* Replaces all the variables of a type by a univar. *)
-type class_match_failure_trace_type =
- | CM_Equality
- | CM_Moregen
+(* Exceptions for special cases of unify *)
+
+type filter_arrow_failure =
+ | Unification_error of Errortrace.unification_error
+ | Label_mismatch of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ }
+ | Not_a_function
+
+exception Filter_arrow_failed of filter_arrow_failure
+
+type filter_method_failure =
+ | Unification_error of Errortrace.unification_error
+ | Not_a_method
+ | Not_an_object of type_expr
+
+exception Filter_method_failed of filter_method_failure
type class_match_failure =
CM_Virtual_class
| CM_Parameter_arity_mismatch of int * int
- | CM_Type_parameter_mismatch of Env.t * Errortrace.comparison Errortrace.t
+ | CM_Type_parameter_mismatch of Env.t * Errortrace.equality_error
| CM_Class_type_mismatch of Env.t * class_type * class_type
- | CM_Parameter_mismatch of Env.t * Errortrace.comparison Errortrace.t
- | CM_Val_type_mismatch of
- class_match_failure_trace_type *
- string * Env.t * Errortrace.comparison Errortrace.t
- | CM_Meth_type_mismatch of
- class_match_failure_trace_type *
- string * Env.t * Errortrace.comparison Errortrace.t
+ | CM_Parameter_mismatch of Env.t * Errortrace.moregen_error
+ | CM_Val_type_mismatch of string * Env.t * Errortrace.comparison_error
+ | CM_Meth_type_mismatch of string * Env.t * Errortrace.comparison_error
| CM_Non_mutable_value of string
| CM_Non_concrete_value of string
| CM_Missing_value of string
| CM_Public_method of string
| CM_Private_method of string
| CM_Virtual_method of string
+
val match_class_types:
?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
(* Check if the first class type is more general than the second. *)
enforce and returns a function that enforces this
constraints. *)
+(* Operations on class signatures *)
+
+val new_class_signature : unit -> class_signature
+val add_dummy_method : Env.t -> scope:int -> class_signature -> unit
+
+type add_method_failure =
+ | Unexpected_method
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_method_failed of add_method_failure
+
+val add_method : Env.t ->
+ label -> private_flag -> virtual_flag -> type_expr -> class_signature -> unit
+
+type add_instance_variable_failure =
+ | Mutability_mismatch of mutable_flag
+ | Type_mismatch of Errortrace.unification_error
+
+exception Add_instance_variable_failed of add_instance_variable_failure
+
+val add_instance_variable : strict:bool -> Env.t ->
+ label -> mutable_flag -> virtual_flag -> type_expr -> class_signature -> unit
+
+type inherit_class_signature_failure =
+ | Self_type_mismatch of Errortrace.unification_error
+ | Method of label * add_method_failure
+ | Instance_variable of label * add_instance_variable_failure
+
+exception Inherit_class_signature_failed of inherit_class_signature_failure
+
+val inherit_class_signature : strict:bool -> Env.t ->
+ class_signature -> class_signature -> unit
+
+val update_class_signature :
+ Env.t -> class_signature -> label list * label list
+
+val hide_private_methods : Env.t -> class_signature -> unit
+
+val close_class_signature : Env.t -> class_signature -> bool
+
exception Nondep_cannot_erase of Ident.t
val nondep_type: Env.t -> Ident.t list -> type_expr -> type_expr
val is_contractive: Env.t -> Path.t -> bool
val normalize_type: type_expr -> unit
-val closed_schema: Env.t -> type_expr -> bool
+val nongen_schema: Env.t -> type_expr -> bool
(* Check whether the given type scheme contains no non-generic
type variables *)
+val nongen_class_declaration: class_declaration -> bool
+ (* Check whether the given class type contains no non-generic
+ type variables. Uses the empty environment. *)
+
val free_variables: ?env:Env.t -> type_expr -> type_expr list
(* If env present, then check for incomplete definitions too *)
val closed_type_decl: type_declaration -> type_expr option
val closed_extension_constructor: extension_constructor -> type_expr option
-type closed_class_failure =
- CC_Method of type_expr * bool * string * type_expr
- | CC_Value of type_expr * bool * string * type_expr
val closed_class:
- type_expr list -> class_signature -> closed_class_failure option
+ type_expr list -> class_signature ->
+ (type_expr * bool * string * type_expr) option
(* Check whether all type variables are bound *)
val unalias: type_expr -> type_expr
-val signature_of_class_type: class_type -> class_signature
-val self_type: class_type -> type_expr
-val class_type_arity: class_type -> int
+
val arity: type_expr -> int
(* Return the arity (as for curried functions) of the given type. *)
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 *)
-
(* Stubs *)
val package_subtype :
(Env.t -> Path.t -> (Longident.t * type_expr) list ->
let free_vars ?(param=false) ty =
let ret = ref TypeSet.empty in
let rec loop ty =
- let ty = repr ty in
if try_mark_node ty then
- match ty.desc with
+ match get_desc ty with
| Tvar _ ->
ret := TypeSet.add ty !ret
| Tvariant row ->
- let row = row_repr row in
iter_row loop row;
if not (static_row row) then begin
- match row.row_more.desc with
+ match get_desc (row_more row) with
| Tvar _ when param -> ret := TypeSet.add ty !ret
- | _ -> loop row.row_more
+ | _ -> loop (row_more row)
end
(* XXX: What about Tobject ? *)
| _ ->
let constructor_descrs ~current_unit ty_path decl cstrs rep =
let ty_res = newgenconstr ty_path decl.type_params in
- let num_consts = ref 0 and num_nonconsts = ref 0 and num_normal = ref 0 in
+ let num_consts = ref 0 and num_nonconsts = ref 0 in
List.iter
- (fun {cd_args; cd_res; _} ->
- if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts;
- if cd_res = None then incr num_normal)
+ (fun {cd_args; _} ->
+ if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts)
cstrs;
let rec describe_constructors idx_const idx_nonconst = function
[] -> []
cstr_tag = tag;
cstr_consts = !num_consts;
cstr_nonconsts = !num_nonconsts;
- cstr_normal = !num_normal;
cstr_private = decl.type_private;
cstr_generalized = cd_res <> None;
cstr_loc = cd_loc;
cstr_consts = -1;
cstr_nonconsts = -1;
cstr_private = ext.ext_private;
- cstr_normal = -1;
cstr_generalized = ext.ext_ret_type <> None;
cstr_loc = ext.ext_loc;
cstr_attributes = ext.ext_attributes;
cstr_uid = ext.ext_uid;
}
-let none = Private_type_expr.create (Ttuple [])
- ~level:(-1) ~scope:Btype.generic_level ~id:(-1)
- (* Clearly ill-formed type *)
+let none =
+ create_expr (Ttuple []) ~level:(-1) ~scope:Btype.generic_level ~id:(-1)
+ (* Clearly ill-formed type *)
+
let dummy_label =
{ lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
open Longident
open Path
open Types
-open Btype
open Local_store
let type_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
let module_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
+let uid_to_loc : Location.t Types.Uid.Tbl.t ref =
+ s_table Types.Uid.Tbl.create 16
+
+let register_uid uid loc = Types.Uid.Tbl.add !uid_to_loc uid loc
+
+let get_uid_to_loc_tbl () = !uid_to_loc
+
type constructor_usage = Positive | Pattern | Exported_private | Exported
type constructor_usages =
{
flags: int;
}
-and module_declaration_lazy =
- (Subst.t * Subst.scoping * module_declaration, module_declaration)
- Lazy_backtrack.t
-
and module_components =
{
alerts: alerts;
and components_maker = {
cm_env: t;
- cm_freshening_subst: Subst.t option;
cm_prefixing_subst: Subst.t;
cm_path: Path.t;
cm_addr: address_lazy;
- cm_mty: Types.module_type;
+ cm_mty: Subst.Lazy.modtype;
+ cm_shape: Shape.t;
}
and module_components_repr =
fcomp_arg: functor_parameter;
(* Formal parameter and argument signature *)
fcomp_res: module_type; (* Result signature *)
+ fcomp_shape: Shape.t;
fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *)
fcomp_subst_cache: (Path.t, module_type) Hashtbl.t
}
and value_data =
{ vda_description : value_description;
- vda_address : address_lazy }
+ vda_address : address_lazy;
+ vda_shape : Shape.t }
and value_entry =
| Val_bound of value_data
and constructor_data =
{ cda_description : constructor_description;
- cda_address : address_lazy option; }
+ cda_address : address_lazy option;
+ cda_shape: Shape.t; }
and label_data = label_description
and type_data =
{ tda_declaration : type_declaration;
- tda_descriptions : type_descriptions; }
+ tda_descriptions : type_descriptions;
+ tda_shape : Shape.t; }
and module_data =
- { mda_declaration : module_declaration_lazy;
+ { mda_declaration : Subst.Lazy.module_decl;
mda_components : module_components;
- mda_address : address_lazy; }
+ mda_address : address_lazy;
+ mda_shape: Shape.t; }
and module_entry =
| Mod_local of module_data
| Mod_persistent
| Mod_unbound of module_unbound_reason
-and modtype_data = modtype_declaration
+and modtype_data =
+ { mtda_declaration : Subst.Lazy.modtype_declaration;
+ mtda_shape : Shape.t; }
and class_data =
{ clda_declaration : class_declaration;
- clda_address : address_lazy }
+ clda_address : address_lazy;
+ clda_shape : Shape.t }
-and cltype_data = class_type_declaration
+and cltype_data =
+ { cltda_declaration : class_type_declaration;
+ cltda_shape : Shape.t }
let empty_structure =
Structure_comps {
| `Class None | `Class_type None | `Component None ->
None
-let subst_modtype_maker (subst, scoping, md) =
- {md with md_type = Subst.modtype scoping subst md.md_type}
-
let empty = {
values = IdTbl.empty; constrs = TycompTbl.empty;
labels = TycompTbl.empty; types = IdTbl.empty;
let strengthen =
(* to be filled with Mtype.strengthen *)
ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
- aliasable:bool -> t -> module_type -> Path.t -> module_type)
+ aliasable:bool -> t -> Subst.Lazy.modtype ->
+ Path.t -> Subst.Lazy.modtype)
let md md_type =
{md_type; md_attributes=[]; md_loc=Location.none
{ env with modules; summary }
end
-let components_of_module ~alerts ~uid env fs ps path addr mty =
+let components_of_module ~alerts ~uid env ps path addr mty shape =
{
alerts;
uid;
comps = Lazy_backtrack.create {
cm_env = env;
- cm_freshening_subst = fs;
cm_prefixing_subst = ps;
cm_path = path;
cm_addr = addr;
- cm_mty = mty
+ cm_mty = mty;
+ cm_shape = shape;
}
}
in
let mda_address = Lazy_backtrack.create_forced (Aident id) in
let mda_declaration =
- Lazy_backtrack.create (Subst.identity, Subst.Make_local, md)
+ Subst.(Lazy.module_decl Make_local identity (Lazy.of_module_decl md))
in
+ let mda_shape = Shape.for_persistent_unit name in
let mda_components =
- let freshening_subst =
- if freshen then (Some Subst.identity) else None
+ let mty = Subst.Lazy.of_modtype (Mty_signature sign) in
+ let mty =
+ if freshen then
+ Subst.Lazy.modtype (Subst.Rescope (Path.scope path))
+ Subst.identity mty
+ else mty
in
components_of_module ~alerts ~uid:md.md_uid
- empty freshening_subst Subst.identity
- path mda_address (Mty_signature sign)
+ empty Subst.identity
+ path mda_address mty mda_shape
in
{
mda_declaration;
mda_components;
mda_address;
+ mda_shape;
}
let read_sign_of_cmi = sign_of_cmi ~freshen:true
Types.Uid.Tbl.clear !module_declarations;
Types.Uid.Tbl.clear !used_constructors;
Types.Uid.Tbl.clear !used_labels;
+ Types.Uid.Tbl.clear !uid_to_loc;
()
let reset_cache () =
match path with
| Pident id ->
let data = find_ident_module id env in
- Lazy_backtrack.force subst_modtype_maker data.mda_declaration
+ Subst.Lazy.force_module_decl data.mda_declaration
| Pdot(p, s) ->
let sc = find_structure_components p env in
let data = NameMap.find s sc.comp_modules in
- Lazy_backtrack.force subst_modtype_maker data.mda_declaration
+ Subst.Lazy.force_module_decl data.mda_declaration
| Papply(p1, p2) ->
let fc = find_functor_components p1 env in
if alias then md (fc.fcomp_res)
else md (modtype_of_functor_appl fc p1 p2)
+let find_module_lazy ~alias path env =
+ match path with
+ | Pident id ->
+ let data = find_ident_module id env in
+ data.mda_declaration
+ | Pdot(p, s) ->
+ let sc = find_structure_components p env in
+ let data = NameMap.find s sc.comp_modules in
+ data.mda_declaration
+ | Papply(p1, p2) ->
+ let fc = find_functor_components p1 env in
+ let md =
+ if alias then md (fc.fcomp_res)
+ else md (modtype_of_functor_appl fc p1 p2)
+ in
+ Subst.Lazy.of_module_decl md
+
+let find_strengthened_module ~aliasable path env =
+ let md = find_module_lazy ~alias:true path env in
+ let mty = !strengthen ~aliasable env md.mdl_type path in
+ Subst.Lazy.force_modtype mty
+
let find_value_full path env =
match path with
| Pident id -> begin
NameMap.find s sc.comp_types
| Papply _ -> raise Not_found
-let find_modtype path env =
+let find_modtype_lazy path env =
match path with
- | Pident id -> IdTbl.find_same id env.modtypes
+ | Pident id -> (IdTbl.find_same id env.modtypes).mtda_declaration
| Pdot(p, s) ->
let sc = find_structure_components p env in
- NameMap.find s sc.comp_modtypes
+ (NameMap.find s sc.comp_modtypes).mtda_declaration
| Papply _ -> raise Not_found
+let find_modtype path env =
+ Subst.Lazy.force_modtype_decl (find_modtype_lazy path env)
+
let find_class_full path env =
match path with
| Pident id -> IdTbl.find_same id env.classes
let find_cltype path env =
match path with
- | Pident id -> IdTbl.find_same id env.cltypes
+ | Pident id -> (IdTbl.find_same id env.cltypes).cltda_declaration
| Pdot(p, s) ->
let sc = find_structure_components p env in
- NameMap.find s sc.comp_cltypes
+ (NameMap.find s sc.comp_cltypes).cltda_declaration
| Papply _ -> raise Not_found
let find_value path env =
{
tda_declaration = decl;
tda_descriptions = Type_record (labels, repr);
+ tda_shape = Shape.leaf decl.type_uid;
}
| _ -> assert false
end
| Regular p -> begin
match Path.Map.find p env.local_constraints with
| decl ->
- { tda_declaration = decl; tda_descriptions = Type_abstract }
+ {
+ tda_declaration = decl;
+ tda_descriptions = Type_abstract;
+ tda_shape = Shape.leaf decl.type_uid;
+ }
| exception Not_found -> find_type_full p env
end
| Cstr (ty_path, s) ->
| Papply _ ->
raise Not_found
+let find_shape env (ns : Shape.Sig_component_kind.t) id =
+ match ns with
+ | Type ->
+ (IdTbl.find_same id env.types).tda_shape
+ | Extension_constructor ->
+ (TycompTbl.find_same id env.constrs).cda_shape
+ | Value ->
+ begin match IdTbl.find_same id env.values with
+ | Val_bound x -> x.vda_shape
+ | Val_unbound _ -> raise Not_found
+ end
+ | Module ->
+ begin match IdTbl.find_same id env.modules with
+ | Mod_local { mda_shape; _ } -> mda_shape
+ | Mod_persistent -> Shape.for_persistent_unit (Ident.name id)
+ | Mod_unbound _ ->
+ (* Only present temporarily while approximating the environment for
+ recursive modules.
+ [find_shape] is only ever called after the environment gets
+ properly populated. *)
+ assert false
+ | exception Not_found
+ when Ident.persistent id && not (Current_unit_name.is_ident id) ->
+ Shape.for_persistent_unit (Ident.name id)
+ end
+ | Module_type ->
+ (IdTbl.find_same id env.modtypes).mtda_shape
+ | Class ->
+ (IdTbl.find_same id env.classes).clda_shape
+ | Class_type ->
+ (IdTbl.find_same id env.cltypes).cltda_shape
+
+let shape_of_path ~namespace env =
+ Shape.of_path ~namespace ~find_shape:(find_shape env)
+
+let shape_or_leaf uid = function
+ | None -> Shape.leaf uid
+ | Some shape -> shape
+
let required_globals = s_ref []
let reset_required_globals () = required_globals := []
let get_required_globals () = !required_globals
expand_module_path lax env path
and expand_module_path lax env path =
- try match find_module ~alias:true path env with
- {md_type=Mty_alias path1} ->
+ try match find_module_lazy ~alias:true path env with
+ {mdl_type=MtyL_alias path1} ->
let path' = normalize_module_path lax env path1 in
if lax || !Clflags.transparent_modules then path' else
let id = Path.head path in
expand_modtype_path env path
and expand_modtype_path env path =
- match (find_modtype path env).mtd_type with
- | Some (Mty_ident path) -> normalize_modtype_path env path
+ match (find_modtype_lazy path env).mtdl_type with
+ | Some (MtyL_ident path) -> normalize_modtype_path env path
| _ | exception Not_found -> path
let find_module path env =
find_module ~alias:false path env
+let find_module_lazy path env =
+ find_module_lazy ~alias:false path env
+
(* Find the manifest type associated to a type when appropriate:
- the type should be public or should have a private row,
- the type should have an associated manifest type. *)
(decl.type_params, body, decl.type_expansion_scope)
| _ -> raise Not_found
-let find_modtype_expansion path env =
- match (find_modtype path env).mtd_type with
+let find_modtype_expansion_lazy path env =
+ match (find_modtype_lazy path env).mtdl_type with
| None -> raise Not_found
| Some mty -> mty
+let find_modtype_expansion path env =
+ Subst.Lazy.force_modtype (find_modtype_expansion_lazy path env)
+
let rec is_functor_arg path env =
match path with
Pident id ->
let memo = Hashtbl.create 16 in
let copy t =
try
- Hashtbl.find memo t.id
+ Hashtbl.find memo (get_id t)
with Not_found ->
let t2 = Subst.type_expr Subst.identity t in
- Hashtbl.add memo t.id t2;
+ Hashtbl.add memo (get_id t) t2;
t2
in
let f = function
{env with values; summary = Env_copy_types env.summary}
)
-(* Helper to handle optional substitutions. *)
-
-let may_subst subst_f sub x =
- match sub with
- | None -> x
- | Some sub -> subst_f sub x
-
(* Iter on an environment (ignoring the body of functors and
not yet evaluated structures) *)
type iter_cont = unit -> unit
let iter_env_cont = ref []
-let rec scrape_alias_for_visit env (sub : Subst.t option) mty =
+let rec scrape_alias_for_visit env mty =
+ let open Subst.Lazy in
match mty with
- | Mty_alias path ->
- begin match may_subst Subst.module_path sub path with
+ | MtyL_alias path -> begin
+ match path with
| Pident id
when Ident.persistent id
&& not (Persistent_env.looked_up !persistent_env (Ident.name id)) ->
false
| path -> (* PR#6600: find_module may raise Not_found *)
- try scrape_alias_for_visit env sub (find_module path env).md_type
+ try
+ scrape_alias_for_visit env (find_module_lazy path env).mdl_type
with Not_found -> false
- end
+ end
| _ -> true
let iter_env wrap proj1 proj2 f env () =
let visit =
match Lazy_backtrack.get_arg mcomps.comps with
| None -> true
- | Some { cm_mty; cm_freshening_subst; _ } ->
- scrape_alias_for_visit env cm_freshening_subst cm_mty
+ | Some { cm_mty; _ } ->
+ scrape_alias_for_visit env cm_mty
in
if not visit then () else
match get_components mcomps with
let used_persistent () =
Persistent_env.fold !persistent_env
- (fun s _m r -> Concr.add s r)
- Concr.empty
+ (fun s _m r -> String.Set.add s r)
+ String.Set.empty
let find_all_comps wrap proj s (p, mda) =
match get_components mda.mda_components with
(* Expand manifest module type names at the top of the given module type *)
-let rec scrape_alias env sub ?path mty =
+let rec scrape_alias env ?path mty =
+ let open Subst.Lazy in
match mty, path with
- Mty_ident _, _ ->
- let p =
- match may_subst (Subst.modtype Keep) sub mty with
- | Mty_ident p -> p
- | _ -> assert false (* only [Mty_ident]s in [sub] *)
- in
+ MtyL_ident p, _ ->
begin try
- scrape_alias env sub (find_modtype_expansion p env) ?path
+ scrape_alias env (find_modtype_expansion_lazy p env) ?path
with Not_found ->
mty
end
- | Mty_alias path, _ ->
- let path = may_subst Subst.module_path sub path in
+ | MtyL_alias path, _ ->
begin try
- scrape_alias env sub (find_module path env).md_type ~path
+ scrape_alias env ((find_module_lazy path env).mdl_type) ~path
with Not_found ->
(*Location.prerr_warning Location.none
(Warnings.No_cmi_file (Path.name path));*)
(* Given a signature and a root path, prefix all idents in the signature
by the root path and build the corresponding substitution. *)
-let prefix_idents root freshening_sub prefixing_sub sg =
- let refresh id add_fn = function
- | None -> id, None
- | Some sub ->
- let id' = Ident.rename id in
- id', Some (add_fn id (Pident id') sub)
- in
- let rec prefix_idents root items_and_paths freshening_sub prefixing_sub =
+let prefix_idents root prefixing_sub sg =
+ let open Subst.Lazy in
+ let rec prefix_idents root items_and_paths prefixing_sub =
function
- | [] -> (List.rev items_and_paths, freshening_sub, prefixing_sub)
- | Sig_value(id, _, _) as item :: rem ->
+ | [] -> (List.rev items_and_paths, prefixing_sub)
+ | SigL_value(id, _, _) as item :: rem ->
let p = Pdot(root, Ident.name id) in
prefix_idents root
- ((item, p) :: items_and_paths) freshening_sub prefixing_sub rem
- | Sig_type(id, td, rs, vis) :: rem ->
+ ((item, p) :: items_and_paths) prefixing_sub rem
+ | SigL_type(id, td, rs, vis) :: rem ->
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub = refresh id Subst.add_type freshening_sub in
prefix_idents root
- ((Sig_type(id', td, rs, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_type id' p prefixing_sub)
+ ((SigL_type(id, td, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
rem
- | Sig_typext(id, ec, es, vis) :: rem ->
+ | SigL_typext(id, ec, es, vis) :: rem ->
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub = refresh id Subst.add_type freshening_sub in
(* we extend the substitution in case of an inlined record *)
prefix_idents root
- ((Sig_typext(id', ec, es, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_type id' p prefixing_sub)
+ ((SigL_typext(id, ec, es, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
rem
- | Sig_module(id, pres, md, rs, vis) :: rem ->
+ | SigL_module(id, pres, md, rs, vis) :: rem ->
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub = refresh id Subst.add_module freshening_sub in
prefix_idents root
- ((Sig_module(id', pres, md, rs, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_module id' p prefixing_sub)
+ ((SigL_module(id, pres, md, rs, vis), p) :: items_and_paths)
+ (Subst.add_module id p prefixing_sub)
rem
- | Sig_modtype(id, mtd, vis) :: rem ->
+ | SigL_modtype(id, mtd, vis) :: rem ->
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub =
- refresh id (fun i p s -> Subst.add_modtype i (Mty_ident p) s)
- freshening_sub
- in
prefix_idents root
- ((Sig_modtype(id', mtd, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_modtype id' (Mty_ident p) prefixing_sub)
+ ((SigL_modtype(id, mtd, vis), p) :: items_and_paths)
+ (Subst.add_modtype id (Mty_ident p) prefixing_sub)
rem
- | Sig_class(id, cd, rs, vis) :: rem ->
+ | SigL_class(id, cd, rs, vis) :: rem ->
(* pretend this is a type, cf. PR#6650 *)
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub = refresh id Subst.add_type freshening_sub in
prefix_idents root
- ((Sig_class(id', cd, rs, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_type id' p prefixing_sub)
+ ((SigL_class(id, cd, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
rem
- | Sig_class_type(id, ctd, rs, vis) :: rem ->
+ | SigL_class_type(id, ctd, rs, vis) :: rem ->
let p = Pdot(root, Ident.name id) in
- let id', freshening_sub = refresh id Subst.add_type freshening_sub in
prefix_idents root
- ((Sig_class_type(id', ctd, rs, vis), p) :: items_and_paths)
- freshening_sub
- (Subst.add_type id' p prefixing_sub)
+ ((SigL_class_type(id, ctd, rs, vis), p) :: items_and_paths)
+ (Subst.add_type id p prefixing_sub)
rem
in
- prefix_idents root [] freshening_sub prefixing_sub sg
+ let sg = Subst.Lazy.force_signature_once sg in
+ prefix_idents root [] prefixing_sub sg
(* Compute structure descriptions *)
let module_declaration_address env id presence md =
match presence with
| Mp_absent -> begin
- match md.md_type with
- | Mty_alias path -> Lazy_backtrack.create (ModAlias {env; path})
+ let open Subst.Lazy in
+ match md.mdl_type with
+ | MtyL_alias path -> Lazy_backtrack.create (ModAlias {env; path})
| _ -> assert false
end
| Mp_present ->
false
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 ->
+ {cm_env; cm_prefixing_subst;
+ cm_path; cm_addr; cm_mty; cm_shape} : _ result =
+ match scrape_alias cm_env cm_mty with
+ MtyL_signature sg ->
let c =
{ comp_values = NameMap.empty;
comp_constrs = NameMap.empty;
comp_modules = NameMap.empty; comp_modtypes = NameMap.empty;
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
+ let items_and_paths, sub =
+ prefix_idents cm_path cm_prefixing_subst sg
in
let env = ref cm_env in
let pos = ref 0 in
incr pos;
Lazy_backtrack.create addr
in
- let sub = may_subst Subst.compose freshening_sub prefixing_sub in
- List.iter (fun (item, path) ->
+ List.iter (fun ((item : Subst.Lazy.signature_item), path) ->
match item with
- Sig_value(id, decl, _) ->
+ SigL_value(id, decl, _) ->
let decl' = Subst.value_description sub decl in
let addr =
match decl.val_kind with
| Val_prim _ -> Lazy_backtrack.create_failed Not_found
| _ -> next_address ()
in
- let vda = { 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
+ let vda_shape = Shape.proj cm_shape (Shape.Item.value id) in
+ let vda =
+ { vda_description = decl'; vda_address = addr; vda_shape }
in
- let final_decl = Subst.type_declaration prefixing_sub fresh_decl in
- Btype.set_row_name final_decl
- (Subst.type_path prefixing_sub (Path.Pident id));
+ c.comp_values <- NameMap.add (Ident.name id) vda c.comp_values;
+ | SigL_type(id, decl, _, _) ->
+ let final_decl = Subst.type_declaration sub decl in
+ Btype.set_static_row_name final_decl
+ (Subst.type_path sub (Path.Pident id));
let descrs =
match decl.type_kind with
| Type_variant (_,repr) ->
in
List.iter
(fun descr ->
+ let cda_shape = Shape.leaf descr.cstr_uid in
let cda = {
cda_description = descr;
- cda_address = None }
+ cda_address = None;
+ cda_shape }
in
c.comp_constrs <-
add_to_tbl descr.cstr_name cda c.comp_constrs
| Type_abstract -> Type_abstract
| Type_open -> Type_open
in
+ let shape = Shape.proj cm_shape (Shape.Item.type_ id) in
let tda =
{ tda_declaration = final_decl;
- tda_descriptions = descrs; }
+ tda_descriptions = descrs;
+ tda_shape = shape; }
in
c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
- env := store_type_infos id fresh_decl !env
- | Sig_typext(id, ext, _, _) ->
+ env := store_type_infos ~tda_shape:shape id decl !env
+ | SigL_typext(id, ext, _, _) ->
let ext' = Subst.extension_constructor sub ext in
let descr =
Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
ext'
in
let addr = next_address () in
- let cda = { cda_description = descr; cda_address = Some addr } in
+ let cda_shape =
+ Shape.proj cm_shape (Shape.Item.extension_constructor id)
+ in
+ let cda =
+ { cda_description = descr; cda_address = Some addr; cda_shape }
+ in
c.comp_constrs <- add_to_tbl (Ident.name id) cda c.comp_constrs
- | Sig_module(id, pres, md, _, _) ->
+ | SigL_module(id, pres, md, _, _) ->
let md' =
(* The prefixed items get the same scope as [cm_path], which is
the prefix. *)
- Lazy_backtrack.create
- (sub, Subst.Rescope (Path.scope cm_path), md)
+ Subst.Lazy.module_decl
+ (Subst.Rescope (Path.scope cm_path)) sub md
in
let addr =
match pres with
| Mp_absent -> begin
- match md.md_type with
- | Mty_alias p ->
- let path = may_subst Subst.module_path freshening_sub p in
+ match md.mdl_type with
+ | MtyL_alias path ->
Lazy_backtrack.create (ModAlias {env = !env; path})
| _ -> assert false
end
| Mp_present -> next_address ()
in
let alerts =
- Builtin_attributes.alerts_of_attrs md.md_attributes
+ Builtin_attributes.alerts_of_attrs md.mdl_attributes
in
+ let shape = Shape.proj cm_shape (Shape.Item.module_ id) in
let comps =
- components_of_module ~alerts ~uid:md.md_uid !env freshening_sub
- prefixing_sub path addr md.md_type
+ components_of_module ~alerts ~uid:md.mdl_uid !env
+ sub path addr md.mdl_type shape
in
let mda =
{ mda_declaration = md';
mda_components = comps;
- mda_address = addr }
+ mda_address = addr;
+ mda_shape = shape; }
in
c.comp_modules <-
NameMap.add (Ident.name id) mda c.comp_modules;
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
- shouldn't be used for anything. So we make the items local. *)
- may_subst (Subst.modtype_declaration Make_local) freshening_sub
- decl
- in
+ store_module ~update_summary:false ~check:None
+ id addr pres md shape !env
+ | SigL_modtype(id, decl, _) ->
let final_decl =
(* The prefixed items get the same scope as [cm_path], which is
the prefix. *)
- Subst.modtype_declaration (Rescope (Path.scope cm_path))
- prefixing_sub fresh_decl
+ Subst.Lazy.modtype_decl (Rescope (Path.scope cm_path))
+ sub decl
+ in
+ let shape = Shape.proj cm_shape (Shape.Item.module_type id) in
+ let mtda =
+ { mtda_declaration = final_decl;
+ mtda_shape = shape; }
in
c.comp_modtypes <-
- NameMap.add (Ident.name id) final_decl c.comp_modtypes;
- env := store_modtype id fresh_decl !env
- | Sig_class(id, decl, _, _) ->
+ NameMap.add (Ident.name id) mtda c.comp_modtypes;
+ env := store_modtype ~update_summary:false id decl shape !env
+ | SigL_class(id, decl, _, _) ->
let decl' = Subst.class_declaration sub decl in
let addr = next_address () in
- let clda = { clda_declaration = decl'; clda_address = addr } in
+ let shape = Shape.proj cm_shape (Shape.Item.class_ id) in
+ let clda =
+ { clda_declaration = decl';
+ clda_address = addr;
+ clda_shape = shape; }
+ in
c.comp_classes <- NameMap.add (Ident.name id) clda c.comp_classes
- | Sig_class_type(id, decl, _, _) ->
+ | SigL_class_type(id, decl, _, _) ->
let decl' = Subst.cltype_declaration sub decl in
+ let shape = Shape.proj cm_shape (Shape.Item.class_type id) in
+ let cltda = { cltda_declaration = decl'; cltda_shape = shape } in
c.comp_cltypes <-
- NameMap.add (Ident.name id) decl' c.comp_cltypes)
+ NameMap.add (Ident.name id) cltda c.comp_cltypes)
items_and_paths;
Ok (Structure_comps c)
- | Mty_functor(arg, ty_res) ->
- let sub =
- may_subst Subst.compose cm_freshening_subst cm_prefixing_subst
- in
+ | MtyL_functor(arg, ty_res) ->
+ let sub = cm_prefixing_subst in
let scoping = Subst.Rescope (Path.scope cm_path) in
+ let open Subst.Lazy in
Ok (Functor_comps {
(* fcomp_arg and fcomp_res must be prefixed eagerly, because
they are interpreted in the outer environment *)
(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;
+ Named (param, force_modtype (modtype scoping sub ty_arg)));
+ fcomp_res = force_modtype (modtype scoping sub ty_res);
+ fcomp_shape = cm_shape;
fcomp_cache = Hashtbl.create 17;
fcomp_subst_cache = Hashtbl.create 17 })
- | Mty_ident _ -> Error No_components_abstract
- | Mty_alias p -> Error (No_components_alias p)
+ | MtyL_ident _ -> Error No_components_abstract
+ | MtyL_alias p -> Error (No_components_alias p)
(* Insertion of bindings by identifier + path *)
error (Illegal_value_name(loc, name))
done
-and store_value ?check id addr decl env =
+and store_value ?check id addr decl shape env =
check_value_name (Ident.name id) decl.val_loc;
Option.iter
(fun f -> check_usage decl.val_loc id decl.val_uid f !value_declarations)
check;
- let vda = { vda_description = decl; vda_address = addr } in
+ let vda =
+ { vda_description = decl;
+ vda_address = addr;
+ vda_shape = shape }
+ in
{ env with
values = IdTbl.add id (Val_bound vda) env.values;
summary = Env_value(env.summary, id, decl) }
(constructor_usage_complaint ~rebind:false priv used));
end;
end;
+ let cda_shape = Shape.leaf cstr.cstr_uid in
{ env with
constrs =
TycompTbl.add cstr_id
- { cda_description = cstr; cda_address = None } env.constrs;
+ { cda_description = cstr; cda_address = None; cda_shape } env.constrs;
}
and store_label ~check type_decl type_id lbl_id lbl env =
labels = TycompTbl.add lbl_id lbl env.labels;
}
-and store_type ~check id info env =
+and store_type ~check id info shape env =
let loc = info.type_loc in
if check then
check_usage loc id info.type_uid
| Type_abstract -> Type_abstract, env
| Type_open -> Type_open, env
in
- let tda = { tda_declaration = info; tda_descriptions = descrs } in
+ let tda =
+ { tda_declaration = info;
+ tda_descriptions = descrs;
+ tda_shape = shape }
+ in
{ env with
types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
-and store_type_infos id info env =
+and store_type_infos ~tda_shape id info env =
(* Simplified version of store_type that doesn't compute and store
constructor and label infos, but simply record the arity and
manifest-ness of the type. Used in components_of_module to
keep track of type abbreviations (e.g. type t = float) in the
computation of label representations. *)
- let tda = { tda_declaration = info; tda_descriptions = Type_abstract } in
+ let tda =
+ {
+ tda_declaration = info;
+ tda_descriptions = Type_abstract;
+ tda_shape
+ }
+ in
{ env with
types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
-and store_extension ~check ~rebind id addr ext env =
+and store_extension ~check ~rebind id addr ext shape env =
let loc = ext.ext_loc in
let cstr =
Datarepr.extension_descr ~current_unit:(get_unit_name ()) (Pident id) ext
in
- let cda = { cda_description = cstr; cda_address = Some addr } in
+ let cda =
+ { cda_description = cstr;
+ cda_address = Some addr;
+ cda_shape = shape }
+ in
if check && not loc.Location.loc_ghost &&
Warnings.is_active (Warnings.Unused_extension ("", false, Unused))
then begin
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
+and store_module ?(update_summary=true) ~check
+ id addr presence md shape env =
+ let open Subst.Lazy in
+ let loc = md.mdl_loc in
Option.iter
- (fun f -> check_usage loc id md.md_uid f !module_declarations) check;
- let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
- let module_decl_lazy =
- match freshening_sub with
- | None -> Lazy_backtrack.create_forced md
- | Some s -> Lazy_backtrack.create (s, Subst.Rescope (Ident.scope id), md)
- in
+ (fun f -> check_usage loc id md.mdl_uid f !module_declarations) check;
+ let alerts = Builtin_attributes.alerts_of_attrs md.mdl_attributes in
let comps =
- components_of_module ~alerts ~uid:md.md_uid
- env freshening_sub Subst.identity (Pident id) addr md.md_type
+ components_of_module ~alerts ~uid:md.mdl_uid
+ env Subst.identity (Pident id) addr md.mdl_type shape
in
let mda =
- { mda_declaration = module_decl_lazy;
+ { mda_declaration = md;
mda_components = comps;
- mda_address = addr }
+ mda_address = addr;
+ mda_shape = shape }
in
+ let summary =
+ if not update_summary then env.summary
+ else Env_module (env.summary, id, presence, force_module_decl md) in
{ env with
modules = IdTbl.add id (Mod_local mda) env.modules;
- summary = Env_module(env.summary, id, presence, md) }
+ summary }
-and store_modtype id info env =
+and store_modtype ?(update_summary=true) id info shape env =
+ let mtda = { mtda_declaration = info; mtda_shape = shape } in
+ let summary =
+ if not update_summary then env.summary
+ else Env_modtype (env.summary, id, Subst.Lazy.force_modtype_decl info) in
{ env with
- modtypes = IdTbl.add id info env.modtypes;
- summary = Env_modtype(env.summary, id, info) }
-
-and store_class id addr desc env =
- let clda = { clda_declaration = desc; clda_address = addr } in
+ modtypes = IdTbl.add id mtda env.modtypes;
+ summary }
+
+and store_class id addr desc shape env =
+ let clda =
+ { clda_declaration = desc;
+ clda_address = addr;
+ clda_shape = shape; }
+ in
{ env with
classes = IdTbl.add id clda env.classes;
summary = Env_class(env.summary, id, desc) }
-and store_cltype id desc env =
+and store_cltype id desc shape env =
+ let cltda = { cltda_declaration = desc; cltda_shape = shape } in
{ env with
- cltypes = IdTbl.add id desc env.cltypes;
+ cltypes = IdTbl.add id cltda env.cltypes;
summary = Env_cltype(env.summary, id, desc) }
-let scrape_alias env mty = scrape_alias env None mty
+let scrape_alias env mty = scrape_alias env mty
(* Compute the components of a functor application in a path. *)
let addr = Lazy_backtrack.create_failed Not_found in
!check_well_formed_module env loc
("the signature of " ^ Path.name p) mty;
+ let shape_arg =
+ shape_of_path ~namespace:Shape.Sig_component_kind.Module env arg
+ in
+ let shape = Shape.app f_comp.fcomp_shape ~arg:shape_arg in
let comps =
components_of_module ~alerts:Misc.Stdlib.String.Map.empty
~uid:Uid.internal_not_actually_unique
(*???*)
- env None Subst.identity p addr mty
+ env Subst.identity p addr (Subst.Lazy.of_modtype mty) shape
in
Hashtbl.add f_comp.fcomp_cache arg comps;
comps
functor_args = Ident.add id () env.functor_args;
summary = Env_functor_arg (env.summary, id)}
-let add_value ?check id desc env =
+let add_value ?check ?shape id desc env =
let addr = value_declaration_address env id desc in
- store_value ?check id addr desc env
+ let shape = shape_or_leaf desc.val_uid shape in
+ store_value ?check id addr desc shape env
-let add_type ~check id info env =
- store_type ~check id info env
+let add_type ~check ?shape id info env =
+ let shape = shape_or_leaf info.type_uid shape in
+ store_type ~check id info shape env
-and add_extension ~check ~rebind id ext env =
+and add_extension ~check ?shape ~rebind id ext env =
let addr = extension_declaration_address env id ext in
- store_extension ~check ~rebind id addr ext env
+ let shape = shape_or_leaf ext.ext_uid shape in
+ store_extension ~check ~rebind id addr ext shape env
-and add_module_declaration ?(arg=false) ~check id presence md env =
+and add_module_declaration ?(arg=false) ?shape ~check id presence md env =
let check =
if not check then
None
else
Some (fun s -> Warnings.Unused_module s)
in
+ let md = Subst.Lazy.of_module_decl md in
let addr = module_declaration_address env id presence md in
- let env = store_module ~freshening_sub:None ~check id addr presence md env in
+ let shape = shape_or_leaf md.mdl_uid shape in
+ let env = store_module ~check id addr presence md shape env in
if arg then add_functor_arg id env else env
-and add_modtype id info env =
- store_modtype id info env
+and add_module_declaration_lazy ~update_summary id presence md env =
+ let addr = module_declaration_address env id presence md in
+ let shape = Shape.leaf md.Subst.Lazy.mdl_uid in
+ let env =
+ store_module ~update_summary ~check:None id addr presence md shape env
+ in
+ env
-and add_class id ty env =
+and add_modtype ?shape id info env =
+ let shape = shape_or_leaf info.mtd_uid shape in
+ store_modtype id (Subst.Lazy.of_modtype_decl info) shape env
+
+and add_modtype_lazy ~update_summary id info env =
+ let shape = Shape.leaf info.Subst.Lazy.mtdl_uid in
+ store_modtype ~update_summary id info shape env
+
+and add_class ?shape id ty env =
let addr = class_declaration_address env id ty in
- store_class id addr ty env
+ let shape = shape_or_leaf ty.cty_uid shape in
+ store_class id addr ty shape env
-and add_cltype id ty env =
- store_cltype id ty env
+and add_cltype ?shape id ty env =
+ let shape = shape_or_leaf ty.clty_uid shape in
+ store_cltype id ty shape env
-let add_module ?arg id presence mty env =
- add_module_declaration ~check:false ?arg id presence (md mty) env
+let add_module ?arg ?shape id presence mty env =
+ add_module_declaration ~check:false ?arg ?shape id presence (md mty) env
let add_local_type path info env =
{ env with
local_constraints = Path.Map.add path info env.local_constraints }
+(* Non-lazy version of scrape_alias *)
+let scrape_alias t mty =
+ mty |> Subst.Lazy.of_modtype |> scrape_alias t |> Subst.Lazy.force_modtype
(* Insertion of bindings by name *)
let enter_value ?check name desc env =
let id = Ident.create_local name in
let addr = value_declaration_address env id desc in
- let env = store_value ?check id addr desc env in
+ let env = store_value ?check id addr desc (Shape.leaf desc.val_uid) env in
(id, env)
let enter_type ~scope name info env =
let id = Ident.create_scoped ~scope name in
- let env = store_type ~check:true id info env in
+ let env = store_type ~check:true id info (Shape.leaf info.type_uid) env in
(id, env)
let enter_extension ~scope ~rebind name ext env =
let id = Ident.create_scoped ~scope name in
let addr = extension_declaration_address env id ext in
- let env = store_extension ~check:true ~rebind id addr ext env in
+ let shape = Shape.leaf ext.ext_uid in
+ let env = store_extension ~check:true ~rebind id addr ext shape env in
(id, env)
-let enter_module_declaration ~scope ?arg s presence md env =
+let enter_module_declaration ~scope ?arg ?shape s presence md env =
let id = Ident.create_scoped ~scope s in
- (id, add_module_declaration ?arg ~check:true id presence md env)
+ (id, add_module_declaration ?arg ?shape ~check:true id presence md env)
let enter_modtype ~scope name mtd env =
let id = Ident.create_scoped ~scope name in
- let env = store_modtype id mtd env in
+ let shape = Shape.leaf mtd.mtd_uid in
+ let env = store_modtype id (Subst.Lazy.of_modtype_decl mtd) shape env in
(id, env)
let enter_class ~scope name desc env =
let id = Ident.create_scoped ~scope name in
let addr = class_declaration_address env id desc in
- let env = store_class id addr desc env in
+ let env = store_class id addr desc (Shape.leaf desc.cty_uid) env in
(id, env)
let enter_cltype ~scope name desc env =
let id = Ident.create_scoped ~scope name in
- let env = store_cltype id desc env in
+ let env = store_cltype id desc (Shape.leaf desc.clty_uid) env in
(id, env)
let enter_module ~scope ?arg s presence mty env =
(* Insertion of all components of a signature *)
-let add_item comp env =
+let add_item (map, mod_shape) comp env =
+ let proj_shape item =
+ match mod_shape with
+ | None -> map, None
+ | Some mod_shape ->
+ let shape = Shape.proj mod_shape item in
+ Shape.Map.add map item shape, Some shape
+ in
match comp with
- Sig_value(id, decl, _) -> add_value id decl env
- | Sig_type(id, decl, _, _) -> add_type ~check:false id decl env
+ | Sig_value(id, decl, _) ->
+ let map, shape = proj_shape (Shape.Item.value id) in
+ map, add_value ?shape id decl env
+ | Sig_type(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.type_ id) in
+ map, add_type ~check:false ?shape id decl env
| Sig_typext(id, ext, _, _) ->
- add_extension ~check:false ~rebind:false id ext env
+ let map, shape = proj_shape (Shape.Item.extension_constructor id) in
+ map, add_extension ~check:false ?shape ~rebind:false id ext env
| Sig_module(id, presence, md, _, _) ->
- add_module_declaration ~check:false id presence md env
- | Sig_modtype(id, decl, _) -> add_modtype id decl env
- | Sig_class(id, decl, _, _) -> add_class id decl env
- | Sig_class_type(id, decl, _, _) -> add_cltype id decl env
-
-let rec add_signature sg env =
+ let map, shape = proj_shape (Shape.Item.module_ id) in
+ map, add_module_declaration ~check:false ?shape id presence md env
+ | Sig_modtype(id, decl, _) ->
+ let map, shape = proj_shape (Shape.Item.module_type id) in
+ map, add_modtype ?shape id decl env
+ | Sig_class(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.class_ id) in
+ map, add_class ?shape id decl env
+ | Sig_class_type(id, decl, _, _) ->
+ let map, shape = proj_shape (Shape.Item.class_type id) in
+ map, add_cltype ?shape id decl env
+
+let rec add_signature (map, mod_shape) sg env =
match sg with
- [] -> env
- | comp :: rem -> add_signature rem (add_item comp env)
+ [] -> map, env
+ | comp :: rem ->
+ let map, env = add_item (map, mod_shape) comp env in
+ add_signature (map, mod_shape) rem env
-let enter_signature ~scope sg env =
+let enter_signature_and_shape ~scope ~parent_shape mod_shape sg env =
let sg = Subst.signature (Rescope scope) Subst.identity sg in
- sg, add_signature sg env
+ let shape, env = add_signature (parent_shape, mod_shape) sg env in
+ sg, shape, env
+
+let enter_signature ?mod_shape ~scope sg env =
+ let sg, _, env =
+ enter_signature_and_shape ~scope ~parent_shape:Shape.Map.empty
+ mod_shape sg env
+ in
+ sg, env
+
+let enter_signature_and_shape ~scope ~parent_shape mod_shape sg env =
+ enter_signature_and_shape ~scope ~parent_shape (Some mod_shape) sg env
+
+let add_value = add_value ?shape:None
+let add_type = add_type ?shape:None
+let add_extension = add_extension ?shape:None
+let add_class = add_class ?shape:None
+let add_cltype = add_cltype ?shape:None
+let add_modtype = add_modtype ?shape:None
+let add_signature sg env =
+ let _, env = add_signature (Shape.Map.empty, None) sg env in
+ env
(* Add "unbound" bindings *)
(* Read a signature from a file *)
let read_signature modname filename =
let mda = read_pers_mod modname filename in
- let md = Lazy_backtrack.force subst_modtype_maker mda.mda_declaration in
+ let md = Subst.Lazy.force_module_decl mda.mda_declaration in
match md.md_type with
| Mty_signature sg -> sg
| Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
| 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
+ let ty_path = Btype.cstr_type_path cstr in
mark_type_path_used env ty_path;
match Types.Uid.Tbl.find !used_constructors cstr.cstr_uid with
| mark -> mark usage
let mark_label_description_used usage env lbl =
let ty_path =
- match repr lbl.lbl_res with
- | {desc=Tconstr(path, _, _)} -> path
+ match get_desc lbl.lbl_res with
+ | Tconstr(path, _, _) -> path
| _ -> assert false
in
mark_type_path_used env ty_path;
end
let use_modtype ~use ~loc path desc =
+ let open Subst.Lazy in
if use then begin
- mark_modtype_used desc.mtd_uid;
- Builtin_attributes.check_alerts loc desc.mtd_attributes
+ mark_modtype_used desc.mtdl_uid;
+ Builtin_attributes.check_alerts loc desc.mtdl_attributes
(Path.name path)
end
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 path data;
- res
+ | (path, data) ->
+ use_modtype ~use ~loc path data.mtda_declaration;
+ (path, data.mtda_declaration)
| exception Not_found ->
may_lookup_error errors loc env (Unbound_modtype (Lident s))
let lookup_ident_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 path data;
- res
+ | path, cltda ->
+ use_cltype ~use ~loc path cltda.cltda_declaration;
+ path, cltda.cltda_declaration
| exception Not_found ->
may_lookup_error errors loc env (Unbound_cltype (Lident s))
match lid with
| Lident s ->
let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
- let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
+ let md = Subst.Lazy.force_module_decl data.mda_declaration in
path, md
| Ldot(l, s) ->
let path, data = lookup_dot_module ~errors ~use ~loc l s env in
- let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
+ let md = Subst.Lazy.force_module_decl data.mda_declaration in
path, md
| Lapply _ as lid ->
let path_f, comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
let 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 ->
+ | mta ->
let path = Pdot(p, s) in
- use_modtype ~use ~loc path desc;
- (path, desc)
+ use_modtype ~use ~loc path mta.mtda_declaration;
+ (path, mta.mtda_declaration)
| exception Not_found ->
may_lookup_error errors loc env (Unbound_modtype (Ldot(l, s)))
let lookup_dot_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 ->
+ | cltda ->
let path = Pdot(p, s) in
- use_cltype ~use ~loc path desc;
- (path, desc)
+ use_cltype ~use ~loc path cltda.cltda_declaration;
+ (path, cltda.cltda_declaration)
| exception Not_found ->
may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
let (path, tda) = lookup_type_full ~errors ~use ~loc lid env in
path, tda.tda_declaration
-let lookup_modtype ~errors ~use ~loc lid env =
+let lookup_modtype_lazy ~errors ~use ~loc lid env =
match lid with
| Lident s -> lookup_ident_modtype ~errors ~use ~loc s env
| Ldot(l, s) -> lookup_dot_modtype ~errors ~use ~loc l s env
| Lapply _ -> assert false
+let lookup_modtype ~errors ~use ~loc lid env =
+ let (path, mt) = lookup_modtype_lazy ~errors ~use ~loc lid env in
+ path, Subst.Lazy.force_modtype_decl mt
+
let lookup_class ~errors ~use ~loc lid env =
match lid with
| Lident s -> lookup_ident_class ~errors ~use ~loc s env
let lookup_modtype ?(use=true) ~loc lid env =
lookup_modtype ~errors:true ~use ~loc lid env
+let lookup_modtype_path ?(use=true) ~loc lid env =
+ fst (lookup_modtype_lazy ~errors:true ~use ~loc lid env)
+
let lookup_class ?(use=true) ~loc lid env =
lookup_class ~errors:true ~use ~loc lid env
| Mod_unbound _ -> acc
| Mod_local mda ->
let md =
- Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
+ Subst.Lazy.force_module_decl mda.mda_declaration
in
f name p md acc
| Mod_persistent ->
| None -> acc
| Some mda ->
let md =
- Lazy_backtrack.force subst_modtype_maker
- mda.mda_declaration
+ Subst.Lazy.force_module_decl mda.mda_declaration
in
f name p md acc)
env.modules
NameMap.fold
(fun s mda acc ->
let md =
- Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
+ Subst.Lazy.force_module_decl mda.mda_declaration
in
f s (Pdot (p, s)) md acc)
c.comp_modules
(fun env -> env.types) (fun sc -> sc.comp_types)
(fun k p tda acc -> f k p tda.tda_declaration acc)
and fold_modtypes f =
+ let f l path data acc = f l path (Subst.Lazy.force_modtype_decl data) acc in
find_all wrap_identity
- (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
+ (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+ (fun k p mta acc -> f k p mta.mtda_declaration acc)
and fold_classes f =
find_all wrap_identity (fun env -> env.classes) (fun sc -> sc.comp_classes)
(fun k p clda acc -> f k p clda.clda_declaration acc)
and fold_cltypes f =
find_all wrap_identity
- (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes) f
+ (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+ (fun k p cltda acc -> f k p cltda.cltda_declaration acc)
let filter_non_loaded_persistent f env =
let to_remove =
open Types
open Misc
+val register_uid : Uid.t -> Location.t -> unit
+
+val get_uid_to_loc_tbl : unit -> Location.t Types.Uid.Tbl.t
+
type value_unbound_reason =
| Val_unbound_instance_variable
| Val_unbound_self
t -> iter_cont
val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
val same_types: t -> t -> bool
-val used_persistent: unit -> Concr.t
+val used_persistent: unit -> Stdlib.String.Set.t
val find_shadowed_types: Path.t -> t -> Path.t list
val without_cmis: ('a -> 'b) -> 'a -> 'b
(* [without_cmis f arg] applies [f] to [arg], but does not
val find_class: Path.t -> t -> class_declaration
val find_cltype: Path.t -> t -> class_type_declaration
+val find_strengthened_module:
+ aliasable:bool -> Path.t -> t -> module_type
+
val find_ident_constructor: Ident.t -> t -> constructor_description
val find_ident_label: Ident.t -> t -> label_description
(* Find the manifest type information associated to a type for the sake
of the compiler's type-based optimisations. *)
val find_modtype_expansion: Path.t -> t -> module_type
+val find_modtype_expansion_lazy: Path.t -> t -> Subst.Lazy.modtype
val find_hash_type: Path.t -> t -> type_declaration
(* Find the "#t" type given the path for "t" *)
val find_class_address: Path.t -> t -> address
val find_constructor_address: Path.t -> t -> address
+val shape_of_path:
+ namespace:Shape.Sig_component_kind.t -> t -> Path.t -> Shape.t
+
val add_functor_arg: Ident.t -> t -> t
val is_functor_arg: Path.t -> t -> bool
val lookup_module_path:
?use:bool -> loc:Location.t -> load:bool -> Longident.t -> t -> Path.t
+val lookup_modtype_path:
+ ?use:bool -> loc:Location.t -> Longident.t -> t -> Path.t
val lookup_constructor:
?use:bool -> loc:Location.t -> constructor_usage -> Longident.t -> t ->
val add_type: check:bool -> Ident.t -> type_declaration -> t -> t
val add_extension:
check:bool -> rebind:bool -> Ident.t -> extension_constructor -> t -> t
-val add_module:
- ?arg:bool -> Ident.t -> module_presence -> module_type -> t -> t
-val add_module_declaration: ?arg:bool -> check:bool -> Ident.t ->
- module_presence -> module_declaration -> t -> t
+val add_module: ?arg:bool -> ?shape:Shape.t ->
+ Ident.t -> module_presence -> module_type -> t -> t
+val add_module_declaration: ?arg:bool -> ?shape:Shape.t -> check:bool ->
+ Ident.t -> module_presence -> module_declaration -> t -> t
+val add_module_declaration_lazy: update_summary:bool ->
+ Ident.t -> module_presence -> Subst.Lazy.module_decl -> t -> t
val add_modtype: Ident.t -> modtype_declaration -> t -> t
+val add_modtype_lazy: update_summary:bool ->
+ Ident.t -> Subst.Lazy.modtype_declaration -> t -> t
val add_class: Ident.t -> class_declaration -> t -> t
val add_cltype: Ident.t -> class_type_declaration -> t -> t
val add_local_type: Path.t -> type_declaration -> t -> t
(* Insertion of all fields of a signature. *)
-val add_item: signature_item -> t -> t
val add_signature: signature -> t -> t
(* Insertion of all fields of a signature, relative to the given path.
scope:int -> ?arg:bool -> string -> module_presence ->
module_type -> t -> Ident.t * t
val enter_module_declaration:
- scope:int -> ?arg:bool -> string -> module_presence ->
+ scope:int -> ?arg:bool -> ?shape:Shape.t -> string -> module_presence ->
module_declaration -> t -> Ident.t * t
val enter_modtype:
scope:int -> string -> modtype_declaration -> t -> Ident.t * t
(* Same as [add_signature] but refreshes (new stamp) and rescopes bound idents
in the process. *)
-val enter_signature: scope:int -> signature -> t -> signature * t
+val enter_signature: ?mod_shape:Shape.t -> scope:int -> signature -> t ->
+ signature * t
+
+(* Same as [enter_signature] but also extends the shape map ([parent_shape])
+ with all the the items from the signature, their shape being a projection
+ from the given shape. *)
+val enter_signature_and_shape: scope:int -> parent_shape:Shape.Map.t ->
+ Shape.t -> signature -> t -> signature * Shape.Map.t * t
val enter_unbound_value : string -> value_unbound_reason -> t -> t
val add_delayed_check_forward: ((unit -> unit) -> unit) ref
(* Forward declaration to break mutual recursion with Mtype. *)
val strengthen:
- (aliasable:bool -> t -> module_type -> Path.t -> module_type) ref
+ (aliasable:bool -> t -> Subst.Lazy.modtype ->
+ Path.t -> Subst.Lazy.modtype) ref
(* Forward declaration to break mutual recursion with Ctype. *)
val same_constr: (t -> type_expr -> type_expr -> bool) ref
(* Forward declaration to break mutual recursion with Printtyp. *)
| First -> fprintf ppf "first"
| Second -> fprintf ppf "second"
-type desc = { t: type_expr; expanded: type_expr option }
-type 'a diff = { got: 'a; expected: 'a}
+type expanded_type = { ty: type_expr; expanded: type_expr }
+
+let trivial_expansion ty = { ty; expanded = ty }
+
+type 'a diff = { got: 'a; expected: 'a }
-let short t = { t; expanded = None }
let map_diff f r =
(* ordering is often meaningful when dealing with type_expr *)
let got = f r.got in
let expected = f r.expected in
- { got; expected}
-
-let flatten_desc f x = match x.expanded with
- | None -> f x.t x.t
- | Some expanded -> f x.t expanded
+ { got; expected }
let swap_diff x = { got = x.expected; expected = x.got }
{ kind : 'a escape_kind;
context : type_expr option }
+let map_escape f esc =
+ {esc with kind = match esc.kind with
+ | Equation eq -> Equation (f eq)
+ | (Constructor _ | Univ _ | Self | Module_type _ | Constraint) as c -> c}
+
let explain trace f =
let rec explain = function
| [] -> None
| Fixed_row :
position * fixed_row_case * fixed_explanation -> unification variant
(* Equality & Moregen *)
+ | Presence_not_guaranteed_for : position * string -> comparison variant
| Openness : position (* Always [Second] for Moregen *) -> comparison variant
type 'variety obj =
(* Unification & Moregen; included in Equality for simplicity *)
| Rec_occur : type_expr * type_expr -> ('a, _) elt
-type 'variety t =
- (desc, 'variety) elt list
+type ('a, 'variety) t = ('a, 'variety) elt list
-let diff got expected = Diff (map_diff short { got; expected })
+type 'variety trace = (type_expr, 'variety) t
+type 'variety error = (expanded_type, 'variety) t
let map_elt (type variety) f : ('a, variety) elt -> ('b, variety) elt = function
| Diff x -> Diff (map_diff f x)
let map f t = List.map (map_elt f) t
-(* Convert desc to type_expr * type_expr *)
-let flatten f = map (flatten_desc f)
-
-let incompatible_fields name got expected =
+let incompatible_fields ~name ~got ~expected =
Incompatible_fields { name; diff={got; expected} }
-
let swap_elt (type variety) : ('a, variety) elt -> ('a, variety) elt = function
| Diff x -> Diff (swap_diff x)
| Incompatible_fields { name; diff } ->
let swap_trace e = List.map swap_elt e
+type unification_error = { trace : unification error } [@@unboxed]
+
+type equality_error =
+ { trace : comparison error;
+ subst : (type_expr * type_expr) list }
+
+type moregen_error = { trace : comparison error } [@@unboxed]
+
+let unification_error ~trace : unification_error =
+ assert (trace <> []);
+ { trace }
+
+let equality_error ~trace ~subst : equality_error =
+ assert (trace <> []);
+ { trace; subst }
+
+let moregen_error ~trace : moregen_error =
+ assert (trace <> []);
+ { trace }
+
+type comparison_error =
+ | Equality_error of equality_error
+ | Moregen_error of moregen_error
+
+let swap_unification_error ({trace} : unification_error) =
+ ({trace = swap_trace trace} : unification_error)
+
module Subtype = struct
type 'a elt =
| Diff of 'a diff
- type t = desc elt list
+ type 'a t = 'a elt list
- let diff got expected = Diff (map_diff short {got;expected})
+ type trace = type_expr t
+ type error_trace = expanded_type t
+
+ type unification_error_trace = unification error (** To avoid shadowing *)
+
+ type nonrec error =
+ { trace : error_trace
+ ; unification_trace : unification error }
+
+ let error ~trace ~unification_trace =
+ assert (trace <> []);
+ { trace; unification_trace }
let map_elt f = function
| Diff x -> Diff (map_diff f x)
let map f t = List.map (map_elt f) t
-
- let flatten f t = map (flatten_desc f) t
end
val swap_position : position -> position
val print_pos : Format.formatter -> position -> unit
-type desc = { t: type_expr; expanded: type_expr option }
-type 'a diff = { got: 'a; expected: 'a}
+type expanded_type = { ty: type_expr; expanded: type_expr }
+
+(** [trivial_expansion ty] creates an [expanded_type] whose expansion is also
+ [ty]. Usually, you want [Ctype.expand_type] instead, since the expansion
+ carries useful information; however, in certain circumstances, the error is
+ about the expansion of the type, meaning that actually performing the
+ expansion produces more confusing or inaccurate output. *)
+val trivial_expansion : type_expr -> expanded_type
+
+type 'a diff = { got: 'a; expected: 'a }
(** [map_diff f {expected;got}] is [{expected=f expected; got=f got}] *)
val map_diff: ('a -> 'b) -> 'a diff -> 'b diff
{ kind : 'a escape_kind;
context : type_expr option }
-val short : type_expr -> desc
+val map_escape : ('a -> 'b) -> 'a escape -> 'b escape
val explain: 'a list ->
(prev:'a option -> 'a -> 'b option) ->
'b option
-(* Type indices *)
+(** Type indices *)
type unification = private Unification
type comparison = private Comparison
| Fixed_row :
position * fixed_row_case * fixed_explanation -> unification variant
(* Equality & Moregen *)
+ | Presence_not_guaranteed_for : position * string -> comparison variant
| Openness : position (* Always [Second] for Moregen *) -> comparison variant
type 'variety obj =
(* Unification & Moregen; included in Equality for simplicity *)
| Rec_occur : type_expr * type_expr -> ('a, _) elt
-type 'variety t =
- (desc, 'variety) elt list
+type ('a, 'variety) t = ('a, 'variety) elt list
+
+type 'variety trace = (type_expr, 'variety) t
+type 'variety error = (expanded_type, 'variety) t
+
+val map : ('a -> 'b) -> ('a, 'variety) t -> ('b, 'variety) t
+
+val incompatible_fields :
+ name:string -> got:type_expr -> expected:type_expr -> (type_expr, _) elt
+
+val swap_trace : ('a, 'variety) t -> ('a, 'variety) t
+
+(** The traces (['variety t]) are the core error types. However, we bundle them
+ up into three "top-level" error types, which are used elsewhere:
+ [unification_error], [equality_error], and [moregen_error]. In the case of
+ [equality_error], this has to bundle in extra information; in general, it
+ distinguishes the three types of errors and allows us to distinguish traces
+ that are being built (or processed) from those that are complete and have
+ become the final error. These error types have the invariants that their
+ traces are nonempty; we ensure that through three smart constructors with
+ matching names. *)
-val diff : type_expr -> type_expr -> (desc, _) elt
+type unification_error = private { trace : unification error } [@@unboxed]
-(** [flatten f trace] flattens all elements of type {!desc} in
- [trace] to either [f x.t expanded] if [x.expanded=Some expanded]
- or [f x.t x.t] otherwise *)
-val flatten :
- (type_expr -> type_expr -> 'a) -> 'variety t -> ('a, 'variety) elt list
+type equality_error = private
+ { trace : comparison error;
+ subst : (type_expr * type_expr) list }
-val map : ('a -> 'b) -> ('a, 'variety) elt list -> ('b, 'variety) elt list
+type moregen_error = private { trace : comparison error } [@@unboxed]
-val incompatible_fields : string -> type_expr -> type_expr -> (desc, _) elt
+val unification_error : trace:unification error -> unification_error
-val swap_trace : 'variety t -> 'variety t
+val equality_error :
+ trace:comparison error -> subst:(type_expr * type_expr) list -> equality_error
+
+val moregen_error : trace:comparison error -> moregen_error
+
+(** Wraps up the two different kinds of [comparison] errors in one type *)
+type comparison_error =
+ | Equality_error of equality_error
+ | Moregen_error of moregen_error
+
+(** Lift [swap_trace] to [unification_error] *)
+val swap_unification_error : unification_error -> unification_error
module Subtype : sig
type 'a elt =
| Diff of 'a diff
- type t = desc elt list
+ type 'a t = 'a elt list
+
+ (** Just as outside [Subtype], we split traces, completed traces, and complete
+ errors. However, in a minor asymmetry, the name [Subtype.error_trace]
+ corresponds to the outside [error] type, and [Subtype.error] corresponds
+ to the outside [*_error] types (e.g., [unification_error]). This [error]
+ type has the invariant that the subtype trace is nonempty; note that no
+ such invariant is imposed on the unification trace. *)
+
+ type trace = type_expr t
+ type error_trace = expanded_type t
+
+ type unification_error_trace = unification error (** To avoid shadowing *)
- val diff: type_expr -> type_expr -> desc elt
+ type nonrec error = private
+ { trace : error_trace
+ ; unification_trace : unification error }
- val flatten : (type_expr -> type_expr -> 'a) -> t -> 'a elt list
+ val error :
+ trace:error_trace -> unification_trace:unification_error_trace -> error
- val map : (desc -> desc) -> desc elt list -> desc elt list
+ val map : ('a -> 'b) -> 'a t -> 'b t
end
| cty -> cty
*)
-let report_error_for = function
- | CM_Equality -> Printtyp.report_equality_error
- | CM_Moregen -> Printtyp.report_moregen_error
-
-let include_err ppf =
+let include_err mode ppf =
function
| CM_Virtual_class ->
fprintf ppf "A class cannot be changed from virtual to concrete"
| CM_Parameter_arity_mismatch _ ->
fprintf ppf
"The classes do not have the same number of type parameters"
- | CM_Type_parameter_mismatch (env, trace) ->
- Printtyp.report_equality_error ppf env trace
+ | CM_Type_parameter_mismatch (env, err) ->
+ Printtyp.report_equality_error ppf mode env err
(function ppf ->
fprintf ppf "A type parameter has type")
(function ppf ->
Printtyp.class_type cty1
"is not matched by the class type"
Printtyp.class_type cty2)
- | CM_Parameter_mismatch (env, trace) ->
- Printtyp.report_moregen_error ppf env trace
+ | CM_Parameter_mismatch (env, err) ->
+ Printtyp.report_moregen_error ppf mode env err
(function ppf ->
fprintf ppf "A parameter has type")
(function ppf ->
fprintf ppf "but is expected to have type")
- | CM_Val_type_mismatch (trace_type, lab, env, trace) ->
- report_error_for trace_type ppf env trace
+ | CM_Val_type_mismatch (lab, env, err) ->
+ Printtyp.report_comparison_error ppf mode env err
(function ppf ->
fprintf ppf "The instance variable %s@ has type" lab)
(function ppf ->
fprintf ppf "but is expected to have type")
- | CM_Meth_type_mismatch (trace_type, lab, env, trace) ->
- report_error_for trace_type ppf env trace
+ | CM_Meth_type_mismatch (lab, env, err) ->
+ Printtyp.report_comparison_error ppf mode env err
(function ppf ->
fprintf ppf "The method %s@ has type" lab)
(function ppf ->
| CM_Private_method lab ->
fprintf ppf "@[The private method %s cannot become public@]" lab
-let report_error ppf = function
+let report_error mode ppf = function
| [] -> ()
| err :: errs ->
let print_errs ppf errs =
- List.iter (fun err -> fprintf ppf "@ %a" include_err err) errs in
- fprintf ppf "@[<v>%a%a@]" include_err err print_errs errs
+ List.iter (fun err -> fprintf ppf "@ %a" (include_err mode) err) errs in
+ fprintf ppf "@[<v>%a%a@]" (include_err mode) err print_errs errs
Env.t -> class_declaration -> class_declaration ->
class_match_failure list
-val report_error: formatter -> class_match_failure list -> unit
+val report_error :
+ Printtyp.type_or_scheme -> formatter -> class_match_failure list -> unit
type value_mismatch =
| Primitive_mismatch of primitive_mismatch
| Not_a_primitive
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.moregen_error
exception Dont_match of value_mismatch
vd1.val_attributes vd2.val_attributes
name;
match Ctype.moregeneral env true vd1.val_type vd2.val_type with
- | exception Ctype.Moregen trace -> raise (Dont_match (Type (env, trace)))
+ | exception Ctype.Moregen err -> raise (Dont_match (Type err))
| () -> begin
match (vd1.val_kind, vd2.val_kind) with
| (Val_prim p1, Val_prim p2) -> begin
| (_, _) -> Tcoerce_none
end
-(* Inclusion between "private" annotations *)
-
-let private_flags decl1 decl2 =
- match decl1.type_private, decl2.type_private with
- | Private, Public ->
- decl2.type_kind = Type_abstract &&
- (decl2.type_manifest = None || decl1.type_kind <> Type_abstract)
- | _, _ -> true
-
(* Inclusion between manifest types (particularly for private row types) *)
let is_absrow env ty =
- match ty.desc with
- | Tconstr(Pident _, _, _) -> begin
- match Ctype.expand_head env ty with
- | {desc=Tobject _|Tvariant _} -> true
+ match get_desc ty with
+ | Tconstr(Pident _, _, _) ->
+ (* This function is checking for an abstract row on the side that is being
+ included into (usually numbered with "2" in this file). In this case,
+ the abstract row variable has been substituted for an object or variant
+ type. *)
+ begin match get_desc (Ctype.expand_head env ty) with
+ | Tobject _|Tvariant _ -> true
| _ -> false
end
| _ -> false
| First -> choose Second first second
| Second -> choose First first second
+(* Documents which kind of private thing would be revealed *)
+type privacy_mismatch =
+ | Private_type_abbreviation
+ | Private_variant_type
+ | Private_record_type
+ | Private_extensible_variant
+ | Private_row_type
+
type label_mismatch =
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.equality_error
| Mutability of position
+type record_change =
+ (Types.label_declaration, Types.label_declaration, label_mismatch)
+ Diffing_with_keys.change
+
type record_mismatch =
- | Label_mismatch of Types.label_declaration
- * Types.label_declaration
- * label_mismatch
- | Label_names of int * Ident.t * Ident.t
- | Label_missing of position * Ident.t
+ | Label_mismatch of record_change list
| Unboxed_float_representation of position
type constructor_mismatch =
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.equality_error
| Arity
- | Inline_record of record_mismatch
+ | Inline_record of record_change list
| 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
* constructor_mismatch
type private_variant_mismatch =
- | Openness
+ | Only_outer_closed (* It's only dangerous in one direction *)
| Missing of position * string
| Presence of string
| Incompatible_types_for of string
- | Types of Env.t * Errortrace.comparison Errortrace.t
+ | Types of Errortrace.equality_error
type private_object_mismatch =
| Missing of string
- | Types of Env.t * Errortrace.comparison Errortrace.t
+ | Types of Errortrace.equality_error
+
+type variant_change =
+ (Types.constructor_declaration as 'l, 'l, constructor_mismatch)
+ Diffing_with_keys.change
type type_mismatch =
| Arity
- | Privacy
+ | Privacy of privacy_mismatch
| Kind
- | Constraint of Env.t * Errortrace.comparison Errortrace.t
- | Manifest of Env.t * Errortrace.comparison Errortrace.t
+ | Constraint of Errortrace.equality_error
+ | Manifest of Errortrace.equality_error
| Private_variant of type_expr * type_expr * private_variant_mismatch
| Private_object of type_expr * type_expr * private_object_mismatch
| Variance
| Record_mismatch of record_mismatch
- | Variant_mismatch of variant_mismatch
+ | Variant_mismatch of variant_change list
| Unboxed_representation of position
| Immediate of Type_immediacy.Violation.t
-let report_label_mismatch first second ppf err =
+let report_primitive_mismatch first second ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : primitive_mismatch) with
+ | Name ->
+ pr "The names of the primitives are not the same"
+ | Arity ->
+ pr "The syntactic arities of these primitives were not the same.@ \
+ (They must have the same number of arrows present in the source.)"
+ | No_alloc ord ->
+ pr "%s primitive is [@@@@noalloc] but %s is not"
+ (String.capitalize_ascii (choose ord first second))
+ (choose_other ord first second)
+ | Native_name ->
+ pr "The native names of the primitives are not the same"
+ | Result_repr ->
+ pr "The two primitives' results have different representations"
+ | Argument_repr n ->
+ pr "The two primitives' %d%s arguments have different representations"
+ n (Misc.ordinal_suffix n)
+
+let report_value_mismatch first second env ppf err =
let pr fmt = Format.fprintf ppf fmt in
+ pr "@ ";
+ match (err : value_mismatch) with
+ | Primitive_mismatch pm ->
+ report_primitive_mismatch first second ppf pm
+ | Not_a_primitive ->
+ pr "The implementation is not a primitive."
+ | Type trace ->
+ Printtyp.report_moregen_error ppf Type_scheme env trace
+ (fun ppf -> Format.fprintf ppf "The type")
+ (fun ppf -> Format.fprintf ppf "is not compatible with the type")
+
+let report_type_inequality env ppf err =
+ Printtyp.report_equality_error ppf Type_scheme env err
+ (fun ppf -> Format.fprintf ppf "The type")
+ (fun ppf -> Format.fprintf ppf "is not equal to the type")
+
+let report_privacy_mismatch ppf err =
+ let singular, item =
+ match err with
+ | Private_type_abbreviation -> true, "type abbreviation"
+ | Private_variant_type -> false, "variant constructor(s)"
+ | Private_record_type -> true, "record constructor"
+ | Private_extensible_variant -> true, "extensible variant"
+ | Private_row_type -> true, "row type"
+ in Format.fprintf ppf "%s %s would be revealed."
+ (if singular then "A private" else "Private")
+ item
+
+let report_label_mismatch first second env ppf err =
match (err : label_mismatch) with
- | Type _ -> pr "The types are not equal."
+ | Type err ->
+ report_type_inequality env ppf err
| Mutability ord ->
- pr "%s is mutable and %s is not."
- (String.capitalize_ascii (choose ord first second))
+ Format.fprintf ppf "%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 pp_record_diff first second prefix decl env ppf (x : record_change) =
+ match x with
+ | Delete cd ->
+ Format.fprintf ppf "%aAn extra field, %s, is provided in %s %s."
+ prefix x (Ident.name cd.delete.ld_id) first decl
+ | Insert cd ->
+ Format.fprintf ppf "%aA field, %s, is missing in %s %s."
+ prefix x (Ident.name cd.insert.ld_id) first decl
+ | Change Type {got=lbl1; expected=lbl2; reason} ->
+ Format.fprintf ppf
+ "@[<hv>%aFields do not match:@;<1 2>\
+ %a@ is not the same as:\
+ @;<1 2>%a@ %a@]"
+ prefix x
+ Printtyp.label lbl1
+ Printtyp.label lbl2
+ (report_label_mismatch first second env) reason
+ | Change Name n ->
+ Format.fprintf ppf "%aFields have different names, %s and %s."
+ prefix x n.got n.expected
+ | Swap sw ->
+ Format.fprintf ppf "%aFields %s and %s have been swapped."
+ prefix x sw.first sw.last
+ | Move {name; got; expected } ->
+ Format.fprintf ppf
+ "@[<2>%aField %s has been moved@ from@ position %d@ to %d.@]"
+ prefix x name expected got
+
+let report_patch pr_diff first second decl env ppf patch =
+ let nl ppf () = Format.fprintf ppf "@," in
+ let no_prefix _ppf _ = () in
+ match patch with
+ | [ elt ] ->
+ Format.fprintf ppf "@[<hv>%a@]"
+ (pr_diff first second no_prefix decl env) elt
+ | _ ->
+ let pp_diff = pr_diff first second Diffing_with_keys.prefix decl env in
+ Format.fprintf ppf "@[<hv>%a@]"
+ (Format.pp_print_list ~pp_sep:nl pp_diff) patch
+
+let report_record_mismatch first second decl env ppf err =
let pr fmt = Format.fprintf ppf fmt in
match err with
- | Label_mismatch (l1, l2, err) ->
- pr
- "@[<hv>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 "@[<hv>Fields number %i have different names, %s and %s.@]"
- n (Ident.name name1) (Ident.name name2)
- | Label_missing (ord, s) ->
- pr "@[<hv>The field %s is only present in %s %s.@]"
- (Ident.name s) (choose ord first second) decl
+ | Label_mismatch patch ->
+ report_patch pp_record_diff first second decl env ppf patch
| Unboxed_float_representation ord ->
pr "@[<hv>Their internal representations differ:@ %s %s %s.@]"
(choose ord first second) decl
"uses unboxed float representation"
-let report_constructor_mismatch first second decl ppf err =
+let report_constructor_mismatch first second decl env ppf err =
let pr fmt = Format.fprintf ppf fmt in
match (err : constructor_mismatch) with
- | Type _ -> pr "The types are not equal."
+ | Type err -> report_type_inequality env ppf err
| Arity -> pr "They have different arities."
- | Inline_record err -> report_record_mismatch first second decl ppf err
+ | Inline_record err ->
+ report_patch pp_record_diff first second decl env ppf err
| Kind ord ->
pr "%s uses inline records and %s doesn't."
(String.capitalize_ascii (choose ord first second))
(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
- "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+let pp_variant_diff first second prefix decl env ppf (x : variant_change) =
+ match x with
+ | Delete cd ->
+ Format.fprintf ppf "%aAn extra constructor, %s, is provided in %s %s."
+ prefix x (Ident.name cd.delete.cd_id) first decl
+ | Insert cd ->
+ Format.fprintf ppf "%aA constructor, %s, is missing in %s %s."
+ prefix x (Ident.name cd.insert.cd_id) first decl
+ | Change Type {got; expected; reason} ->
+ Format.fprintf ppf
+ "@[<hv>%aConstructors do not match:@;<1 2>\
+ %a@ is not the same as:\
@;<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 =
+ prefix x
+ Printtyp.constructor got
+ Printtyp.constructor expected
+ (report_constructor_mismatch first second decl env) reason
+ | Change Name n ->
+ Format.fprintf ppf
+ "%aConstructors have different names, %s and %s."
+ prefix x n.got n.expected
+ | Swap sw ->
+ Format.fprintf ppf
+ "%aConstructors %s and %s have been swapped."
+ prefix x sw.first sw.last
+ | Move {name; got; expected} ->
+ Format.fprintf ppf
+ "@[<2>%aConstructor %s has been moved@ from@ position %d@ to %d.@]"
+ prefix x name expected got
+
+let report_extension_constructor_mismatch first second decl env 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_privacy ->
+ pr "Private extension constructor(s) would be revealed."
| Constructor_mismatch (id, ext1, ext2, err) ->
- pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+ pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not the same as:\
@;<1 2>%a@ %a@]"
(Printtyp.extension_only_constructor id) ext1
(Printtyp.extension_only_constructor id) ext2
- (report_constructor_mismatch first second decl) err
+ (report_constructor_mismatch first second decl env) err
-let report_type_mismatch0 first second decl ppf err =
+let report_private_variant_mismatch first second decl env ppf err =
let pr fmt = Format.fprintf ppf fmt in
+ match (err : private_variant_mismatch) with
+ | Only_outer_closed ->
+ (* It's only dangerous in one direction, so we don't have a position *)
+ pr "%s is private and closed, but %s is not closed"
+ (String.capitalize_ascii second) first
+ | Missing (ord, name) ->
+ pr "The constructor %s is only present in %s %s."
+ name (choose ord first second) decl
+ | Presence s ->
+ pr "The tag `%s is present in the %s %s,@ but might not be in the %s"
+ s second decl first
+ | Incompatible_types_for s -> pr "Types for tag `%s are incompatible" s
+ | Types err ->
+ report_type_inequality env ppf err
+
+let report_private_object_mismatch env ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ match (err : private_object_mismatch) with
+ | Missing s -> pr "The implementation is missing the method %s" s
+ | Types err -> report_type_inequality env ppf err
+
+let report_type_mismatch first second decl env ppf err =
+ let pr fmt = Format.fprintf ppf fmt in
+ pr "@ ";
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 _ -> ()
- | Private_variant _ -> ()
- | Private_object _ -> ()
- | 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
+ | Arity ->
+ pr "They have different arities."
+ | Privacy err ->
+ report_privacy_mismatch ppf err
+ | Kind ->
+ pr "Their kinds differ."
+ | Constraint err ->
+ (* This error can come from implicit parameter disagreement or from
+ explicit `constraint`s. Both affect the parameters, hence this choice
+ of explanatory text *)
+ pr "Their parameters differ@,";
+ report_type_inequality env ppf err
+ | Manifest err ->
+ report_type_inequality env ppf err
+ | Private_variant (_ty1, _ty2, mismatch) ->
+ report_private_variant_mismatch first second decl env ppf mismatch
+ | Private_object (_ty1, _ty2, mismatch) ->
+ report_private_object_mismatch env ppf mismatch
+ | Variance ->
+ pr "Their variances do not agree."
+ | Record_mismatch err ->
+ report_record_mismatch first second decl env ppf err
+ | Variant_mismatch err ->
+ report_patch pp_variant_diff first second decl env ppf err
| Unboxed_representation ord ->
pr "Their internal representations differ:@ %s %s %s."
(choose ord first second) decl
pr "%s is not a type that is always immediate on 64 bit platforms."
first
-let report_type_mismatch first second decl ppf err =
- match err with
- | Manifest _ -> ()
- | Private_variant _ -> ()
- | Private_object _ -> ()
- | _ -> Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
-
-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 (Arity : constructor_mismatch)
- else begin
- (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
- match Ctype.equal env true (params1 @ arg1) (params2 @ arg2) with
- | exception Ctype.Equality trace -> Some (Type (env, trace))
- | () -> None
- end
- | Types.Cstr_record l1, Types.Cstr_record l2 ->
- 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 -> begin
- match Ctype.equal env true [r1] [r2] with
- | exception Ctype.Equality trace -> Some (Type (env, trace))
- | () -> compare_constructor_arguments ~loc env [r1] [r2] args1 args2
- end
- | Some _, None -> Some (Explicit_return_type First)
- | None, Some _ -> Some (Explicit_return_type Second)
- | None, None ->
- compare_constructor_arguments ~loc env params1 params2 args1 args2
-
-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 (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 (Constructor_names (n, cd1.cd_id, cd2.cd_id))
- else begin
- Builtin_attributes.check_alerts_inclusion
- ~def:cd1.cd_loc
- ~use:cd2.cd_loc
- loc
- cd1.cd_attributes cd2.cd_attributes
- (Ident.name cd1.cd_id);
- match compare_constructors ~loc env params1 params2
- cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
- | Some r ->
- Some ((Constructor_mismatch (cd1, cd2, r)) : variant_mismatch)
- | None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2
- end
+module Record_diffing = struct
-and compare_variants_with_representation ~loc env params1 params2 n
- cstrs1 cstrs2 rep1 rep2
- =
- let err = compare_variants ~loc env params1 params2 n cstrs1 cstrs2 in
- match err, rep1, rep2 with
- | None, Variant_regular, Variant_regular
- | None, Variant_unboxed, Variant_unboxed ->
- None
- | Some err, _, _ ->
- Some (Variant_mismatch err)
- | None, Variant_unboxed, Variant_regular ->
- Some (Unboxed_representation First)
- | None, Variant_regular, Variant_unboxed ->
- Some (Unboxed_representation Second)
-
-and compare_labels env params1 params2
- (ld1 : Types.label_declaration) (ld2 : Types.label_declaration) =
- if ld1.ld_mutable <> ld2.ld_mutable then begin
- let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
- Some (Mutability ord)
- end else begin
+ let compare_labels env params1 params2
+ (ld1 : Types.label_declaration)
+ (ld2 : Types.label_declaration) =
+ if ld1.ld_mutable <> ld2.ld_mutable
+ then
+ let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+ Some (Mutability ord)
+ else
let tl1 = params1 @ [ld1.ld_type] in
let tl2 = params2 @ [ld2.ld_type] in
match Ctype.equal env true tl1 tl2 with
- | exception Ctype.Equality trace ->
- Some (Type (env, trace) : label_mismatch)
+ | exception Ctype.Equality err ->
+ Some (Type err : label_mismatch)
| () -> None
+
+ let rec equal ~loc env params1 params2
+ (labels1 : Types.label_declaration list)
+ (labels2 : Types.label_declaration list) =
+ match labels1, labels2 with
+ | [], [] -> true
+ | _ :: _ , [] | [], _ :: _ -> false
+ | ld1 :: rem1, ld2 :: rem2 ->
+ if Ident.name ld1.ld_id <> Ident.name ld2.ld_id
+ then false
+ else begin
+ Builtin_attributes.check_deprecated_mutable_inclusion
+ ~def:ld1.ld_loc
+ ~use:ld2.ld_loc
+ loc
+ ld1.ld_attributes ld2.ld_attributes
+ (Ident.name ld1.ld_id);
+ match compare_labels env params1 params2 ld1 ld2 with
+ | Some _ -> false
+ (* add arguments to the parameters, cf. PR#7378 *)
+ | None ->
+ equal ~loc env
+ (ld1.ld_type::params1) (ld2.ld_type::params2)
+ rem1 rem2
+ end
+
+ module Defs = struct
+ type left = Types.label_declaration
+ type right = left
+ type diff = label_mismatch
+ type state = type_expr list * type_expr list
end
+ module Diff = Diffing_with_keys.Define(Defs)
+
+ let update (d:Diff.change) (params1,params2 as st) =
+ match d with
+ | Insert _ | Change _ | Delete _ -> st
+ | Keep (x,y,_) ->
+ (* We need to add equality between existential type parameters
+ (in inline records) *)
+ x.data.ld_type::params1, y.data.ld_type::params2
+
+ let test _loc env (params1,params2)
+ ({pos; data=lbl1}: Diff.left)
+ ({data=lbl2; _ }: Diff.right)
+ =
+ let name1, name2 = Ident.name lbl1.ld_id, Ident.name lbl2.ld_id in
+ if name1 <> name2 then
+ let types_match =
+ match compare_labels env params1 params2 lbl1 lbl2 with
+ | Some _ -> false
+ | None -> true
+ in
+ Error
+ (Diffing_with_keys.Name {types_match; pos; got=name1; expected=name2})
+ else
+ match compare_labels env params1 params2 lbl1 lbl2 with
+ | Some reason ->
+ Error (
+ Diffing_with_keys.Type {pos; got=lbl1; expected=lbl2; reason}
+ )
+ | None -> Ok ()
+
+ let weight: Diff.change -> _ = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Keep _ -> 0
+ | Change (_,_,Diffing_with_keys.Name t ) ->
+ if t.types_match then 10 else 15
+ | Change _ -> 10
+
+
+
+ let key (x: Defs.left) = Ident.name x.ld_id
+ let diffing loc env params1 params2 cstrs_1 cstrs_2 =
+ let module Compute = Diff.Simple(struct
+ let key_left = key
+ let key_right = key
+ let update = update
+ let test = test loc env
+ let weight = weight
+ end)
+ in
+ Compute.diff (params1,params2) cstrs_1 cstrs_2
-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 (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 (Label_names (n, ld1.ld_id, ld2.ld_id))
- else begin
- Builtin_attributes.check_deprecated_mutable_inclusion
- ~def:ld1.ld_loc
- ~use:ld2.ld_loc
- loc
- ld1.ld_attributes ld2.ld_attributes
- (Ident.name ld1.ld_id);
- match compare_labels env params1 params2 ld1 ld2 with
- | Some 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 compare ~loc env params1 params2 l r =
+ if equal ~loc env params1 params2 l r then
+ None
+ else
+ Some (diffing loc env params1 params2 l r)
-let compare_records_with_representation ~loc env params1 params2 n
- labels1 labels2 rep1 rep2
- =
- match compare_records ~loc env params1 params2 n labels1 labels2 with
- | Some err -> Some (Record_mismatch err)
- | None ->
+
+ let compare_with_representation ~loc env params1 params2 l r rep1 rep2 =
+ if not (equal ~loc env params1 params2 l r) then
+ let patch = diffing loc env params1 params2 l r in
+ Some (Record_mismatch (Label_mismatch patch))
+ else
match rep1, rep2 with
| Record_unboxed _, Record_unboxed _ -> None
| Record_unboxed _, _ -> Some (Unboxed_representation First)
(Record_regular|Record_inlined _|Record_extension _) ->
assert false
+end
+
+
+module Variant_diffing = struct
+
+ let compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
+ match arg1, arg2 with
+ | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
+ if List.length arg1 <> List.length arg2 then
+ Some (Arity : constructor_mismatch)
+ else begin
+ (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
+ match Ctype.equal env true (params1 @ arg1) (params2 @ arg2) with
+ | exception Ctype.Equality err -> Some (Type err)
+ | () -> None
+ end
+ | Types.Cstr_record l1, Types.Cstr_record l2 ->
+ Option.map
+ (fun rec_err -> Inline_record rec_err)
+ (Record_diffing.compare env ~loc params1 params2 l1 l2)
+ | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch)
+ | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch)
+
+ let compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
+ match res1, res2 with
+ | Some r1, Some r2 ->
+ begin match Ctype.equal env true [r1] [r2] with
+ | exception Ctype.Equality err -> Some (Type err)
+ | () -> compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+ end
+ | Some _, None -> Some (Explicit_return_type First)
+ | None, Some _ -> Some (Explicit_return_type Second)
+ | None, None ->
+ compare_constructor_arguments ~loc env params1 params2 args1 args2
+
+ let equal ~loc env params1 params2
+ (cstrs1 : Types.constructor_declaration list)
+ (cstrs2 : Types.constructor_declaration list) =
+ List.length cstrs1 = List.length cstrs2 &&
+ List.for_all2 (fun (cd1:Types.constructor_declaration)
+ (cd2:Types.constructor_declaration) ->
+ Ident.name cd1.cd_id = Ident.name cd2.cd_id
+ &&
+ begin
+ Builtin_attributes.check_alerts_inclusion
+ ~def:cd1.cd_loc
+ ~use:cd2.cd_loc
+ loc
+ cd1.cd_attributes cd2.cd_attributes
+ (Ident.name cd1.cd_id)
+ ;
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some _ -> false
+ | None -> true
+ end) cstrs1 cstrs2
+
+ module Defs = struct
+ type left = Types.constructor_declaration
+ type right = left
+ type diff = constructor_mismatch
+ type state = type_expr list * type_expr list
+ end
+ module D = Diffing_with_keys.Define(Defs)
+
+ let update _ st = st
+
+ let weight: D.change -> _ = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Keep _ -> 0
+ | Change (_,_,Diffing_with_keys.Name t) ->
+ if t.types_match then 10 else 15
+ | Change _ -> 10
+
+
+ let test loc env (params1,params2)
+ ({pos; data=cd1}: D.left)
+ ({data=cd2; _}: D.right) =
+ let name1, name2 = Ident.name cd1.cd_id, Ident.name cd2.cd_id in
+ if name1 <> name2 then
+ let types_match =
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some _ -> false
+ | None -> true
+ in
+ Error
+ (Diffing_with_keys.Name {types_match; pos; got=name1; expected=name2})
+ else
+ match compare_constructors ~loc env params1 params2
+ cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
+ | Some reason ->
+ Error (Diffing_with_keys.Type {pos; got=cd1; expected=cd2; reason})
+ | None -> Ok ()
+
+ let diffing loc env params1 params2 cstrs_1 cstrs_2 =
+ let key (x:Defs.left) = Ident.name x.cd_id in
+ let module Compute = D.Simple(struct
+ let key_left = key
+ let key_right = key
+ let test = test loc env
+ let update = update
+ let weight = weight
+ end)
+ in
+ Compute.diff (params1,params2) cstrs_1 cstrs_2
+
+ let compare ~loc env params1 params2 l r =
+ if equal ~loc env params1 params2 l r then
+ None
+ else
+ Some (diffing loc env params1 params2 l r)
+
+ let compare_with_representation ~loc env params1 params2
+ cstrs1 cstrs2 rep1 rep2
+ =
+ let err = compare ~loc env params1 params2 cstrs1 cstrs2 in
+ match err, rep1, rep2 with
+ | None, Variant_regular, Variant_regular
+ | None, Variant_unboxed, Variant_unboxed ->
+ None
+ | Some err, _, _ ->
+ Some (Variant_mismatch err)
+ | None, Variant_unboxed, Variant_regular ->
+ Some (Unboxed_representation First)
+ | None, Variant_regular, Variant_unboxed ->
+ Some (Unboxed_representation Second)
+end
+
+(* Inclusion between "private" annotations *)
+let privacy_mismatch env decl1 decl2 =
+ match decl1.type_private, decl2.type_private with
+ | Private, Public -> begin
+ match decl1.type_kind, decl2.type_kind with
+ | Type_record _, Type_record _ -> Some Private_record_type
+ | Type_variant _, Type_variant _ -> Some Private_variant_type
+ | Type_open, Type_open -> Some Private_extensible_variant
+ | Type_abstract, Type_abstract
+ when Option.is_some decl2.type_manifest -> begin
+ match decl1.type_manifest with
+ | Some ty1 -> begin
+ let ty1 = Ctype.expand_head env ty1 in
+ match get_desc ty1 with
+ | Tvariant row when Btype.is_constr_row ~allow_ident:true
+ (row_more row) ->
+ Some Private_row_type
+ | Tobject (fi, _) when Btype.is_constr_row ~allow_ident:true
+ (snd (Ctype.flatten_fields fi)) ->
+ Some Private_row_type
+ | _ ->
+ Some Private_type_abbreviation
+ end
+ | None ->
+ None
+ end
+ | _, _ ->
+ None
+ end
+ | _, _ ->
+ None
+
let private_variant env row1 params1 row2 params2 =
let r1, r2, pairs =
- Ctype.merge_row_fields row1.row_fields row2.row_fields
+ Ctype.merge_row_fields (row_fields row1) (row_fields row2)
in
+ let row1_closed = row_closed row1 in
+ let row2_closed = row_closed row2 in
let err =
- if row2.row_closed && not row1.row_closed then Some Openness
+ if row2_closed && not row1_closed then Some Only_outer_closed
else begin
- match row2.row_closed, Ctype.filter_row_fields false r1 with
+ match row2_closed, Ctype.filter_row_fields false r1 with
| true, (s, _) :: _ ->
Some (Missing (Second, s) : private_variant_mismatch)
| _, _ -> None
let missing =
List.find_opt
(fun (_,f) ->
- match Btype.row_field_repr f with
+ match row_field_repr f with
| Rabsent | Reither _ -> false
| Rpresent _ -> true)
r2
match pairs with
| [] -> begin
match Ctype.equal env true tl1 tl2 with
- | exception Ctype.Equality trace ->
- Some (Types (env, trace) : private_variant_mismatch)
+ | exception Ctype.Equality err ->
+ Some (Types err : private_variant_mismatch)
| () -> None
end
| (s, f1, f2) :: pairs -> begin
- match Btype.row_field_repr f1, Btype.row_field_repr f2 with
+ match row_field_repr f1, row_field_repr f2 with
| Rpresent to1, Rpresent to2 -> begin
match to1, to2 with
| Some t1, Some t2 ->
| Some _, None | None, Some _ ->
Some (Incompatible_types_for s)
end
- | Rpresent to1, Reither(const2, ts2, _, _) -> begin
+ | Rpresent to1, Reither(const2, ts2, _) -> begin
match to1, const2, ts2 with
| Some t1, false, [t2] -> loop (t1 :: tl1) (t2 :: tl2) pairs
| None, true, [] -> loop tl1 tl2 pairs
end
| Rpresent _, Rabsent ->
Some (Missing (Second, s) : private_variant_mismatch)
- | Reither(const1, ts1, _, _), Reither(const2, ts2, _, _) ->
+ | Reither(const1, ts1, _), Reither(const2, ts2, _) ->
if const1 = const2 && List.length ts1 = List.length ts2 then
loop (ts1 @ tl1) (ts2 @ tl2) pairs
else
in
begin
match Ctype.equal env true (params1 @ tl1) (params2 @ tl2) with
- | exception Ctype.Equality trace -> Some (Types (env, trace))
+ | exception Ctype.Equality err -> Some (Types err)
| () -> None
end
-let type_manifest env ty1 params1 ty2 params2 priv2 =
+let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
- match ty1'.desc, ty2'.desc with
+ match get_desc ty1', get_desc ty2' with
| Tvariant row1, Tvariant row2
- when is_absrow env (Btype.row_more row2) -> begin
- let row1 = Btype.row_repr row1 and row2 = Btype.row_repr row2 in
- assert (Ctype.is_equal env true (ty1::params1) (row2.row_more::params2));
+ when is_absrow env (row_more row2) -> begin
+ assert (Ctype.is_equal env true (ty1::params1) (row_more row2::params2));
match private_variant env row1 params1 row2 params2 with
| None -> None
| Some err -> Some (Private_variant(ty1, ty2, err))
| Some err -> Some (Private_object(ty1, ty2, err))
end
| _ -> begin
- match
- match priv2 with
- | Private -> Ctype.equal_private env params1 ty1 params2 ty2
- | Public -> Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
- with
- | exception Ctype.Equality trace -> Some (Manifest (env, trace))
- | () -> None
- end
+ let is_private_abbrev_2 =
+ match priv2, kind2 with
+ | Private, Type_abstract -> begin
+ (* Same checks as the [when] guards from above, inverted *)
+ match get_desc ty2' with
+ | Tvariant row ->
+ not (is_absrow env (row_more row))
+ | Tobject (fi, _) ->
+ not (is_absrow env (snd (Ctype.flatten_fields fi)))
+ | _ -> true
+ end
+ | _, _ -> false
+ in
+ match
+ if is_private_abbrev_2 then
+ Ctype.equal_private env params1 ty1 params2 ty2
+ else
+ Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
+ with
+ | exception Ctype.Equality err -> Some (Manifest err)
+ | () -> None
+ end
let type_declarations ?(equality = false) ~loc env ~mark name
decl1 path decl2 =
decl1.type_attributes decl2.type_attributes
name;
if decl1.type_arity <> decl2.type_arity then Some Arity else
- if not (private_flags decl1 decl2) then Some Privacy else
+ let err =
+ match privacy_mismatch env decl1 decl2 with
+ | Some err -> Some (Privacy err)
+ | None -> None
+ in
+ if err <> None then err else
let err = match (decl1.type_manifest, decl2.type_manifest) with
(_, None) ->
begin
match Ctype.equal env true decl1.type_params decl2.type_params with
- | exception Ctype.Equality trace -> Some (Constraint(env, trace))
+ | exception Ctype.Equality err -> Some (Constraint err)
| () -> None
end
| (Some ty1, Some ty2) ->
type_manifest env ty1 decl1.type_params ty2 decl2.type_params
- decl2.type_private
+ decl2.type_private decl2.type_kind
| (None, Some ty2) ->
let ty1 =
Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
in
match Ctype.equal env true decl1.type_params decl2.type_params with
- | exception Ctype.Equality trace -> Some (Constraint(env, trace))
+ | exception Ctype.Equality err -> Some (Constraint err)
| () ->
match Ctype.equal env false [ty1] [ty2] with
- | exception Ctype.Equality trace -> Some (Manifest(env, trace))
+ | exception Ctype.Equality err -> Some (Manifest err)
| () -> None
in
if err <> None then err else
mark usage cstrs1;
if equality then mark Env.Exported cstrs2
end;
- compare_variants_with_representation ~loc env
- decl1.type_params decl2.type_params 1
- cstrs1 cstrs2
- rep1 rep2
+ Variant_diffing.compare_with_representation ~loc env
+ decl1.type_params
+ decl2.type_params
+ cstrs1
+ cstrs2
+ rep1
+ rep2
| (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
if mark then begin
let mark usage lbls =
mark usage labels1;
if equality then mark Env.Exported labels2
end;
- compare_records_with_representation ~loc env
- decl1.type_params decl2.type_params 1
+ Record_diffing.compare_with_representation ~loc env
+ decl1.type_params decl2.type_params
labels1 labels2
rep1 rep2
| (Type_open, Type_open) -> None
if not need_variance then None else
let abstr = abstr || decl2.type_private = Private in
let opn = decl2.type_kind = Type_open && decl2.type_manifest = None in
- let constrained ty = not (Btype.(is_Tvar (repr ty))) in
+ let constrained ty = not (Btype.is_Tvar ty) in
if List.for_all2
(fun ty (v1,v2) ->
let open Variance in
let tl1 = ty1 :: ext1.ext_type_params in
let tl2 = ty2 :: ext2.ext_type_params in
match Ctype.equal env true tl1 tl2 with
- | exception Ctype.Equality trace ->
- Some (Constructor_mismatch (id, ext1, ext2, Type(env, trace)))
+ | exception Ctype.Equality err ->
+ Some (Constructor_mismatch (id, ext1, ext2, Type err))
| () ->
let r =
- compare_constructors ~loc env
+ Variant_diffing.compare_constructors ~loc env
ext1.ext_type_params ext2.ext_type_params
ext1.ext_ret_type ext2.ext_ret_type
ext1.ext_args ext2.ext_args
type value_mismatch =
| Primitive_mismatch of primitive_mismatch
| Not_a_primitive
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.moregen_error
exception Dont_match of value_mismatch
+(* Documents which kind of private thing would be revealed *)
+type privacy_mismatch =
+ | Private_type_abbreviation
+ | Private_variant_type
+ | Private_record_type
+ | Private_extensible_variant
+ | Private_row_type
+
type label_mismatch =
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.equality_error
| Mutability of position
+type record_change =
+ (Types.label_declaration as 'ld, 'ld, label_mismatch) Diffing_with_keys.change
+
type record_mismatch =
- | Label_mismatch of label_declaration * label_declaration * label_mismatch
- | Label_names of int * Ident.t * Ident.t
- | Label_missing of position * Ident.t
+ | Label_mismatch of record_change list
| Unboxed_float_representation of position
type constructor_mismatch =
- | Type of Env.t * Errortrace.comparison Errortrace.t
+ | Type of Errortrace.equality_error
| Arity
- | Inline_record of record_mismatch
+ | Inline_record of record_change list
| 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 variant_change =
+ (Types.constructor_declaration as 'cd, 'cd, constructor_mismatch)
+ Diffing_with_keys.change
type private_variant_mismatch =
- | Openness
+ | Only_outer_closed
| Missing of position * string
| Presence of string
| Incompatible_types_for of string
- | Types of Env.t * Errortrace.comparison Errortrace.t
+ | Types of Errortrace.equality_error
type private_object_mismatch =
| Missing of string
- | Types of Env.t * Errortrace.comparison Errortrace.t
+ | Types of Errortrace.equality_error
type type_mismatch =
| Arity
- | Privacy
+ | Privacy of privacy_mismatch
| Kind
- | Constraint of Env.t * Errortrace.comparison Errortrace.t
- | Manifest of Env.t * Errortrace.comparison Errortrace.t
+ | Constraint of Errortrace.equality_error
+ | Manifest of Errortrace.equality_error
| Private_variant of type_expr * type_expr * private_variant_mismatch
| Private_object of type_expr * type_expr * private_object_mismatch
| Variance
| Record_mismatch of record_mismatch
- | Variant_mismatch of variant_mismatch
+ | Variant_mismatch of variant_change list
| Unboxed_representation of position
| Immediate of Type_immediacy.Violation.t
Env.t -> class_type -> class_type -> bool
*)
-val report_type_mismatch:
- string -> string -> string -> Format.formatter -> type_mismatch -> unit
-val report_extension_constructor_mismatch: string -> string -> string ->
+val report_value_mismatch :
+ string -> string ->
+ Env.t ->
+ Format.formatter -> value_mismatch -> unit
+
+val report_type_mismatch :
+ string -> string -> string ->
+ Env.t ->
+ Format.formatter -> type_mismatch -> unit
+
+val report_extension_constructor_mismatch :
+ string -> string -> string ->
+ Env.t ->
Format.formatter -> extension_constructor_mismatch -> unit
let sdiff x y = {got=x; expected=y; symptom=()}
type core_sigitem_symptom =
- | Value_descriptions of value_description core_diff
+ | Value_descriptions of (value_description, Includecore.value_mismatch) diff
| Type_declarations of (type_declaration, Includecore.type_mismatch) diff
| Extension_constructors of
(extension_constructor, Includecore.extension_constructor_mismatch) diff
missings: signature_item list;
incompatibles: (Ident.t * sigitem_symptom) list;
oks: (int * module_coercion) list;
+ leftovers: (signature_item * signature_item * int) list;
}
and sigitem_symptom =
| Core of core_sigitem_symptom
let vd2 = Subst.value_description subst vd2 in
try
Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
- with Includecore.Dont_match _err ->
- Error Error.(Core (Value_descriptions (sdiff vd1 vd2)))
+ with Includecore.Dont_match err ->
+ Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
(* Inclusion between type declarations *)
| exception Not_found -> None
| x -> Some x
-let expand_module_alias env path =
- match (Env.find_module path env).md_type with
+let expand_module_alias ~strengthen env path =
+ match
+ if strengthen then Env.find_strengthened_module ~aliasable:true path env
+ else (Env.find_module path env).md_type
+ with
| x -> Ok x
| exception Not_found -> Error (Error.Unbound_module_path path)
| None -> List.rev before, res
end
| Mty_alias p as res ->
- begin match expand_module_alias env p with
+ begin match expand_module_alias ~strengthen:false env p with
| Ok mty -> retrieve_functor_params before env mty
| Error _ -> List.rev before, res
end
Return the restriction that transforms a value of the smaller type
into a value of the bigger type. *)
-let rec modtypes ~loc env ~mark subst mty1 mty2 =
- match try_modtypes ~loc env ~mark subst mty1 mty2 with
+(* When computing a signature difference, we need to distinguish between
+ recoverable errors at the value level and unrecoverable errors at the type
+ level that require us to stop the computation of the difference due to
+ incoherent types.
+*)
+type 'a recoverable_error = { error: 'a; recoverable:bool }
+let mark_error_as_recoverable r =
+ Result.map_error (fun error -> { error; recoverable=true}) r
+let mark_error_as_unrecoverable r =
+ Result.map_error (fun error -> { error; recoverable=false}) r
+
+
+module Sign_diff = struct
+ type t = {
+ runtime_coercions: (int * Typedtree.module_coercion) list;
+ shape_map: Shape.Map.t;
+ deep_modifications:bool;
+ errors: (Ident.t * Error.sigitem_symptom) list;
+ leftovers: ((Types.signature_item as 'it) * 'it * int) list
+ }
+
+ let empty = {
+ runtime_coercions = [];
+ shape_map = Shape.Map.empty;
+ deep_modifications = false;
+ errors = [];
+ leftovers = []
+ }
+
+ let merge x y =
+ {
+ runtime_coercions = x.runtime_coercions @ y.runtime_coercions;
+ shape_map = y.shape_map;
+ (* the shape map is threaded the map during the difference computation,
+ the last shape map contains all previous elements. *)
+ deep_modifications = x.deep_modifications || y.deep_modifications;
+ errors = x.errors @ y.errors;
+ leftovers = x.leftovers @ y.leftovers
+ }
+end
+
+(**
+ In the group of mutual functions below, the [~in_eq] argument is [true] when
+ we are in fact checking equality of module types.
+
+ The module subtyping relation [A <: B] checks that [A.T = B.T] when [A]
+ and [B] define a module type [T]. The relation [A.T = B.T] is equivalent
+ to [(A.T <: B.T) and (B.T <: A.T)], but checking both recursively would lead
+ to an exponential slowdown (see #10598 and #10616).
+ To avoid this issue, when [~in_eq] is [true], we compute a coarser relation
+ [A << B] which is the same as [A <: B] except that module types [T] are
+ checked only for [A.T << B.T] and not the reverse.
+ Thus, we can implement a cheap module type equality check [A.T = B.T] by
+ computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential slowdown
+ described above.
+*)
+
+let rec modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape =
+ match try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape with
| Ok _ as ok -> ok
| Error reason ->
let mty2 = Subst.modtype Make_local subst mty2 in
Error Error.(diff mty1 mty2 reason)
-and try_modtypes ~loc env ~mark subst mty1 mty2 =
+and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
match mty1, mty2 with
| (Mty_alias p1, Mty_alias p2) ->
if Env.is_functor_arg p2 env then
Error (Error.Invalid_module_alias p2)
else if not (equal_module_paths env p1 subst p2) then
Error Error.(Mt_core Incompatible_aliases)
- else Ok Tcoerce_none
+ else Ok (Tcoerce_none, orig_shape)
| (Mty_alias p1, _) -> begin
match
Env.normalize_module_path (Some Location.none) env p1
| exception Env.Error (Env.Missing_module (_, _, path)) ->
Error Error.(Mt_core(Unbound_module_path path))
| p1 ->
- begin match expand_module_alias env p1 with
+ begin match expand_module_alias ~strengthen:false env p1 with
| Error e -> Error (Error.Mt_core e)
| Ok mty1 ->
- match strengthened_modtypes ~loc ~aliasable:true env ~mark
- subst mty1 p1 mty2
+ match strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark
+ subst mty1 p1 mty2 orig_shape
with
| Ok _ as x -> x
| Error reason -> Error (Error.After_alias_expansion reason)
| (Mty_ident p1, Mty_ident p2) ->
let p1 = Env.normalize_modtype_path env p1 in
let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
- if Path.same p1 p2 then Ok Tcoerce_none
+ if Path.same p1 p2 then Ok (Tcoerce_none, orig_shape)
else
begin match expand_modtype_path env p1, expand_modtype_path env p2 with
| Some mty1, Some mty2 ->
- try_modtypes ~loc env ~mark subst mty1 mty2
+ try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape
| None, _ | _, None -> Error (Error.Mt_core Abstract_module_type)
end
| (Mty_ident p1, _) ->
let p1 = Env.normalize_modtype_path env p1 in
begin match expand_modtype_path env p1 with
| Some p1 ->
- try_modtypes ~loc env ~mark subst p1 mty2
+ try_modtypes ~in_eq ~loc env ~mark subst p1 mty2 orig_shape
| None -> Error (Error.Mt_core Abstract_module_type)
end
| (_, Mty_ident p2) ->
let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
begin match expand_modtype_path env p2 with
- | Some p2 -> try_modtypes ~loc env ~mark subst mty1 p2
+ | Some p2 -> try_modtypes ~in_eq ~loc env ~mark subst mty1 p2 orig_shape
| None ->
begin match mty1 with
| Mty_functor _ ->
end
end
| (Mty_signature sig1, Mty_signature sig2) ->
- begin match signatures ~loc env ~mark subst sig1 sig2 with
+ begin match
+ signatures ~in_eq ~loc env ~mark subst sig1 sig2 orig_shape
+ with
| Ok _ as ok -> ok
| Error e -> Error (Error.Signature e)
end
| Mty_functor (param1, res1), Mty_functor (param2, res2) ->
let cc_arg, env, subst =
- functor_param ~loc env ~mark:(negate_mark mark) subst param1 param2
+ functor_param ~in_eq ~loc env ~mark:(negate_mark mark)
+ subst param1 param2
+ in
+ let var, res_shape =
+ match Shape.decompose_abs orig_shape with
+ | Some (var, res_shape) -> var, res_shape
+ | None ->
+ (* Using a fresh variable with a placeholder uid here is fine: users
+ will never try to jump to the definition of that variable.
+ If they try to jump to the parameter from inside the functor,
+ they will use the variable shape that is stored in the local
+ environment. *)
+ let var, shape_var =
+ Shape.fresh_var Uid.internal_not_actually_unique
+ in
+ var, Shape.app orig_shape ~arg:shape_var
in
- let cc_res = modtypes ~loc env ~mark subst res1 res2 in
+ let cc_res = modtypes ~in_eq ~loc env ~mark subst res1 res2 res_shape in
begin match cc_arg, cc_res with
- | Ok Tcoerce_none, Ok Tcoerce_none -> Ok Tcoerce_none
- | Ok cc_arg, Ok cc_res -> Ok (Tcoerce_functor(cc_arg, cc_res))
+ | Ok Tcoerce_none, Ok (Tcoerce_none, final_res_shape) ->
+ let final_shape =
+ if final_res_shape == res_shape
+ then orig_shape
+ else Shape.abs var final_res_shape
+ in
+ Ok (Tcoerce_none, final_shape)
+ | Ok cc_arg, Ok (cc_res, final_res_shape) ->
+ let final_shape =
+ if final_res_shape == res_shape
+ then orig_shape
+ else Shape.abs var final_res_shape
+ in
+ Ok (Tcoerce_functor(cc_arg, cc_res), final_shape)
| _, Error {Error.symptom = Error.Functor Error.Params res; _} ->
let got_params, got_res = res.got in
let expected_params, expected_res = res.expected in
(* Functor parameters *)
-and functor_param ~loc env ~mark subst param1 param2 = match param1, param2 with
+and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
+ match param1, param2 with
| Unit, Unit ->
Ok Tcoerce_none, env, subst
| Named (name1, arg1), Named (name2, arg2) ->
let arg2' = Subst.modtype Keep subst arg2 in
let cc_arg =
- match modtypes ~loc env ~mark Subst.identity arg2' arg1 with
- | Ok cc -> Ok cc
+ match
+ modtypes ~in_eq ~loc env ~mark Subst.identity arg2' arg1
+ Shape.dummy_mod
+ with
+ | Ok (cc, _) -> Ok cc
| Error err -> Error (Error.Mismatch err)
in
let env, subst =
Env.add_module id1 Mp_present arg2' env,
Subst.add_module id2 (Path.Pident id1) subst
| None, Some id2 ->
- Env.add_module id2 Mp_present arg2' env, subst
+ let id1 = Ident.rename id2 in
+ Env.add_module id1 Mp_present arg2' env,
+ Subst.add_module id2 (Path.Pident id1) subst
| Some id1, None ->
Env.add_module id1 Mp_present arg2' env, subst
| None, None ->
| _, _ ->
Error (Error.Incompatible_params (param1, param2)), env, subst
-and strengthened_modtypes ~loc ~aliasable env ~mark subst mty1 path1 mty2 =
+and strengthened_modtypes ~in_eq ~loc ~aliasable env ~mark
+ subst mty1 path1 mty2 shape =
match mty1, mty2 with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
- Ok Tcoerce_none
+ Ok (Tcoerce_none, shape)
| _, _ ->
let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
- modtypes ~loc env ~mark subst mty1 mty2
+ modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape
-and strengthened_module_decl ~loc ~aliasable env ~mark subst md1 path1 md2 =
+and strengthened_module_decl ~loc ~aliasable env ~mark
+ subst md1 path1 md2 shape =
match md1.md_type, md2.md_type with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
- Ok Tcoerce_none
+ Ok (Tcoerce_none, shape)
| _, _ ->
let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
- modtypes ~loc env ~mark subst md1.md_type md2.md_type
+ modtypes ~in_eq:false ~loc env ~mark subst md1.md_type md2.md_type shape
(* Inclusion between signatures *)
-and signatures ~loc env ~mark subst sig1 sig2 =
+and signatures ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
(* Environment used to check inclusion of components *)
let new_env =
Env.add_signature sig1 (Env.in_signature true env) in
([], 0) sig1 in
(* Build a table of the components of sig1, along with their positions.
The table is indexed by kind and name of component *)
- let rec build_component_table pos tbl = function
- [] -> pos, tbl
- | (Sig_value (_, _, Hidden)
- |Sig_type (_, _, _, Hidden)
- |Sig_typext (_, _, _, Hidden)
- |Sig_module (_, _, _, _, Hidden)
- |Sig_modtype (_, _, Hidden)
- |Sig_class (_, _, _, Hidden)
- |Sig_class_type (_, _, _, Hidden)
- ) as item :: rem ->
- let pos = if is_runtime_component item then pos + 1 else pos in
- build_component_table pos tbl rem (* do not pair private items. *)
+ let rec build_component_table nb_exported pos tbl = function
+ [] -> nb_exported, pos, tbl
| item :: rem ->
- let (id, _loc, name) = item_ident_name item in
let pos, nextpos =
if is_runtime_component item then pos, pos + 1
else -1, pos
in
- build_component_table nextpos
- (FieldMap.add name (id, item, pos) tbl) rem in
- let len1, comps1 =
- build_component_table 0 FieldMap.empty sig1 in
- let len2 =
- List.fold_left
- (fun n i -> if is_runtime_component i then n + 1 else n)
- 0
- sig2
+ match item_visibility item with
+ | Hidden ->
+ (* do not pair private items. *)
+ build_component_table nb_exported nextpos tbl rem
+ | Exported ->
+ let (id, _loc, name) = item_ident_name item in
+ build_component_table (nb_exported + 1) nextpos
+ (FieldMap.add name (id, item, pos) tbl) rem
+ in
+ let exported_len1, runtime_len1, comps1 =
+ build_component_table 0 0 FieldMap.empty sig1
+ in
+ let exported_len2, runtime_len2 =
+ List.fold_left (fun (el, rl) i ->
+ let el = match item_visibility i with Hidden -> el | Exported -> el + 1 in
+ let rl = if is_runtime_component i then rl + 1 else rl in
+ el, rl
+ ) (0, 0) sig2
in
(* Pair each component of sig2 with a component of sig1,
identifying the names along the way.
and the coercion to be applied to it. *)
let rec pair_components subst paired unpaired = function
[] ->
- let oks, errors =
- signature_components ~loc env ~mark new_env subst (List.rev paired) in
- begin match unpaired, errors, oks with
- | [], [], cc ->
- if len1 = len2 then (* see PR#5098 *)
- Ok (simplify_structure_coercion cc id_pos_list)
+ let open Sign_diff in
+ let d =
+ signature_components ~in_eq ~loc env ~mark new_env subst mod_shape
+ Shape.Map.empty
+ (List.rev paired)
+ in
+ begin match unpaired, d.errors, d.runtime_coercions, d.leftovers with
+ | [], [], cc, [] ->
+ let shape =
+ if not d.deep_modifications && exported_len1 = exported_len2
+ then mod_shape
+ else Shape.str ?uid:mod_shape.Shape.uid d.shape_map
+ in
+ if runtime_len1 = runtime_len2 then (* see PR#5098 *)
+ Ok (simplify_structure_coercion cc id_pos_list, shape)
else
- Ok (Tcoerce_structure (cc, id_pos_list))
- | missings, incompatibles, cc ->
- Error { env=new_env; Error.missings; incompatibles; oks=cc }
+ Ok (Tcoerce_structure (cc, id_pos_list), shape)
+ | missings, incompatibles, runtime_coercions, leftovers ->
+ Error {
+ Error.env=new_env;
+ missings;
+ incompatibles;
+ oks=runtime_coercions;
+ leftovers;
+ }
end
| item2 :: rem ->
let (id2, _loc, name2) = item_ident_name item2 in
false
| _ -> name2, true
in
- begin try
- let (id1, item1, pos1) = FieldMap.find name2 comps1 in
+ begin match FieldMap.find name2 comps1 with
+ | (id1, item1, pos1) ->
let new_subst =
match item2 with
Sig_type _ ->
in
pair_components new_subst
((item1, item2, pos1) :: paired) unpaired rem
- with Not_found ->
+ | exception Not_found ->
let unpaired =
if report then
item2 :: unpaired
(* Inclusion between signature components *)
-and signature_components ~loc old_env ~mark env subst paired =
+and signature_components ~in_eq ~loc old_env ~mark env subst
+ orig_shape shape_map paired =
match paired with
- | [] -> [], []
+ | [] -> Sign_diff.{ empty with shape_map }
| (sigi1, sigi2, pos) :: rem ->
- let id, item, present_at_runtime =
+ let shape_modified = ref false in
+ let id, item, shape_map, present_at_runtime =
match sigi1, sigi2 with
| Sig_value(id1, valdecl1, _) ,Sig_value(_id2, valdecl2, _) ->
let item =
value_descriptions ~loc env ~mark subst id1 valdecl1 valdecl2
in
+ let item = mark_error_as_recoverable item in
let present_at_runtime = match valdecl2.val_kind with
| Val_prim _ -> false
| _ -> true
in
- id1, item, present_at_runtime
+ let shape_map = Shape.Map.add_value_proj shape_map id1 orig_shape in
+ id1, item, shape_map, present_at_runtime
| Sig_type(id1, tydec1, _, _), Sig_type(_id2, tydec2, _, _) ->
let item =
type_declarations ~loc ~old_env env ~mark subst id1 tydec1 tydec2
in
- id1, item, false
+ let item = mark_error_as_unrecoverable item in
+ let shape_map = Shape.Map.add_type_proj shape_map id1 orig_shape in
+ id1, item, shape_map, false
| Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _) ->
let item =
extension_constructors ~loc env ~mark subst id1 ext1 ext2
in
- id1, item, true
+ let item = mark_error_as_unrecoverable item in
+ let shape_map =
+ Shape.Map.add_extcons_proj shape_map id1 orig_shape
+ in
+ id1, item, shape_map, true
| Sig_module(id1, pres1, mty1, _, _), Sig_module(_, pres2, mty2, _, _)
-> begin
- let item =
- module_declarations ~loc env ~mark subst id1 mty1 mty2
+ let orig_shape =
+ Shape.(proj orig_shape (Item.module_ id1))
in
let item =
- Result.map_error (fun diff -> Error.Module_type diff) item
+ module_declarations ~in_eq ~loc env ~mark subst id1 mty1 mty2
+ orig_shape
+ in
+ let item, shape_map =
+ match item with
+ | Ok (cc, shape) ->
+ if shape != orig_shape then shape_modified := true;
+ let mod_shape = Shape.set_uid_if_none shape mty1.md_uid in
+ Ok cc, Shape.Map.add_module shape_map id1 mod_shape
+ | Error diff ->
+ Error (Error.Module_type diff),
+ (* We add the original shape to the map, even though
+ there is a type error.
+ It could still be useful for merlin. *)
+ Shape.Map.add_module shape_map id1 orig_shape
in
let present_at_runtime, item =
match pres1, pres2, mty1.md_type with
true, Result.map (fun i -> Tcoerce_alias (env, p1, i)) item
| Mp_absent, Mp_present, _ -> assert false
in
- id1, item, present_at_runtime
+ let item = mark_error_as_unrecoverable item in
+ id1, item, shape_map, present_at_runtime
end
| Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _) ->
let item =
- modtype_infos ~loc env ~mark subst id1 info1 info2
+ modtype_infos ~in_eq ~loc env ~mark subst id1 info1 info2
in
- id1, item, false
+ let shape_map =
+ Shape.Map.add_module_type_proj shape_map id1 orig_shape
+ in
+ let item = mark_error_as_unrecoverable item in
+ id1, item, shape_map, false
| Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _) ->
let item =
class_declarations ~old_env env subst decl1 decl2
in
- id1, item, true
+ let shape_map =
+ Shape.Map.add_class_proj shape_map id1 orig_shape
+ in
+ let item = mark_error_as_unrecoverable item in
+ id1, item, shape_map, true
| Sig_class_type(id1, info1, _, _), Sig_class_type(_id2, info2, _, _) ->
let item =
class_type_declarations ~loc ~old_env env subst info1 info2
in
- id1, item, false
+ let item = mark_error_as_unrecoverable item in
+ let shape_map =
+ Shape.Map.add_class_type_proj shape_map id1 orig_shape
+ in
+ id1, item, shape_map, false
| _ ->
assert false
in
- let oks, errors =
- signature_components ~loc old_env ~mark env subst rem
+ let deep_modifications = !shape_modified in
+ let first =
+ match item with
+ | Ok x ->
+ let runtime_coercions =
+ if present_at_runtime then [pos,x] else []
+ in
+ Sign_diff.{ empty with deep_modifications; runtime_coercions }
+ | Error { error; recoverable=_ } ->
+ Sign_diff.{ empty with errors=[id,error]; deep_modifications }
in
- match item with
- | Ok x when present_at_runtime -> (pos,x) :: oks, errors
- | Ok _ -> oks, errors
- | Error y -> oks , (id,y) :: errors
-
-and module_declarations ~loc env ~mark subst id1 md1 md2 =
+ let continue = match item with
+ | Ok _ -> true
+ | Error x -> x.recoverable
+ in
+ let rest =
+ if continue then
+ signature_components ~in_eq ~loc old_env ~mark env subst
+ orig_shape shape_map rem
+ else Sign_diff.{ empty with leftovers=rem }
+ in
+ Sign_diff.merge first rest
+
+and module_declarations ~in_eq ~loc env ~mark subst id1 md1 md2 orig_shape =
Builtin_attributes.check_alerts_inclusion
~def:md1.md_loc
~use:md2.md_loc
let p1 = Path.Pident id1 in
if mark_positive mark then
Env.mark_module_used md1.md_uid;
- strengthened_modtypes ~loc ~aliasable:true env ~mark subst
- md1.md_type p1 md2.md_type
+ strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark subst
+ md1.md_type p1 md2.md_type orig_shape
(* Inclusion between module type specifications *)
-and modtype_infos ~loc env ~mark subst id info1 info2 =
+and modtype_infos ~in_eq ~loc env ~mark subst id info1 info2 =
Builtin_attributes.check_alerts_inclusion
~def:info1.mtd_loc
~use:info2.mtd_loc
(None, None) -> Ok Tcoerce_none
| (Some _, None) -> Ok Tcoerce_none
| (Some mty1, Some mty2) ->
- check_modtype_equiv ~loc env ~mark mty1 mty2
+ check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2
| (None, Some mty2) ->
- check_modtype_equiv ~loc env ~mark (Mty_ident(Path.Pident id)) mty2 in
+ let mty1 = Mty_ident(Path.Pident id) in
+ check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 in
match r with
| Ok _ as ok -> ok
| Error e -> Error Error.(Module_type_declaration (diff info1 info2 e))
-and check_modtype_equiv ~loc env ~mark mty1 mty2 =
- match
- (modtypes ~loc env ~mark Subst.identity mty1 mty2,
- modtypes ~loc env ~mark:(negate_mark mark) Subst.identity mty2 mty1)
- with
- (Ok Tcoerce_none, Ok Tcoerce_none) -> Ok Tcoerce_none
- | (Ok c1, Ok _c2) ->
+and check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 =
+ let c1 =
+ modtypes ~in_eq:true ~loc env ~mark Subst.identity mty1 mty2 Shape.dummy_mod
+ in
+ let c2 =
+ (* For nested module type paths, we check only one side of the equivalence:
+ the outer module type is the one responsible for checking the other side
+ of the equivalence.
+ *)
+ if in_eq then None
+ else
+ let mark = negate_mark mark in
+ Some (
+ modtypes ~in_eq:true ~loc env ~mark Subst.identity
+ mty2 mty1 Shape.dummy_mod
+ )
+ in
+ match c1, c2 with
+ | Ok (Tcoerce_none, _), (Some Ok (Tcoerce_none, _)|None) -> Ok Tcoerce_none
+ | Ok (c1, _), (Some Ok _ | None) ->
(* Format.eprintf "@[c1 = %a@ c2 = %a@]@."
- print_coercion _c1 print_coercion _c2; *)
+ print_coercion _c1 print_coercion _c2; *)
Error Error.(Illegal_permutation c1)
- | Ok _, Error e -> Error Error.(Not_greater_than e)
- | Error e, Ok _ -> Error Error.(Not_less_than e)
- | Error less_than, Error greater_than ->
+ | Ok _, Some Error e -> Error Error.(Not_greater_than e)
+ | Error e, (Some Ok _ | None) -> Error Error.(Not_less_than e)
+ | Error less_than, Some Error greater_than ->
Error Error.(Incomparable {less_than; greater_than})
let check_modtype_inclusion_raw ~loc env mty1 path1 mty2 =
let aliasable = can_alias env path1 in
- strengthened_modtypes ~loc ~aliasable env ~mark:Mark_both
- Subst.identity mty1 path1 mty2
+ strengthened_modtypes ~in_eq:false ~loc ~aliasable env ~mark:Mark_both
+ Subst.identity mty1 path1 mty2 Shape.dummy_mod
+ |> Result.map fst
let check_modtype_inclusion ~loc env mty1 path1 mty2 =
match check_modtype_inclusion_raw ~loc env mty1 path1 mty2 with
(* Check that an implementation of a compilation unit meets its
interface. *)
-let compunit env ~mark impl_name impl_sig intf_name intf_sig =
+let compunit env ~mark impl_name impl_sig intf_name intf_sig unit_shape =
match
- signatures ~loc:(Location.in_file impl_name) env ~mark Subst.identity
- impl_sig intf_sig
+ signatures ~in_eq:false ~loc:(Location.in_file impl_name) env ~mark
+ Subst.identity impl_sig intf_sig unit_shape
with Result.Error reasons ->
let cdiff =
Error.In_Compilation_unit(Error.diff impl_name intf_name reasons) in
*)
module Functor_inclusion_diff = struct
- open Diffing
+
+ module Defs = struct
+ type left = Types.functor_parameter
+ type right = left
+ type eq = Typedtree.module_coercion
+ type diff = (Types.functor_parameter, unit) Error.functor_param_symptom
+ type state = {
+ res: module_type option;
+ env: Env.t;
+ subst: Subst.t;
+ }
+ end
+ open Defs
+
+ module Diff = Diffing.Define(Defs)
let param_name = function
| Named(x,_) -> x
| Unit -> None
- let weight = function
+ let weight: Diff.change -> _ = function
| Insert _ -> 10
| Delete _ -> 10
| Change _ -> 10
| Some _, None | None, Some _ -> 1
end
- type state = {
- res: module_type option;
- env: Env.t;
- subst: Subst.t;
- }
+
let keep_expansible_param = function
| Mty_ident _ | Mty_alias _ as mty -> Some mty
| None -> state, [||]
| Some (res, expansion) -> { state with res }, expansion
- let update d st = match d with
+ let update (d:Diff.change) st = match d with
| Insert (Unit | Named (None,_))
| Delete (Unit | Named (None,_))
| Keep (Unit,_,_)
end
let diff env (l1,res1) (l2,_) =
- let update = Diffing.With_left_extensions update in
- let test st mty1 mty2 =
- let loc = Location.none in
- let res, _, _ =
- functor_param ~loc st.env ~mark:Mark_neither st.subst mty1 mty2
- in
- res
+ let module Compute = Diff.Left_variadic(struct
+ let test st mty1 mty2 =
+ let loc = Location.none in
+ let res, _, _ =
+ functor_param ~in_eq:false ~loc st.env ~mark:Mark_neither
+ st.subst mty1 mty2
+ in
+ res
+ let update = update
+ let weight = weight
+ end)
in
let param1 = Array.of_list l1 in
let param2 = Array.of_list l2 in
let state =
{ env; subst = Subst.identity; res = keep_expansible_param res1}
in
- Diffing.variadic_diff ~weight ~test ~update state param1 param2
+ Compute.diff state param1 param2
end
module Functor_app_diff = struct
module I = Functor_inclusion_diff
- open Diffing
-
- let weight = function
+ module Defs= struct
+ type left = Error.functor_arg_descr * Types.module_type
+ type right = Types.functor_parameter
+ type eq = Typedtree.module_coercion
+ type diff = (Error.functor_arg_descr, unit) Error.functor_param_symptom
+ type state = I.Defs.state
+ end
+ module Diff = Diffing.Define(Defs)
+
+ let weight: Diff.change -> _ = function
| Insert _ -> 10
| Delete _ -> 10
| Change _ -> 10
| Named _, None | (Unit | Anonymous), Some _ -> 1
end
- let update (d: (_,Types.functor_parameter,_,_) change) (st:I.state) =
+ let update (d: Diff.change) (st:Defs.state) =
let open Error in
match d with
| Insert _
let diff env ~f ~args =
let params, res = retrieve_functor_params env f in
- let update = Diffing.With_right_extensions update in
- let test (state:I.state) (arg,arg_mty) param =
- let loc = Location.none in
- let res = match (arg:Error.functor_arg_descr), param with
- | Unit, Unit -> Ok Tcoerce_none
- | Unit, Named _ | (Anonymous | Named _), Unit ->
- Result.Error (Error.Incompatible_params(arg,param))
- | ( Anonymous | Named _ ) , Named (_, param) ->
- match
- modtypes ~loc state.env ~mark:Mark_neither state.subst
- arg_mty param
- with
- | Error mty -> Result.Error (Error.Mismatch mty)
- | Ok _ as x -> x
- in
- res
+ let module Compute = Diff.Right_variadic(struct
+ let update = update
+ let test (state:Defs.state) (arg,arg_mty) param =
+ let loc = Location.none in
+ let res = match (arg:Error.functor_arg_descr), param with
+ | Unit, Unit -> Ok Tcoerce_none
+ | Unit, Named _ | (Anonymous | Named _), Unit ->
+ Result.Error (Error.Incompatible_params(arg,param))
+ | ( Anonymous | Named _ ) , Named (_, param) ->
+ match
+ modtypes ~in_eq:false ~loc state.env ~mark:Mark_neither
+ state.subst arg_mty param Shape.dummy_mod
+ with
+ | Error mty -> Result.Error (Error.Mismatch mty)
+ | Ok (cc, _) -> Ok cc
+ in
+ res
+ let weight = weight
+ end)
in
let args = Array.of_list args in
let params = Array.of_list params in
- let state : I.state =
+ let state : Defs.state =
{ env; subst = Subst.identity; res = I.keep_expansible_param res }
in
- Diffing.variadic_diff ~weight ~test ~update state args params
+ Compute.diff state args params
end
(* Hide the context and substitution parameters to the outside world *)
+let modtypes_with_shape ~shape ~loc env ~mark mty1 mty2 =
+ match modtypes ~in_eq:false ~loc env ~mark
+ Subst.identity mty1 mty2 shape
+ with
+ | Ok (cc, shape) -> cc, shape
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
let modtypes ~loc env ~mark mty1 mty2 =
- match modtypes ~loc env ~mark Subst.identity mty1 mty2 with
- | Ok x -> x
+ match modtypes ~in_eq:false ~loc env ~mark
+ Subst.identity mty1 mty2 Shape.dummy_mod
+ with
+ | Ok (cc, _) -> cc
| Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
let signatures env ~mark sig1 sig2 =
- match signatures ~loc:Location.none env ~mark Subst.identity sig1 sig2 with
- | Ok x -> x
+ match signatures ~in_eq:false ~loc:Location.none env ~mark
+ Subst.identity sig1 sig2 Shape.dummy_mod
+ with
+ | Ok (cc, _) -> cc
| Error reason -> raise (Error(env,Error.(In_Signature reason)))
let type_declarations ~loc env ~mark id decl1 decl2 =
let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
match strengthened_module_decl ~loc ~aliasable env ~mark Subst.identity
- md1 path1 md2 with
- | Ok x -> x
+ md1 path1 md2 Shape.dummy_mod with
+ | Ok (x, _shape) -> x
| Error mdiff ->
raise (Error(env,Error.(In_Module_type mdiff)))
-let expand_module_alias env path =
- match expand_module_alias env path with
+let expand_module_alias ~strengthen env path =
+ match expand_module_alias ~strengthen env path with
| Ok x -> x
| Result.Error _ ->
raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
let check_modtype_equiv ~loc env id mty1 mty2 =
- match check_modtype_equiv ~loc env ~mark:Mark_both mty1 mty2 with
+ match check_modtype_equiv ~in_eq:false ~loc env ~mark:Mark_both mty1 mty2 with
| Ok _ -> ()
| Error e ->
raise (Error(env,
| Unit
type core_sigitem_symptom =
- | Value_descriptions of Types.value_description core_diff
+ | Value_descriptions of
+ (Types.value_description, Includecore.value_mismatch) diff
| Type_declarations of
(Types.type_declaration, Includecore.type_mismatch) diff
| Extension_constructors of
missings: Types.signature_item list;
incompatibles: (Ident.t * sigitem_symptom) list;
oks: (int * Typedtree.module_coercion) list;
+ leftovers: ((Types.signature_item as 'it) * 'it * int) list
+ (** signature items that could not be compared due to type divergence *)
}
and sigitem_symptom =
| Core of core_sigitem_symptom
loc:Location.t -> Env.t -> mark:mark ->
module_type -> module_type -> module_coercion
+val modtypes_with_shape:
+ shape:Shape.t -> loc:Location.t -> Env.t -> mark:mark ->
+ module_type -> module_type -> module_coercion * Shape.t
+
val strengthened_module_decl:
loc:Location.t -> aliasable:bool -> Env.t -> mark:mark ->
module_declaration -> Path.t -> module_declaration -> module_coercion
val compunit:
Env.t -> mark:mark -> string -> signature ->
- string -> signature -> module_coercion
+ string -> signature -> Shape.t -> module_coercion * Shape.t
val type_declarations:
loc:Location.t -> Env.t -> mark:mark ->
args : (Error.functor_arg_descr * Types.module_type) list ;
}
-val expand_module_alias: Env.t -> Path.t -> Types.module_type
+val expand_module_alias: strengthen:bool -> Env.t -> Path.t -> Types.module_type
module Functor_inclusion_diff: sig
+ module Defs: sig
+ type left = Types.functor_parameter
+ type right = left
+ type eq = Typedtree.module_coercion
+ type diff = (Types.functor_parameter, unit) Error.functor_param_symptom
+ type state
+ end
val diff: Env.t ->
- Types.functor_parameter list * Types.module_type ->
- Types.functor_parameter list * Types.module_type ->
- (Types.functor_parameter, Types.functor_parameter,
- Typedtree.module_coercion,
- (Types.functor_parameter, 'c) Error.functor_param_symptom)
- Diffing.patch
+ Types.functor_parameter list * Types.module_type ->
+ Types.functor_parameter list * Types.module_type ->
+ Diffing.Define(Defs).patch
end
module Functor_app_diff: sig
+ module Defs: sig
+ type left = Error.functor_arg_descr * Types.module_type
+ type right = Types.functor_parameter
+ type eq = Typedtree.module_coercion
+ type diff = (Error.functor_arg_descr, unit) Error.functor_param_symptom
+ type state
+ end
val diff:
Env.t ->
f:Types.module_type ->
args:(Error.functor_arg_descr * Types.module_type) list ->
- (Error.functor_arg_descr * Types.module_type,
- Types.functor_parameter, Typedtree.module_coercion,
- (Error.functor_arg_descr, 'a) Error.functor_param_symptom)
- Diffing.patch
+ Diffing.Define(Defs).patch
end
| Unneeded -> "..."
(** Add shorthands to a patch *)
+ open Diffing
let patch ctx p =
let add_shorthand side pos mty =
{name = (make side pos); item = mty }
let aux i d =
let pos = i + 1 in
let d = match d with
- | Diffing.Insert mty ->
- Diffing.Insert (add_shorthand Expected pos mty)
- | Diffing.Delete mty ->
- Diffing.Delete (add_shorthand (elide_if_app ctx Got) pos mty)
- | Diffing.Change (g, e, p) ->
- Diffing.Change
+ | Insert mty ->
+ Insert (add_shorthand Expected pos mty)
+ | Delete mty ->
+ Delete (add_shorthand (elide_if_app ctx Got) pos mty)
+ | Change (g, e, p) ->
+ Change
(add_shorthand Got pos g,
add_shorthand Expected pos e, p)
- | Diffing.Keep (g, e, p) ->
- Diffing.Keep (add_shorthand Got pos g,
+ | Keep (g, e, p) ->
+ Keep (add_shorthand Got pos g,
add_shorthand (elide_if_app ctx Expected) pos e, p)
in
pos, d
module Functor_suberror = struct
open Err
- let style = function
- | Diffing.Keep _ -> Misc.Color.[ FG Green ]
- | Diffing.Delete _ -> Misc.Color.[ FG Red; Bold]
- | Diffing.Insert _ -> Misc.Color.[ FG Red; Bold]
- | Diffing.Change _ -> Misc.Color.[ FG Magenta; Bold]
-
- let prefix ppf (pos, p) =
- let sty = style p in
- Format.pp_open_stag ppf (Misc.Color.Style sty);
- Format.fprintf ppf "%i." pos;
- Format.pp_close_stag ppf ()
-
let param_id x = match x.With_shorthand.item with
| Types.Named (Some _ as x,_) -> x
| Types.(Unit | Named(None,_)) -> None
(** Print the list of params with style *)
let pretty_params sep proj printer patch =
let elt (x,param) =
- let sty = style x in
+ let sty = Diffing.(style @@ classify x) in
Format.dprintf "%a%t%a"
Format.pp_open_stag (Misc.Color.Style sty)
(printer param)
Printtyp.functor_parameters ~sep elt params
let expected d =
- let extract = function
- | Diffing.Insert mty
- | Diffing.Keep(_,mty,_)
- | Diffing.Change (_,mty,_) as x ->
+ let extract: _ Diffing.change -> _ = function
+ | Insert mty
+ | Keep(_,mty,_)
+ | Change (_,mty,_) as x ->
Some (param_id mty,(x, mty))
- | Diffing.Delete _ -> None
+ | Delete _ -> None
in
pretty_params space extract With_shorthand.qualified_param d
module Inclusion = struct
let got d =
- let extract = function
- | Diffing.Delete mty
- | Diffing.Keep (mty,_,_)
- | Diffing.Change (mty,_,_) as x ->
+ let extract: _ Diffing.change -> _ = function
+ | Delete mty
+ | Keep (mty,_,_)
+ | Change (mty,_,_) as x ->
Some (param_id mty,(x,mty))
- | Diffing.Insert _ -> None
+ | Insert _ -> None
in
pretty_params space extract With_shorthand.qualified_param d
|> prepare_patch ~drop:true ~ctx:App
let got d =
- let extract = function
- | Diffing.Delete mty
- | Diffing.Keep (mty,_,_)
- | Diffing.Change (mty,_,_) as x ->
+ let extract: _ Diffing.change -> _ = function
+ | Delete mty
+ | Keep (mty,_,_)
+ | Change (mty,_,_) as x ->
Some (None,(x,mty))
- | Diffing.Insert _ -> None
+ | Insert _ -> None
in
pretty_params space extract With_shorthand.arg d
end
let subcase sub ~expansion_token env (pos, diff) =
- Location.msg "%a%a%a %a@[<hv 2>%t@]%a"
+ Location.msg "%a%a%a%a@[<hv 2>%t@]%a"
Format.pp_print_tab ()
Format.pp_open_tbox ()
- prefix (pos, diff)
+ Diffing.prefix (pos, Diffing.classify diff)
Format.pp_set_tab ()
(Printtyp.wrap_printing_env env ~error:true
(fun () -> sub ~expansion_token env diff)
(List.rev l)
(* Printers for leaves *)
-let core id x =
+let core env id x =
match x with
| Err.Value_descriptions diff ->
- let t1 = Printtyp.tree_of_value_description id diff.got in
- let t2 = Printtyp.tree_of_value_description id diff.expected in
- Format.dprintf
- "@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]%a%t"
- !Oprint.out_sig_item t1
- !Oprint.out_sig_item t2
+ Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+ "Values do not match"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_value_description id diff.got)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_value_description id diff.expected)
+ (Includecore.report_value_mismatch
+ "the first" "the second" env) diff.symptom
show_locs (diff.got.val_loc, diff.expected.val_loc)
Printtyp.Conflicts.print_explanations
| Err.Type_declarations diff ->
!Oprint.out_sig_item
(Printtyp.tree_of_type_declaration id diff.expected Trec_first)
(Includecore.report_type_mismatch
- "the first" "the second" "declaration") diff.symptom
+ "the first" "the second" "declaration" env) diff.symptom
show_locs (diff.got.type_loc, diff.expected.type_loc)
Printtyp.Conflicts.print_explanations
| Err.Extension_constructors diff ->
!Oprint.out_sig_item
(Printtyp.tree_of_extension_constructor id diff.expected Text_first)
(Includecore.report_extension_constructor_mismatch
- "the first" "the second" "declaration") diff.symptom
+ "the first" "the second" "declaration" env) diff.symptom
show_locs (diff.got.ext_loc, diff.expected.ext_loc)
Printtyp.Conflicts.print_explanations
| Err.Class_type_declarations diff ->
(Printtyp.tree_of_cltype_declaration id diff.got Trec_first)
!Oprint.out_sig_item
(Printtyp.tree_of_cltype_declaration id diff.expected Trec_first)
- Includeclass.report_error diff.symptom
+ (Includeclass.report_error Type_scheme) diff.symptom
Printtyp.Conflicts.print_explanations
| Err.Class_declarations {got;expected;symptom} ->
let t1 = Printtyp.tree_of_class_declaration id got Trec_first in
%a@;<1 -2>does not match@ %a@]@ %a%t"
!Oprint.out_sig_item t1
!Oprint.out_sig_item t2
- Includeclass.report_error symptom
+ (Includeclass.report_error Type_scheme) symptom
Printtyp.Conflicts.print_explanations
let missing_field ppf item =
)
and sigitem ~expansion_token ~env ~before ~ctx (name,s) = match s with
| Core c ->
- dwith_context ctx (core name c):: before
+ dwith_context ctx (core env name c) :: before
| Module_type diff ->
module_type ~expansion_token ~eqmode:false ~env ~before
~ctx:(Context.Module name :: ctx) diff
:: before
end
-and functor_arg_diff ~expansion_token env = function
- | Diffing.Insert mty -> Functor_suberror.Inclusion.insert mty
- | Diffing.Delete mty -> Functor_suberror.Inclusion.delete mty
- | Diffing.Keep (x, y, _) -> Functor_suberror.Inclusion.ok x y
- | Diffing.Change (_, _, Err.Incompatible_params (i,_)) ->
+and functor_arg_diff ~expansion_token env (patch: _ Diffing.change) =
+ match patch with
+ | Insert mty -> Functor_suberror.Inclusion.insert mty
+ | Delete mty -> Functor_suberror.Inclusion.delete mty
+ | Keep (x, y, _) -> Functor_suberror.Inclusion.ok x y
+ | Change (_, _, Err.Incompatible_params (i,_)) ->
Functor_suberror.Inclusion.incompatible i
- | Diffing.Change (g, e, Err.Mismatch mty_diff) ->
+ | Change (g, e, Err.Mismatch mty_diff) ->
let more () =
subcase_list @@
module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
in
Functor_suberror.Inclusion.diff g e more
-let functor_app_diff ~expansion_token env = function
- | Diffing.Insert mty -> Functor_suberror.App.insert mty
- | Diffing.Delete mty -> Functor_suberror.App.delete mty
- | Diffing.Keep (x, y, _) -> Functor_suberror.App.ok x y
- | Diffing.Change (_, _, Err.Incompatible_params (i,_)) ->
+let functor_app_diff ~expansion_token env (patch: _ Diffing.change) =
+ match patch with
+ | Insert mty -> Functor_suberror.App.insert mty
+ | Delete mty -> Functor_suberror.App.delete mty
+ | Keep (x, y, _) -> Functor_suberror.App.ok x y
+ | Change (_, _, Err.Incompatible_params (i,_)) ->
Functor_suberror.App.incompatible i
- | Diffing.Change (g, e, Err.Mismatch mty_diff) ->
+ | Change (g, e, Err.Mismatch mty_diff) ->
let more () =
subcase_list @@
module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
let first = Location.msg "%a" interface_mismatch diff in
signature ~expansion_token:true ~env ~before:[first] ~ctx:[] diff.symptom
| In_Type_declaration (id,reason) ->
- [Location.msg "%t" (core id reason)]
+ [Location.msg "%t" (core env id reason)]
| In_Module_type diff ->
module_type ~expansion_token:true ~eqmode:false ~before:[] ~env ~ctx:[]
diff
match d with
(* We specialize the one change and one argument case to remove the
presentation of the functor arguments *)
- | [ _, Diffing.Change (_, _, Err.Incompatible_params (i,_)) ] ->
+ | [ _, Change (_, _, Err.Incompatible_params (i,_)) ] ->
Location.errorf ~loc "%t" (Functor_suberror.App.incompatible i)
- | [ _, Diffing.Change (g, e, Err.Mismatch mty_diff) ] ->
+ | [ _, Change (g, e, Err.Mismatch mty_diff) ] ->
let more () =
subcase_list @@
module_type_symptom ~eqmode:false ~expansion_token:true ~env ~before:[]
open Path
open Types
-
-let rec scrape env mty =
+let rec scrape_lazy env mty =
+ let open Subst.Lazy in
match mty with
- Mty_ident p ->
+ MtyL_ident p ->
begin try
- scrape env (Env.find_modtype_expansion p env)
+ scrape_lazy env (Env.find_modtype_expansion_lazy p env)
with Not_found ->
mty
end
| _ -> mty
+let scrape env mty =
+ match mty with
+ Mty_ident p ->
+ Subst.Lazy.force_modtype (scrape_lazy env (MtyL_ident p))
+ | _ -> mty
+
let freshen ~scope mty =
Subst.modtype (Rescope scope) Subst.identity mty
-let rec strengthen ~aliasable env mty p =
- match scrape env mty with
- Mty_signature sg ->
- Mty_signature(strengthen_sig ~aliasable env sg p)
- | Mty_functor(Named (Some param, arg), res)
+let rec strengthen_lazy ~aliasable env mty p =
+ let open Subst.Lazy in
+ match scrape_lazy env mty with
+ MtyL_signature sg ->
+ MtyL_signature(strengthen_lazy_sig ~aliasable env sg p)
+ | MtyL_functor(Named (Some param, arg), res)
when !Clflags.applicative_functors ->
- Mty_functor(Named (Some param, arg),
- strengthen ~aliasable:false env res (Papply(p, Pident param)))
- | Mty_functor(Named (None, arg), res)
+ MtyL_functor(Named (Some param, arg),
+ strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
+ | MtyL_functor(Named (None, arg), res)
when !Clflags.applicative_functors ->
let param = Ident.create_scoped ~scope:(Path.scope p) "Arg" in
- Mty_functor(Named (Some param, arg),
- strengthen ~aliasable:false env res (Papply(p, Pident param)))
+ MtyL_functor(Named (Some param, arg),
+ strengthen_lazy ~aliasable:false env res (Papply(p, Pident param)))
| mty ->
mty
-and strengthen_sig ~aliasable env sg p =
+and strengthen_lazy_sig' ~aliasable env sg p =
+ let open Subst.Lazy in
match sg with
[] -> []
- | (Sig_value(_, _, _) as sigelt) :: rem ->
- sigelt :: strengthen_sig ~aliasable env rem p
- | Sig_type(id, {type_kind=Type_abstract}, _, _) :: rem
+ | (SigL_value(_, _, _) as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_type(id, {type_kind=Type_abstract}, _, _) :: rem
when Btype.is_row_name (Ident.name id) ->
- strengthen_sig ~aliasable env rem p
- | Sig_type(id, decl, rs, vis) :: rem ->
+ strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_type(id, decl, rs, vis) :: rem ->
let newdecl =
match decl.type_manifest, decl.type_private, decl.type_kind with
Some _, Public, _ -> decl
else
{ decl with type_manifest = manif }
in
- Sig_type(id, newdecl, rs, vis) :: strengthen_sig ~aliasable env rem p
- | (Sig_typext _ as sigelt) :: rem ->
- sigelt :: strengthen_sig ~aliasable env rem p
- | Sig_module(id, pres, md, rs, vis) :: rem ->
+ SigL_type(id, newdecl, rs, vis) ::
+ strengthen_lazy_sig' ~aliasable env rem p
+ | (SigL_typext _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | SigL_module(id, pres, md, rs, vis) :: rem ->
let str =
- strengthen_decl ~aliasable env md (Pdot(p, Ident.name id))
+ strengthen_lazy_decl ~aliasable env md (Pdot(p, Ident.name id))
in
- Sig_module(id, pres, str, rs, vis)
- :: strengthen_sig ~aliasable
- (Env.add_module_declaration ~check:false id pres md env) rem p
+ let env =
+ Env.add_module_declaration_lazy ~update_summary:false id pres md env in
+ SigL_module(id, pres, str, rs, vis)
+ :: strengthen_lazy_sig' ~aliasable env rem p
(* Need to add the module in case it defines manifest module types *)
- | Sig_modtype(id, decl, vis) :: rem ->
+ | SigL_modtype(id, decl, vis) :: rem ->
let newdecl =
- match decl.mtd_type with
- None ->
- {decl with mtd_type = Some(Mty_ident(Pdot(p,Ident.name id)))}
- | Some _ ->
+ match decl.mtdl_type with
+ | Some _ when not aliasable ->
+ (* [not alisable] condition needed because of recursive modules.
+ See [Typemod.check_recmodule_inclusion]. *)
decl
+ | _ ->
+ {decl with mtdl_type = Some(MtyL_ident(Pdot(p,Ident.name id)))}
in
- Sig_modtype(id, newdecl, vis) ::
- strengthen_sig ~aliasable (Env.add_modtype id decl env) rem p
+ let env = Env.add_modtype_lazy ~update_summary:false id decl env in
+ SigL_modtype(id, newdecl, vis) ::
+ strengthen_lazy_sig' ~aliasable env rem p
(* Need to add the module type in case it is manifest *)
- | (Sig_class _ as sigelt) :: rem ->
- sigelt :: strengthen_sig ~aliasable env rem p
- | (Sig_class_type _ as sigelt) :: rem ->
- sigelt :: strengthen_sig ~aliasable env rem p
-
-and strengthen_decl ~aliasable env md p =
- match md.md_type with
- | Mty_alias _ -> md
- | _ when aliasable -> {md with md_type = Mty_alias p}
- | mty -> {md with md_type = strengthen ~aliasable env mty p}
-
-let () = Env.strengthen := strengthen
+ | (SigL_class _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+ | (SigL_class_type _ as sigelt) :: rem ->
+ sigelt :: strengthen_lazy_sig' ~aliasable env rem p
+
+and strengthen_lazy_sig ~aliasable env sg p =
+ let sg = Subst.Lazy.force_signature_once sg in
+ let sg = strengthen_lazy_sig' ~aliasable env sg p in
+ Subst.Lazy.of_signature_items sg
+
+and strengthen_lazy_decl ~aliasable env md p =
+ let open Subst.Lazy in
+ match md.mdl_type with
+ | MtyL_alias _ -> md
+ | _ when aliasable -> {md with mdl_type = MtyL_alias p}
+ | mty -> {md with mdl_type = strengthen_lazy ~aliasable env mty p}
+
+let () = Env.strengthen := strengthen_lazy
+
+let strengthen ~aliasable env mty p =
+ let mty = strengthen_lazy ~aliasable env (Subst.Lazy.of_modtype mty) p in
+ Subst.Lazy.force_modtype mty
+
+let strengthen_decl ~aliasable env md p =
+ let md = strengthen_lazy_decl ~aliasable env
+ (Subst.Lazy.of_module_decl md) p in
+ Subst.Lazy.force_module_decl md
let rec make_aliases_absent pres mty =
match mty with
let lower_nongen nglev mty =
let open Btype in
let it_type_expr it ty =
- let ty = repr ty in
- match ty with
- {desc=Tvar _; level} ->
+ match get_desc ty with
+ Tvar _ ->
+ let level = get_level ty in
if level < generic_level && level > nglev then set_level ty nglev
| _ ->
type_iterators.it_type_expr it ty
| Oval_string (s, maxlen, kind) ->
begin try
let len = String.length s in
+ let maxlen = max maxlen 8 in (* always show a little prefix *)
let s = if len > maxlen then String.sub s 0 maxlen else s in
begin match kind with
| Ostr_bytes -> fprintf ppf "Bytes.of_string %S" s
let l, rest = collect_functor_args [] mty in
List.rev l, rest
+let constructor_of_extension_constructor
+ (ext : out_extension_constructor) : out_constructor
+=
+ {
+ ocstr_name = ext.oext_name;
+ ocstr_args = ext.oext_args;
+ ocstr_return_type = ext.oext_ret_type;
+ }
+
let split_anon_functor_arguments params =
let rec uncollect_anonymous_suffix acc rest = match acc with
| Some (None, mty_arg) :: acc ->
match items with
Osig_typext(ext, Oext_next) :: items ->
gather_extensions
- ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+ (constructor_of_extension_constructor ext :: acc)
items
| _ -> (List.rev acc, items)
in
let exts, items =
gather_extensions
- [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+ [constructor_of_extension_constructor ext]
items
in
let te =
name !out_class_type clt
| Osig_typext (ext, Oext_exception) ->
fprintf ppf "@[<2>exception %a@]"
- print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+ print_out_constr (constructor_of_extension_constructor ext)
| Osig_typext (ext, _es) ->
print_out_extension_constructor ppf ext
| Osig_modtype (name, Omty_abstract) ->
print_immediate
print_unboxed
-and print_out_constr ppf (name, tyl,ret_type_opt) =
+and print_out_constr ppf constr =
+ let {
+ ocstr_name = name;
+ ocstr_args = tyl;
+ ocstr_return_type = return_type;
+ } = constr in
let name =
match name with
| "::" -> "(::)" (* #7200 *)
| s -> s
in
- match ret_type_opt with
+ match return_type with
| None ->
begin match tyl with
| [] ->
fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
print_extended_type
(if ext.oext_private = Asttypes.Private then " private" else "")
- print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+ print_out_constr
+ (constructor_of_extension_constructor ext)
and print_out_type_extension ppf te =
let print_extended_type ppf =
match items with
(Osig_typext(ext, Oext_next), None) :: items ->
gather_extensions
- ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+ (constructor_of_extension_constructor ext :: acc)
items
| _ -> (List.rev acc, items)
in
let exts, items =
gather_extensions
- [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+ [constructor_of_extension_constructor ext]
items
in
let te =
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_constr : (formatter -> out_constructor -> unit) ref
val out_class_type : (formatter -> out_class_type -> unit) ref
val out_module_type : (formatter -> out_module_type -> unit) ref
val out_sig_item : (formatter -> out_sig_item -> unit) ref
| Otyp_object of (string * out_type) list * bool option
| Otyp_record of (string * bool * out_type) list
| Otyp_stuff of string
- | Otyp_sum of (string * out_type list * out_type option) list
+ | Otyp_sum of out_constructor list
| Otyp_tuple of out_type list
| Otyp_var of bool * string
| Otyp_variant of
| Otyp_module of out_ident * (string * out_type) list
| Otyp_attribute of out_type * out_attribute
+and out_constructor = {
+ ocstr_name: string;
+ ocstr_args: out_type list;
+ ocstr_return_type: out_type option;
+}
+
and out_variant =
| Ovar_fields of (string * bool * out_type list) list
| Ovar_typ of out_type
and out_type_extension =
{ otyext_name: string;
otyext_params: string list;
- otyext_constructors: (string * out_type list * out_type option) list;
+ otyext_constructors: out_constructor list;
otyext_private: Asttypes.private_flag }
and out_val_decl =
{ oval_name: string;
*)
-let is_absent tag row = Btype.row_field tag !row = Rabsent
+let is_absent tag row = row_field_repr (get_row_field tag !row) = Rabsent
let is_absent_pat d =
match d.pat_desc with
(* May need a clean copy, cf. PR#4745 *)
let clean_copy ty =
- if ty.level = Btype.generic_level then ty
+ if get_level ty = Btype.generic_level then ty
else Subst.type_expr Subst.identity ty
let get_constructor_type_path ty tenv =
- let ty = Ctype.repr (Ctype.expand_head tenv (clean_copy ty)) in
- match ty.desc with
+ let ty = Ctype.expand_head tenv (clean_copy ty) in
+ match get_desc ty with
| Tconstr (path,_,_) -> path
| _ -> assert false
)
let close_variant env row =
- let row = Btype.row_repr row in
- let nm =
+ let Row {fields; more; name=orig_name; closed; fixed} = row_repr row in
+ let name, static =
List.fold_left
- (fun nm (_tag,f) ->
- match Btype.row_field_repr f with
- | Reither(_, _, false, e) ->
- (* m=false means that this tag is not explicitly matched *)
- Btype.set_row_field e Rabsent;
- None
- | Rabsent | Reither (_, _, true, _) | Rpresent _ -> nm)
- row.row_name row.row_fields in
- if not row.row_closed || nm != row.row_name then begin
+ (fun (nm, static) (_tag,f) ->
+ match row_field_repr f with
+ | Reither(_, _, false) ->
+ (* fixed=false means that this tag is not explicitly matched *)
+ link_row_field_ext ~inside:f rf_absent;
+ (None, static)
+ | Reither (_, _, true) -> (nm, false)
+ | Rabsent | Rpresent _ -> (nm, static))
+ (orig_name, true) fields in
+ if not closed || name != orig_name then begin
+ let more' = if static then Btype.newgenty Tnil else Btype.newgenvar () in
(* this unification cannot fail *)
- Ctype.unify env row.row_more
+ Ctype.unify env more
(Btype.newgenty
- (Tvariant {row with row_fields = []; row_more = Btype.newgenvar();
- row_closed = true; row_name = nm}))
+ (Tvariant
+ (create_row ~fields:[] ~more:more'
+ ~closed:true ~name ~fixed)))
end
(*
env
in
let row = type_row () in
- if closing && not (Btype.row_fixed row) then
+ if closing && not (Btype.has_fixed_explanation row) then
(* closing=true, we are considering the variant as closed *)
List.for_all
(fun (tag,f) ->
- match Btype.row_field_repr f with
- Rabsent | Reither(_, _, false, _) -> true
- | Reither (_, _, true, _)
+ match row_field_repr f with
+ Rabsent | Reither(_, _, false) -> true
+ | Reither (_, _, true)
(* m=true, do not discard matched tags, rather warn *)
| Rpresent _ -> List.mem tag fields)
- row.row_fields
+ (row_fields row)
else
- row.row_closed &&
+ row_closed row &&
List.for_all
(fun (tag,f) ->
- Btype.row_field_repr f = Rabsent || List.mem tag fields)
- row.row_fields
+ row_field_repr f = Rabsent || List.mem tag fields)
+ (row_fields row)
| Constant Const_char _ ->
List.length env = 256
| Constant _
let pats_of_type ?(always=false) env ty =
let ty' = Ctype.expand_head env ty in
- match ty'.desc with
+ match get_desc ty' with
| Tconstr (path, _, _) ->
begin match Env.find_type_descrs path env with
| exception Not_found -> [omega]
| _ -> [omega]
let rec get_variant_constructors env ty =
- match (Ctype.repr ty).desc with
+ match get_desc ty with
| Tconstr (path,_,_) -> begin
try match Env.find_type path env, Env.find_type_descrs path env with
| _, Type_variant (cstrs,_) -> cstrs
List.fold_left
(fun others (tag,f) ->
if List.mem tag tags then others else
- match Btype.row_field_repr f with
+ match row_field_repr f with
Rabsent (* | Reither _ *) -> others
(* This one is called after erasing pattern info *)
- | Reither (c, _, _, _) -> make_other_pat tag c :: others
+ | Reither (c, _, _) -> make_other_pat tag c :: others
| Rpresent arg -> make_other_pat tag (arg = None) :: others)
- [] row.row_fields
+ [] (row_fields row)
with
[] ->
let tag =
- if Btype.row_fixed row then some_private_tag else
+ if Btype.has_fixed_explanation row then some_private_tag else
let rec mktag tag =
if List.mem tag tags then mktag (tag ^ "'") else tag in
mktag "AnyOtherTag"
match d.pat_desc with
| Variant { type_row; _ } ->
let row = type_row () in
- if Btype.row_fixed row
+ if Btype.has_fixed_explanation row
|| pressure_variants None default then ()
else close_variant env row
| _ -> ()
| 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
+ match get_desc (Ctype.expand_head q.pat_env q.pat_type) with
+ | Tvariant type_row -> type_row
+ | _ -> assert false
in
Variant {tag; has_arg; cstr_row; type_row}, pats
| `Array args ->
ext_uid = Uid.of_predef_id id;
}
in
- add_extension ident_match_failure
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_extension ident_out_of_memory [] (
- add_extension ident_stack_overflow [] (
- add_extension ident_invalid_argument [type_string] (
- add_extension ident_failure [type_string] (
- add_extension ident_not_found [] (
- add_extension ident_sys_blocked_io [] (
- add_extension ident_sys_error [type_string] (
- add_extension ident_end_of_file [] (
- add_extension ident_division_by_zero [] (
- add_extension ident_assert_failure
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_extension ident_undefined_recursive_module
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_type ident_int64 (
- add_type ident_int32 (
- add_type ident_nativeint (
- add_type1 ident_lazy_t ~variance:Variance.covariant
- ~separability:Separability.Ind (
- add_type1 ident_option ~variance:Variance.covariant
- ~separability:Separability.Ind
- ~kind:(fun tvar ->
- Type_variant([cstr ident_none []; cstr ident_some [tvar]],
- Variant_regular)
- ) (
- add_type1 ident_list ~variance:Variance.covariant
- ~separability:Separability.Ind
- ~kind:(fun tvar ->
- Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]],
- Variant_regular)
- ) (
- add_type1 ident_array ~variance:Variance.full ~separability:Separability.Ind (
- add_type ident_exn ~kind:Type_open (
- add_type ident_unit ~immediate:Always
- ~kind:(Type_variant([cstr ident_void []], Variant_regular)) (
- add_type ident_bool ~immediate:Always
- ~kind:(Type_variant([cstr ident_false []; cstr ident_true []],
- Variant_regular)) (
- add_type ident_float (
- add_type ident_string (
- add_type ident_char ~immediate:Always (
- add_type ident_int ~immediate:Always (
- add_type ident_extension_constructor (
- add_type ident_floatarray (
- empty_env))))))))))))))))))))))))))))
+ let variant constrs = Type_variant (constrs, Variant_regular) in
+ empty_env
+ (* Predefined types - alphabetical order *)
+ |> add_type1 ident_array
+ ~variance:Variance.full
+ ~separability:Separability.Ind
+ |> add_type ident_bool
+ ~immediate:Always
+ ~kind:(variant [cstr ident_false []; cstr ident_true []])
+ |> add_type ident_char ~immediate:Always
+ |> add_type ident_exn ~kind:Type_open
+ |> add_type ident_extension_constructor
+ |> add_type ident_float
+ |> add_type ident_floatarray
+ |> add_type ident_int ~immediate:Always
+ |> add_type ident_int32
+ |> add_type ident_int64
+ |> add_type1 ident_lazy_t
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ |> add_type1 ident_list
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ ~kind:(fun tvar ->
+ variant [cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]])
+ |> add_type ident_nativeint
+ |> add_type1 ident_option
+ ~variance:Variance.covariant
+ ~separability:Separability.Ind
+ ~kind:(fun tvar ->
+ variant [cstr ident_none []; cstr ident_some [tvar]])
+ |> add_type ident_string
+ |> add_type ident_unit
+ ~immediate:Always
+ ~kind:(variant [cstr ident_void []])
+ (* Predefined exceptions - alphabetical order *)
+ |> add_extension ident_assert_failure
+ [newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_division_by_zero []
+ |> add_extension ident_end_of_file []
+ |> add_extension ident_failure [type_string]
+ |> add_extension ident_invalid_argument [type_string]
+ |> add_extension ident_match_failure
+ [newgenty (Ttuple[type_string; type_int; type_int])]
+ |> add_extension ident_not_found []
+ |> add_extension ident_out_of_memory []
+ |> add_extension ident_stack_overflow []
+ |> add_extension ident_sys_blocked_io []
+ |> add_extension ident_sys_error [type_string]
+ |> add_extension ident_undefined_recursive_module
+ [newgenty (Ttuple[type_string; type_int; type_int])]
let build_initial_env add_type add_exception empty_env =
let common = common_initial_env add_type add_exception empty_env in
let protected = ref S.empty
(* When dealing with functor arguments, identity becomes fuzzy because the same
- syntactic argument may be represented by different identifers during the
+ syntactic argument may be represented by different identifiers during the
error processing, we are thus disabling disambiguation on the argument name
*)
let fuzzy = ref S.empty
let kind_vars = ref []
let kind_count = ref 0
-let rec safe_kind_repr v = function
- Fvar {contents=Some k} ->
- if List.memq k v then "Fvar loop" else
- safe_kind_repr (k::v) k
- | Fvar r ->
- let vid =
- try List.assq r !kind_vars
- with Not_found ->
- let c = incr kind_count; !kind_count in
- kind_vars := (r,c) :: !kind_vars;
- c
- in
- Printf.sprintf "Fvar {None}@%d" vid
- | Fpresent -> "Fpresent"
+let string_of_field_kind v =
+ match field_kind_repr v with
+ | Fpublic -> "Fpublic"
| Fabsent -> "Fabsent"
+ | Fprivate -> "Fprivate"
-let rec safe_commu_repr v = function
- Cok -> "Cok"
- | Cunknown -> "Cunknown"
- | Clink r ->
- if List.memq r v then "Clink loop" else
- safe_commu_repr (r::v) !r
-
-let rec safe_repr v = function
+let rec safe_repr v t =
+ match Transient_expr.coerce t with
{desc = Tlink t} when not (List.memq t v) ->
safe_repr (t::v) t
- | t -> t
+ | t' -> t'
let rec list_of_memo = function
Mnil -> []
| Tarrow(l,t1,t2,c) ->
fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
(string_of_label l) raw_type t1 raw_type t2
- (safe_commu_repr [] c)
+ (if is_commu_ok c then "Cok" else "Cunknown")
| Ttuple tl ->
fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
| Tconstr (p, tl, abbrev) ->
fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
| Tfield (f, k, t1, t2) ->
fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
- (safe_kind_repr [] k)
+ (string_of_field_kind k)
raw_type t1 raw_type t2
| Tnil -> fprintf ppf "Tnil"
| Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
raw_type t
raw_type_list tl
| Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
fprintf ppf
"@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
"row_fields="
(raw_list (fun ppf (l, f) ->
fprintf ppf "@[%s,@ %a@]" l raw_field f))
- row.row_fields
- "row_more=" raw_type row.row_more
- "row_closed=" row.row_closed
- "row_fixed=" raw_row_fixed row.row_fixed
+ fields
+ "row_more=" raw_type more
+ "row_closed=" closed
+ "row_fixed=" raw_row_fixed fixed
"row_name="
(fun ppf ->
- match row.row_name with None -> fprintf ppf "None"
+ match name with None -> fprintf ppf "None"
| Some(p,tl) ->
fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
| Tpackage (p, fl) ->
| 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"
- | Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t
- | Reither (c,tl,m,e) ->
- fprintf ppf "@[<hov1>Reither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+and raw_field ppf rf =
+ match_row_field
+ ~absent:(fun _ -> fprintf ppf "RFabsent")
+ ~present:(function
+ | None ->
+ fprintf ppf "RFpresent None"
+ | Some t ->
+ fprintf ppf "@[<1>RFpresent(Some@,%a)@]" raw_type t)
+ ~either:(fun c tl m e ->
+ fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
raw_type_list tl m
(fun ppf ->
- match !e with None -> fprintf ppf " None"
- | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f)
- | Rabsent -> fprintf ppf "Rabsent"
+ match e with None -> fprintf ppf " RFnone"
+ | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
+ rf
let raw_type_expr ppf t =
visited := []; kind_vars := []; kind_count := 0;
cache for short-paths
*)
let printing_old = ref Env.empty
-let printing_pers = ref Concr.empty
+let printing_pers = ref String.Set.empty
(** {!printing_old} and {!printing_pers} are the keys of the one-slot cache *)
let printing_depth = ref 0
the {!printing_map} one level further (see also {!Env.run_iter_cont})
*)
-let same_type t t' = repr t == repr t'
-
let rec index l x =
match l with
[] -> raise Not_found
- | a :: l -> if x == a then 0 else 1 + index l x
+ | a :: l -> if eq_type x a then 0 else 1 + index l x
let rec uniq = function
[] -> true
- | a :: l -> not (List.memq a l) && uniq l
+ | a :: l -> not (List.memq (a : int) l) && uniq l
let rec normalize_type_path ?(cache=false) env p =
try
let (params, ty, _) = Env.find_type_expansion p env in
- let params = List.map repr params in
- match repr ty with
- {desc = Tconstr (p1, tyl, _)} ->
- let tyl = List.map repr tyl in
+ match get_desc ty with
+ Tconstr (p1, tyl, _) ->
if List.length params = List.length tyl
- && List.for_all2 (==) params tyl
+ && List.for_all2 eq_type params tyl
then normalize_type_path ~cache env p1
else if cache || List.length params <= List.length tyl
- || not (uniq tyl) then (p, Id)
+ || not (uniq (List.map get_id tyl)) then (p, Id)
else
let l1 = List.map (index params) tyl in
let (p2, s2) = normalize_type_path ~cache env p1 in
(p2, compose l1 s2)
- | ty ->
+ | _ ->
(p, Nth (index params ty))
with
Not_found ->
let same_printing_env env =
let used_pers = Env.used_persistent () in
- Env.same_types !printing_old env && Concr.equal !printing_pers used_pers
+ Env.same_types !printing_old env && String.Set.equal !printing_pers used_pers
let set_printing_env env =
printing_env := env;
(* Print a type expression *)
-let names = ref ([] : (type_expr * string) list)
-let name_counter = ref 0
-let named_vars = ref ([] : string list)
+let proxy ty = Transient_expr.repr (proxy ty)
-let weak_counter = ref 1
-let weak_var_map = ref TypeMap.empty
-let named_weak_vars = ref String.Set.empty
+(* When printing a type scheme, we print weak names. When printing a plain
+ type, we do not. This type controls that behavior *)
+type type_or_scheme = Type | Type_scheme
-let reset_names () = names := []; name_counter := 0; named_vars := []
-let add_named_var ty =
- match ty.desc with
- Tvar (Some name) | Tunivar (Some name) ->
- if List.mem name !named_vars then () else
- named_vars := name :: !named_vars
- | _ -> ()
+let is_non_gen mode ty =
+ match mode with
+ | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
+ | Type -> false
-let name_is_already_used name =
- List.mem name !named_vars
- || List.exists (fun (_, name') -> name = name') !names
- || String.Set.mem name !named_weak_vars
-
-let rec new_name () =
- let name =
- if !name_counter < 26
- then String.make 1 (Char.chr(97 + !name_counter))
- else String.make 1 (Char.chr(97 + !name_counter mod 26)) ^
- Int.to_string(!name_counter / 26) in
- incr name_counter;
- if name_is_already_used name then new_name () else name
-
-let rec new_weak_name ty () =
- let name = "weak" ^ Int.to_string !weak_counter in
- incr weak_counter;
- if name_is_already_used name then new_weak_name ty ()
- else begin
- named_weak_vars := String.Set.add name !named_weak_vars;
- weak_var_map := TypeMap.add ty name !weak_var_map;
- name
+let nameable_row row =
+ row_name row <> None &&
+ List.for_all
+ (fun (_, f) ->
+ match row_field_repr f with
+ | Reither(c, l, _) ->
+ row_closed row && if c then l = [] else List.length l = 1
+ | _ -> true)
+ (row_fields row)
+
+(* This specialized version of [Btype.iter_type_expr] normalizes and
+ short-circuits the traversal of the [type_expr], so that it covers only the
+ subterms that would be printed by the type printer. *)
+let printer_iter_type_expr f ty =
+ match get_desc ty with
+ | Tconstr(p, tyl, _) ->
+ let (_p', s) = best_type_path p in
+ List.iter f (apply_subst s tyl)
+ | Tvariant row -> begin
+ match row_name row with
+ | Some(_p, tyl) when nameable_row row ->
+ List.iter f tyl
+ | _ ->
+ iter_row f row
end
+ | Tobject (fi, nm) -> begin
+ match !nm with
+ | None ->
+ let fields, _ = flatten_fields fi in
+ List.iter
+ (fun (_, kind, ty) ->
+ if field_kind_repr kind = Fpublic then
+ f ty)
+ fields
+ | Some (_, l) ->
+ List.iter f (List.tl l)
+ end
+ | Tfield(_, kind, ty1, ty2) ->
+ if field_kind_repr kind = Fpublic then
+ f ty1;
+ f ty2
+ | _ ->
+ Btype.iter_type_expr f ty
-let name_of_type name_generator t =
- (* We've already been through repr at this stage, so t is our representative
- of the union-find class. *)
- try List.assq t !names with Not_found ->
- try TypeMap.find t !weak_var_map with Not_found ->
- let name =
- match t.desc with
- Tvar (Some name) | Tunivar (Some name) ->
- (* Some part of the type we've already printed has assigned another
- * unification variable to that name. We want to keep the name, so try
- * adding a number until we find a name that's not taken. *)
- let current_name = ref name in
- let i = ref 0 in
- while List.exists (fun (_, name') -> !current_name = name') !names do
- current_name := name ^ (Int.to_string !i);
- i := !i + 1;
- done;
- !current_name
+module Names : sig
+ val reset_names : unit -> unit
+
+ val add_named_vars : type_expr -> unit
+ val add_subst : (type_expr * type_expr) list -> unit
+
+ val new_name : unit -> string
+ val new_weak_name : type_expr -> unit -> string
+
+ val name_of_type : (unit -> string) -> transient_expr -> string
+ val check_name_of_type : transient_expr -> unit
+
+ val remove_names : transient_expr list -> unit
+
+ val with_local_names : (unit -> 'a) -> 'a
+
+ (* Refresh the weak variable map in the toplevel; for [print_items], which is
+ itself for the toplevel *)
+ val refresh_weak : unit -> unit
+end = struct
+ (* We map from types to names, but not directly; we also store a substitution,
+ which maps from types to types. The lookup process is
+ "type -> apply substitution -> find name". The substitution is presumed to
+ be acyclic. *)
+ let names = ref ([] : (transient_expr * string) list)
+ let name_subst = ref ([] : (transient_expr * transient_expr) list)
+ let name_counter = ref 0
+ let named_vars = ref ([] : string list)
+ let visited_for_named_vars = ref ([] : transient_expr list)
+
+ let weak_counter = ref 1
+ let weak_var_map = ref TypeMap.empty
+ let named_weak_vars = ref String.Set.empty
+
+ let reset_names () =
+ names := [];
+ name_subst := [];
+ name_counter := 0;
+ named_vars := [];
+ visited_for_named_vars := []
+
+ let add_named_var tty =
+ match tty.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ if List.mem name !named_vars then () else
+ named_vars := name :: !named_vars
+ | _ -> ()
+
+ let rec add_named_vars ty =
+ let tty = Transient_expr.repr ty in
+ let px = proxy ty in
+ if not (List.memq px !visited_for_named_vars) then begin
+ visited_for_named_vars := px :: !visited_for_named_vars;
+ match tty.desc with
+ | Tvar _ | Tunivar _ ->
+ add_named_var tty
| _ ->
- (* No name available, create a new one *)
- name_generator ()
- in
- (* Exception for type declarations *)
- if name <> "_" then names := (t, name) :: !names;
- name
+ printer_iter_type_expr add_named_vars ty
+ end
+
+ let rec substitute ty =
+ match List.assq ty !name_subst with
+ | ty' -> substitute ty'
+ | exception Not_found -> ty
+
+ let add_subst subst =
+ name_subst :=
+ List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
+ subst
+ @ !name_subst
+
+ let name_is_already_used name =
+ List.mem name !named_vars
+ || List.exists (fun (_, name') -> name = name') !names
+ || String.Set.mem name !named_weak_vars
+
+ let rec new_name () =
+ let name =
+ if !name_counter < 26
+ then String.make 1 (Char.chr(97 + !name_counter))
+ else String.make 1 (Char.chr(97 + !name_counter mod 26)) ^
+ Int.to_string(!name_counter / 26) in
+ incr name_counter;
+ if name_is_already_used name then new_name () else name
+
+ let rec new_weak_name ty () =
+ let name = "weak" ^ Int.to_string !weak_counter in
+ incr weak_counter;
+ if name_is_already_used name then new_weak_name ty ()
+ else begin
+ named_weak_vars := String.Set.add name !named_weak_vars;
+ weak_var_map := TypeMap.add ty name !weak_var_map;
+ name
+ end
-let check_name_of_type t = ignore(name_of_type new_name t)
+ let name_of_type name_generator t =
+ (* We've already been through repr at this stage, so t is our representative
+ of the union-find class. *)
+ let t = substitute t in
+ try List.assq t !names with Not_found ->
+ try TransientTypeMap.find t !weak_var_map with Not_found ->
+ let name =
+ match t.desc with
+ Tvar (Some name) | Tunivar (Some name) ->
+ (* Some part of the type we've already printed has assigned another
+ * unification variable to that name. We want to keep the name, so
+ * try adding a number until we find a name that's not taken. *)
+ let current_name = ref name in
+ let i = ref 0 in
+ while List.exists
+ (fun (_, name') -> !current_name = name')
+ !names
+ do
+ current_name := name ^ (Int.to_string !i);
+ i := !i + 1;
+ done;
+ !current_name
+ | _ ->
+ (* No name available, create a new one *)
+ name_generator ()
+ in
+ (* Exception for type declarations *)
+ if name <> "_" then names := (t, name) :: !names;
+ name
+
+ let check_name_of_type t = ignore(name_of_type new_name t)
+
+ let remove_names tyl =
+ let tyl = List.map substitute tyl in
+ names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+ let with_local_names f =
+ let old_names = !names in
+ let old_subst = !name_subst in
+ names := [];
+ name_subst := [];
+ try_finally
+ ~always:(fun () ->
+ names := old_names;
+ name_subst := old_subst)
+ f
+
+ let refresh_weak () =
+ let refresh t name (m,s) =
+ if is_non_gen Type_scheme t then
+ begin
+ TypeMap.add t name m,
+ String.Set.add name s
+ end
+ else m, s in
+ let m, s =
+ TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
+ named_weak_vars := s;
+ weak_var_map := m
+end
+
+let reserve_names ty =
+ normalize_type ty;
+ Names.add_named_vars ty
-let remove_names tyl =
- let tyl = List.map repr tyl in
- names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+let visited_objects = ref ([] : transient_expr list)
+let aliased = ref ([] : transient_expr list)
+let delayed = ref ([] : transient_expr list)
+let printed_aliases = ref ([] : transient_expr list)
-let visited_objects = ref ([] : type_expr list)
-let aliased = ref ([] : type_expr list)
-let delayed = ref ([] : type_expr list)
+(* [printed_aliases] is a subset of [aliased] that records only those aliased
+ types that have actually been printed; this allows us to avoid naming loops
+ that the user will never see. *)
let add_delayed t =
if not (List.memq t !delayed) then delayed := t :: !delayed
-let is_aliased ty = List.memq (proxy ty) !aliased
-let add_alias ty =
- let px = proxy ty in
- if not (is_aliased px) then begin
- aliased := px :: !aliased;
- add_named_var px
- end
+let is_aliased_proxy px = List.memq px !aliased
+
+let add_alias_proxy px =
+ if not (is_aliased_proxy px) then
+ aliased := px :: !aliased
+
+let add_alias ty = add_alias_proxy (proxy ty)
+
+let add_printed_alias_proxy px =
+ Names.check_name_of_type px;
+ printed_aliases := px :: !printed_aliases
+
+let add_printed_alias ty = add_printed_alias_proxy (proxy ty)
let aliasable ty =
- match ty.desc with
+ match get_desc ty with
Tvar _ | Tunivar _ | Tpoly _ -> false
| Tconstr (p, _, _) ->
not (is_nth (snd (best_type_path p)))
| _ -> true
-let namable_row row =
- row.row_name <> None &&
- List.for_all
- (fun (_, f) ->
- match row_field_repr f with
- | Reither(c, l, _, _) ->
- row.row_closed && if c then l = [] else List.length l = 1
- | _ -> true)
- row.row_fields
+let should_visit_object ty =
+ match get_desc ty with
+ | Tvariant row -> not (static_row row)
+ | Tobject _ -> opened_object ty
+ | _ -> false
let rec mark_loops_rec visited ty =
- let ty = repr ty in
let px = proxy ty in
- if List.memq px visited && aliasable ty then add_alias px else
+ if List.memq px visited && aliasable ty then add_alias_proxy px else
+ let tty = Transient_expr.repr ty in
let visited = px :: visited in
- match ty.desc with
- | Tvar _ -> add_named_var ty
- | Tarrow(_, ty1, ty2, _) ->
- mark_loops_rec visited ty1; mark_loops_rec visited ty2
- | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
- | Tconstr(p, tyl, _) ->
- let (_p', s) = best_type_path p in
- List.iter (mark_loops_rec visited) (apply_subst s tyl)
- | Tpackage (_, fl) ->
- List.iter (fun (_n, ty) -> mark_loops_rec visited ty) fl
- | Tvariant row ->
- if List.memq px !visited_objects then add_alias px else
- begin
- let row = row_repr row in
- if not (static_row row) then
+ match tty.desc with
+ | Tvariant _ | Tobject _ ->
+ if List.memq px !visited_objects then add_alias_proxy px else begin
+ if should_visit_object ty then
visited_objects := px :: !visited_objects;
- match row.row_name with
- | Some(_p, tyl) when namable_row row ->
- List.iter (mark_loops_rec visited) tyl
- | _ ->
- iter_row (mark_loops_rec visited) row
- end
- | Tobject (fi, nm) ->
- if List.memq px !visited_objects then add_alias px else
- begin
- if opened_object ty then
- visited_objects := px :: !visited_objects;
- begin match !nm with
- | None ->
- let fields, _ = flatten_fields fi in
- List.iter
- (fun (_, kind, ty) ->
- if field_kind_repr kind = Fpresent then
- mark_loops_rec visited ty)
- fields
- | Some (_, l) ->
- List.iter (mark_loops_rec visited) (List.tl l)
- end
+ printer_iter_type_expr (mark_loops_rec visited) ty
end
- | Tfield(_, kind, ty1, ty2) when field_kind_repr kind = Fpresent ->
- mark_loops_rec visited ty1; mark_loops_rec visited ty2
- | Tfield(_, _, _, ty2) ->
- mark_loops_rec visited ty2
- | Tnil -> ()
- | Tsubst _ -> () (* we do not print arguments *)
- | Tlink _ -> fatal_error "Printtyp.mark_loops_rec (2)"
- | Tpoly (ty, tyl) ->
- List.iter (fun t -> add_alias t) tyl;
+ | Tpoly(ty, tyl) ->
+ List.iter add_alias tyl;
mark_loops_rec visited ty
- | Tunivar _ -> add_named_var ty
+ | _ ->
+ printer_iter_type_expr (mark_loops_rec visited) ty
let mark_loops ty =
- normalize_type ty;
mark_loops_rec [] ty;;
+let prepare_type ty =
+ reserve_names ty;
+ mark_loops ty;;
+
let reset_loop_marks () =
- visited_objects := []; aliased := []; delayed := []
+ visited_objects := []; aliased := []; delayed := []; printed_aliases := []
let reset_except_context () =
- reset_names (); reset_loop_marks ()
+ Names.reset_names (); reset_loop_marks ()
let reset () =
reset_naming_context (); Conflicts.reset ();
reset_except_context ()
-let reset_and_mark_loops ty =
- reset_except_context (); mark_loops ty
-
-let reset_and_mark_loops_list tyl =
- reset_except_context (); List.iter mark_loops tyl
+let prepare_for_printing tyl =
+ reset_except_context (); List.iter prepare_type tyl
(* Disabled in classic mode when printing an unification error *)
let print_labels = ref true
-let rec tree_of_typexp sch ty =
- let ty = repr ty in
+let rec tree_of_typexp mode ty =
let px = proxy ty in
- if List.mem_assq px !names && not (List.memq px !delayed) then
- let mark = is_non_gen sch ty in
- let name = name_of_type (if mark then new_weak_name ty else new_name) px in
+ if List.memq px !printed_aliases && not (List.memq px !delayed) then
+ let mark = is_non_gen mode ty in
+ let name = Names.name_of_type
+ (if mark then Names.new_weak_name ty else Names.new_name)
+ px
+ in
Otyp_var (mark, name) else
let pr_typ () =
- match ty.desc with
+ let tty = Transient_expr.repr ty in
+ match tty.desc with
| Tvar _ ->
- (*let lev =
- if is_non_gen sch ty then "/" ^ Int.to_string ty.level else "" in*)
- let non_gen = is_non_gen sch ty in
- let name_gen = if non_gen then new_weak_name ty else new_name in
- Otyp_var (non_gen, name_of_type name_gen ty)
+ let non_gen = is_non_gen mode ty in
+ let name_gen =
+ if non_gen then Names.new_weak_name ty else Names.new_name
+ in
+ Otyp_var (non_gen, Names.name_of_type name_gen tty)
| Tarrow(l, ty1, ty2, _) ->
let lab =
if !print_labels || is_optional l then string_of_label l else ""
in
let t1 =
if is_optional l then
- match (repr ty1).desc with
+ match get_desc ty1 with
| Tconstr(path, [ty], _)
when Path.same path Predef.path_option ->
- tree_of_typexp sch ty
+ tree_of_typexp mode ty
| _ -> Otyp_stuff "<hidden>"
- else tree_of_typexp sch ty1 in
- Otyp_arrow (lab, t1, tree_of_typexp sch ty2)
+ else tree_of_typexp mode ty1 in
+ Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
| Ttuple tyl ->
- Otyp_tuple (tree_of_typlist sch tyl)
+ Otyp_tuple (tree_of_typlist mode tyl)
| Tconstr(p, tyl, _abbrev) ->
let p', s = best_type_path p in
let tyl' = apply_subst s tyl in
- if is_nth s && not (tyl'=[]) then tree_of_typexp sch (List.hd tyl') else
- Otyp_constr (tree_of_path Type p', tree_of_typlist sch tyl')
+ if is_nth s && not (tyl'=[])
+ then tree_of_typexp mode (List.hd tyl')
+ else Otyp_constr (tree_of_path Type p', tree_of_typlist mode tyl')
| Tvariant row ->
- let row = row_repr row in
+ let Row {fields; name; closed} = row_repr row in
let fields =
- if row.row_closed then
+ if closed then
List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
- row.row_fields
- else row.row_fields in
+ fields
+ else fields in
let present =
List.filter
(fun (_, f) ->
| _ -> false)
fields in
let all_present = List.length present = List.length fields in
- begin match row.row_name with
- | Some(p, tyl) when namable_row row ->
+ begin match name with
+ | Some(p, tyl) when nameable_row row ->
let (p', s) = best_type_path p in
let id = tree_of_path Type p' in
- let args = tree_of_typlist sch (apply_subst s tyl) in
+ let args = tree_of_typlist mode (apply_subst s tyl) in
let out_variant =
if is_nth s then List.hd args else Otyp_constr (id, args) in
- if row.row_closed && all_present then
+ if closed && all_present then
out_variant
else
- let non_gen = is_non_gen sch px in
+ let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
let tags =
if all_present then None else Some (List.map fst present) in
- Otyp_variant (non_gen, Ovar_typ out_variant, row.row_closed, tags)
+ Otyp_variant (non_gen, Ovar_typ out_variant, closed, tags)
| _ ->
let non_gen =
- not (row.row_closed && all_present) && is_non_gen sch px in
- let fields = List.map (tree_of_row_field sch) fields in
+ not (closed && all_present) &&
+ is_non_gen mode (Transient_expr.type_expr px) in
+ let fields = List.map (tree_of_row_field mode) fields in
let tags =
if all_present then None else Some (List.map fst present) in
- Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags)
+ Otyp_variant (non_gen, Ovar_fields fields, closed, tags)
end
| Tobject (fi, nm) ->
- tree_of_typobject sch fi !nm
+ tree_of_typobject mode fi !nm
| Tnil | Tfield _ ->
- tree_of_typobject sch ty None
+ tree_of_typobject mode ty None
| Tsubst _ ->
(* This case should only happen when debugging the compiler *)
Otyp_stuff "<Tsubst>"
| Tlink _ ->
fatal_error "Printtyp.tree_of_typexp"
| Tpoly (ty, []) ->
- tree_of_typexp sch ty
+ tree_of_typexp mode ty
| Tpoly (ty, tyl) ->
(*let print_names () =
List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
prerr_string "; " in *)
- let tyl = List.map repr tyl in
- if tyl = [] then tree_of_typexp sch ty else begin
+ if tyl = [] then tree_of_typexp mode ty else begin
+ let tyl = List.map Transient_expr.repr tyl in
let old_delayed = !delayed in
(* Make the names delayed, so that the real type is
printed once when used as proxy *)
List.iter add_delayed tyl;
- let tl = List.map (name_of_type new_name) tyl in
- let tr = Otyp_poly (tl, tree_of_typexp sch ty) in
+ let tl = List.map (Names.name_of_type Names.new_name) tyl in
+ let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
(* Forget names when we leave scope *)
- remove_names tyl;
+ Names.remove_names tyl;
delayed := old_delayed; tr
end
| Tunivar _ ->
- Otyp_var (false, name_of_type new_name ty)
+ Otyp_var (false, Names.name_of_type Names.new_name tty)
| Tpackage (p, fl) ->
let fl =
List.map
(fun (li, ty) -> (
String.concat "." (Longident.flatten li),
- tree_of_typexp sch ty
+ tree_of_typexp mode ty
)) fl in
Otyp_module (tree_of_path Module_type p, fl)
in
if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
- if is_aliased px && aliasable ty then begin
- check_name_of_type px;
- Otyp_alias (pr_typ (), name_of_type new_name px) end
+ if is_aliased_proxy px && aliasable ty then begin
+ add_printed_alias_proxy px;
+ Otyp_alias (pr_typ (), Names.name_of_type Names.new_name px) end
else pr_typ ()
-and tree_of_row_field sch (l, f) =
+and tree_of_row_field mode (l, f) =
match row_field_repr f with
- | Rpresent None | Reither(true, [], _, _) -> (l, false, [])
- | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty])
- | Reither(c, tyl, _, _) ->
+ | Rpresent None | Reither(true, [], _) -> (l, false, [])
+ | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
+ | Reither(c, tyl, _) ->
if c (* contradiction: constant constructor with an argument *)
- then (l, true, tree_of_typlist sch tyl)
- else (l, false, tree_of_typlist sch tyl)
+ then (l, true, tree_of_typlist mode tyl)
+ else (l, false, tree_of_typlist mode tyl)
| Rabsent -> (l, false, [] (* actually, an error *))
-and tree_of_typlist sch tyl =
- List.map (tree_of_typexp sch) tyl
+and tree_of_typlist mode tyl =
+ List.map (tree_of_typexp mode) tyl
-and tree_of_typobject sch fi nm =
+and tree_of_typobject mode fi nm =
begin match nm with
| None ->
let pr_fields fi =
List.fold_right
(fun (n, k, t) l ->
match field_kind_repr k with
- | Fpresent -> (n, t) :: l
+ | Fpublic -> (n, t) :: l
| _ -> l)
fields [] in
let sorted_fields =
List.sort
(fun (n, _) (n', _) -> String.compare n n') present_fields in
- tree_of_typfields sch rest sorted_fields in
+ tree_of_typfields mode rest sorted_fields in
let (fields, rest) = pr_fields fi in
Otyp_object (fields, rest)
| Some (p, ty :: tyl) ->
- let non_gen = is_non_gen sch (repr ty) in
- let args = tree_of_typlist sch tyl in
+ let non_gen = is_non_gen mode ty in
+ let args = tree_of_typlist mode tyl in
let (p', s) = best_type_path p in
assert (s = Id);
Otyp_class (non_gen, tree_of_path Type p', args)
fatal_error "Printtyp.tree_of_typobject"
end
-and is_non_gen sch ty =
- sch && is_Tvar ty && ty.level <> generic_level
-
-and tree_of_typfields sch rest = function
+and tree_of_typfields mode rest = function
| [] ->
let rest =
- match rest.desc with
- | Tvar _ | Tunivar _ -> Some (is_non_gen sch rest)
+ match get_desc rest with
+ | Tvar _ | Tunivar _ -> Some (is_non_gen mode rest)
| Tconstr _ -> Some false
| Tnil -> None
| _ -> fatal_error "typfields (1)"
in
([], rest)
| (s, t) :: l ->
- let field = (s, tree_of_typexp sch t) in
- let (fields, rest) = tree_of_typfields sch rest l in
+ let field = (s, tree_of_typexp mode t) in
+ let (fields, rest) = tree_of_typfields mode rest l in
(field :: fields, rest)
-let typexp sch ppf ty =
- !Oprint.out_type ppf (tree_of_typexp sch ty)
+let typexp mode ppf ty =
+ !Oprint.out_type ppf (tree_of_typexp mode ty)
-let marked_type_expr ppf ty = typexp false ppf ty
+let prepared_type_expr ppf ty = typexp Type 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
+ prepare_for_printing [ty];
+ prepared_type_expr ppf ty
+
+(* "Half-prepared" type expression: [ty] should have had its names reserved, but
+ should not have had its loops marked. *)
+let type_expr_with_reserved_names ppf ty =
+ reset_loop_marks ();
+ mark_loops ty;
+ prepared_type_expr ppf ty
-and type_sch ppf ty = typexp true ppf ty
+let shared_type_scheme ppf ty =
+ prepare_type ty;
+ typexp Type_scheme ppf ty
-and type_scheme ppf ty = reset_and_mark_loops ty; typexp true ppf ty
+let type_scheme ppf ty =
+ prepare_for_printing [ty];
+ typexp Type_scheme ppf ty
let type_path ppf p =
let (p', s) = best_type_path p in
let t = tree_of_path Type p in
!Oprint.out_ident ppf t
-(* Maxence *)
-let type_scheme_max ?(b_reset_names=true) ppf ty =
- if b_reset_names then reset_names () ;
- typexp true ppf ty
-(* End Maxence *)
-
-let tree_of_type_scheme ty = reset_and_mark_loops ty; tree_of_typexp true ty
+let tree_of_type_scheme ty =
+ prepare_for_printing [ty];
+ tree_of_typexp Type_scheme ty
(* Print one type declaration *)
(fun ty list ->
let ty' = unalias ty in
if proxy ty != proxy ty' then
- let tr = tree_of_typexp true ty in
- (tr, tree_of_typexp true ty') :: list
+ let tr = tree_of_typexp Type_scheme ty in
+ (tr, tree_of_typexp Type_scheme ty') :: list
else list)
params []
let params =
List.fold_left
(fun tyl ty ->
- let ty = repr ty in
- if List.memq ty tyl then Btype.newgenty (Ttuple [ty]) :: tyl
+ if List.exists (eq_type ty) tyl
+ then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
else ty :: tyl)
(* Two parameters might be identical due to a constraint but we need to
print them differently in order to make the output syntactically valid.
[] tyl
in List.rev params
-let mark_loops_constructor_arguments = function
- | Cstr_tuple l -> List.iter mark_loops l
- | Cstr_record l -> List.iter (fun l -> mark_loops l.ld_type) l
+let prepare_type_constructor_arguments = function
+ | Cstr_tuple l -> List.iter prepare_type l
+ | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
let rec tree_of_type_decl id decl =
| Some ty ->
let vars = free_variables ty in
List.iter
- (function {desc = Tvar (Some "_")} as ty ->
- if List.memq ty vars then set_type_desc ty (Tvar None)
- | _ -> ())
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
params
| None -> ()
end;
List.iter add_alias params;
- List.iter mark_loops params;
- List.iter check_name_of_type (List.map proxy params);
+ List.iter prepare_type params;
+ List.iter add_printed_alias params;
let ty_manifest =
match decl.type_manifest with
| None -> None
| Some ty ->
let ty =
(* Special hack to hide variant name *)
- match repr ty with {desc=Tvariant row} ->
- let row = row_repr row in
- begin match row.row_name with
- Some (Pident id', _) when Ident.same id id' ->
- newgenty (Tvariant {row with row_name = None})
- | _ -> ty
- end
+ match get_desc ty with
+ Tvariant row ->
+ begin match row_name row with
+ Some (Pident id', _) when Ident.same id id' ->
+ newgenty (Tvariant (set_row_name row None))
+ | _ -> ty
+ end
| _ -> ty
in
- mark_loops ty;
+ prepare_type ty;
Some ty
in
begin match decl.type_kind with
| Type_variant (cstrs, _rep) ->
List.iter
(fun c ->
- mark_loops_constructor_arguments c.cd_args;
- Option.iter mark_loops c.cd_res)
+ prepare_type_constructor_arguments c.cd_args;
+ Option.iter prepare_type c.cd_res)
cstrs
| Type_record(l, _rep) ->
- List.iter (fun l -> mark_loops l.ld_type) l
+ List.iter (fun l -> prepare_type l.ld_type) l
| Type_open -> ()
end;
let vari =
List.map2
(fun ty v ->
- let is_var = is_Tvar (repr ty) in
+ let is_var = is_Tvar ty in
if abstr || not is_var then
let inj =
decl.type_kind = Type_abstract && Variance.mem Inj v &&
decl.type_params decl.type_variance
in
(Ident.name id,
- List.map2 (fun ty cocn -> type_param (tree_of_typexp false ty), cocn)
+ List.map2 (fun ty cocn -> type_param (tree_of_typexp Type ty), cocn)
params vari)
in
let tree_of_manifest ty1 =
match ty_manifest with
| None -> ty1
- | Some ty -> Otyp_manifest (tree_of_typexp false ty, ty1)
+ | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
in
let (name, args) = type_defined decl in
let constraints = tree_of_constraints params in
begin match ty_manifest with
| None -> (Otyp_abstract, Public, false)
| Some ty ->
- tree_of_typexp false ty, decl.type_private, false
+ tree_of_typexp Type ty, decl.type_private, false
end
| Type_variant (cstrs, rep) ->
tree_of_manifest (Otyp_sum (List.map tree_of_constructor cstrs)),
otype_cstrs = constraints }
and tree_of_constructor_arguments = function
- | Cstr_tuple l -> tree_of_typlist false l
+ | Cstr_tuple l -> tree_of_typlist Type l
| Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
and tree_of_constructor cd =
let name = Ident.name cd.cd_id in
let arg () = tree_of_constructor_arguments cd.cd_args in
match cd.cd_res with
- | None -> (name, arg (), None)
+ | None -> {
+ ocstr_name = name;
+ ocstr_args = arg ();
+ ocstr_return_type = None;
+ }
| Some res ->
- let nm = !names in
- names := [];
- let ret = tree_of_typexp false res in
- let args = arg () in
- names := nm;
- (name, args, Some ret)
+ Names.with_local_names (fun () ->
+ let ret = tree_of_typexp Type res in
+ let args = arg () in
+ {
+ ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = Some ret;
+ })
and tree_of_label l =
- (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+ (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp Type l.ld_type)
let constructor ppf c =
reset_except_context ();
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)
+ Names.with_local_names (fun () ->
+ let ret = tree_of_typexp Type res in
+ let args = tree_of_constructor_arguments ext_args in
+ (args, Some ret))
let tree_of_extension_constructor id ext es =
reset_except_context ();
let ty_name = Path.name ext.ext_type_path in
let ty_params = filter_params ext.ext_type_params in
List.iter add_alias ty_params;
- List.iter mark_loops ty_params;
- List.iter check_name_of_type (List.map proxy ty_params);
- mark_loops_constructor_arguments ext.ext_args;
- Option.iter mark_loops ext.ext_ret_type;
+ List.iter prepare_type ty_params;
+ List.iter add_printed_alias ty_params;
+ prepare_type_constructor_arguments ext.ext_args;
+ Option.iter prepare_type ext.ext_ret_type;
let type_param =
function
| Otyp_var (_, id) -> id
| _ -> "?"
in
let ty_params =
- List.map (fun ty -> type_param (tree_of_typexp false ty)) ty_params
+ List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
in
let name = Ident.name id in
let args, ret =
ext.ext_ret_type
in
Format.fprintf ppf "@[<hv>%a@]"
- !Oprint.out_constr (name, args, ret)
+ !Oprint.out_constr {
+ ocstr_name = name;
+ ocstr_args = args;
+ ocstr_return_type = ret;
+ }
(* Print a value declaration *)
(* Print a class type *)
-let method_type (_, kind, ty) =
- match field_kind_repr kind, repr ty with
- Fpresent, {desc=Tpoly(ty, tyl)} -> (ty, tyl)
- | _ , ty -> (ty, [])
-
-let tree_of_metho sch concrete csil (lab, kind, ty) =
- if lab <> dummy_method then begin
- let kind = field_kind_repr kind in
- let priv = kind <> Fpresent in
- let virt = not (Concr.mem lab concrete) in
- let (ty, tyl) = method_type (lab, kind, ty) in
- let tty = tree_of_typexp sch ty in
- remove_names tyl;
- Ocsg_method (lab, priv, virt, tty) :: csil
- end
- else csil
+let method_type priv ty =
+ match priv, get_desc ty with
+ | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
+ | _ , _ -> (ty, [])
+
+let prepare_method _lab (priv, _virt, ty) =
+ let ty, _ = method_type priv ty in
+ prepare_type ty
+
+let tree_of_method mode (lab, priv, virt, ty) =
+ let (ty, tyl) = method_type priv ty in
+ let tty = tree_of_typexp mode ty in
+ Names.remove_names (List.map Transient_expr.repr tyl);
+ let priv = priv <> Mpublic in
+ let virt = virt = Virtual in
+ Ocsg_method (lab, priv, virt, tty)
let rec prepare_class_type params = function
| Cty_constr (_p, tyl, cty) ->
- let sty = Ctype.self_type cty in
- if List.memq (proxy sty) !visited_objects
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !visited_objects
|| not (List.for_all is_Tvar params)
- || List.exists (deep_occur sty) tyl
+ || List.exists (deep_occur row) tyl
then prepare_class_type params cty
- else List.iter mark_loops tyl
+ else List.iter prepare_type tyl
| Cty_signature sign ->
- let sty = repr sign.csig_self in
(* Self may have a name *)
- let px = proxy sty in
- if List.memq px !visited_objects then add_alias sty
+ let px = proxy sign.csig_self_row in
+ if List.memq px !visited_objects then add_alias_proxy px
else visited_objects := px :: !visited_objects;
- let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
- in
- List.iter (fun met -> mark_loops (fst (method_type met))) fields;
- Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.csig_vars
+ Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
+ Meths.iter prepare_method sign.csig_meths
| Cty_arrow (_, ty, cty) ->
- mark_loops ty;
+ prepare_type ty;
prepare_class_type params cty
-let rec tree_of_class_type sch params =
+let rec tree_of_class_type mode params =
function
| Cty_constr (p', tyl, cty) ->
- let sty = Ctype.self_type cty in
- if List.memq (proxy sty) !visited_objects
+ let row = Btype.self_type_row cty in
+ if List.memq (proxy row) !visited_objects
|| not (List.for_all is_Tvar params)
then
- tree_of_class_type sch params cty
+ tree_of_class_type mode params cty
else
let namespace = Namespace.best_class_namespace p' in
- Octy_constr (tree_of_path namespace p', tree_of_typlist true tyl)
+ Octy_constr (tree_of_path namespace p', tree_of_typlist Type_scheme tyl)
| Cty_signature sign ->
- let sty = repr sign.csig_self in
+ let px = proxy sign.csig_self_row in
let self_ty =
- if is_aliased sty then
- Some (Otyp_var (false, name_of_type new_name (proxy sty)))
+ if is_aliased_proxy px then
+ Some
+ (Otyp_var (false, Names.name_of_type Names.new_name px))
else None
in
- let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
- in
let csil = [] in
let csil =
List.fold_left
let csil =
List.fold_left
(fun csil (l, m, v, t) ->
- Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp sch t)
+ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
:: csil)
csil all_vars
in
+ let all_meths =
+ Meths.fold
+ (fun l (p, v, t) all -> (l, p, v, t) :: all)
+ sign.csig_meths []
+ in
+ let all_meths = List.rev all_meths in
let csil =
- List.fold_left (tree_of_metho sch sign.csig_concr) csil fields
+ List.fold_left
+ (fun csil meth -> tree_of_method mode meth :: csil)
+ csil all_meths
in
Octy_signature (self_ty, List.rev csil)
| Cty_arrow (l, ty, cty) ->
in
let tr =
if is_optional l then
- match (repr ty).desc with
+ match get_desc ty with
| Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
- tree_of_typexp sch ty
+ tree_of_typexp mode ty
| _ -> Otyp_stuff "<hidden>"
- else tree_of_typexp sch ty in
- Octy_arrow (lab, tr, tree_of_class_type sch params cty)
+ else tree_of_typexp mode ty in
+ Octy_arrow (lab, tr, tree_of_class_type mode params cty)
let class_type ppf cty =
reset ();
prepare_class_type [] cty;
- !Oprint.out_class_type ppf (tree_of_class_type false [] cty)
+ !Oprint.out_class_type ppf (tree_of_class_type Type [] cty)
let tree_of_class_param param variance =
- (match tree_of_typexp true param with
+ (match tree_of_typexp Type_scheme param with
Otyp_var (_, s) -> s
| _ -> "?"),
- if is_Tvar (repr param) then Asttypes.(NoVariance, NoInjectivity)
- else variance
+ if is_Tvar param then Asttypes.(NoVariance, NoInjectivity)
+ else variance
let class_variance =
let open Variance in let open Asttypes in
reset_except_context ();
List.iter add_alias params;
prepare_class_type params cl.cty_type;
- let sty = Ctype.self_type cl.cty_type in
- List.iter mark_loops params;
+ let px = proxy (Btype.self_type_row cl.cty_type) in
+ List.iter prepare_type params;
- List.iter check_name_of_type (List.map proxy params);
- if is_aliased sty then check_name_of_type (proxy sty);
+ List.iter add_printed_alias params;
+ if is_aliased_proxy px then add_printed_alias_proxy px;
let vir_flag = cl.cty_new = None in
Osig_class
(vir_flag, Ident.name id,
List.map2 tree_of_class_param params (class_variance cl.cty_variance),
- tree_of_class_type true params cl.cty_type,
+ tree_of_class_type Type_scheme params cl.cty_type,
tree_of_rec rs)
let class_declaration id ppf cl =
!Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
let tree_of_cltype_declaration id cl rs =
- let params = List.map repr cl.clty_params in
+ let params = cl.clty_params in
reset_except_context ();
List.iter add_alias params;
prepare_class_type params cl.clty_type;
- let sty = Ctype.self_type cl.clty_type in
- List.iter mark_loops params;
-
- List.iter check_name_of_type (List.map proxy params);
- if is_aliased sty then check_name_of_type (proxy sty);
-
- let sign = Ctype.signature_of_class_type cl.clty_type in
-
- let virt =
- let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields sign.csig_self) in
- List.exists
- (fun (lab, _, _) ->
- not (lab = dummy_method || Concr.mem lab sign.csig_concr))
- fields
- || Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b) sign.csig_vars false
- in
+ let px = proxy (Btype.self_type_row cl.clty_type) in
+ List.iter prepare_type params;
+ List.iter add_printed_alias params;
+ if is_aliased_proxy px then add_printed_alias_proxy px;
+
+ let sign = Btype.signature_of_class_type cl.clty_type in
+ let has_virtual_vars =
+ Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_vars false
+ in
+ let has_virtual_meths =
+ Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+ sign.csig_meths false
+ in
Osig_class_type
- (virt, Ident.name id,
+ (has_virtual_vars || has_virtual_meths, Ident.name id,
List.map2 tree_of_class_param params (class_variance cl.clty_variance),
- tree_of_class_type true params cl.clty_type,
+ tree_of_class_type Type_scheme params cl.clty_type,
tree_of_rec rs)
let cltype_declaration id ppf cl =
(* For the toplevel: merge with tree_of_signature? *)
-(* Refresh weak variable map in the toplevel *)
-let refresh_weak () =
- let refresh t name (m,s) =
- if is_non_gen true (repr t) then
- begin
- TypeMap.add t name m,
- String.Set.add name s
- end
- else m, s in
- let m, s =
- TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
- named_weak_vars := s;
- weak_var_map := m
-
let print_items showval env x =
- refresh_weak();
+ Names.refresh_weak();
reset_naming_context ();
Conflicts.reset ();
let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
end;
fprintf ppf "%a" print_signature t
-(* Print an unification error *)
+(* Trace-specific printing *)
+
+(* A configuration type that controls which trace we print. This could be
+ exposed, but we instead expose three separate
+ [report_{unification,equality,moregen}_error] functions. This also lets us
+ give the unification case an extra optional argument without adding it to the
+ equality and moregen cases. *)
+type 'variety trace_format =
+ | Unification : Errortrace.unification trace_format
+ | Equality : Errortrace.comparison trace_format
+ | Moregen : Errortrace.comparison trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+ function
+ | Unification -> "is not compatible with type"
+ | Equality -> "is not equal to type"
+ | Moregen -> "is not compatible with type"
+
+(* Print a unification error *)
let same_path t t' =
- let t = repr t and t' = repr t' in
- t == t' ||
- match t.desc, t'.desc with
+ eq_type t t' ||
+ match get_desc t, get_desc t' with
Tconstr(p,tl,_), Tconstr(p',tl',_) ->
let (p1, s1) = best_type_path p and (p2, s2) = best_type_path p' in
begin match s1, s2 with
| (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
List.length tl = List.length tl' &&
- List.for_all2 same_type tl tl'
+ List.for_all2 eq_type tl tl'
| _ -> false
end
| _ ->
type 'a diff = Same of 'a | Diff of 'a * 'a
-let trees_of_type_expansion (t,t') =
+let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
+ reset_loop_marks ();
+ mark_loops t;
if same_path t t'
- then begin add_delayed (proxy t); Same (tree_of_typexp false t) end
- else
+ then begin add_delayed (proxy t); Same (tree_of_typexp mode t) end
+ else begin
+ mark_loops t';
let t' = if proxy t == proxy t' then unalias t' else t' in
(* beware order matter due to side effect,
e.g. when printing object types *)
- let first = tree_of_typexp false t in
- let second = tree_of_typexp false t' in
+ let first = tree_of_typexp mode t in
+ let second = tree_of_typexp mode t' in
if first = second then Same first
else Diff(first,second)
+ end
let type_expansion ppf = function
| Same t -> !Oprint.out_type ppf t
| Diff(t,t') ->
fprintf ppf "@[<2>%a@ =@ %a@]" !Oprint.out_type t !Oprint.out_type t'
-let trees_of_trace = List.map (Errortrace.map_diff trees_of_type_expansion)
+let trees_of_trace mode =
+ List.map (Errortrace.map_diff (trees_of_type_expansion mode))
let trees_of_type_path_expansion (tp,tp') =
if Path.same tp tp' then Same(tree_of_path Type tp) else
type error.
*)
-let diff_printing_status { Errortrace.got=t1, t1'; expected=t2, t2'} =
+let diff_printing_status Errortrace.{ got = {ty = t1; expanded = t1'};
+ expected = {ty = t2; expanded = t2'} } =
if is_constr_row ~allow_ident:true t1'
|| is_constr_row ~allow_ident:true t2'
then Discard
else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
else Keep
-(* A configuration type that controls which trace we print. This could be
- exposed, but we instead expose three separate
- [report_{unification,equality,moregen}_error] functions. This also lets us
- give the unification case an extra optional argument without adding it to the
- equality and moregen cases. *)
-type 'variety trace_format =
- | Unification : Errortrace.unification trace_format
- | Equality : Errortrace.comparison trace_format
- | Moregen : Errortrace.comparison trace_format
-
-let incompatibility_phrase (type variety) : variety trace_format -> string =
- function
- | Unification -> "is not compatible with type"
- | Equality -> "is not equal to type"
- | Moregen -> "is not compatible with type"
-
let printing_status = function
| Errortrace.Diff d -> diff_printing_status d
| Errortrace.Escape {kind = Constraint} -> Keep
| elt :: rem -> elt :: List.fold_right clean_trace rem []
let prepare_trace f tr =
- prepare_any_trace printing_status (Errortrace.flatten f tr)
+ prepare_any_trace printing_status (Errortrace.map f tr)
(** Keep elements that are not [Diff _ ] and take the decision
for the last element, require a prepared trace *)
-let rec filter_trace trace_format keep_last = function
+let rec filter_trace
+ (trace_format : 'variety trace_format)
+ keep_last
+ : ('a, 'variety) Errortrace.t -> _ = function
| [] -> []
| [Errortrace.Diff d as elt]
when printing_status elt = Optional_refinement ->
(* Hide variant name and var, to force printing the expanded type *)
let hide_variant_name t =
- match repr t with
- | {desc = Tvariant row} as t when (row_repr row).row_name <> None ->
- newty2 t.level
- (Tvariant {(row_repr row) with row_name = None;
- row_more = newvar2 (row_more row).level})
+ match get_desc t with
+ | Tvariant row ->
+ let Row {fields; more; name; fixed; closed} = row_repr row in
+ if name = None then t else
+ newty2 ~level:(get_level t)
+ (Tvariant
+ (create_row ~fields ~fixed ~closed ~name:None
+ ~more:(newvar2 (get_level more))))
| _ -> t
-let prepare_expansion (t, t') =
- let t' = hide_variant_name t' in
- mark_loops t;
- if not (same_path t t') then mark_loops t';
- (t, t')
+let prepare_expansion Errortrace.{ty; expanded} =
+ let expanded = hide_variant_name expanded in
+ reserve_names ty;
+ if not (same_path ty expanded) then reserve_names expanded;
+ Errortrace.{ty; expanded}
-let may_prepare_expansion compact (t, t') =
- match (repr t').desc with
+let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
+ match get_desc expanded with
Tvariant _ | Tobject _ when compact ->
- mark_loops t; (t, t)
- | _ -> prepare_expansion (t, t')
+ reserve_names ty; Errortrace.{ty; expanded = ty}
+ | _ -> prepare_expansion ty_exp
let print_path p = Format.dprintf "%a" !Oprint.out_ident (tree_of_path Type p)
Format.pp_print_list ~pp_sep:comma print_tag
let is_unit env ty =
- match (Ctype.expand_head env ty).desc with
+ match get_desc (Ctype.expand_head env ty) with
| Tconstr (p, _, _) -> Path.same p Predef.path_unit
| _ -> false
res
let explanation_diff env t3 t4 : (Format.formatter -> unit) option =
- match t3.desc, t4.desc with
+ match get_desc t3, get_desc t4 with
| Tarrow (_, ty1, ty2, _), _
when is_unit env ty1 && unifiable env ty2 t4 ->
Some (fun ppf ->
| Fixed_private ->
dprintf "The %a variant type is private" Errortrace.print_pos pos
| Univar x ->
+ reserve_names x;
dprintf "The %a variant type is bound to the universal type variable %a"
- Errortrace.print_pos pos type_expr x
+ Errortrace.print_pos pos type_expr_with_reserved_names x
| Reified p ->
dprintf "The %a variant type is bound to %t"
Errortrace.print_pos pos (print_path p)
(* this case never happens *)
None
(* Equality & Moregen *)
+ | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
+ dprintf
+ "@,@[The tag `%s is guaranteed to be present in the %a variant type,\
+ @ but not in the %a@]"
+ s
+ Errortrace.print_pos (Errortrace.swap_position pos)
+ Errortrace.print_pos pos
+ )
| Errortrace.Openness pos ->
- Some(dprintf "@,The %a variant type is open and the %a is not"
- Errortrace.print_pos pos
- Errortrace.print_pos (Errortrace.swap_position pos))
+ Some(dprintf "@,The %a variant type is open and the %a is not"
+ Errortrace.print_pos pos
+ Errortrace.print_pos (Errortrace.swap_position pos))
let explain_escape pre = function
- | Errortrace.Univ u -> Some(
- dprintf "%t@,The universal variable %a would escape its scope"
- pre type_expr u)
+ | Errortrace.Univ u ->
+ reserve_names u;
+ Some(
+ dprintf "%t@,The universal variable %a would escape its scope"
+ pre type_expr_with_reserved_names u)
| Errortrace.Constructor p -> Some(
dprintf
"%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
"%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
pre path p
)
- | Errortrace.Equation (_,t) -> Some(
- dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
- pre type_expr t
- "it would escape the scope of its equation"
- )
+ | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
+ reserve_names t;
+ Some(
+ dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
+ pre type_expr_with_reserved_names t
+ "it would escape the scope of its equation"
+ )
| Errortrace.Self ->
Some (dprintf "%t@,Self type cannot escape its class" pre)
| Errortrace.Constraint ->
Some (dprintf "@,Self type cannot be unified with a closed object type")
let explanation (type variety) intro prev env
- : ('a, variety) Errortrace.elt -> _ = function
- | Errortrace.Diff { Errortrace.got = _,s; expected = _,t } ->
- explanation_diff env s t
- | Errortrace.Escape {kind;context} ->
+ : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
+ | Errortrace.Diff {got; expected} ->
+ explanation_diff env got.expanded expected.expanded
+ | Errortrace.Escape {kind; context} ->
let pre =
match context, kind, prev with
| Some ctx, _, _ ->
- dprintf "@[%t@;<1 2>%a@]" intro type_expr ctx
+ reserve_names ctx;
+ dprintf "@[%t@;<1 2>%a@]" intro type_expr_with_reserved_names ctx
| None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+ reserve_names diff.got;
+ reserve_names diff.expected;
dprintf "@,@[The method %s has type@ %a,@ \
but the expected method type was@ %a@]"
- name type_expr diff.got type_expr diff.expected
+ name
+ type_expr_with_reserved_names diff.got
+ type_expr_with_reserved_names diff.expected
| _ -> ignore
in
explain_escape pre kind
| Errortrace.Obj o ->
explain_object o
| Errortrace.Rec_occur(x,y) ->
- reset_and_mark_loops y;
- begin match x.desc with
+ reserve_names x;
+ reserve_names y;
+ begin match get_desc x with
| Tvar _ | Tunivar _ ->
- Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
- type_expr x type_expr y)
+ Some(fun ppf ->
+ reset_loop_marks ();
+ mark_loops x;
+ mark_loops y;
+ dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ prepared_type_expr x prepared_type_expr y
+ ppf)
| _ ->
(* We had a delayed unification of the type variable with
a non-variable after the occur check. *)
| Some explain -> explain ppf
let warn_on_missing_def env ppf t =
- match t.desc with
+ match get_desc t with
| Tconstr (p,_,_) ->
begin
try
Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
| _ -> None
-let head_error_printer txt_got txt_but = function
+let head_error_printer mode txt_got txt_but = function
| None -> ignore
| Some d ->
- let d = Errortrace.map_diff trees_of_type_expansion d in
+ let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
txt_got type_expansion d.Errortrace.got
txt_but type_expansion d.Errortrace.expected
let warn_on_missing_defs env ppf = function
| None -> ()
- | Some {Errortrace.got=te1,_; expected=te2,_ } ->
+ | Some Errortrace.{got = {ty=te1; expanded=_};
+ expected = {ty=te2; expanded=_} } ->
warn_on_missing_def env ppf te1;
warn_on_missing_def env ppf te2
-let error trace_format env tr txt1 ppf txt2 ty_expect_explanation =
+(* [subst] comes out of equality, and is [[]] otherwise *)
+let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
reset ();
- let tr = prepare_trace (fun t t' -> t, hide_variant_name t') tr in
+ (* We want to substitute in the opposite order from [Eqtype] *)
+ Names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
+ let tr =
+ prepare_trace
+ (fun ty_exp ->
+ Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
+ tr
+ in
let mis = mismatch txt1 env tr in
match tr with
| [] -> assert false
let tr = filter_trace trace_format (mis = None) tr in
let head = prepare_expansion_head (tr=[]) elt in
let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
- let head_error = head_error_printer txt1 txt2 head in
- let tr = trees_of_trace tr in
+ let head_error = head_error_printer mode txt1 txt2 head in
+ let tr = trees_of_trace mode tr in
fprintf ppf
"@[<v>\
@[%t%t@]%a%t\
print_labels := true;
raise exn
-let report_error trace_format ppf env tr
+let report_error trace_format ppf mode env tr
+ ?(subst = [])
?(type_expected_explanation = fun _ -> ())
txt1 txt2 =
- wrap_printing_env env (fun () -> error trace_format env tr txt1 ppf txt2
- type_expected_explanation)
- ~error:true
+ wrap_printing_env ~error:true env (fun () ->
+ error trace_format mode subst env tr txt1 ppf txt2
+ type_expected_explanation)
+
+let report_unification_error
+ ppf env ({trace} : Errortrace.unification_error) =
+ report_error Unification ppf Type env
+ ?subst:None trace
-let report_unification_error =
- report_error Unification
-let report_equality_error =
- report_error Equality ?type_expected_explanation:None
-let report_moregen_error =
- report_error Moregen ?type_expected_explanation:None
+let report_equality_error
+ ppf mode env ({subst; trace} : Errortrace.equality_error) =
+ report_error Equality ppf mode env
+ ~subst ?type_expected_explanation:None trace
+
+let report_moregen_error
+ ppf mode env ({trace} : Errortrace.moregen_error) =
+ report_error Moregen ppf mode env
+ ?subst:None ?type_expected_explanation:None trace
+
+let report_comparison_error ppf mode env = function
+ | Errortrace.Equality_error error -> report_equality_error ppf mode env error
+ | Errortrace.Moregen_error error -> report_moregen_error ppf mode env error
module Subtype = struct
(* There's a frustrating amount of code duplication between this module and
let prepare_unification_trace = prepare_trace
let prepare_trace f tr =
- prepare_any_trace printing_status (Errortrace.Subtype.flatten f tr)
+ prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
let trace filter_trace get_diff fst keep_last txt ppf tr =
print_labels := not !Clflags.classic;
| elt :: tr' ->
let diffed_elt = get_diff elt in
let tr =
- trees_of_trace
+ trees_of_trace Type
@@ List.map (Errortrace.map_diff prepare_expansion)
@@ filter_trace keep_last tr' in
let tr =
let unification_get_diff = function
| Errortrace.Diff diff ->
- Some (Errortrace.map_diff trees_of_type_expansion diff)
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
| _ -> None
let subtype_get_diff = function
| Errortrace.Subtype.Diff diff ->
- Some (Errortrace.map_diff trees_of_type_expansion diff)
+ Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
- let report_error ppf env tr1 txt1 tr2 =
+ let report_error
+ ppf
+ env
+ (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
+ txt1 =
wrap_printing_env ~error:true env (fun () ->
reset ();
- let tr1 =
- prepare_trace (fun t t' -> prepare_expansion (t, t')) tr1
- in
- let tr2 =
- prepare_unification_trace (fun t t' -> prepare_expansion (t, t')) tr2
- in
- let keep_first = match tr2 with
+ let tr_sub = prepare_trace prepare_expansion tr_sub in
+ let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
+ let keep_first = match tr_unif with
| [Obj _ | Variant _ | Escape _ ] | [] -> true
| _ -> false in
fprintf ppf "@[<v>%a"
- (trace filter_subtype_trace subtype_get_diff true keep_first txt1) tr1;
- if tr2 = [] then fprintf ppf "@]" else
- let mis = mismatch (dprintf "Within this type") env tr2 in
+ (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
+ tr_sub;
+ if tr_unif = [] then fprintf ppf "@]" else
+ let mis = mismatch (dprintf "Within this type") env tr_unif in
fprintf ppf "%a%t%t@]"
(trace filter_unification_trace unification_get_diff false
- (mis = None) "is not compatible with type") tr2
+ (mis = None) "is not compatible with type") tr_unif
(explain mis)
Conflicts.print_explanations
)
(* Adapt functions to exposed interface *)
let tree_of_path = tree_of_path Other
let tree_of_modtype = tree_of_modtype ~ellipsis:false
-let type_expansion ty ppf ty' =
- type_expansion ppf (trees_of_type_expansion (ty,ty'))
+let type_expansion mode ppf ty_exp =
+ type_expansion ppf (trees_of_type_expansion mode ty_exp)
let tree_of_type_declaration ident td rs =
with_hidden_items [{hide=true; ident}]
(fun () -> tree_of_type_declaration ident td rs)
end
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
+(** Print out a type. This will pick names for type variables, and will not
+ reuse names for common type variables shared across multiple type
+ expressions. (It will also reset the printing state, which matters for
+ other type formatters such as [prepared_type_expr].) If you want multiple
+ types to use common names for type variables, see [prepare_for_printing] and
+ [prepared_type_expr]. *)
val type_expr: formatter -> type_expr -> unit
-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).
- *)
+
+(** [prepare_for_printing] resets the global printing environment, a la [reset],
+ and prepares the types for printing by reserving names and marking loops.
+ Any type variables that are shared between multiple types in the input list
+ will be given the same name when printed with [prepared_type_expr]. *)
+val prepare_for_printing: type_expr list -> unit
+val prepared_type_expr: formatter -> type_expr -> unit
+(** The function [prepared_type_expr] is a less-safe but more-flexible version
+ of [type_expr] that should only be called on [type_expr]s that have been
+ passed to [prepare_for_printing]. Unlike [type_expr], this function does no
+ extra work before printing a type; in particular, this means that any loops
+ in the type expression may cause a stack overflow (see #8860) since this
+ function does not mark any loops. The benefit of this is that if multiple
+ type expressions are prepared simultaneously and then printed with
+ [prepared_type_expr], they will use the same names for the same type
+ variables. *)
val constructor_arguments: formatter -> constructor_arguments -> unit
val tree_of_type_scheme: type_expr -> out_type
-val type_sch : formatter -> type_expr -> unit
val type_scheme: formatter -> type_expr -> unit
-(* Maxence *)
-val reset_names: unit -> unit
-val type_scheme_max: ?b_reset_names: bool ->
- formatter -> type_expr -> unit
-(* End Maxence *)
+val shared_type_scheme: formatter -> type_expr -> unit
+(** [shared_type_scheme] is very similar to [type_scheme], but does not reset
+ the printing context first. This is intended to be used in cases where the
+ printing should have a particularly wide context, such as documentation
+ generators; most use cases, such as error messages, have narrower contexts
+ for which [type_scheme] is better suited. *)
+
val tree_of_value_description: Ident.t -> value_description -> out_sig_item
val value_description: Ident.t -> formatter -> value_description -> unit
val label : formatter -> label_declaration -> unit
('b -> Format.formatter -> unit) ->
(Ident.t option * 'b) list -> Format.formatter -> unit
+type type_or_scheme = Type | Type_scheme
+
val tree_of_signature: Types.signature -> out_sig_item list
-val tree_of_typexp: bool -> type_expr -> out_type
+val tree_of_typexp: type_or_scheme -> type_expr -> out_type
val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
val class_type: formatter -> class_type -> unit
val tree_of_class_declaration:
val tree_of_cltype_declaration:
Ident.t -> class_type_declaration -> rec_status -> out_sig_item
val cltype_declaration: Ident.t -> formatter -> class_type_declaration -> unit
-val type_expansion: type_expr -> Format.formatter -> type_expr -> unit
-val prepare_expansion: type_expr * type_expr -> type_expr * type_expr
+val type_expansion :
+ type_or_scheme -> Format.formatter -> Errortrace.expanded_type -> unit
+val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
val report_ambiguous_type_error:
formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
(formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
val report_unification_error :
- formatter -> Env.t ->
- Errortrace.unification Errortrace.t ->
+ formatter ->
+ Env.t -> Errortrace.unification_error ->
?type_expected_explanation:(formatter -> unit) ->
(formatter -> unit) -> (formatter -> unit) ->
unit
val report_equality_error :
- formatter -> Env.t ->
- Errortrace.comparison Errortrace.t ->
+ formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.equality_error ->
(formatter -> unit) -> (formatter -> unit) ->
unit
val report_moregen_error :
- formatter -> Env.t ->
- Errortrace.comparison Errortrace.t ->
+ formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.moregen_error ->
+ (formatter -> unit) -> (formatter -> unit) ->
+ unit
+
+val report_comparison_error :
+ formatter ->
+ type_or_scheme ->
+ Env.t -> Errortrace.comparison_error ->
(formatter -> unit) -> (formatter -> unit) ->
unit
val report_error :
formatter ->
Env.t ->
- Errortrace.Subtype.t ->
+ Errortrace.Subtype.error ->
string ->
- Errortrace.unification Errortrace.t ->
unit
end
| Labelled s -> line i ppf "Labelled \"%s\"\n" s
;;
+let typevars ppf vs =
+ List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt) vs
+;;
+
let record_representation i ppf = let open Types in function
| Record_regular -> line i ppf "Record_regular\n"
| Record_float -> line i ppf "Record_float\n"
line i ppf "pattern %a\n" fmt_location x.pat_loc;
attributes i ppf x.pat_attributes;
let i = i+1 in
- match x.pat_extra with
- | extra :: rem ->
- pattern_extra i ppf extra;
- pattern i ppf { x with pat_extra = rem }
- | [] ->
+ begin match x.pat_extra with
+ | [] -> ()
+ | extra ->
+ line i ppf "extra\n";
+ List.iter (pattern_extra (i+1) ppf) extra;
+ end;
match x.pat_desc with
| Tpat_any -> line i ppf "Tpat_any\n";
| Tpat_var (s,_) -> line i ppf "Tpat_var \"%a\"\n" fmt_ident s;
line i ppf "Tpat_extra_type %a\n" fmt_path id;
attributes i ppf attrs;
| Tpat_open (id,_,_) ->
- line i ppf "Tpat_extra_open \"%a\"\n" fmt_path id;
+ line i ppf "Tpat_extra_open %a\n" fmt_path id;
attributes i ppf attrs;
-and expression_extra i ppf x attrs =
+and expression_extra i ppf (x,_,attrs) =
match x with
| Texp_constraint ct ->
line i ppf "Texp_constraint\n";
and expression i ppf x =
line i ppf "expression %a\n" fmt_location x.exp_loc;
attributes i ppf x.exp_attributes;
- let i =
- List.fold_left (fun i (extra,_,attrs) ->
- expression_extra i ppf extra attrs; i+1)
- (i+1) x.exp_extra
- in
+ let i = i+1 in
+ begin match x.exp_extra with
+ | [] -> ()
+ | extra ->
+ line i ppf "extra\n";
+ List.iter (expression_extra (i+1) ppf) extra;
+ end;
match x.exp_desc with
| Texp_ident (li,_,_) -> line i ppf "Texp_ident %a\n" fmt_path li;
| Texp_instvar (_, li,_) -> line i ppf "Texp_instvar %a\n" fmt_path li;
expression i ppf e1;
expression i ppf e2;
expression i ppf e3;
- | Texp_send (e, Tmeth_name s, eo) ->
+ | Texp_send (e, Tmeth_name s) ->
line i ppf "Texp_send \"%s\"\n" s;
- expression i ppf e;
- option i expression ppf eo
- | Texp_send (e, Tmeth_val s, eo) ->
+ expression i ppf e
+ | Texp_send (e, Tmeth_val s) ->
line i ppf "Texp_send \"%a\"\n" fmt_ident s;
- expression i ppf e;
- option i expression ppf eo
+ expression i ppf e
+ | Texp_send (e, Tmeth_ancestor(s, _)) ->
+ line i ppf "Texp_send \"%a\"\n" fmt_ident s;
+ expression i ppf e
| Texp_new (li, _, _) -> line i ppf "Texp_new %a\n" fmt_path li;
| Texp_setinstvar (_, s, _, e) ->
- line i ppf "Texp_setinstvar \"%a\"\n" fmt_path s;
+ line i ppf "Texp_setinstvar %a\n" fmt_path s;
expression i ppf e;
| Texp_override (_, l) ->
line i ppf "Texp_override\n";
and extension_constructor_kind i ppf x =
match x with
- Text_decl(a, r) ->
+ Text_decl(v, a, r) ->
line i ppf "Text_decl\n";
+ if v <> [] then line (i+1) ppf "vars%a\n" typevars v;
constructor_arguments (i+1) ppf a;
option (i+1) core_type ppf r;
| Text_rebind(p, _) ->
core_type (i+1) ppf ct1;
core_type (i+1) ppf ct2;
-and constructor_decl i ppf {cd_id; cd_name = _; cd_args; cd_res; cd_loc;
- cd_attributes} =
+and constructor_decl i ppf {cd_id; cd_name = _; cd_vars;
+ cd_args; cd_res; cd_loc; cd_attributes} =
line i ppf "%a\n" fmt_location cd_loc;
line (i+1) ppf "%a\n" fmt_ident cd_id;
+ if cd_vars <> [] then line (i+1) ppf "cd_vars =%a\n" typevars cd_vars;
attributes i ppf cd_attributes;
constructor_arguments (i+1) ppf cd_args;
option (i+1) core_type ppf cd_res
expression (i+1) ppf x.vb_expr
and string_x_expression i ppf (s, _, e) =
- line i ppf "<override> \"%a\"\n" fmt_path s;
+ line i ppf "<override> \"%a\"\n" fmt_ident s;
expression (i+1) ppf e;
and record_field i ppf = function
expression cond << Dereference;
expression body << Guard;
]
- | Texp_send (e1, _, eo) ->
+ | Texp_send (e1, _) ->
(*
G |- e: m[Dereference]
---------------------- (plus weird 'eo' option)
G |- e#x: m
*)
join [
- expression e1 << Dereference;
- option expression eo << Dereference;
+ expression e1 << Dereference
]
| Texp_field (e, _, _) ->
(*
is_destructuring_pattern l || is_destructuring_pattern r
let is_valid_recursive_expression idlist expr =
- let ty = expression expr Return in
- match Env.unguarded ty idlist, Env.dependent ty idlist,
- classify_expression expr with
- | _ :: _, _, _ (* The expression inspects rec-bound variables *)
- | [], _ :: _, Dynamic -> (* The expression depends on rec-bound variables
- and its size is unknown *)
- false
- | [], _, Static (* The expression has known size *)
- | [], [], Dynamic -> (* The expression has unknown size,
- but does not depend on rec-bound variables *)
- true
+ match expr.exp_desc with
+ | Texp_function _ ->
+ (* Fast path: functions can never have invalid recursive references *)
+ true
+ | _ ->
+ match classify_expression expr with
+ | Static ->
+ (* The expression has known size *)
+ let ty = expression expr Return in
+ Env.unguarded ty idlist = []
+ | Dynamic ->
+ (* The expression has unknown size *)
+ let ty = expression expr Return in
+ Env.unguarded ty idlist = [] && Env.dependent ty idlist = []
(* A class declaration may contain let-bindings. If they are recursive,
their validity will already be checked by [is_valid_recursive_expression]
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+module Uid = struct
+ type t =
+ | Compilation_unit of string
+ | Item of { comp_unit: string; id: int }
+ | Internal
+ | Predef of string
+
+ include Identifiable.Make(struct
+ type nonrec t = t
+
+ let equal (x : t) y = x = y
+ let compare (x : t) y = compare x y
+ let hash (x : t) = Hashtbl.hash x
+
+ let print fmt = function
+ | Internal -> Format.pp_print_string fmt "<internal>"
+ | Predef name -> Format.fprintf fmt "<predef:%s>" name
+ | Compilation_unit s -> Format.pp_print_string fmt s
+ | Item { comp_unit; id } -> Format.fprintf fmt "%s.%d" comp_unit id
+
+ let output oc t =
+ let fmt = Format.formatter_of_out_channel oc in
+ print fmt t
+ end)
+
+ let id = ref (-1)
+
+ let reinit () = id := (-1)
+
+ let mk ~current_unit =
+ incr id;
+ Item { comp_unit = current_unit; id = !id }
+
+ let of_compilation_unit_id id =
+ if not (Ident.persistent id) then
+ Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id);
+ Compilation_unit (Ident.name id)
+
+ let of_predef_id id =
+ if not (Ident.is_predef id) then
+ Misc.fatal_errorf "Types.Uid.of_predef_id %S" (Ident.name id);
+ Predef (Ident.name id)
+
+ let internal_not_actually_unique = Internal
+
+ let for_actual_declaration = function
+ | Item _ -> true
+ | _ -> false
+end
+
+module Sig_component_kind = struct
+ type t =
+ | Value
+ | Type
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+ let to_string = function
+ | Value -> "value"
+ | Type -> "type"
+ | Module -> "module"
+ | Module_type -> "module type"
+ | Extension_constructor -> "extension constructor"
+ | Class -> "class"
+ | Class_type -> "class type"
+
+ let can_appear_in_types = function
+ | Value
+ | Extension_constructor ->
+ false
+ | Type
+ | Module
+ | Module_type
+ | Class
+ | Class_type ->
+ true
+end
+
+module Item = struct
+ module T = struct
+ type t = string * Sig_component_kind.t
+ let compare = compare
+
+ let make str ns = str, ns
+
+ let value id = Ident.name id, Sig_component_kind.Value
+ let type_ id = Ident.name id, Sig_component_kind.Type
+ let module_ id = Ident.name id, Sig_component_kind.Module
+ let module_type id = Ident.name id, Sig_component_kind.Module_type
+ let extension_constructor id =
+ Ident.name id, Sig_component_kind.Extension_constructor
+ let class_ id =
+ Ident.name id, Sig_component_kind.Class
+ let class_type id =
+ Ident.name id, Sig_component_kind.Class_type
+
+ let print fmt (name, ns) =
+ Format.fprintf fmt "%S[%s]"
+ name
+ (Sig_component_kind.to_string ns)
+ end
+
+ include T
+
+ module Map = Map.Make(T)
+end
+
+type var = Ident.t
+type t = { uid: Uid.t option; desc: desc }
+and desc =
+ | Var of var
+ | Abs of var * t
+ | App of t * t
+ | Struct of t Item.Map.t
+ | Leaf
+ | Proj of t * Item.t
+ | Comp_unit of string
+
+let print fmt =
+ let print_uid_opt =
+ Format.pp_print_option (fun fmt -> Format.fprintf fmt "<%a>" Uid.print)
+ in
+ let rec aux fmt { uid; desc } =
+ match desc with
+ | Var id ->
+ Format.fprintf fmt "%a%a" Ident.print id print_uid_opt uid
+ | Abs (id, t) ->
+ Format.fprintf fmt "Abs@[%a@,(@[%a,@ @[%a@]@])@]"
+ print_uid_opt uid Ident.print id aux t
+ | App (t1, t2) ->
+ Format.fprintf fmt "@[%a(@,%a)%a@]" aux t1 aux t2
+ print_uid_opt uid
+ | Leaf ->
+ Format.fprintf fmt "<%a>" (Format.pp_print_option Uid.print) uid
+ | Proj (t, item) ->
+ begin match uid with
+ | None ->
+ Format.fprintf fmt "@[%a@ .@ %a@]"
+ aux t
+ Item.print item
+ | Some uid ->
+ Format.fprintf fmt "@[(%a@ .@ %a)<%a>@]"
+ aux t
+ Item.print item
+ Uid.print uid
+ end
+ | Comp_unit name -> Format.fprintf fmt "CU %s" name
+ | Struct map ->
+ let print_map fmt =
+ Item.Map.iter (fun item t ->
+ Format.fprintf fmt "@[<hv 4>%a ->@ %a;@]@,"
+ Item.print item
+ aux t
+ )
+ in
+ Format.fprintf fmt "{@[<v>%a@,%a@]}" print_uid_opt uid print_map map
+ in
+ Format.fprintf fmt"@[%a@]@;" aux
+
+let fresh_var ?(name="shape-var") uid =
+ let var = Ident.create_local name in
+ var, { uid = Some uid; desc = Var var }
+
+let for_unnamed_functor_param = Ident.create_local "()"
+
+let var uid id =
+ { uid = Some uid; desc = Var id }
+
+let abs ?uid var body =
+ { uid; desc = Abs (var, body) }
+
+let str ?uid map =
+ { uid; desc = Struct map }
+
+let leaf uid =
+ { uid = Some uid; desc = Leaf }
+
+let proj ?uid t item =
+ match t.desc with
+ | Leaf ->
+ (* When stuck projecting in a leaf we propagate the leaf
+ as a best effort *)
+ t
+ | Struct map ->
+ begin try Item.Map.find item map
+ with Not_found -> t (* ill-typed program *)
+ end
+ | _ ->
+ { uid; desc = Proj (t, item) }
+
+let app ?uid f ~arg =
+ { uid; desc = App (f, arg) }
+
+let decompose_abs t =
+ match t.desc with
+ | Abs (x, t) -> Some (x, t)
+ | _ -> None
+
+module Make_reduce(Params : sig
+ type env
+ val fuel : int
+ val read_unit_shape : unit_name:string -> t option
+ val find_shape : env -> Ident.t -> t
+end) = struct
+ (* We implement a strong call-by-need reduction, following an
+ evaluator from Nathanaelle Courant. *)
+
+ type nf = { uid: Uid.t option; desc: nf_desc }
+ and nf_desc =
+ | NVar of var
+ | NApp of nf * nf
+ | NAbs of local_env * var * t * delayed_nf
+ | NStruct of delayed_nf Item.Map.t
+ | NProj of nf * Item.t
+ | NLeaf
+ | NComp_unit of string
+ | NoFuelLeft of desc
+ (* A type of normal forms for strong call-by-need evaluation.
+ The normal form of an abstraction
+ Abs(x, t)
+ is a closure
+ NAbs(env, x, t, dnf)
+ when [env] is the local environment, and [dnf] is a delayed
+ normal form of [t].
+
+ A "delayed normal form" is morally equivalent to (nf Lazy.t), but
+ we use a different representation that is compatible with
+ memoization (lazy values are not hashable/comparable by default
+ comparison functions): we represent a delayed normal form as
+ just a not-yet-computed pair [local_env * t] of a term in a
+ local environment -- we could also see this as a term under
+ an explicit substitution. This delayed thunked is "forced"
+ by calling the normalization function as usual, but duplicate
+ computations are precisely avoided by memoization.
+ *)
+ and delayed_nf = Thunk of local_env * t
+
+ and local_env = delayed_nf option Ident.Map.t
+ (* When reducing in the body of an abstraction [Abs(x, body)], we
+ bind [x] to [None] in the environment. [Some v] is used for
+ actual substitutions, for example in [App(Abs(x, body), t)], when
+ [v] is a thunk that will evaluate to the normal form of [t]. *)
+
+ let improve_uid uid (nf : nf) =
+ match nf.uid with
+ | Some _ -> nf
+ | None -> { nf with uid }
+
+ let in_memo_table memo_table memo_key f arg =
+ match Hashtbl.find memo_table memo_key with
+ | res -> res
+ | exception Not_found ->
+ let res = f arg in
+ Hashtbl.replace memo_table memo_key res;
+ res
+
+ type env = {
+ fuel: int ref;
+ global_env: Params.env;
+ local_env: local_env;
+ reduce_memo_table: (local_env * t, nf) Hashtbl.t;
+ read_back_memo_table: (nf, t) Hashtbl.t;
+ }
+
+ let bind env var shape =
+ { env with local_env = Ident.Map.add var shape env.local_env }
+
+ let rec reduce_ env t =
+ let memo_key = (env.local_env, t) in
+ in_memo_table env.reduce_memo_table memo_key (reduce__ env) t
+ (* Memoization is absolutely essential for performance on this
+ problem, because the normal forms we build can in some real-world
+ cases contain an exponential amount of redundancy. Memoization
+ can avoid the repeated evaluation of identical subterms,
+ providing a large speedup, but even more importantly it
+ implicitly shares the memory of the repeated results, providing
+ much smaller normal forms (that blow up again if printed back
+ as trees). A functor-heavy file from Irmin has its shape normal
+ form decrease from 100Mio to 2.5Mio when memoization is enabled.
+
+ Note: the local environment is part of the memoization key, while
+ it is defined using a type Ident.Map.t of non-canonical balanced
+ trees: two maps could have exactly the same items, but be
+ balanced differently and therefore hash differently, reducing
+ the effectivenss of memoization.
+ This could in theory happen, say, with the two programs
+ (fun x -> fun y -> ...)
+ and
+ (fun y -> fun x -> ...)
+ having "the same" local environments, with additions done in
+ a different order, giving non-structurally-equal trees. Should we
+ define our own hash functions to provide robust hashing on
+ environments?
+
+ We believe that the answer is "no": this problem does not occur
+ in practice. We can assume that identifiers are unique on valid
+ typedtree fragments (identifier "stamps" distinguish
+ binding positions); in particular the two program fragments above
+ in fact bind *distinct* identifiers x (with different stamps) and
+ different identifiers y, so the environments are distinct. If two
+ environments are structurally the same, they must correspond to
+ the evaluation evnrionments of two sub-terms that are under
+ exactly the same scope of binders. So the two environments were
+ obtained by the same term traversal, adding binders in the same
+ order, giving the same balanced trees: the environments have the
+ same hash.
+*)
+
+ and reduce__ ({fuel; global_env; local_env; _} as env) (t : t) =
+ let reduce env t = reduce_ env t in
+ let delay_reduce env t = Thunk (env.local_env, t) in
+ let force (Thunk (local_env, t)) =
+ reduce { env with local_env } t in
+ let return desc : nf = { uid = t.uid; desc } in
+ if !fuel < 0 then return (NoFuelLeft t.desc)
+ else
+ match t.desc with
+ | Comp_unit unit_name ->
+ begin match Params.read_unit_shape ~unit_name with
+ | Some t -> reduce env t
+ | None -> return (NComp_unit unit_name)
+ end
+ | App(f, arg) ->
+ let f = reduce env f in
+ begin match f.desc with
+ | NAbs(clos_env, var, body, _body_nf) ->
+ let arg = delay_reduce env arg in
+ let env = bind { env with local_env = clos_env } var (Some arg) in
+ reduce env body
+ |> improve_uid t.uid
+ | _ ->
+ let arg = reduce env arg in
+ return (NApp(f, arg))
+ end
+ | Proj(str, item) ->
+ let str = reduce env str in
+ let nored () = return (NProj(str, item)) in
+ begin match str.desc with
+ | NStruct (items) ->
+ begin match Item.Map.find item items with
+ | exception Not_found -> nored ()
+ | nf ->
+ force nf
+ |> improve_uid t.uid
+ end
+ | _ ->
+ nored ()
+ end
+ | Abs(var, body) ->
+ let body_nf = delay_reduce (bind env var None) body in
+ return (NAbs(local_env, var, body, body_nf))
+ | Var id ->
+ begin match Ident.Map.find id local_env with
+ (* Note: instead of binding abstraction-bound variables to
+ [None], we could unify it with the [Some v] case by
+ binding the bound variable [x] to [NVar x].
+
+ One reason to distinguish the situations is that we can
+ provide a different [Uid.t] location; for bound
+ variables, we use the [Uid.t] of the bound occurrence
+ (not the binding site), whereas for bound values we use
+ their binding-time [Uid.t]. *)
+ | None -> return (NVar id)
+ | Some def -> force def
+ | exception Not_found ->
+ match Params.find_shape global_env id with
+ | exception Not_found -> return (NVar id)
+ | res when res = t -> return (NVar id)
+ | res ->
+ decr fuel;
+ reduce env res
+ end
+ | Leaf -> return NLeaf
+ | Struct m ->
+ let mnf = Item.Map.map (delay_reduce env) m in
+ return (NStruct mnf)
+
+ let rec read_back env (nf : nf) : t =
+ in_memo_table env.read_back_memo_table nf (read_back_ env) nf
+ (* The [nf] normal form we receive may contain a lot of internal
+ sharing due to the use of memoization in the evaluator. We have
+ to memoize here again, otherwise the sharing is lost by mapping
+ over the term as a tree. *)
+
+ and read_back_ env (nf : nf) : t =
+ { uid = nf.uid; desc = read_back_desc env nf.desc }
+
+ and read_back_desc env desc =
+ let read_back nf = read_back env nf in
+ let read_back_force (Thunk (local_env, t)) =
+ read_back (reduce_ { env with local_env } t) in
+ match desc with
+ | NVar v ->
+ Var v
+ | NApp (nft, nfu) ->
+ App(read_back nft, read_back nfu)
+ | NAbs (_env, x, _t, nf) ->
+ Abs(x, read_back_force nf)
+ | NStruct nstr ->
+ Struct (Item.Map.map read_back_force nstr)
+ | NProj (nf, item) ->
+ Proj (read_back nf, item)
+ | NLeaf -> Leaf
+ | NComp_unit s -> Comp_unit s
+ | NoFuelLeft t -> t
+
+ let reduce global_env t =
+ let fuel = ref Params.fuel in
+ let reduce_memo_table = Hashtbl.create 42 in
+ let read_back_memo_table = Hashtbl.create 42 in
+ let local_env = Ident.Map.empty in
+ let env = {
+ fuel;
+ global_env;
+ reduce_memo_table;
+ read_back_memo_table;
+ local_env;
+ } in
+ reduce_ env t |> read_back env
+end
+
+module Local_reduce =
+ (* Note: this definition with [type env = unit] is only suitable for
+ reduction of toplevel shapes -- shapes of compilation units,
+ where free variables are only Comp_unit names. If we wanted to
+ reduce shapes inside module signatures, we would need to take
+ a typing environment as parameter. *)
+ Make_reduce(struct
+ type env = unit
+ let fuel = 10
+ let read_unit_shape ~unit_name:_ = None
+ let find_shape _env _id = raise Not_found
+ end)
+
+let local_reduce shape =
+ Local_reduce.reduce () shape
+
+let dummy_mod = { uid = None; desc = Struct Item.Map.empty }
+
+let of_path ~find_shape ~namespace =
+ let rec aux : Sig_component_kind.t -> Path.t -> t = fun ns -> function
+ | Pident id -> find_shape ns id
+ | Pdot (path, name) -> proj (aux Module path) (name, ns)
+ | Papply (p1, p2) -> app (aux Module p1) ~arg:(aux Module p2)
+ in
+ aux namespace
+
+let for_persistent_unit s =
+ { uid = Some (Uid.of_compilation_unit_id (Ident.create_persistent s));
+ desc = Comp_unit s }
+
+let leaf_for_unpack = { uid = None; desc = Leaf }
+
+let set_uid_if_none t uid =
+ match t.uid with
+ | None -> { t with uid = Some uid }
+ | _ -> t
+
+module Map = struct
+ type shape = t
+ type nonrec t = t Item.Map.t
+
+ let empty = Item.Map.empty
+
+ let add t item shape = Item.Map.add item shape t
+
+ let add_value t id uid = Item.Map.add (Item.value id) (leaf uid) t
+ let add_value_proj t id shape =
+ let item = Item.value id in
+ Item.Map.add item (proj shape item) t
+
+ let add_type t id uid = Item.Map.add (Item.type_ id) (leaf uid) t
+ let add_type_proj t id shape =
+ let item = Item.type_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_module t id shape = Item.Map.add (Item.module_ id) shape t
+ let add_module_proj t id shape =
+ let item = Item.module_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_module_type t id uid =
+ Item.Map.add (Item.module_type id) (leaf uid) t
+ let add_module_type_proj t id shape =
+ let item = Item.module_type id in
+ Item.Map.add item (proj shape item) t
+
+ let add_extcons t id uid =
+ Item.Map.add (Item.extension_constructor id) (leaf uid) t
+ let add_extcons_proj t id shape =
+ let item = Item.extension_constructor id in
+ Item.Map.add item (proj shape item) t
+
+ let add_class t id uid = Item.Map.add (Item.class_ id) (leaf uid) t
+ let add_class_proj t id shape =
+ let item = Item.class_ id in
+ Item.Map.add item (proj shape item) t
+
+ let add_class_type t id uid = Item.Map.add (Item.class_type id) (leaf uid) t
+ let add_class_type_proj t id shape =
+ let item = Item.class_type id in
+ Item.Map.add item (proj shape item) t
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Ulysse Gérard, Thomas Refis, Tarides *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+module Uid : sig
+ type t = private
+ | Compilation_unit of string
+ | Item of { comp_unit: string; id: int }
+ | Internal
+ | Predef of string
+
+ val reinit : unit -> unit
+
+ val mk : current_unit:string -> t
+ val of_compilation_unit_id : Ident.t -> t
+ val of_predef_id : Ident.t -> t
+ val internal_not_actually_unique : t
+
+ val for_actual_declaration : t -> bool
+
+ include Identifiable.S with type t := t
+end
+
+module Sig_component_kind : sig
+ type t =
+ | Value
+ | Type
+ | Module
+ | Module_type
+ | Extension_constructor
+ | Class
+ | Class_type
+
+ val to_string : t -> string
+
+ (** Whether the name of a component of that kind can appear in a type. *)
+ val can_appear_in_types : t -> bool
+end
+
+module Item : sig
+ type t
+
+ val make : string -> Sig_component_kind.t -> t
+
+ val value : Ident.t -> t
+ val type_ : Ident.t -> t
+ val module_ : Ident.t -> t
+ val module_type : Ident.t -> t
+ val extension_constructor : Ident.t -> t
+ val class_ : Ident.t -> t
+ val class_type : Ident.t -> t
+
+ module Map : Map.S with type key = t
+end
+
+type var = Ident.t
+type t = { uid: Uid.t option; desc: desc }
+and desc =
+ | Var of var
+ | Abs of var * t
+ | App of t * t
+ | Struct of t Item.Map.t
+ | Leaf
+ | Proj of t * Item.t
+ | Comp_unit of string
+
+val print : Format.formatter -> t -> unit
+
+(* Smart constructors *)
+
+val for_unnamed_functor_param : var
+val fresh_var : ?name:string -> Uid.t -> var * t
+
+val var : Uid.t -> Ident.t -> t
+val abs : ?uid:Uid.t -> var -> t -> t
+val app : ?uid:Uid.t -> t -> arg:t -> t
+val str : ?uid:Uid.t -> t Item.Map.t -> t
+val proj : ?uid:Uid.t -> t -> Item.t -> t
+val leaf : Uid.t -> t
+
+val decompose_abs : t -> (var * t) option
+
+val for_persistent_unit : string -> t
+val leaf_for_unpack : t
+
+module Map : sig
+ type shape = t
+ type nonrec t = t Item.Map.t
+
+ val empty : t
+
+ val add : t -> Item.t -> shape -> t
+
+ val add_value : t -> Ident.t -> Uid.t -> t
+ val add_value_proj : t -> Ident.t -> shape -> t
+
+ val add_type : t -> Ident.t -> Uid.t -> t
+ val add_type_proj : t -> Ident.t -> shape -> t
+
+ val add_module : t -> Ident.t -> shape -> t
+ val add_module_proj : t -> Ident.t -> shape -> t
+
+ val add_module_type : t -> Ident.t -> Uid.t -> t
+ val add_module_type_proj : t -> Ident.t -> shape -> t
+
+ val add_extcons : t -> Ident.t -> Uid.t -> t
+ val add_extcons_proj : t -> Ident.t -> shape -> t
+
+ val add_class : t -> Ident.t -> Uid.t -> t
+ val add_class_proj : t -> Ident.t -> shape -> t
+
+ val add_class_type : t -> Ident.t -> Uid.t -> t
+ val add_class_type_proj : t -> Ident.t -> shape -> t
+end
+
+val dummy_mod : t
+
+val of_path :
+ find_shape:(Sig_component_kind.t -> Ident.t -> t) ->
+ namespace:Sig_component_kind.t -> Path.t -> t
+
+val set_uid_if_none : t -> Uid.t -> t
+
+(** The [Make_reduce] functor is used to generate a reduction function for
+ shapes.
+
+ It is parametrized by:
+ - an environment and a function to find shapes by path in that environment
+ - a function to load the shape of an external compilation unit
+ - some fuel, which is used to bound recursion when dealing with recursive
+ shapes introduced by recursive modules. (FTR: merlin currently uses a
+ fuel of 10, which seems to be enough for most practical examples)
+*)
+module Make_reduce(Context : sig
+ type env
+
+ val fuel : int
+
+ val read_unit_shape : unit_name:string -> t option
+
+ val find_shape : env -> Ident.t -> t
+ end) : sig
+ val reduce : Context.env -> t -> t
+end
+
+val local_reduce : t -> t
(** Private row types are manifested as a sequence of definitions
preceding a recursive group, we collect them and separate them from the
- syntatic recursive group. *)
+ syntactic recursive group. *)
type rec_group =
{ pre_ghosts: Types.signature_item list; group:core_rec_group }
match current with
| [] -> next_group f (commit ghosts) sg
| a :: q ->
- match f ~rec_group:q ~ghosts a.src with
+ match f ~ghosts a.src with
| Some (info, {ghosts; replace_by}) ->
let after = List.concat_map flatten q @ sg in
let after = match recursive_sigitem a.src, replace_by with
(** Private #row types are manifested as a sequence of definitions
preceding a recursive group, we collect them and separate them from the
- syntatic recursive group. *)
+ syntactic recursive group. *)
type rec_group =
{ pre_ghosts: Types.signature_item list; group:core_rec_group }
[component]
*)
val replace_in_place:
- ( rec_group:sig_item list -> ghosts:Types.signature -> Types.signature_item
+ ( ghosts:Types.signature -> Types.signature_item
-> ('a * in_place_patch) option )
-> Types.signature -> ('a * Types.signature) option
end;
output_string pp "type(\n";
printtyp_reset_maybe loc;
- Printtyp.mark_loops typ;
Format.pp_print_string Format.str_formatter " ";
Printtyp.wrap_printing_env ~error:false env
- (fun () -> Printtyp.type_sch Format.str_formatter typ);
+ (fun () -> Printtyp.shared_type_scheme Format.str_formatter typ);
Format.pp_print_newline Format.str_formatter ();
let s = Format.flush_str_formatter () in
output_string pp s;
let newpersty desc =
decr new_id;
- Private_type_expr.create
+ create_expr
desc ~level:generic_level ~scope:Btype.lowest_level ~id:!new_id
(* ensure that all occurrences of 'Tvar None' are physically shared *)
(* Similar to [Ctype.nondep_type_rec]. *)
let rec typexp copy_scope s ty =
- let ty = repr ty in
- match ty.desc with
- Tvar _ | Tunivar _ as desc ->
- if s.for_saving || ty.id < 0 then
+ let desc = get_desc ty in
+ match desc with
+ Tvar _ | Tunivar _ ->
+ if s.for_saving || get_id ty < 0 then
let ty' =
if s.for_saving then newpersty (norm desc)
- else newty2 ty.level desc
+ else newty2 ~level:(get_level ty) desc
in
- For_copy.save_desc copy_scope ty desc;
- Private_type_expr.set_desc ty (Tsubst (ty', None));
- (* TODO: move this line to btype.ml
- there is a similar problem also in ctype.ml *)
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty', None));
ty'
else ty
| Tsubst (ty, _) ->
ty
| Tfield (m, k, _t1, _t2) when not s.for_saving && m = dummy_method
- && field_kind_repr k <> Fabsent && (repr ty).level < generic_level ->
+ && field_kind_repr k <> Fabsent && get_level ty < generic_level ->
(* do not copy the type of self when it is not generalized *)
ty
(* cannot do it, since it would omit substitution
ty
*)
| _ ->
- let desc = ty.desc in
- For_copy.save_desc copy_scope ty desc;
let tm = row_of_type ty in
let has_fixed_row =
not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm in
(* Make a stub *)
- let ty' = if s.for_saving then newpersty (Tvar None) else newgenvar () in
- Private_type_expr.set_scope ty' ty.scope;
- Private_type_expr.set_desc ty (Tsubst (ty', None));
- Private_type_expr.set_desc ty'
- begin if has_fixed_row then
- match tm.desc with (* PR#7348 *)
+ let ty' =
+ if s.for_saving then newpersty (Tvar None)
+ else newgenstub ~scope:(get_scope ty)
+ in
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty', None));
+ let desc =
+ if has_fixed_row then
+ match get_desc tm with (* PR#7348 *)
Tconstr (Pdot(m,i), tl, _abbrev) ->
let i' = String.sub i 0 (String.length i - 4) in
Tconstr(type_path s (Pdot(m,i')), tl, ref Mnil)
in
Tobject (t1', ref name')
| Tvariant row ->
- let row = row_repr row in
- let more = repr row.row_more in
+ let more = row_more row in
+ let mored = get_desc more in
(* We must substitute in a subtle way *)
(* Tsubst takes a tuple containing the row var and the variant *)
- begin match more.desc with
+ begin match mored with
Tsubst (_, Some ty2) ->
(* This variant type has been already copied *)
- Private_type_expr.set_desc ty (Tsubst (ty2, None));
- (* avoid Tlink in the new type *)
+ (* Change the stub to avoid Tlink in the new type *)
+ For_copy.redirect_desc copy_scope ty (Tsubst (ty2, None));
Tlink ty2
| _ ->
let dup =
- s.for_saving || more.level = generic_level || static_row row ||
- match more.desc with Tconstr _ -> true | _ -> false in
+ s.for_saving || get_level more = generic_level ||
+ static_row row || is_Tconstr more in
(* Various cases for the row variable *)
let more' =
- match more.desc with
+ match mored with
Tsubst (ty, None) -> ty
| Tconstr _ | Tnil -> typexp copy_scope s more
| Tunivar _ | Tvar _ ->
- For_copy.save_desc copy_scope more more.desc;
- if s.for_saving then newpersty (norm more.desc) else
- if dup && is_Tvar more then newgenty more.desc else more
+ if s.for_saving then newpersty (norm mored)
+ else if dup && is_Tvar more then newgenty mored
+ else more
| _ -> assert false
in
(* Register new type first for recursion *)
- Private_type_expr.set_desc more
+ For_copy.redirect_desc copy_scope more
(Tsubst (more', Some ty'));
(* TODO: check if more' can be eliminated *)
(* Return a new copy *)
let row =
copy_row (typexp copy_scope s) true row (not dup) more' in
- match row.row_name with
+ match row_name row with
| Some (p, tl) ->
- Tvariant {row with row_name =
- if to_subst_by_type_function s p
- then None
- else Some (type_path s p, tl)}
+ let name =
+ if to_subst_by_type_function s p then None
+ else Some (type_path s p, tl)
+ in
+ Tvariant (set_row_name row name)
| None ->
Tvariant row
end
| Tfield(_label, kind, _t1, t2) when field_kind_repr kind = Fabsent ->
Tlink (typexp copy_scope s t2)
| _ -> copy_type_desc (typexp copy_scope s) desc
- end;
+ in
+ Transient_expr.set_stub_desc ty' desc;
ty'
(*
let class_signature copy_scope s sign =
{ csig_self = typexp copy_scope s sign.csig_self;
+ csig_self_row = typexp copy_scope s sign.csig_self_row;
csig_vars =
Vars.map
- (function (m, v, t) -> (m, v, typexp copy_scope s t)) sign.csig_vars;
- csig_concr = sign.csig_concr;
- csig_inher =
- List.map
- (fun (p, tl) -> (type_path s p, List.map (typexp copy_scope s) tl))
- sign.csig_inher;
+ (function (m, v, t) -> (m, v, typexp copy_scope s t))
+ sign.csig_vars;
+ csig_meths =
+ Meths.map
+ (function (p, v, t) -> (p, v, typexp copy_scope s t))
+ sign.csig_meths;
}
let rec class_type copy_scope s = function
For_copy.with_scope
(fun copy_scope -> extension_constructor' copy_scope s ext)
+
+(* For every binding k |-> d of m1, add k |-> f d to m2
+ and return resulting merged map. *)
+
+let merge_path_maps f m1 m2 =
+ Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
+
+let keep_latest_loc l1 l2 =
+ match l2 with
+ | None -> l1
+ | Some _ -> l2
+
+let type_replacement s = function
+ | Path p -> Path (type_path s p)
+ | Type_function { params; body } ->
+ For_copy.with_scope (fun copy_scope ->
+ let params = List.map (typexp copy_scope s) params in
+ let body = typexp copy_scope s body in
+ Type_function { params; body })
+
type scoping =
| Keep
| Make_local
| Rescope of int
+module Lazy_types = struct
+
+ type module_decl =
+ {
+ mdl_type: modtype;
+ mdl_attributes: Parsetree.attributes;
+ mdl_loc: Location.t;
+ mdl_uid: Uid.t;
+ }
+
+ and modtype =
+ | MtyL_ident of Path.t
+ | MtyL_signature of signature
+ | MtyL_functor of functor_parameter * modtype
+ | MtyL_alias of Path.t
+
+ and modtype_declaration =
+ {
+ mtdl_type: modtype option;
+ mtdl_attributes: Parsetree.attributes;
+ mtdl_loc: Location.t;
+ mtdl_uid: Uid.t;
+ }
+
+ and signature' =
+ | S_eager of Types.signature
+ | S_lazy of signature_item list
+
+ and signature =
+ (scoping * t * signature', signature') Lazy_backtrack.t
+
+ and signature_item =
+ SigL_value of Ident.t * value_description * visibility
+ | SigL_type of Ident.t * type_declaration * rec_status * visibility
+ | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+ | SigL_module of
+ Ident.t * module_presence * module_decl * rec_status * visibility
+ | SigL_modtype of Ident.t * modtype_declaration * visibility
+ | SigL_class of Ident.t * class_declaration * rec_status * visibility
+ | SigL_class_type of Ident.t * class_type_declaration *
+ rec_status * visibility
+
+ and functor_parameter =
+ | Unit
+ | Named of Ident.t option * modtype
+
+end
+open Lazy_types
+
let rename_bound_idents scoping s sg =
let rename =
let open Ident in
in
let rec rename_bound_idents s sg = function
| [] -> sg, s
- | Sig_type(id, td, rs, vis) :: rest ->
+ | SigL_type(id, td, rs, vis) :: rest ->
let id' = rename id in
rename_bound_idents
(add_type id (Pident id') s)
- (Sig_type(id', td, rs, vis) :: sg)
+ (SigL_type(id', td, rs, vis) :: sg)
rest
- | Sig_module(id, pres, md, rs, vis) :: rest ->
+ | SigL_module(id, pres, md, rs, vis) :: rest ->
let id' = rename id in
rename_bound_idents
(add_module id (Pident id') s)
- (Sig_module (id', pres, md, rs, vis) :: sg)
+ (SigL_module (id', pres, md, rs, vis) :: sg)
rest
- | Sig_modtype(id, mtd, vis) :: rest ->
+ | SigL_modtype(id, mtd, vis) :: rest ->
let id' = rename id in
rename_bound_idents
(add_modtype id (Mty_ident(Pident id')) s)
- (Sig_modtype(id', mtd, vis) :: sg)
+ (SigL_modtype(id', mtd, vis) :: sg)
rest
- | Sig_class(id, cd, rs, vis) :: rest ->
+ | SigL_class(id, cd, rs, vis) :: rest ->
(* cheat and pretend they are types cf. PR#6650 *)
let id' = rename id in
rename_bound_idents
(add_type id (Pident id') s)
- (Sig_class(id', cd, rs, vis) :: sg)
+ (SigL_class(id', cd, rs, vis) :: sg)
rest
- | Sig_class_type(id, ctd, rs, vis) :: rest ->
+ | SigL_class_type(id, ctd, rs, vis) :: rest ->
(* cheat and pretend they are types cf. PR#6650 *)
let id' = rename id in
rename_bound_idents
(add_type id (Pident id') s)
- (Sig_class_type(id', ctd, rs, vis) :: sg)
+ (SigL_class_type(id', ctd, rs, vis) :: sg)
rest
- | Sig_value(id, vd, vis) :: rest ->
+ | SigL_value(id, vd, vis) :: rest ->
(* scope doesn't matter for value identifiers. *)
let id' = Ident.rename id in
- rename_bound_idents s (Sig_value(id', vd, vis) :: sg) rest
- | Sig_typext(id, ec, es, vis) :: rest ->
+ rename_bound_idents s (SigL_value(id', vd, vis) :: sg) rest
+ | SigL_typext(id, ec, es, vis) :: rest ->
let id' = rename id in
- rename_bound_idents s (Sig_typext(id',ec,es,vis) :: sg) rest
+ rename_bound_idents s (SigL_typext(id',ec,es,vis) :: sg) rest
in
rename_bound_idents s [] sg
-let rec modtype scoping s = function
- Mty_ident p as mty ->
+let rec lazy_module_decl md =
+ { mdl_type = lazy_modtype md.md_type;
+ mdl_attributes = md.md_attributes;
+ mdl_loc = md.md_loc;
+ mdl_uid = md.md_uid }
+
+and subst_lazy_module_decl scoping s md =
+ let mdl_type = subst_lazy_modtype scoping s md.mdl_type in
+ { mdl_type;
+ mdl_attributes = attrs s md.mdl_attributes;
+ mdl_loc = loc s md.mdl_loc;
+ mdl_uid = md.mdl_uid }
+
+and force_module_decl md =
+ let md_type = force_modtype md.mdl_type in
+ { md_type;
+ md_attributes = md.mdl_attributes;
+ md_loc = md.mdl_loc;
+ md_uid = md.mdl_uid }
+
+and lazy_modtype = function
+ | Mty_ident p -> MtyL_ident p
+ | Mty_signature sg ->
+ MtyL_signature (Lazy_backtrack.create_forced (S_eager sg))
+ | Mty_functor (Unit, mty) -> MtyL_functor (Unit, lazy_modtype mty)
+ | Mty_functor (Named (id, arg), res) ->
+ MtyL_functor (Named (id, lazy_modtype arg), lazy_modtype res)
+ | Mty_alias p -> MtyL_alias p
+
+and subst_lazy_modtype scoping s = function
+ | MtyL_ident p ->
begin match Path.Map.find p s.modtypes with
- | mty -> mty
+ | mty -> lazy_modtype mty
| exception Not_found ->
begin match p with
- | Pident _ -> mty
+ | Pident _ -> MtyL_ident p
| Pdot(p, n) ->
- Mty_ident(Pdot(module_path s p, n))
+ MtyL_ident(Pdot(module_path s p, n))
| Papply _ ->
fatal_error "Subst.modtype"
end
end
- | Mty_signature sg ->
- Mty_signature(signature scoping s sg)
- | 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) ->
+ | MtyL_signature sg ->
+ MtyL_signature(subst_lazy_signature scoping s sg)
+ | MtyL_functor(Unit, res) ->
+ MtyL_functor(Unit, subst_lazy_modtype scoping s res)
+ | MtyL_functor(Named (None, arg), res) ->
+ MtyL_functor(Named (None, (subst_lazy_modtype scoping s) arg),
+ subst_lazy_modtype scoping s res)
+ | MtyL_functor(Named (Some id, arg), res) ->
let id' = Ident.rename id in
- 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)
-
-and signature scoping s sg =
+ MtyL_functor(Named (Some id', (subst_lazy_modtype scoping s) arg),
+ subst_lazy_modtype scoping (add_module id (Pident id') s) res)
+ | MtyL_alias p ->
+ MtyL_alias (module_path s p)
+
+and force_modtype = function
+ | MtyL_ident p -> Mty_ident p
+ | MtyL_signature sg -> Mty_signature (force_signature sg)
+ | MtyL_functor (param, res) ->
+ let param : Types.functor_parameter =
+ match param with
+ | Unit -> Unit
+ | Named (id, mty) -> Named (id, force_modtype mty) in
+ Mty_functor (param, force_modtype res)
+ | MtyL_alias p -> Mty_alias p
+
+and lazy_modtype_decl mtd =
+ let mtdl_type = Option.map lazy_modtype mtd.mtd_type in
+ { mtdl_type;
+ mtdl_attributes = mtd.mtd_attributes;
+ mtdl_loc = mtd.mtd_loc;
+ mtdl_uid = mtd.mtd_uid }
+
+and subst_lazy_modtype_decl scoping s mtd =
+ { mtdl_type = Option.map (subst_lazy_modtype scoping s) mtd.mtdl_type;
+ mtdl_attributes = attrs s mtd.mtdl_attributes;
+ mtdl_loc = loc s mtd.mtdl_loc;
+ mtdl_uid = mtd.mtdl_uid }
+
+and force_modtype_decl mtd =
+ let mtd_type = Option.map force_modtype mtd.mtdl_type in
+ { mtd_type;
+ mtd_attributes = mtd.mtdl_attributes;
+ mtd_loc = mtd.mtdl_loc;
+ mtd_uid = mtd.mtdl_uid }
+
+and subst_lazy_signature scoping s sg =
+ match Lazy_backtrack.get_contents sg with
+ | Left (scoping', s', sg) ->
+ let scoping =
+ match scoping', scoping with
+ | sc, Keep -> sc
+ | _, (Make_local|Rescope _) -> scoping
+ in
+ let s = compose s' s in
+ Lazy_backtrack.create (scoping, s, sg)
+ | Right sg ->
+ Lazy_backtrack.create (scoping, s, sg)
+
+and force_signature sg =
+ List.map force_signature_item (force_signature_once sg)
+
+and force_signature_once sg =
+ lazy_signature' (Lazy_backtrack.force force_signature_once' sg)
+
+and lazy_signature' = function
+ | S_lazy sg -> sg
+ | S_eager sg -> List.map lazy_signature_item sg
+
+and force_signature_once' (scoping, s, sg) =
+ let sg = lazy_signature' sg in
(* Components of signature may be mutually recursive (e.g. type declarations
or class and type declarations), so first build global renaming
substitution... *)
let (sg', s') = rename_bound_idents scoping s sg in
(* ... then apply it to each signature component in turn *)
For_copy.with_scope (fun copy_scope ->
- List.rev_map (signature_item' copy_scope scoping s') sg'
+ S_lazy (List.rev_map (subst_lazy_signature_item' copy_scope scoping s') sg')
)
-
-and signature_item' copy_scope scoping s comp =
- match comp with
- Sig_value(id, d, vis) ->
- Sig_value(id, value_description' copy_scope s d, vis)
+and lazy_signature_item = function
+ | Sig_value(id, d, vis) ->
+ SigL_value(id, d, vis)
| Sig_type(id, d, rs, vis) ->
- Sig_type(id, type_declaration' copy_scope s d, rs, vis)
+ SigL_type(id, d, rs, vis)
| Sig_typext(id, ext, es, vis) ->
- Sig_typext(id, extension_constructor' copy_scope s ext, es, vis)
- | Sig_module(id, pres, d, rs, vis) ->
- Sig_module(id, pres, module_declaration scoping s d, rs, vis)
+ SigL_typext(id, ext, es, vis)
+ | Sig_module(id, res, d, rs, vis) ->
+ SigL_module(id, res, lazy_module_decl d, rs, vis)
| Sig_modtype(id, d, vis) ->
- Sig_modtype(id, modtype_declaration scoping s d, vis)
+ SigL_modtype(id, lazy_modtype_decl d, vis)
| Sig_class(id, d, rs, vis) ->
- Sig_class(id, class_declaration' copy_scope s d, rs, vis)
+ SigL_class(id, d, rs, vis)
| Sig_class_type(id, d, rs, vis) ->
- Sig_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
-
-and signature_item scoping s comp =
- For_copy.with_scope
- (fun copy_scope -> signature_item' copy_scope scoping s comp)
+ SigL_class_type(id, d, rs, vis)
-and module_declaration scoping s decl =
- {
- md_type = modtype scoping s decl.md_type;
- md_attributes = attrs s decl.md_attributes;
- md_loc = loc s decl.md_loc;
- md_uid = decl.md_uid;
- }
-
-and modtype_declaration scoping s decl =
- {
- mtd_type = Option.map (modtype scoping s) decl.mtd_type;
- mtd_attributes = attrs s decl.mtd_attributes;
- mtd_loc = loc s decl.mtd_loc;
- mtd_uid = decl.mtd_uid;
- }
-
-
-(* For every binding k |-> d of m1, add k |-> f d to m2
- and return resulting merged map. *)
-
-let merge_path_maps f m1 m2 =
- Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
-
-let keep_latest_loc l1 l2 =
- match l2 with
- | None -> l1
- | Some _ -> l2
-
-let type_replacement s = function
- | Path p -> Path (type_path s p)
- | Type_function { params; body } ->
- For_copy.with_scope (fun copy_scope ->
- let params = List.map (typexp copy_scope s) params in
- let body = typexp copy_scope s body in
- Type_function { params; body })
+and subst_lazy_signature_item' copy_scope scoping s comp =
+ match comp with
+ SigL_value(id, d, vis) ->
+ SigL_value(id, value_description' copy_scope s d, vis)
+ | SigL_type(id, d, rs, vis) ->
+ SigL_type(id, type_declaration' copy_scope s d, rs, vis)
+ | SigL_typext(id, ext, es, vis) ->
+ SigL_typext(id, extension_constructor' copy_scope s ext, es, vis)
+ | SigL_module(id, pres, d, rs, vis) ->
+ SigL_module(id, pres, subst_lazy_module_decl scoping s d, rs, vis)
+ | SigL_modtype(id, d, vis) ->
+ SigL_modtype(id, subst_lazy_modtype_decl scoping s d, vis)
+ | SigL_class(id, d, rs, vis) ->
+ SigL_class(id, class_declaration' copy_scope s d, rs, vis)
+ | SigL_class_type(id, d, rs, vis) ->
+ SigL_class_type(id, cltype_declaration' copy_scope s d, rs, vis)
+
+and force_signature_item = function
+ | SigL_value(id, vd, vis) -> Sig_value(id, vd, vis)
+ | SigL_type(id, d, rs, vis) -> Sig_type(id, d, rs, vis)
+ | SigL_typext(id, ext, es, vis) -> Sig_typext(id, ext, es, vis)
+ | SigL_module(id, pres, d, rs, vis) ->
+ Sig_module(id, pres, force_module_decl d, rs, vis)
+ | SigL_modtype(id, d, vis) ->
+ Sig_modtype (id, force_modtype_decl d, vis)
+ | SigL_class(id, d, rs, vis) -> Sig_class(id, d, rs, vis)
+ | SigL_class_type(id, d, rs, vis) -> Sig_class_type(id, d, rs, vis)
+
+and modtype scoping s t =
+ t |> lazy_modtype |> subst_lazy_modtype scoping s |> force_modtype
(* Composition of substitutions:
apply (compose s1 s2) x = apply s2 (apply s1 x) *)
-let compose s1 s2 =
+and compose s1 s2 =
+ if s1 == identity then s2 else
+ if s2 == identity then s1 else
{ types = merge_path_maps (type_replacement s2) s1.types s2.types;
modules = merge_path_maps (module_path s2) s1.modules s2.modules;
modtypes = merge_path_maps (modtype Keep s2) s1.modtypes s2.modtypes;
for_saving = s1.for_saving || s2.for_saving;
loc = keep_latest_loc s1.loc s2.loc;
}
+
+
+let subst_lazy_signature_item scoping s comp =
+ For_copy.with_scope
+ (fun copy_scope -> subst_lazy_signature_item' copy_scope scoping s comp)
+
+module Lazy = struct
+ include Lazy_types
+
+ let of_module_decl = lazy_module_decl
+ let of_modtype = lazy_modtype
+ let of_modtype_decl = lazy_modtype_decl
+ let of_signature sg = Lazy_backtrack.create_forced (S_eager sg)
+ let of_signature_items sg = Lazy_backtrack.create_forced (S_lazy sg)
+ let of_signature_item = lazy_signature_item
+
+ let module_decl = subst_lazy_module_decl
+ let modtype = subst_lazy_modtype
+ let modtype_decl = subst_lazy_modtype_decl
+ let signature = subst_lazy_signature
+ let signature_item = subst_lazy_signature_item
+
+ let force_module_decl = force_module_decl
+ let force_modtype = force_modtype
+ let force_modtype_decl = force_modtype_decl
+ let force_signature = force_signature
+ let force_signature_once = force_signature_once
+ let force_signature_item = force_signature_item
+end
+
+let signature sc s sg =
+ Lazy.(sg |> of_signature |> signature sc s |> force_signature)
+
+let signature_item sc s comp =
+ Lazy.(comp|> of_signature_item |> signature_item sc s |> force_signature_item)
+
+let modtype_declaration sc s decl =
+ Lazy.(decl |> of_modtype_decl |> modtype_decl sc s |> force_modtype_decl)
+
+let module_declaration scoping s decl =
+ Lazy.(decl |> of_module_decl |> module_decl scoping s |> force_module_decl)
(* A forward reference to be filled in ctype.ml. *)
val ctype_apply_env_empty:
(type_expr list -> type_expr -> type_expr list -> type_expr) ref
+
+
+module Lazy : sig
+ type module_decl =
+ {
+ mdl_type: modtype;
+ mdl_attributes: Parsetree.attributes;
+ mdl_loc: Location.t;
+ mdl_uid: Uid.t;
+ }
+
+ and modtype =
+ | MtyL_ident of Path.t
+ | MtyL_signature of signature
+ | MtyL_functor of functor_parameter * modtype
+ | MtyL_alias of Path.t
+
+ and modtype_declaration =
+ {
+ mtdl_type: modtype option; (* Note: abstract *)
+ mtdl_attributes: Parsetree.attributes;
+ mtdl_loc: Location.t;
+ mtdl_uid: Uid.t;
+ }
+
+ and signature
+
+ and signature_item =
+ SigL_value of Ident.t * value_description * visibility
+ | SigL_type of Ident.t * type_declaration * rec_status * visibility
+ | SigL_typext of Ident.t * extension_constructor * ext_status * visibility
+ | SigL_module of
+ Ident.t * module_presence * module_decl * rec_status * visibility
+ | SigL_modtype of Ident.t * modtype_declaration * visibility
+ | SigL_class of Ident.t * class_declaration * rec_status * visibility
+ | SigL_class_type of Ident.t * class_type_declaration *
+ rec_status * visibility
+
+ and functor_parameter =
+ | Unit
+ | Named of Ident.t option * modtype
+
+
+ val of_module_decl : Types.module_declaration -> module_decl
+ val of_modtype : Types.module_type -> modtype
+ val of_modtype_decl : Types.modtype_declaration -> modtype_declaration
+ val of_signature : Types.signature -> signature
+ val of_signature_items : signature_item list -> signature
+ val of_signature_item : Types.signature_item -> signature_item
+
+ val module_decl : scoping -> t -> module_decl -> module_decl
+ val modtype : scoping -> t -> modtype -> modtype
+ val modtype_decl : scoping -> t -> modtype_declaration -> modtype_declaration
+ val signature : scoping -> t -> signature -> signature
+ val signature_item : scoping -> t -> signature_item -> signature_item
+
+ val force_module_decl : module_decl -> Types.module_declaration
+ val force_modtype : modtype -> Types.module_type
+ val force_modtype_decl : modtype_declaration -> Types.modtype_declaration
+ val force_signature : signature -> Types.signature
+ val force_signature_once : signature -> signature_item list
+ val force_signature_item : signature_item -> Types.signature_item
+end
let extension_constructor sub {ext_kind; _} =
match ext_kind with
- | Text_decl (ctl, cto) ->
+ | Text_decl (_, ctl, cto) ->
constructor_args sub ctl;
Option.iter (sub.typ sub) cto
| Text_rebind _ -> ()
sub.expr sub exp1;
sub.expr sub exp2;
sub.expr sub exp3
- | Texp_send (exp, _, expo) ->
- sub.expr sub exp;
- Option.iter (sub.expr sub) expo
+ | Texp_send (exp, _) ->
+ sub.expr sub exp
| Texp_new _ -> ()
| Texp_instvar _ -> ()
| Texp_setinstvar (_, _, _, exp) ->sub.expr sub exp
let extension_constructor sub x =
let ext_kind =
match x.ext_kind with
- Text_decl(ctl, cto) ->
- Text_decl(constructor_args sub ctl, Option.map (sub.typ sub) cto)
+ Text_decl(v, ctl, cto) ->
+ Text_decl(v, constructor_args sub ctl, Option.map (sub.typ sub) cto)
| Text_rebind _ as d -> d
in
{x with ext_kind}
dir,
sub.expr sub exp3
)
- | Texp_send (exp, meth, expo) ->
+ | Texp_send (exp, meth) ->
Texp_send
(
sub.expr sub exp,
- meth,
- Option.map (sub.expr sub) expo
+ meth
)
| Texp_new _
| Texp_instvar _ as d -> d
req: 'a Typedtree.class_infos;
}
-type class_env = { val_env : Env.t; met_env : Env.t; par_env : Env.t }
+type kind =
+ | Object
+ | Class
+ | Class_type
+
+type final =
+ | Final
+ | Not_final
+
+let kind_of_final = function
+ | Final -> Object
+ | Not_final -> Class
type error =
- | Unconsistent_constraint of Errortrace.unification Errortrace.t
- | Field_type_mismatch of string * string * Errortrace.unification Errortrace.t
+ | Unconsistent_constraint of Errortrace.unification_error
+ | Field_type_mismatch of string * string * Errortrace.unification_error
+ | Unexpected_field of type_expr * string
| Structure_expected of class_type
| Cannot_apply of class_type
| Apply_wrong_label of arg_label
| Unbound_class_2 of Longident.t
| Unbound_class_type_2 of Longident.t
| Abbrev_type_clash of type_expr * type_expr * type_expr
- | Constructor_type_mismatch of string * Errortrace.unification Errortrace.t
- | Virtual_class of bool * bool * string list * string list
+ | Constructor_type_mismatch of string * Errortrace.unification_error
+ | Virtual_class of kind * string list * string list
+ | Undeclared_methods of kind * string list
| Parameter_arity_mismatch of Longident.t * int * int
- | Parameter_mismatch of Errortrace.unification Errortrace.t
+ | Parameter_mismatch of Errortrace.unification_error
| Bad_parameters of Ident.t * type_expr * type_expr
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
- | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+ | Unbound_type_var of
+ (formatter -> unit) * (type_expr * bool * string * type_expr)
| Non_generalizable_class of Ident.t * Types.class_declaration
| Cannot_coerce_self of type_expr
| Non_collapsable_conjunction of
- Ident.t * Types.class_declaration * Errortrace.unification Errortrace.t
- | Final_self_clash of Errortrace.unification Errortrace.t
+ Ident.t * Types.class_declaration * Errortrace.unification_error
+ | Self_clash of Errortrace.unification_error
| Mutability_mismatch of string * mutable_flag
| No_overriding of string * string
| Duplicate of string * string
- | Closing_self_type of type_expr
+ | Closing_self_type of class_signature
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
{ ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env;
ctyp_attributes = [] }
- (**********************)
- (* Useful constants *)
- (**********************)
-
-
-(*
- Self type have a dummy private method, thus preventing it to become
- closed.
-*)
-let dummy_method = Btype.dummy_method
-
(*
Path associated to the temporary class type of a class being typed
(its constructor is not available).
(* Some operations on class types *)
(************************************)
+let extract_constraints cty =
+ let sign = Btype.signature_of_class_type cty in
+ (Btype.instance_vars sign,
+ Btype.methods sign,
+ Btype.concrete_methods sign)
-(* Fully expand the head of a class type *)
-let rec scrape_class_type =
- function
- Cty_constr (_, _, cty) -> scrape_class_type cty
- | cty -> cty
-
-(* Generalize a class type *)
-let rec generalize_class_type gen =
- function
- Cty_constr (_, params, cty) ->
- List.iter gen params;
- generalize_class_type gen cty
- | Cty_signature {csig_self = sty; csig_vars = vars; csig_inher = inher} ->
- gen sty;
- Vars.iter (fun _ (_, _, ty) -> gen ty) vars;
- List.iter (fun (_,tl) -> List.iter gen tl) inher
- | Cty_arrow (_, ty, cty) ->
- gen ty;
- generalize_class_type gen cty
-
-let generalize_class_type vars =
- let gen = if vars then Ctype.generalize else Ctype.generalize_structure in
- generalize_class_type gen
-
-(* Return the virtual methods of a class type *)
-let virtual_methods sign =
- let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields sign.Types.csig_self)
+(* Record a class type *)
+let rc node =
+ Cmt_format.add_saved_type (Cmt_format.Partial_class_expr node);
+ node
+
+let update_class_signature loc env ~warn_implicit_public virt kind sign =
+ let implicit_public, implicit_declared =
+ Ctype.update_class_signature env sign
in
- List.fold_left
- (fun virt (lab, _, _) ->
- if lab = dummy_method then virt else
- if Concr.mem lab sign.csig_concr then virt else
- lab::virt)
- [] fields
+ if implicit_declared <> [] then begin
+ match virt with
+ | Virtual -> () (* Should perhaps emit warning 17 here *)
+ | Concrete ->
+ raise (Error(loc, env, Undeclared_methods(kind, implicit_declared)))
+ end;
+ if warn_implicit_public && implicit_public <> [] then begin
+ Location.prerr_warning
+ loc (Warnings.Implicit_public_methods implicit_public)
+ end
+
+let complete_class_signature loc env virt kind sign =
+ update_class_signature loc env ~warn_implicit_public:false virt kind sign;
+ Ctype.hide_private_methods env sign
+
+let complete_class_type loc env virt kind typ =
+ let sign = Btype.signature_of_class_type typ in
+ complete_class_signature loc env virt kind sign
+
+let check_virtual loc env virt kind sign =
+ match virt with
+ | Virtual -> ()
+ | Concrete ->
+ match Btype.virtual_methods sign, Btype.virtual_instance_vars sign with
+ | [], [] -> ()
+ | meths, vars ->
+ raise(Error(loc, env, Virtual_class(kind, meths, vars)))
(* Return the constructor type associated to a class type *)
let rec constructor_type constr cty =
| Cty_signature _ ->
constr
| Cty_arrow (l, ty, cty) ->
- Ctype.newty (Tarrow (l, ty, constructor_type constr cty, Cok))
-
-let rec class_body cty =
- match cty with
- Cty_constr _ ->
- cty (* Only class bodies can be abbreviated *)
- | Cty_signature _ ->
- cty
- | Cty_arrow (_, _, cty) ->
- class_body cty
-
-let extract_constraints cty =
- let sign = Ctype.signature_of_class_type cty in
- (Vars.fold (fun lab _ vars -> lab :: vars) sign.csig_vars [],
- begin let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields sign.csig_self)
- in
- List.fold_left
- (fun meths (lab, _, _) ->
- if lab = dummy_method then meths else lab::meths)
- [] fields
- end,
- sign.csig_concr)
-
-let rec abbreviate_class_type path params cty =
- match cty with
- Cty_constr (_, _, _) | Cty_signature _ ->
- Cty_constr (path, params, cty)
- | Cty_arrow (l, ty, cty) ->
- Cty_arrow (l, ty, abbreviate_class_type path params cty)
-
-(* Check that all type variables are generalizable *)
-(* Use Env.empty to prevent expansion of recursively defined object types;
- cf. typing-poly/poly.ml *)
-let rec closed_class_type =
- function
- Cty_constr (_, params, _) ->
- List.for_all (Ctype.closed_schema Env.empty) params
- | Cty_signature sign ->
- Ctype.closed_schema Env.empty sign.csig_self
- &&
- Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema Env.empty ty && cc)
- sign.csig_vars
- true
- | Cty_arrow (_, ty, cty) ->
- Ctype.closed_schema Env.empty ty
- &&
- closed_class_type cty
-
-let closed_class cty =
- List.for_all (Ctype.closed_schema Env.empty) cty.cty_params
- &&
- closed_class_type cty.cty_type
-
-let rec limited_generalize rv =
- function
- Cty_constr (_path, params, cty) ->
- List.iter (Ctype.limited_generalize rv) params;
- limited_generalize rv cty
- | Cty_signature sign ->
- Ctype.limited_generalize rv sign.csig_self;
- Vars.iter (fun _ (_, _, ty) -> Ctype.limited_generalize rv ty)
- sign.csig_vars;
- List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
- sign.csig_inher
- | Cty_arrow (_, ty, cty) ->
- Ctype.limited_generalize rv ty;
- limited_generalize rv cty
-
-(* Record a class type *)
-let rc node =
- Cmt_format.add_saved_type (Cmt_format.Partial_class_expr node);
- node
-
+ Ctype.newty (Tarrow (l, ty, constructor_type constr cty, commu_ok))
(***********************************)
(* Primitives for typing classes *)
(***********************************)
-
-(* Enter a value in the method environment only *)
-let enter_met_env ?check loc lab kind unbound_kind ty class_env =
- let {val_env; met_env; par_env} = class_env in
- 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;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()); } met_env
- in
- let class_env = {val_env; met_env; par_env} in
- (id,class_env )
-
-(* Enter an instance variable in the environment *)
-let enter_val cl_num vars inh lab mut virt ty class_env loc =
- let val_env = class_env.val_env in
- let (id, virt) =
- try
- let (id, mut', virt', ty') = Vars.find lab !vars in
- if mut' <> mut then
- raise (Error(loc, val_env, Mutability_mismatch(lab, mut)));
- Ctype.unify val_env (Ctype.instance ty) (Ctype.instance ty');
- (if not inh then Some id else None),
- (if virt' = Concrete then virt' else virt)
- with
- Ctype.Unify tr ->
- raise (Error(loc, val_env,
- Field_type_mismatch("instance variable", lab, tr)))
- | Not_found -> None, virt
- in
- let (id, _) as result =
- match id with Some id -> (id, class_env)
- | None ->
- enter_met_env Location.none lab (Val_ivar (mut, cl_num))
- Val_unbound_instance_variable ty class_env
+let raise_add_method_failure loc env label sign failure =
+ match (failure : Ctype.add_method_failure) with
+ | Ctype.Unexpected_method ->
+ raise(Error(loc, env, Unexpected_field (sign.Types.csig_self, label)))
+ | Ctype.Type_mismatch trace ->
+ raise(Error(loc, env, Field_type_mismatch ("method", label, trace)))
+
+let raise_add_instance_variable_failure loc env label failure =
+ match (failure : Ctype.add_instance_variable_failure) with
+ | Ctype.Mutability_mismatch mut ->
+ raise (Error(loc, env, Mutability_mismatch(label, mut)))
+ | Ctype.Type_mismatch trace ->
+ raise (Error(loc, env,
+ Field_type_mismatch("instance variable", label, trace)))
+
+let raise_inherit_class_signature_failure loc env sign = function
+ | Ctype.Self_type_mismatch trace ->
+ raise(Error(loc, env, Self_clash trace))
+ | Ctype.Method(label, failure) ->
+ raise_add_method_failure loc env label sign failure
+ | Ctype.Instance_variable(label, failure) ->
+ raise_add_instance_variable_failure loc env label failure
+
+let add_method loc env label priv virt ty sign =
+ match Ctype.add_method env label priv virt ty sign with
+ | () -> ()
+ | exception Ctype.Add_method_failed failure ->
+ raise_add_method_failure loc env label sign failure
+
+let add_instance_variable ~strict loc env label mut virt ty sign =
+ match Ctype.add_instance_variable ~strict env label mut virt ty sign with
+ | () -> ()
+ | exception Ctype.Add_instance_variable_failed failure ->
+ raise_add_instance_variable_failure loc env label failure
+
+let inherit_class_signature ~strict loc env sign1 sign2 =
+ match Ctype.inherit_class_signature ~strict env sign1 sign2 with
+ | () -> ()
+ | exception Ctype.Inherit_class_signature_failed failure ->
+ raise_inherit_class_signature_failure loc env sign1 failure
+
+let inherit_class_type ~strict loc env sign1 cty2 =
+ let sign2 =
+ match Btype.scrape_class_type cty2 with
+ | Cty_signature sign2 -> sign2
+ | _ ->
+ raise(Error(loc, env, Structure_expected cty2))
in
- vars := Vars.add lab (id, mut, virt, ty) !vars;
- result
-
-let concr_vals vars =
- Vars.fold
- (fun id (_, vf, _) s -> if vf = Virtual then s else Concr.add id s)
- vars Concr.empty
-
-let inheritance self_type env ovf concr_meths warn_vals loc parent =
- match scrape_class_type parent with
- Cty_signature cl_sig ->
-
- (* Methods *)
- begin try
- Ctype.unify env self_type cl_sig.csig_self
- with Ctype.Unify trace ->
- match trace with
- | Diff _ :: Incompatible_fields {name = n; _ } :: rem ->
- raise(Error(loc, env, Field_type_mismatch ("method", n, rem)))
- | _ -> assert false
- end;
-
- (* Overriding *)
- let over_meths = Concr.inter cl_sig.csig_concr concr_meths in
- let concr_vals = concr_vals cl_sig.csig_vars in
- let over_vals = Concr.inter concr_vals warn_vals in
- begin match ovf with
- Some Fresh ->
- let cname =
- match parent with
- Cty_constr (p, _, _) -> Path.name p
- | _ -> "inherited"
- in
- if not (Concr.is_empty over_meths) then
- Location.prerr_warning loc
- (Warnings.Method_override (cname :: Concr.elements over_meths));
- if not (Concr.is_empty over_vals) then
- Location.prerr_warning loc
- (Warnings.Instance_variable_override
- (cname :: Concr.elements over_vals));
- | Some Override
- when Concr.is_empty over_meths && Concr.is_empty over_vals ->
- raise (Error(loc, env, No_overriding ("","")))
- | _ -> ()
- end;
-
- let concr_meths = Concr.union cl_sig.csig_concr concr_meths
- and warn_vals = Concr.union concr_vals warn_vals in
-
- (cl_sig, concr_meths, warn_vals)
+ inherit_class_signature ~strict loc env sign1 sign2
- | _ ->
- raise(Error(loc, env, Structure_expected parent))
-
-let virtual_method val_env meths self_type lab priv sty loc =
- let (_, ty') =
- Ctype.filter_self_method val_env lab priv meths self_type
- in
- let sty = Ast_helper.Typ.force_poly sty in
- let cty = transl_simple_type val_env false sty in
- let ty = cty.ctyp_type in
- begin
- try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
- raise(Error(loc, val_env, Field_type_mismatch ("method", lab, trace)));
- end;
- cty
-
-let delayed_meth_specs = ref []
-
-let declare_method val_env meths self_type lab priv sty loc =
- let (_, ty') =
- Ctype.filter_self_method val_env lab priv meths self_type
- in
- let unif ty =
- try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
- raise(Error(loc, val_env, Field_type_mismatch ("method", lab, trace)))
- in
- let sty = Ast_helper.Typ.force_poly sty in
- match sty.ptyp_desc, priv with
- Ptyp_poly ([],sty'), Public ->
-(* TODO: we moved the [transl_simple_type_univars] outside of the lazy,
-so that we can get an immediate value. Is that correct ? Ask Jacques. *)
- let returned_cty = ctyp Ttyp_any (Ctype.newty Tnil) val_env loc in
- delayed_meth_specs :=
- Warnings.mk_lazy (fun () ->
- let cty = transl_simple_type_univars val_env sty' in
- let ty = cty.ctyp_type in
- unif ty;
- returned_cty.ctyp_desc <- Ttyp_poly ([], cty);
- returned_cty.ctyp_type <- ty;
- ) ::
- !delayed_meth_specs;
- returned_cty
- | _ ->
- let cty = transl_simple_type val_env false sty in
- let ty = cty.ctyp_type in
- unif ty;
- cty
+let unify_delayed_method_type loc env label ty expected_ty=
+ match Ctype.unify env ty expected_ty with
+ | () -> ()
+ | exception Ctype.Unify trace ->
+ raise(Error(loc, env, Field_type_mismatch ("method", label, trace)))
let type_constraint val_env sty sty' loc =
let cty = transl_simple_type val_env false sty in
let cty' = transl_simple_type val_env false sty' in
let ty' = cty'.ctyp_type in
begin
- try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
- raise(Error(loc, val_env, Unconsistent_constraint trace));
+ try Ctype.unify val_env ty ty' with Ctype.Unify err ->
+ raise(Error(loc, val_env, Unconsistent_constraint err));
end;
(cty, cty')
(*******************************)
-let add_val lab (mut, virt, ty) val_sig =
- let virt =
- try
- let (_mut', virt', _ty') = Vars.find lab val_sig in
- if virt' = Concrete then virt' else virt
- with Not_found -> virt
- in
- Vars.add lab (mut, virt, ty) val_sig
-
-let rec class_type_field env self_type meths arg ctf =
- Builtin_attributes.warning_scope ctf.pctf_attributes
- (fun () -> class_type_field_aux env self_type meths arg ctf)
-
-and class_type_field_aux env self_type meths
- (fields, val_sig, concr_meths, inher) ctf =
+let delayed_meth_specs = ref []
+let rec class_type_field env sign self_scope ctf =
let loc = ctf.pctf_loc in
let mkctf desc =
{ ctf_desc = desc; ctf_loc = loc; ctf_attributes = ctf.pctf_attributes }
in
+ let mkctf_with_attrs f =
+ Builtin_attributes.warning_scope ctf.pctf_attributes
+ (fun () -> mkctf (f ()))
+ in
match ctf.pctf_desc with
- Pctf_inherit sparent ->
- let parent = class_type env sparent in
- let inher =
- match parent.cltyp_type with
- Cty_constr (p, tl, _) -> (p, tl) :: inher
- | _ -> inher
- in
- let (cl_sig, concr_meths, _) =
- inheritance self_type env None concr_meths Concr.empty sparent.pcty_loc
- parent.cltyp_type
- in
- let val_sig =
- Vars.fold add_val cl_sig.csig_vars val_sig in
- (mkctf (Tctf_inherit parent) :: fields,
- val_sig, concr_meths, inher)
-
+ | Pctf_inherit sparent ->
+ mkctf_with_attrs
+ (fun () ->
+ let parent = class_type env Virtual self_scope sparent in
+ complete_class_type parent.cltyp_loc
+ env Virtual Class_type parent.cltyp_type;
+ inherit_class_type ~strict:false loc env sign parent.cltyp_type;
+ Tctf_inherit parent)
| Pctf_val ({txt=lab}, mut, virt, sty) ->
- let cty = transl_simple_type env false sty in
- let ty = cty.ctyp_type in
- (mkctf (Tctf_val (lab, mut, virt, cty)) :: fields,
- add_val lab (mut, virt, ty) val_sig, concr_meths, inher)
+ mkctf_with_attrs
+ (fun () ->
+ let cty = transl_simple_type env false sty in
+ let ty = cty.ctyp_type in
+ add_instance_variable ~strict:false loc env lab mut virt ty sign;
+ Tctf_val (lab, mut, virt, cty))
| Pctf_method ({txt=lab}, priv, virt, sty) ->
- let cty =
- declare_method env meths self_type lab priv sty ctf.pctf_loc in
- let concr_meths =
- match virt with
- | Concrete -> Concr.add lab concr_meths
- | Virtual -> concr_meths
- in
- (mkctf (Tctf_method (lab, priv, virt, cty)) :: fields,
- val_sig, concr_meths, inher)
+ mkctf_with_attrs
+ (fun () ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ match sty.ptyp_desc, priv with
+ | Ptyp_poly ([],sty'), Public ->
+ let expected_ty = Ctype.newvar () in
+ add_method loc env lab priv virt expected_ty sign;
+ let returned_cty = ctyp Ttyp_any (Ctype.newty Tnil) env loc in
+ delayed_meth_specs :=
+ Warnings.mk_lazy (fun () ->
+ let cty = transl_simple_type_univars env sty' in
+ let ty = cty.ctyp_type in
+ unify_delayed_method_type loc env lab ty expected_ty;
+ returned_cty.ctyp_desc <- Ttyp_poly ([], cty);
+ returned_cty.ctyp_type <- ty;
+ ) :: !delayed_meth_specs;
+ Tctf_method (lab, priv, virt, returned_cty)
+ | _ ->
+ let cty = transl_simple_type env false sty in
+ let ty = cty.ctyp_type in
+ add_method loc env lab priv virt ty sign;
+ Tctf_method (lab, priv, virt, cty))
| Pctf_constraint (sty, sty') ->
- let (cty, cty') = type_constraint env sty sty' ctf.pctf_loc in
- (mkctf (Tctf_constraint (cty, cty')) :: fields,
- val_sig, concr_meths, inher)
+ mkctf_with_attrs
+ (fun () ->
+ let (cty, cty') = type_constraint env sty sty' ctf.pctf_loc in
+ Tctf_constraint (cty, cty'))
| Pctf_attribute x ->
Builtin_attributes.warning_attribute x;
- (mkctf (Tctf_attribute x) :: fields,
- val_sig, concr_meths, inher)
+ mkctf (Tctf_attribute x)
| Pctf_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
-and class_signature env {pcsig_self=sty; pcsig_fields=sign} =
- let meths = ref Meths.empty in
+and class_signature virt env pcsig self_scope loc =
+ let {pcsig_self=sty; pcsig_fields=psign} = pcsig in
+ let sign = Ctype.new_class_signature () in
+ (* Introduce a dummy method preventing self type from being closed. *)
+ Ctype.add_dummy_method env ~scope:self_scope sign;
+
let self_cty = transl_simple_type env false sty in
- let self_cty = { self_cty with
- ctyp_type = Ctype.expand_head env self_cty.ctyp_type } in
- let self_type = self_cty.ctyp_type in
-
- (* Check that the binder is a correct type, and introduce a dummy
- method preventing self type from being closed. *)
- let dummy_obj = Ctype.newvar () in
- Ctype.unify env (Ctype.filter_method env dummy_method Private dummy_obj)
- (Ctype.newty (Ttuple []));
+ let self_type = self_cty.ctyp_type in
begin try
- Ctype.unify env self_type dummy_obj
+ Ctype.unify env self_type sign.csig_self
with Ctype.Unify _ ->
raise(Error(sty.ptyp_loc, env, Pattern_type_clash self_type))
end;
(* Class type fields *)
- let (rev_fields, val_sig, concr_meths, inher) =
+ let fields =
Builtin_attributes.warning_scope []
- (fun () ->
- List.fold_left (class_type_field env self_type meths)
- ([], Vars.empty, Concr.empty, [])
- sign
- )
- in
- let cty = {csig_self = self_type;
- csig_vars = val_sig;
- csig_concr = concr_meths;
- csig_inher = inher}
+ (fun () -> List.map (class_type_field env sign self_scope) psign)
in
+ check_virtual loc env virt Class_type sign;
{ csig_self = self_cty;
- csig_fields = List.rev rev_fields;
- csig_type = cty;
- }
+ csig_fields = fields;
+ csig_type = sign; }
-and class_type env scty =
+and class_type env virt self_scope scty =
Builtin_attributes.warning_scope scty.pcty_attributes
- (fun () -> class_type_aux env scty)
+ (fun () -> class_type_aux env virt self_scope scty)
-and class_type_aux env scty =
+and class_type_aux env virt self_scope scty =
let cltyp desc typ =
{
cltyp_desc = desc;
}
in
match scty.pcty_desc with
- Pcty_constr (lid, styl) ->
+ | Pcty_constr (lid, styl) ->
let (path, decl) = Env.lookup_cltype ~loc:scty.pcty_loc lid.txt env in
if Path.same decl.clty_path unbound_class then
raise(Error(scty.pcty_loc, env, Unbound_class_type_2 lid.txt));
let (params, clty) =
Ctype.instance_class decl.clty_params decl.clty_type
in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method env ~scope:self_scope
+ (Btype.signature_of_class_type clty);
if List.length params <> List.length styl then
raise(Error(scty.pcty_loc, env,
Parameter_arity_mismatch (lid.txt, List.length params,
let cty' = transl_simple_type env false sty in
let ty' = cty'.ctyp_type in
begin
- try Ctype.unify env ty' ty with Ctype.Unify trace ->
- raise(Error(sty.ptyp_loc, env, Parameter_mismatch trace))
+ try Ctype.unify env ty' ty with Ctype.Unify err ->
+ raise(Error(sty.ptyp_loc, env, Parameter_mismatch err))
end;
cty'
) styl params
cltyp (Tcty_constr ( path, lid , ctys)) typ
| Pcty_signature pcsig ->
- let clsig = class_signature env pcsig in
+ let clsig = class_signature virt env pcsig self_scope scty.pcty_loc in
let typ = Cty_signature clsig.csig_type in
cltyp (Tcty_signature clsig) typ
if Btype.is_optional l
then Ctype.newty (Tconstr(Predef.path_option,[ty], ref Mnil))
else ty in
- let clty = class_type env scty in
+ let clty = class_type env virt self_scope scty in
let typ = Cty_arrow (l, ty, clty.cltyp_type) in
cltyp (Tcty_arrow (l, cty, clty)) typ
| Pcty_open (od, e) ->
let (od, newenv) = !type_open_descr env od in
- let clty = class_type newenv e in
+ let clty = class_type newenv virt self_scope e in
cltyp (Tcty_open (od, clty)) clty.cltyp_type
| Pcty_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
-let class_type env scty =
+let class_type env virt self_scope scty =
delayed_meth_specs := [];
- let cty = class_type env scty in
+ let cty = class_type env virt self_scope scty in
List.iter Lazy.force (List.rev !delayed_meth_specs);
delayed_meth_specs := [];
cty
(*******************************)
-let rec class_field self_loc cl_num self_type meths vars arg cf =
- Builtin_attributes.warning_scope cf.pcf_attributes
- (fun () -> class_field_aux self_loc cl_num self_type meths vars arg cf)
+let enter_ancestor_val name val_env =
+ Env.enter_unbound_value name Val_unbound_ancestor val_env
-and class_field_aux self_loc cl_num self_type meths vars
- (class_env, fields, concr_meths, warn_vals, inher,
- local_meths, local_vals) cf =
- let loc = cf.pcf_loc in
- let mkcf desc =
- { cf_desc = desc; cf_loc = loc; cf_attributes = cf.pcf_attributes }
+let enter_self_val name val_env =
+ Env.enter_unbound_value name Val_unbound_self val_env
+
+let enter_instance_var_val name val_env =
+ Env.enter_unbound_value name Val_unbound_instance_variable val_env
+
+let enter_ancestor_met ~loc name ~sign ~meths ~cl_num ~ty ~attrs met_env =
+ let check s = Warnings.Unused_ancestor s in
+ let kind = Val_anc (sign, meths, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
in
- let {val_env; met_env; par_env} = class_env in
+ Env.enter_value ~check name desc met_env
+
+let add_self_met loc id sign self_var_kind vars cl_num
+ as_var ty attrs met_env =
+ let check =
+ if as_var then (fun s -> Warnings.Unused_var s)
+ else (fun s -> Warnings.Unused_var_strict s)
+ in
+ let kind = Val_self (sign, self_var_kind, vars, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ in
+ Env.add_value ~check id desc met_env
+
+let add_instance_var_met loc label id sign cl_num attrs met_env =
+ let mut, ty =
+ match Vars.find label sign.csig_vars with
+ | (mut, _, ty) -> mut, ty
+ | exception Not_found -> assert false
+ in
+ let kind = Val_ivar (mut, cl_num) in
+ let desc =
+ { val_type = ty; val_kind = kind;
+ val_attributes = attrs;
+ Types.val_loc = loc;
+ val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ in
+ Env.add_value id desc met_env
+
+let add_instance_vars_met loc vars sign cl_num met_env =
+ List.fold_left
+ (fun met_env (label, id) ->
+ add_instance_var_met loc label id sign cl_num [] met_env)
+ met_env vars
+
+type intermediate_class_field =
+ | Inherit of
+ { override : override_flag;
+ parent : class_expr;
+ super : string option;
+ inherited_vars : (string * Ident.t) list;
+ super_meths : (string * Ident.t) list;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Virtual_val of
+ { label : string loc;
+ mut : mutable_flag;
+ id : Ident.t;
+ cty : core_type;
+ already_declared : bool;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Concrete_val of
+ { label : string loc;
+ mut : mutable_flag;
+ id : Ident.t;
+ override : override_flag;
+ definition : expression;
+ already_declared : bool;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Virtual_method of
+ { label : string loc;
+ priv : private_flag;
+ cty : core_type;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Concrete_method of
+ { label : string loc;
+ priv : private_flag;
+ override : override_flag;
+ sdefinition : Parsetree.expression;
+ warning_state : Warnings.state;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Constraint of
+ { cty1 : core_type;
+ cty2 : core_type;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Initializer of
+ { sexpr : Parsetree.expression;
+ warning_state : Warnings.state;
+ loc : Location.t;
+ attributes : attribute list; }
+ | Attribute of
+ { attribute : attribute;
+ loc : Location.t;
+ attributes : attribute list; }
+
+type first_pass_accummulater =
+ { rev_fields : intermediate_class_field list;
+ val_env : Env.t;
+ par_env : Env.t;
+ concrete_meths : MethSet.t;
+ concrete_vals : VarSet.t;
+ local_meths : MethSet.t;
+ local_vals : VarSet.t;
+ vars : Ident.t Vars.t;
+ meths : Ident.t Meths.t; }
+
+let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
+ let { rev_fields; val_env; par_env; concrete_meths; concrete_vals;
+ local_meths; local_vals; vars; meths } = acc
+ in
+ let loc = cf.pcf_loc in
+ let attributes = cf.pcf_attributes in
+ let with_attrs f = Builtin_attributes.warning_scope attributes f in
match cf.pcf_desc with
- Pcf_inherit (ovf, sparent, super) ->
- let parent = class_expr cl_num val_env par_env sparent in
- let inher =
- match parent.cl_type with
- Cty_constr (p, tl, _) -> (p, tl) :: inher
- | _ -> inher
- in
- let (cl_sig, concr_meths, warn_vals) =
- inheritance self_type val_env (Some ovf) concr_meths warn_vals
- sparent.pcl_loc parent.cl_type
- in
- (* Variables *)
- let (class_env, inh_vars) =
- Vars.fold
- (fun lab info (class_env, inh_vars) ->
- let mut, vr, ty = info in
- let (id, class_env) =
- enter_val cl_num vars true lab mut vr ty class_env
- sparent.pcl_loc ;
- in
- (class_env, (lab, id) :: inh_vars))
- cl_sig.csig_vars (class_env, [])
- in
- (* Inherited concrete methods *)
- let inh_meths =
- Concr.fold (fun lab rem -> (lab, Ident.create_local lab)::rem)
- cl_sig.csig_concr []
+ | Pcf_inherit (override, sparent, super) ->
+ with_attrs
+ (fun () ->
+ let parent =
+ class_expr cl_num val_env par_env
+ Virtual self_scope sparent
+ in
+ complete_class_type parent.cl_loc
+ par_env Virtual Class parent.cl_type;
+ inherit_class_type ~strict:true loc val_env sign parent.cl_type;
+ let parent_sign = Btype.signature_of_class_type parent.cl_type in
+ let new_concrete_meths = Btype.concrete_methods parent_sign in
+ let new_concrete_vals = Btype.concrete_instance_vars parent_sign in
+ let over_meths = MethSet.inter new_concrete_meths concrete_meths in
+ let over_vals = VarSet.inter new_concrete_vals concrete_vals in
+ begin match override with
+ | Fresh ->
+ let cname =
+ match parent.cl_type with
+ | Cty_constr (p, _, _) -> Path.name p
+ | _ -> "inherited"
+ in
+ if not (MethSet.is_empty over_meths) then
+ Location.prerr_warning loc
+ (Warnings.Method_override
+ (cname :: MethSet.elements over_meths));
+ if not (VarSet.is_empty over_vals) then
+ Location.prerr_warning loc
+ (Warnings.Instance_variable_override
+ (cname :: VarSet.elements over_vals));
+ | Override ->
+ if MethSet.is_empty over_meths && VarSet.is_empty over_vals then
+ raise (Error(loc, val_env, No_overriding ("","")))
+ end;
+ let concrete_vals = VarSet.union new_concrete_vals concrete_vals in
+ let concrete_meths =
+ MethSet.union new_concrete_meths concrete_meths
+ in
+ let val_env, par_env, inherited_vars, vars =
+ Vars.fold
+ (fun label _ (val_env, par_env, inherited_vars, vars) ->
+ let val_env = enter_instance_var_val label val_env in
+ let par_env = enter_instance_var_val label par_env in
+ let id = Ident.create_local label in
+ let inherited_vars = (label, id) :: inherited_vars in
+ let vars = Vars.add label id vars in
+ (val_env, par_env, inherited_vars, vars))
+ parent_sign.csig_vars (val_env, par_env, [], vars)
+ in
+ let meths =
+ Meths.fold
+ (fun label _ meths ->
+ if Meths.mem label meths then meths
+ else Meths.add label (Ident.create_local label) meths)
+ parent_sign.csig_meths meths
+ in
+ (* Methods available through super *)
+ let super_meths =
+ MethSet.fold
+ (fun label acc -> (label, Ident.create_local label) :: acc)
+ new_concrete_meths []
+ in
+ (* Super *)
+ let (val_env, par_env, super) =
+ match super with
+ | None -> (val_env, par_env, None)
+ | Some {txt=name} ->
+ let val_env = enter_ancestor_val name val_env in
+ let par_env = enter_ancestor_val name par_env in
+ (val_env, par_env, Some name)
+ in
+ let field =
+ Inherit
+ { override; parent; super; inherited_vars;
+ super_meths; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields; val_env; par_env;
+ concrete_meths; concrete_vals; vars; meths })
+ | Pcf_val (label, mut, Cfk_virtual styp) ->
+ with_attrs
+ (fun () ->
+ if !Clflags.principal then Ctype.begin_def ();
+ let cty = Typetexp.transl_simple_type val_env false styp in
+ let ty = cty.ctyp_type in
+ if !Clflags.principal then begin
+ Ctype.end_def ();
+ Ctype.generalize_structure ty
+ end;
+ add_instance_variable ~strict:true loc val_env
+ label.txt mut Virtual ty sign;
+ let already_declared, val_env, par_env, id, vars =
+ match Vars.find label.txt vars with
+ | id -> true, val_env, par_env, id, vars
+ | exception Not_found ->
+ let name = label.txt in
+ let val_env = enter_instance_var_val name val_env in
+ let par_env = enter_instance_var_val name par_env in
+ let id = Ident.create_local name in
+ let vars = Vars.add label.txt id vars in
+ false, val_env, par_env, id, vars
+ in
+ let field =
+ Virtual_val
+ { label; mut; id; cty; already_declared; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields; val_env; par_env; vars })
+ | Pcf_val (label, mut, Cfk_concrete (override, sdefinition)) ->
+ with_attrs
+ (fun () ->
+ if VarSet.mem label.txt local_vals then
+ raise(Error(loc, val_env,
+ Duplicate ("instance variable", label.txt)));
+ if VarSet.mem label.txt concrete_vals then begin
+ if override = Fresh then
+ Location.prerr_warning label.loc
+ (Warnings.Instance_variable_override[label.txt])
+ end else begin
+ if override = Override then
+ raise(Error(loc, val_env,
+ No_overriding ("instance variable", label.txt)))
+ end;
+ if !Clflags.principal then Ctype.begin_def ();
+ let definition = type_exp val_env sdefinition in
+ if !Clflags.principal then begin
+ Ctype.end_def ();
+ Ctype.generalize_structure definition.exp_type
+ end;
+ add_instance_variable ~strict:true loc val_env
+ label.txt mut Concrete definition.exp_type sign;
+ let already_declared, val_env, par_env, id, vars =
+ match Vars.find label.txt vars with
+ | id -> true, val_env, par_env, id, vars
+ | exception Not_found ->
+ let name = label.txt in
+ let val_env = enter_instance_var_val name val_env in
+ let par_env = enter_instance_var_val name par_env in
+ let id = Ident.create_local name in
+ let vars = Vars.add label.txt id vars in
+ false, val_env, par_env, id, vars
+ in
+ let field =
+ Concrete_val
+ { label; mut; id; override; definition;
+ already_declared; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ let concrete_vals = VarSet.add label.txt concrete_vals in
+ let local_vals = VarSet.add label.txt local_vals in
+ { acc with rev_fields; val_env; par_env;
+ concrete_vals; local_vals; vars })
+
+ | Pcf_method (label, priv, Cfk_virtual sty) ->
+ with_attrs
+ (fun () ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ let cty = transl_simple_type val_env false sty in
+ let ty = cty.ctyp_type in
+ add_method loc val_env label.txt priv Virtual ty sign;
+ let meths =
+ if Meths.mem label.txt meths then meths
+ else Meths.add label.txt (Ident.create_local label.txt) meths
+ in
+ let field =
+ Virtual_method { label; priv; cty; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields; meths })
+
+ | Pcf_method (label, priv, Cfk_concrete (override, expr)) ->
+ with_attrs
+ (fun () ->
+ if MethSet.mem label.txt local_meths then
+ raise(Error(loc, val_env, Duplicate ("method", label.txt)));
+ if MethSet.mem label.txt concrete_meths then begin
+ if override = Fresh then begin
+ Location.prerr_warning loc
+ (Warnings.Method_override [label.txt])
+ end
+ end else begin
+ if override = Override then begin
+ raise(Error(loc, val_env, No_overriding("method", label.txt)))
+ end
+ end;
+ let expr =
+ match expr.pexp_desc with
+ | Pexp_poly _ -> expr
+ | _ -> Ast_helper.Exp.poly ~loc:expr.pexp_loc expr None
+ in
+ let sbody, sty =
+ match expr.pexp_desc with
+ | Pexp_poly (sbody, sty) -> sbody, sty
+ | _ -> assert false
+ in
+ let ty =
+ match sty with
+ | None -> Ctype.newvar ()
+ | Some sty ->
+ let sty = Ast_helper.Typ.force_poly sty in
+ let cty' =
+ Typetexp.transl_simple_type val_env false sty
+ in
+ cty'.ctyp_type
+ in
+ add_method loc val_env label.txt priv Concrete ty sign;
+ begin
+ try
+ match get_desc ty with
+ | Tvar _ ->
+ let ty' = Ctype.newvar () in
+ Ctype.unify val_env (Ctype.newty (Tpoly (ty', []))) ty;
+ Ctype.unify val_env (type_approx val_env sbody) ty'
+ | Tpoly (ty1, tl) ->
+ let _, ty1' = Ctype.instance_poly false tl ty1 in
+ let ty2 = type_approx val_env sbody in
+ Ctype.unify val_env ty2 ty1'
+ | _ -> assert false
+ with Ctype.Unify err ->
+ raise(Error(loc, val_env,
+ Field_type_mismatch ("method", label.txt, err)))
+ end;
+ let meths =
+ if Meths.mem label.txt meths then meths
+ else Meths.add label.txt (Ident.create_local label.txt) meths
+ in
+ let sdefinition = make_method self_loc cl_num expr in
+ let warning_state = Warnings.backup () in
+ let field =
+ Concrete_method
+ { label; priv; override; sdefinition;
+ warning_state; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ let concrete_meths = MethSet.add label.txt concrete_meths in
+ let local_meths = MethSet.add label.txt local_meths in
+ { acc with rev_fields; concrete_meths; local_meths; meths })
+
+ | Pcf_constraint (sty1, sty2) ->
+ with_attrs
+ (fun () ->
+ let (cty1, cty2) = type_constraint val_env sty1 sty2 loc in
+ let field =
+ Constraint { cty1; cty2; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields })
+
+ | Pcf_initializer sexpr ->
+ with_attrs
+ (fun () ->
+ let sexpr = make_method self_loc cl_num sexpr in
+ let warning_state = Warnings.backup () in
+ let field =
+ Initializer { sexpr; warning_state; loc; attributes }
+ in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields })
+ | Pcf_attribute attribute ->
+ Builtin_attributes.warning_attribute attribute;
+ let field = Attribute { attribute; loc; attributes } in
+ let rev_fields = field :: rev_fields in
+ { acc with rev_fields }
+ | Pcf_extension ext ->
+ raise (Error_forward (Builtin_attributes.error_of_extension ext))
+
+and class_fields_first_pass self_loc cl_num sign self_scope
+ val_env par_env cfs =
+ let rev_fields = [] in
+ let concrete_meths = MethSet.empty in
+ let concrete_vals = VarSet.empty in
+ let local_meths = MethSet.empty in
+ let local_vals = VarSet.empty in
+ let vars = Vars.empty in
+ let meths = Meths.empty in
+ let init_acc =
+ { rev_fields; val_env; par_env;
+ concrete_meths; concrete_vals;
+ local_meths; local_vals; vars; meths }
+ in
+ let acc =
+ Builtin_attributes.warning_scope []
+ (fun () ->
+ List.fold_left
+ (class_field_first_pass self_loc cl_num sign self_scope)
+ init_acc cfs)
+ in
+ List.rev acc.rev_fields, acc.vars, acc.meths
+
+and class_field_second_pass cl_num sign met_env field =
+ let mkcf desc loc attrs =
+ { cf_desc = desc; cf_loc = loc; cf_attributes = attrs }
+ in
+ match field with
+ | Inherit { override; parent; super;
+ inherited_vars; super_meths; loc; attributes } ->
+ let met_env =
+ add_instance_vars_met loc inherited_vars sign cl_num met_env
in
- (* Super *)
- let (class_env,super) =
+ let met_env =
match super with
- None ->
- (class_env,None)
- | Some {txt=name} ->
- let (_id, class_env) =
- enter_met_env ~check:(fun s -> Warnings.Unused_ancestor s)
- sparent.pcl_loc name (Val_anc (inh_meths, cl_num))
- Val_unbound_ancestor self_type class_env
+ | None -> met_env
+ | Some name ->
+ let meths =
+ List.fold_left
+ (fun acc (label, id) -> Meths.add label id acc)
+ Meths.empty super_meths
in
- (class_env,Some name)
- in
- (class_env,
- lazy (mkcf (Tcf_inherit (ovf, parent, super, inh_vars, inh_meths)))
- :: fields,
- concr_meths, warn_vals, inher, local_meths, local_vals)
-
- | Pcf_val (lab, mut, Cfk_virtual styp) ->
- if !Clflags.principal then Ctype.begin_def ();
- let cty = Typetexp.transl_simple_type val_env false styp in
- let ty = cty.ctyp_type in
- if !Clflags.principal then begin
- Ctype.end_def ();
- Ctype.generalize_structure ty
- end;
- let (id, class_env') =
- enter_val cl_num vars false lab.txt mut Virtual ty
- class_env loc
- in
- (class_env',
- lazy (mkcf (Tcf_val (lab, mut, id, Tcfk_virtual cty,
- met_env == class_env'.met_env)))
- :: fields,
- concr_meths, warn_vals, inher, local_meths, local_vals)
-
- | Pcf_val (lab, mut, Cfk_concrete (ovf, sexp)) ->
- if Concr.mem lab.txt local_vals then
- raise(Error(loc, val_env, Duplicate ("instance variable", lab.txt)));
- if Concr.mem lab.txt warn_vals then begin
- if ovf = Fresh then
- Location.prerr_warning lab.loc
- (Warnings.Instance_variable_override[lab.txt])
- end else begin
- if ovf = Override then
- raise(Error(loc, val_env,
- No_overriding ("instance variable", lab.txt)))
- end;
- if !Clflags.principal then Ctype.begin_def ();
- let exp = type_exp val_env sexp in
- if !Clflags.principal then begin
- Ctype.end_def ();
- Ctype.generalize_structure exp.exp_type
- end;
- let (id, class_env') =
- enter_val cl_num vars false lab.txt mut Concrete exp.exp_type
- class_env loc
+ let ty = Btype.self_type parent.cl_type in
+ let attrs = [] in
+ let _id, met_env =
+ enter_ancestor_met ~loc name ~sign ~meths
+ ~cl_num ~ty ~attrs met_env
+ in
+ met_env
in
- (class_env',
- lazy (mkcf (Tcf_val (lab, mut, id,
- Tcfk_concrete (ovf, exp), met_env == class_env'.met_env)))
- :: fields,
- concr_meths, Concr.add lab.txt warn_vals, inher, local_meths,
- Concr.add lab.txt local_vals)
-
- | Pcf_method (lab, priv, Cfk_virtual sty) ->
- let cty = virtual_method val_env meths self_type lab.txt priv sty loc in
- (class_env,
- lazy (mkcf(Tcf_method (lab, priv, Tcfk_virtual cty)))
- ::fields,
- concr_meths, warn_vals, inher, local_meths, local_vals)
-
- | Pcf_method (lab, priv, Cfk_concrete (ovf, expr)) ->
- let expr =
- match expr.pexp_desc with
- | Pexp_poly _ -> expr
- | _ -> Ast_helper.Exp.poly ~loc:expr.pexp_loc expr None
+ let desc =
+ Tcf_inherit(override, parent, super, inherited_vars, super_meths)
in
- if Concr.mem lab.txt local_meths then
- raise(Error(loc, val_env, Duplicate ("method", lab.txt)));
- if Concr.mem lab.txt concr_meths then begin
- if ovf = Fresh then
- Location.prerr_warning loc (Warnings.Method_override [lab.txt])
- end else begin
- if ovf = Override then
- raise(Error(loc, val_env, No_overriding("method", lab.txt)))
- end;
- let (_, ty) =
- Ctype.filter_self_method val_env lab.txt priv meths self_type
+ met_env, mkcf desc loc attributes
+ | Virtual_val { label; mut; id; cty; already_declared; loc; attributes } ->
+ let met_env =
+ if already_declared then met_env
+ else begin
+ add_instance_var_met loc label.txt id sign cl_num attributes met_env
+ end
in
- begin try match expr.pexp_desc with
- Pexp_poly (sbody, sty) ->
- begin match sty with None -> ()
- | Some sty ->
- let sty = Ast_helper.Typ.force_poly sty in
- let cty' = Typetexp.transl_simple_type val_env false sty in
- let ty' = cty'.ctyp_type in
- Ctype.unify val_env ty' ty
- end;
- begin match (Ctype.repr ty).desc with
- Tvar _ ->
- let ty' = Ctype.newvar () in
- Ctype.unify val_env (Ctype.newty (Tpoly (ty', []))) ty;
- Ctype.unify val_env (type_approx val_env sbody) ty'
- | Tpoly (ty1, tl) ->
- let _, ty1' = Ctype.instance_poly false tl ty1 in
- let ty2 = type_approx val_env sbody in
- Ctype.unify val_env ty2 ty1'
- | _ -> assert false
- end
- | _ -> assert false
- with Ctype.Unify trace ->
- raise(Error(loc, val_env,
- Field_type_mismatch ("method", lab.txt, trace)))
- end;
- let meth_expr = make_method self_loc cl_num expr in
- (* backup variables for Pexp_override *)
- let vars_local = !vars in
-
- let field =
- Warnings.mk_lazy
- (fun () ->
- (* Read the generalized type *)
- let (_, ty) = Meths.find lab.txt !meths in
- let meth_type = mk_expected (
- Btype.newgenty (Tarrow(Nolabel, self_type, ty, Cok))
- ) in
- Ctype.raise_nongen_level ();
- vars := vars_local;
- let texp = type_expect met_env meth_expr meth_type in
- Ctype.end_def ();
- mkcf (Tcf_method (lab, priv, Tcfk_concrete (ovf, texp)))
- )
+ let kind = Tcfk_virtual cty in
+ let desc = Tcf_val(label, mut, id, kind, already_declared) in
+ met_env, mkcf desc loc attributes
+ | Concrete_val { label; mut; id; override;
+ definition; already_declared; loc; attributes } ->
+ let met_env =
+ if already_declared then met_env
+ else begin
+ add_instance_var_met loc label.txt id sign cl_num attributes met_env
+ end
in
- (class_env, field::fields,
- Concr.add lab.txt concr_meths, warn_vals, inher,
- Concr.add lab.txt local_meths, local_vals)
-
- | Pcf_constraint (sty, sty') ->
- let (cty, cty') = type_constraint val_env sty sty' loc in
- (class_env,
- lazy (mkcf (Tcf_constraint (cty, cty'))) :: fields,
- concr_meths, warn_vals, inher, local_meths, local_vals)
-
- | Pcf_initializer expr ->
- let expr = make_method self_loc cl_num expr in
- let vars_local = !vars in
- let field =
- lazy begin
- Ctype.raise_nongen_level ();
- let meth_type = mk_expected (
- Ctype.newty
- (Tarrow (Nolabel, self_type,
- Ctype.instance Predef.type_unit, Cok))
- ) in
- vars := vars_local;
- let texp = type_expect met_env expr meth_type in
- Ctype.end_def ();
- mkcf (Tcf_initializer texp)
- end in
- (class_env, field::fields, concr_meths, warn_vals,
- inher, local_meths, local_vals)
- | Pcf_attribute x ->
- Builtin_attributes.warning_attribute x;
- (class_env,
- lazy (mkcf (Tcf_attribute x)) :: fields,
- concr_meths, warn_vals, inher, local_meths, local_vals)
- | Pcf_extension ext ->
- raise (Error_forward (Builtin_attributes.error_of_extension ext))
+ let kind = Tcfk_concrete(override, definition) in
+ let desc = Tcf_val(label, mut, id, kind, already_declared) in
+ met_env, mkcf desc loc attributes
+ | Virtual_method { label; priv; cty; loc; attributes } ->
+ let kind = Tcfk_virtual cty in
+ let desc = Tcf_method(label, priv, kind) in
+ met_env, mkcf desc loc attributes
+ | Concrete_method { label; priv; override;
+ sdefinition; warning_state; loc; attributes } ->
+ Warnings.with_state warning_state
+ (fun () ->
+ let ty = Btype.method_type label.txt sign in
+ let self_type = sign.Types.csig_self in
+ let meth_type =
+ mk_expected
+ (Btype.newgenty (Tarrow(Nolabel, self_type, ty, commu_ok)))
+ in
+ Ctype.raise_nongen_level ();
+ let texp = type_expect met_env sdefinition meth_type in
+ Ctype.end_def ();
+ let kind = Tcfk_concrete (override, texp) in
+ let desc = Tcf_method(label, priv, kind) in
+ met_env, mkcf desc loc attributes)
+ | Constraint { cty1; cty2; loc; attributes } ->
+ let desc = Tcf_constraint(cty1, cty2) in
+ met_env, mkcf desc loc attributes
+ | Initializer { sexpr; warning_state; loc; attributes } ->
+ Warnings.with_state warning_state
+ (fun () ->
+ Ctype.raise_nongen_level ();
+ let unit_type = Ctype.instance Predef.type_unit in
+ let self_type = sign.Types.csig_self in
+ let meth_type =
+ mk_expected
+ (Ctype.newty (Tarrow (Nolabel, self_type, unit_type, commu_ok)))
+ in
+ let texp = type_expect met_env sexpr meth_type in
+ Ctype.end_def ();
+ let desc = Tcf_initializer texp in
+ met_env, mkcf desc loc attributes)
+ | Attribute { attribute; loc; attributes; } ->
+ let desc = Tcf_attribute attribute in
+ met_env, mkcf desc loc attributes
+
+and class_fields_second_pass cl_num sign met_env fields =
+ let _, rev_cfs =
+ List.fold_left
+ (fun (met_env, cfs) field ->
+ let met_env, cf =
+ class_field_second_pass cl_num sign met_env field
+ in
+ met_env, cf :: cfs)
+ (met_env, []) fields
+ in
+ List.rev rev_cfs
(* N.B. the self type of a final object type doesn't contain a dummy method in
the beginning.
somehow we've unified the self type of the object with the self type of a not
yet finished class.
When this happens, we cannot close the object type and must error. *)
-and class_structure cl_num final val_env met_env loc
+and class_structure cl_num virt self_scope final val_env met_env loc
{ pcstr_self = spat; pcstr_fields = str } =
(* Environment for substructures *)
let par_env = met_env in
(* Location of self. Used for locations of self arguments *)
let self_loc = {spat.ppat_loc with Location.loc_ghost = true} in
- let self_type = Ctype.newobj (Ctype.newvar ()) in
+ let sign = Ctype.new_class_signature () in
- (* Adding a dummy method to the self type prevents it from being closed /
- escaping.
- That isn't needed for objects though. *)
- if not final then
- Ctype.unify val_env
- (Ctype.filter_method val_env dummy_method Private self_type)
- (Ctype.newty (Ttuple []));
-
- (* Private self is used for private method calls *)
- let private_self = if final then Ctype.newvar () else self_type in
+ (* Adding a dummy method to the signature prevents it from being closed /
+ escaping. That isn't needed for objects though. *)
+ begin match final with
+ | Not_final -> Ctype.add_dummy_method val_env ~scope:self_scope sign;
+ | Final -> ()
+ end;
(* Self binder *)
- let (pat, meths, vars, val_env, met_env, par_env) =
- type_self_pattern cl_num private_self val_env met_env par_env spat
+ let (self_pat, self_pat_vars) = type_self_pattern val_env spat in
+ let val_env, par_env =
+ List.fold_right
+ (fun {pv_id; _} (val_env, par_env) ->
+ let name = Ident.name pv_id in
+ let val_env = enter_self_val name val_env in
+ let par_env = enter_self_val name par_env in
+ val_env, par_env)
+ self_pat_vars (val_env, par_env)
in
- let public_self = pat.pat_type in
(* Check that the binder has a correct type *)
- let ty =
- if final then Ctype.newobj (Ctype.newvar()) else self_type in
- begin try Ctype.unify val_env public_self ty with
+ begin try Ctype.unify val_env self_pat.pat_type sign.csig_self with
Ctype.Unify _ ->
- raise(Error(spat.ppat_loc, val_env, Pattern_type_clash public_self))
- end;
- let get_methods ty =
- (fst (Ctype.flatten_fields
- (Ctype.object_fields (Ctype.expand_head val_env ty)))) in
- if final then begin
- (* Copy known information to still empty self_type *)
- List.iter
- (fun (lab,kind,ty) ->
- let k =
- if Btype.field_kind_repr kind = Fpresent then Public else Private in
- try Ctype.unify val_env ty
- (Ctype.filter_method val_env lab k self_type)
- with _ -> assert false)
- (get_methods public_self)
+ raise(Error(spat.ppat_loc, val_env,
+ Pattern_type_clash self_pat.pat_type))
end;
(* Typing of class fields *)
- let class_env = {val_env; met_env; par_env} in
- let (_, fields, concr_meths, _, inher, _local_meths, _local_vals) =
- Builtin_attributes.warning_scope []
- (fun () ->
- List.fold_left (class_field self_loc cl_num self_type meths vars)
- ( class_env,[], Concr.empty, Concr.empty, [],
- Concr.empty, Concr.empty)
- str
- )
+ let (fields, vars, meths) =
+ class_fields_first_pass self_loc cl_num sign self_scope
+ val_env par_env str
in
- 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;
- csig_concr = concr_meths;
- csig_inher = inher} in
- let methods = get_methods self_type in
- 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 *)
- if not (Ctype.close_object self_type) then
- raise(Error(loc, val_env, Closing_self_type self_type));
- let mets = virtual_methods {sign with csig_self = self_type} in
- let vals =
- Vars.fold
- (fun name (_mut, vr, _ty) l -> if vr = Virtual then name :: l else l)
- sign.csig_vars [] in
- if mets <> [] || vals <> [] then
- raise(Error(loc, val_env, Virtual_class(true, final, mets, vals)));
- let self_methods =
- List.fold_right
- (fun (lab,kind,ty) rem ->
- Ctype.newty(Tfield(lab, Btype.copy_kind kind, ty, rem)))
- methods (Ctype.newty Tnil) in
- begin try
- Ctype.unify val_env private_self
- (Ctype.newty (Tobject(self_methods, ref None)));
- Ctype.unify val_env public_self self_type
- with Ctype.Unify trace -> raise(Error(loc, val_env, Final_self_clash trace))
- end;
- end;
+ let kind = kind_of_final final in
- (* Typing of method bodies *)
- (* if !Clflags.principal then *) begin
- let ms = !meths in
- (* Generalize the spine of methods accessed through self *)
- Meths.iter (fun _ (_,ty) -> Ctype.generalize_spine ty) ms;
- meths :=
- Meths.map (fun (id,ty) -> (id, Ctype.generic_instance ty)) ms;
- (* But keep levels correct on the type of self *)
- Meths.iter (fun _ (_,ty) -> Ctype.unify val_env ty (Ctype.newvar ())) ms
+ (* Check for unexpected virtual methods *)
+ check_virtual loc val_env virt kind sign;
+
+ (* Update the class signature *)
+ update_class_signature loc val_env
+ ~warn_implicit_public:false virt kind sign;
+
+ (* Close the signature if it is final *)
+ begin match final with
+ | Not_final -> ()
+ | Final ->
+ if not (Ctype.close_class_signature val_env sign) then
+ raise(Error(loc, val_env, Closing_self_type sign));
end;
- let fields = List.map Lazy.force (List.rev fields) in
- let meths = Meths.map (function (id, _ty) -> id) !meths in
-
- (* Check for private methods made public *)
- let pub_meths' =
- List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind = Fpresent)
- (get_methods public_self) in
- let names = List.map (fun (x,_,_) -> x) in
- let l1 = names priv_meths and l2 = names pub_meths' in
- let added = List.filter (fun x -> List.mem x l1) l2 in
- if added <> [] then
- Location.prerr_warning loc (Warnings.Implicit_public_methods added);
- let sign = if final then sign else
- {sign with Types.csig_self = Ctype.expand_head val_env public_self} in
- {
- cstr_self = pat;
+ (* Typing of method bodies *)
+ Ctype.generalize_class_signature_spine val_env sign;
+ let self_var_kind =
+ match virt with
+ | Virtual -> Self_virtual(ref meths)
+ | Concrete -> Self_concrete meths
+ in
+ let met_env =
+ List.fold_right
+ (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} met_env ->
+ add_self_met pv_loc pv_id sign self_var_kind vars
+ cl_num pv_as_var pv_type pv_attributes met_env)
+ self_pat_vars met_env
+ in
+ let fields =
+ class_fields_second_pass cl_num sign met_env fields
+ in
+
+ (* Update the class signature and warn about public methods made private *)
+ update_class_signature loc val_env
+ ~warn_implicit_public:true virt kind sign;
+
+ let meths =
+ match self_var_kind with
+ | Self_virtual meths_ref -> !meths_ref
+ | Self_concrete meths -> meths
+ in
+ { cstr_self = self_pat;
cstr_fields = fields;
cstr_type = sign;
- cstr_meths = meths}, sign (* redondant, since already in cstr_type *)
+ cstr_meths = meths; }
-and class_expr cl_num val_env met_env scl =
+and class_expr cl_num val_env met_env virt self_scope scl =
Builtin_attributes.warning_scope scl.pcl_attributes
- (fun () -> class_expr_aux cl_num val_env met_env scl)
+ (fun () -> class_expr_aux cl_num val_env met_env virt self_scope scl)
-and class_expr_aux cl_num val_env met_env scl =
+and class_expr_aux cl_num val_env met_env virt self_scope scl =
match scl.pcl_desc with
- Pcl_constr (lid, styl) ->
+ | Pcl_constr (lid, styl) ->
let (path, decl) = Env.lookup_class ~loc:scl.pcl_loc lid.txt val_env in
if Path.same decl.cty_path unbound_class then
raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt));
let (params, clty) =
Ctype.instance_class decl.cty_params decl.cty_type
in
- let clty' = abbreviate_class_type path params clty in
+ let clty' = Btype.abbreviate_class_type path params clty in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method val_env ~scope:self_scope
+ (Btype.signature_of_class_type clty');
if List.length params <> List.length tyl then
raise(Error(scl.pcl_loc, val_env,
Parameter_arity_mismatch (lid.txt, List.length params,
List.iter2
(fun cty' ty ->
let ty' = cty'.ctyp_type in
- try Ctype.unify val_env ty' ty with Ctype.Unify trace ->
- raise(Error(cty'.ctyp_loc, val_env, Parameter_mismatch trace)))
+ try Ctype.unify val_env ty' ty with Ctype.Unify err ->
+ raise(Error(cty'.ctyp_loc, val_env, Parameter_mismatch err)))
tyl params;
let cl =
rc {cl_desc = Tcl_ident (path, lid, tyl);
cl_attributes = []; (* attributes are kept on the inner cl node *)
}
| Pcl_structure cl_str ->
- let (desc, ty) =
- class_structure cl_num false val_env met_env scl.pcl_loc cl_str in
+ let desc =
+ class_structure cl_num virt self_scope Not_final
+ val_env met_env scl.pcl_loc cl_str
+ in
rc {cl_desc = Tcl_structure desc;
cl_loc = scl.pcl_loc;
- cl_type = Cty_signature ty;
+ cl_type = Cty_signature desc.cstr_type;
cl_env = val_env;
cl_attributes = scl.pcl_attributes;
}
(* Note: we don't put the '#default' attribute, as it
is not detected for class-level let bindings. See #5975.*)
in
- class_expr cl_num val_env met_env sfun
+ class_expr cl_num val_env met_env virt self_scope sfun
| Pcl_fun (l, None, spat, scl') ->
if !Clflags.principal then Ctype.begin_def ();
let (pat, pv, val_env', met_env) =
[{c_lhs = pat; c_guard = None; c_rhs = dummy}]
in
Ctype.raise_nongen_level ();
- let cl = class_expr cl_num val_env' met_env scl' in
+ let cl = class_expr cl_num val_env' met_env virt self_scope scl' in
Ctype.end_def ();
if Btype.is_optional l && not_nolabel_function cl.cl_type then
Location.prerr_warning pat.pat_loc
| Pcl_apply (scl', sargs) ->
assert (sargs <> []);
if !Clflags.principal then Ctype.begin_def ();
- let cl = class_expr cl_num val_env met_env scl' in
+ let cl = class_expr cl_num val_env met_env virt self_scope scl' in
if !Clflags.principal then begin
Ctype.end_def ();
- generalize_class_type false cl.cl_type;
+ Ctype.generalize_class_type_structure cl.cl_type;
end;
let rec nonopt_labels ls ty_fun =
match ty_fun with
(let_bound_idents_full defs)
([], met_env)
in
- let cl = class_expr cl_num val_env met_env scl' in
+ let cl = class_expr cl_num val_env met_env virt self_scope scl' in
let () = if rec_flag = Recursive then
check_recursive_bindings val_env defs
in
| Pcl_constraint (scl', scty) ->
Ctype.begin_class_def ();
let context = Typetexp.narrow () in
- let cl = class_expr cl_num val_env met_env scl' in
+ let cl = class_expr cl_num val_env met_env virt self_scope scl' in
+ complete_class_type cl.cl_loc val_env virt Class_type cl.cl_type;
Typetexp.widen context;
let context = Typetexp.narrow () in
- let clty = class_type val_env scty in
+ let clty = class_type val_env virt self_scope scty in
+ complete_class_type clty.cltyp_loc val_env virt Class clty.cltyp_type;
Typetexp.widen context;
Ctype.end_def ();
- limited_generalize (Ctype.row_variable (Ctype.self_type cl.cl_type))
- cl.cl_type;
- limited_generalize (Ctype.row_variable (Ctype.self_type clty.cltyp_type))
- clty.cltyp_type;
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row cl.cl_type) cl.cl_type;
+ Ctype.limited_generalize_class_type
+ (Btype.self_type_row clty.cltyp_type) clty.cltyp_type;
begin match
Includeclass.class_types val_env cl.cl_type clty.cltyp_type
| error -> raise(Error(cl.cl_loc, val_env, Class_match_failure error))
end;
let (vals, meths, concrs) = extract_constraints clty.cltyp_type in
+ let ty = snd (Ctype.instance_class [] clty.cltyp_type) in
+ (* Adding a dummy method to the self type prevents it from being closed /
+ escaping. *)
+ Ctype.add_dummy_method val_env ~scope:self_scope
+ (Btype.signature_of_class_type ty);
rc {cl_desc = Tcl_constraint (cl, Some clty, vals, meths, concrs);
cl_loc = scl.pcl_loc;
- cl_type = snd (Ctype.instance_class [] clty.cltyp_type);
+ cl_type = ty;
cl_env = val_env;
cl_attributes = scl.pcl_attributes;
}
let used_slot = ref false in
let (od, new_val_env) = !type_open_descr ~used_slot val_env pod in
let ( _, new_met_env) = !type_open_descr ~used_slot met_env pod in
- let cl = class_expr cl_num new_val_env new_met_env e in
+ let cl = class_expr cl_num new_val_env new_met_env virt self_scope e in
rc {cl_desc = Tcl_open (od, cl);
cl_loc = scl.pcl_loc;
cl_type = cl.cl_type;
let arg =
if Btype.is_optional l then Ctype.instance var_option
else Ctype.newvar () in
- Ctype.newty (Tarrow (l, arg, approx_declaration cl, Cok))
+ Ctype.newty (Tarrow (l, arg, approx_declaration cl, commu_ok))
| Pcl_let (_, _, cl) ->
approx_declaration cl
| Pcl_constraint (cl, _) ->
let arg =
if Btype.is_optional l then Ctype.instance var_option
else Ctype.newvar () in
- Ctype.newty (Tarrow (l, arg, approx_description ct, Cok))
+ Ctype.newty (Tarrow (l, arg, approx_description ct, commu_ok))
| _ -> Ctype.newvar ()
(*******************************)
let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity uid in
(* Temporary type for the class constructor *)
+ if !Clflags.principal then Ctype.begin_def ();
let constr_type = approx cl.pci_expr in
- if !Clflags.principal then Ctype.generalize_spine constr_type;
- let dummy_cty =
- Cty_signature
- { csig_self = Ctype.newvar ();
- csig_vars = Vars.empty;
- csig_concr = Concr.empty;
- csig_inher = [] }
- in
+ if !Clflags.principal then begin
+ Ctype.end_def ();
+ Ctype.generalize_structure constr_type;
+ end;
+ let dummy_cty = Cty_signature (Ctype.new_class_signature ()) in
let dummy_class =
{Types.cty_params = []; (* Dummy value *)
cty_variance = [];
try
Typecore.self_coercion :=
(Path.Pident obj_id, coercion_locs) :: !Typecore.self_coercion;
- let res = kind env cl.pci_expr in
+ let res = kind env cl.pci_virt cl.pci_expr in
Typecore.self_coercion := List.tl !Typecore.self_coercion;
res
with exn ->
Typecore.self_coercion := []; raise exn
in
+ let sign = Btype.signature_of_class_type typ in
Ctype.end_def ();
- let sty = Ctype.self_type typ in
-
- (* First generalize the type of the dummy method (cf PR#6123) *)
- let (fields, _) = Ctype.flatten_fields (Ctype.object_fields sty) in
- List.iter (fun (met, _, ty) -> if met = dummy_method then Ctype.generalize ty)
- fields;
(* Generalize the row variable *)
- let rv = Ctype.row_variable sty in
- List.iter (Ctype.limited_generalize rv) params;
- limited_generalize rv typ;
+ List.iter (Ctype.limited_generalize sign.csig_self_row) params;
+ Ctype.limited_generalize_class_type sign.csig_self_row typ;
(* Check the abbreviation for the object type *)
let (obj_params', obj_type) = Ctype.instance_class params typ in
let constr = Ctype.newconstr (Path.Pident obj_id) obj_params in
begin
- let ty = Ctype.self_type obj_type in
- Ctype.hide_private_methods ty;
- if not (Ctype.close_object ty) then
- raise(Error(cl.pci_loc, env, Closing_self_type ty));
+ let row = Btype.self_type_row obj_type in
+ Ctype.unify env row (Ctype.newty Tnil);
begin try
List.iter2 (Ctype.unify env) obj_params obj_params'
with Ctype.Unify _ ->
Ctype.newconstr (Path.Pident obj_id)
obj_params')))
end;
+ let ty = Btype.self_type obj_type in
begin try
Ctype.unify env ty constr
with Ctype.Unify _ ->
end
end;
+ Ctype.set_object_name obj_id params (Btype.self_type typ);
+
(* Check the other temporary abbreviation (#-type) *)
begin
let (cl_params', cl_type) = Ctype.instance_class params typ in
- let ty = Ctype.self_type cl_type in
- Ctype.hide_private_methods ty;
- Ctype.set_object_name obj_id (Ctype.row_variable ty) cl_params ty;
+ let ty = Btype.self_type cl_type in
begin try
List.iter2 (Ctype.unify env) cl_params cl_params'
with Ctype.Unify _ ->
Ctype.unify env
(constructor_type constr obj_type)
(Ctype.instance constr_type)
- with Ctype.Unify trace ->
+ with Ctype.Unify err ->
raise(Error(cl.pci_loc, env,
- Constructor_type_mismatch (cl.pci_name.txt, trace)))
+ Constructor_type_mismatch (cl.pci_name.txt, err)))
end;
(* Class and class type temporary definitions *)
let cty_variance =
Variance.unknown_signature ~injective:false ~arity:(List.length params) in
let cltydef =
- {clty_params = params; clty_type = class_body typ;
+ {clty_params = params; clty_type = Btype.class_body typ;
clty_variance = cty_variance;
clty_path = Path.Pident obj_id;
clty_loc = cl.pci_loc;
if define_class then Env.add_class id clty env else env)
in
- if cl.pci_virt = Concrete then begin
- let sign = Ctype.signature_of_class_type typ in
- let mets = virtual_methods sign in
- let vals =
- Vars.fold
- (fun name (_mut, vr, _ty) l -> if vr = Virtual then name :: l else l)
- sign.csig_vars [] in
- if mets <> [] || vals <> [] then
- raise(Error(cl.pci_loc, env, Virtual_class(define_class, false, mets,
- vals)));
- end;
-
(* Misc. *)
- let arity = Ctype.class_type_arity typ in
- let pub_meths =
- let (fields, _) =
- Ctype.flatten_fields (Ctype.object_fields (Ctype.expand_head env obj_ty))
- in
- List.map (function (lab, _, _) -> lab) fields
- in
+ let arity = Btype.class_type_arity typ in
+ let pub_meths = Btype.public_methods sign in
(* Final definitions *)
let (params', typ') = Ctype.instance_class params typ in
let cltydef =
- {clty_params = params'; clty_type = class_body typ';
+ {clty_params = params'; clty_type = Btype.class_body typ';
clty_variance = cty_variance;
clty_path = Path.Pident obj_id;
clty_loc = cl.pci_loc;
}
in
let (cl_params, cl_ty) =
- Ctype.instance_parameterized_type params (Ctype.self_type typ)
+ Ctype.instance_parameterized_type params (Btype.self_type typ)
in
- Ctype.hide_private_methods cl_ty;
- Ctype.set_object_name obj_id (Ctype.row_variable cl_ty) cl_params cl_ty;
+ Ctype.set_object_name obj_id cl_params cl_ty;
let cl_abbr =
let arity = List.length cl_params in
{
arity, pub_meths, coe, expr) =
begin try Ctype.collapse_conj_params env clty.cty_params
- with Ctype.Unify trace ->
- raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, trace)))
- end;
-
- (* make the dummy method disappear *)
- begin
- let self_type = Ctype.self_type clty.cty_type in
- let methods, _ =
- Ctype.flatten_fields
- (Ctype.object_fields (Ctype.expand_head env self_type))
- in
- List.iter (fun (lab,kind,_) ->
- if lab = dummy_method then
- match Btype.field_kind_repr kind with
- Fvar r -> Btype.set_kind r Fabsent
- | _ -> ()
- ) methods
+ with Ctype.Unify err ->
+ raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, err)))
end;
List.iter Ctype.generalize clty.cty_params;
- generalize_class_type true clty.cty_type;
+ Ctype.generalize_class_type clty.cty_type;
Option.iter Ctype.generalize clty.cty_new;
List.iter Ctype.generalize obj_abbr.type_params;
Option.iter Ctype.generalize obj_abbr.type_manifest;
List.iter Ctype.generalize cl_abbr.type_params;
Option.iter Ctype.generalize cl_abbr.type_manifest;
- if not (closed_class clty) then
+ if Ctype.nongen_class_declaration clty then
raise(Error(cl.pci_loc, env, Non_generalizable_class (id, clty)));
begin match
Ctype.closed_class clty.cty_params
- (Ctype.signature_of_class_type clty.cty_type)
+ (Btype.signature_of_class_type clty.cty_type)
with
None -> ()
| Some reason ->
| _ -> assert false
in
begin try Ctype.subtype env cl_ty obj_ty ()
- with Ctype.Subtype (tr1, tr2) ->
- raise(Typecore.Error(loc, env, Typecore.Not_subtype(tr1, tr2)))
+ with Ctype.Subtype err ->
+ raise(Typecore.Error(loc, env, Typecore.Not_subtype err))
end;
if not (Ctype.opened_object cl_ty) then
raise(Error(loc, env, Cannot_coerce_self obj_ty))
(res, env)
let class_num = ref 0
-let class_declaration env sexpr =
+let class_declaration env virt sexpr =
incr class_num;
- let expr = class_expr (Int.to_string !class_num) env env sexpr in
+ let self_scope = Ctype.get_current_level () in
+ let expr =
+ class_expr (Int.to_string !class_num) env env virt self_scope sexpr
+ in
+ complete_class_type expr.cl_loc env virt Class expr.cl_type;
(expr, expr.cl_type)
-let class_description env sexpr =
- let expr = class_type env sexpr in
+let class_description env virt sexpr =
+ let self_scope = Ctype.get_current_level () in
+ let expr = class_type env virt self_scope sexpr in
+ complete_class_type expr.cltyp_loc env virt Class_type expr.cltyp_type;
(expr, expr.cltyp_type)
let class_declarations env cls =
decls,
env)
-let rec unify_parents env ty cl =
- match cl.cl_desc with
- Tcl_ident (p, _, _) ->
- begin try
- let decl = Env.find_class p env in
- let _, body = Ctype.find_cltype_for_path env decl.cty_path in
- Ctype.unify env ty (Ctype.instance body)
- with
- Not_found -> ()
- | _exn -> assert false
- end
- | Tcl_structure st -> unify_parents_struct env ty st
- | Tcl_open (_, cl)
- | Tcl_fun (_, _, _, cl, _)
- | Tcl_apply (cl, _)
- | Tcl_let (_, _, _, cl)
- | Tcl_constraint (cl, _, _, _, _) -> unify_parents env ty cl
-and unify_parents_struct env ty st =
- List.iter
- (function
- | {cf_desc = Tcf_inherit (_, cl, _, _, _)} ->
- unify_parents env ty cl
- | _ -> ())
- st.cstr_fields
-
let type_object env loc s =
incr class_num;
- let (desc, sign) =
- class_structure (Int.to_string !class_num) true env env loc s in
- let sty = Ctype.expand_head env sign.csig_self in
- Ctype.hide_private_methods sty;
- let (fields, _) = Ctype.flatten_fields (Ctype.object_fields sty) in
- let meths = List.map (fun (s,_,_) -> s) fields in
- unify_parents_struct env sign.csig_self desc;
- (desc, sign, meths)
+ let desc =
+ class_structure (Int.to_string !class_num)
+ Concrete Btype.lowest_level Final env env loc s
+ in
+ complete_class_signature loc env Concrete Object desc.cstr_type;
+ let meths = Btype.public_methods desc.cstr_type in
+ (desc, meths)
let () =
Typecore.type_object := type_object
open Format
+let non_virtual_string_of_kind = function
+ | Object -> "object"
+ | Class -> "non-virtual class"
+ | Class_type -> "non-virtual class type"
+
let report_error env ppf = function
| Repeated_parameter ->
fprintf ppf "A type parameter occurs several times"
- | Unconsistent_constraint trace ->
+ | Unconsistent_constraint err ->
fprintf ppf "@[<v>The class constraints are not consistent.@ ";
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_unification_error ppf env err
(fun ppf -> fprintf ppf "Type")
(fun ppf -> fprintf ppf "is not compatible with type");
fprintf ppf "@]"
- | Field_type_mismatch (k, m, trace) ->
- Printtyp.report_unification_error ppf env trace
+ | Field_type_mismatch (k, m, err) ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "The %s %s@ has type" k m)
(function ppf ->
fprintf ppf "but is expected to have type")
+ | Unexpected_field (ty, lab) ->
+ Printtyp.prepare_for_printing [ty];
+ fprintf ppf
+ "@[@[<2>This object is expected to have type :@ %a@]\
+ @ This type does not have a method %s."
+ Printtyp.type_expr ty lab
| Structure_expected clty ->
fprintf ppf
"@[This class expression is not a class structure; it has type@ %a@]"
Printtyp.longident cl
| Abbrev_type_clash (abbrev, actual, expected) ->
(* XXX Afficher une trace ? | Print a trace? *)
- Printtyp.reset_and_mark_loops_list [abbrev; actual; expected];
+ Printtyp.prepare_for_printing [abbrev; actual; expected];
fprintf ppf "@[The abbreviation@ %a@ expands to type@ %a@ \
but is used with type@ %a@]"
- !Oprint.out_type (Printtyp.tree_of_typexp false abbrev)
- !Oprint.out_type (Printtyp.tree_of_typexp false actual)
- !Oprint.out_type (Printtyp.tree_of_typexp false expected)
- | Constructor_type_mismatch (c, trace) ->
- Printtyp.report_unification_error ppf env trace
+ !Oprint.out_type (Printtyp.tree_of_typexp Type abbrev)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type actual)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type expected)
+ | Constructor_type_mismatch (c, err) ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "The expression \"new %s\" has type" c)
(function ppf ->
fprintf ppf "but is used with type")
- | Virtual_class (cl, imm, mets, vals) ->
- let print_mets ppf mets =
- List.iter (function met -> fprintf ppf "@ %s" met) mets in
+ | Virtual_class (kind, mets, vals) ->
+ let kind = non_virtual_string_of_kind kind in
let missings =
match mets, vals with
[], _ -> "variables"
| _, [] -> "methods"
| _ -> "methods and variables"
in
- let print_msg ppf =
- if imm then fprintf ppf "This object has virtual %s" missings
- else if cl then fprintf ppf "This class should be virtual"
- else fprintf ppf "This class type should be virtual"
- in
fprintf ppf
- "@[%t.@ @[<2>The following %s are undefined :%a@]@]"
- print_msg missings print_mets (mets @ vals)
+ "@[This %s has virtual %s.@ \
+ @[<2>The following %s are virtual : %a@]@]"
+ kind missings missings
+ (pp_print_list ~pp_sep:pp_print_space pp_print_string) (mets @ vals)
+ | Undeclared_methods(kind, mets) ->
+ let kind = non_virtual_string_of_kind kind in
+ fprintf ppf
+ "@[This %s has undeclared virtual methods.@ \
+ @[<2>The following methods were not declared : %a@]@]"
+ kind (pp_print_list ~pp_sep:pp_print_space pp_print_string) mets
| Parameter_arity_mismatch(lid, expected, provided) ->
fprintf ppf
"@[The class constructor %a@ expects %i type argument(s),@ \
but is here applied to %i type argument(s)@]"
Printtyp.longident lid expected provided
- | Parameter_mismatch trace ->
- Printtyp.report_unification_error ppf env trace
+ | Parameter_mismatch err ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "The type parameter")
(function ppf ->
fprintf ppf "does not meet its constraint: it should be")
| Bad_parameters (id, params, cstrs) ->
- Printtyp.reset_and_mark_loops_list [params; cstrs];
+ Printtyp.prepare_for_printing [params; cstrs];
fprintf ppf
"@[The abbreviation %a@ is used with parameters@ %a@ \
which are incompatible with constraints@ %a@]"
Printtyp.ident id
- !Oprint.out_type (Printtyp.tree_of_typexp false params)
- !Oprint.out_type (Printtyp.tree_of_typexp false cstrs)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type params)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type cstrs)
| Class_match_failure error ->
- Includeclass.report_error ppf error
+ Includeclass.report_error Type ppf error
| Unbound_val lab ->
fprintf ppf "Unbound instance variable %s" lab
| Unbound_type_var (printer, reason) ->
- let print_common ppf kind ty0 real lab ty =
+ let print_reason ppf (ty0, real, lab, ty) =
let ty1 =
if real then ty0 else Btype.newgenty(Tobject(ty0, ref None)) in
- List.iter Printtyp.mark_loops [ty; ty1];
+ Printtyp.prepare_for_printing [ty; ty1];
fprintf ppf
- "The %s %s@ has type@;<1 2>%a@ where@ %a@ is unbound"
- kind lab
- !Oprint.out_type (Printtyp.tree_of_typexp false ty)
- !Oprint.out_type (Printtyp.tree_of_typexp false ty0)
- in
- let print_reason ppf = function
- | Ctype.CC_Method (ty0, real, lab, ty) ->
- print_common ppf "method" ty0 real lab ty
- | Ctype.CC_Value (ty0, real, lab, ty) ->
- print_common ppf "instance variable" ty0 real lab ty
+ "The method %s@ has type@;<1 2>%a@ where@ %a@ is unbound"
+ lab
+ !Oprint.out_type (Printtyp.tree_of_typexp Type ty)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type ty0)
in
- Printtyp.reset ();
fprintf ppf
"@[<v>@[Some type variables are unbound in this type:@;<1 2>%t@]@ \
@[%a@]@]"
the type of the current class:@ %a.@.\
Some occurrences are contravariant@]"
Printtyp.type_scheme ty
- | Non_collapsable_conjunction (id, clty, trace) ->
+ | Non_collapsable_conjunction (id, clty, err) ->
fprintf ppf
"@[The type of this class,@ %a,@ \
contains non-collapsible conjunctive types in constraints.@ %t@]"
(Printtyp.class_declaration id) clty
- (fun ppf -> Printtyp.report_unification_error ppf env trace
+ (fun ppf -> Printtyp.report_unification_error ppf env err
(fun ppf -> fprintf ppf "Type")
(fun ppf -> fprintf ppf "is not compatible with type")
)
- | Final_self_clash trace ->
- Printtyp.report_unification_error ppf env trace
+ | Self_clash err ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "This object is expected to have type")
(function ppf ->
| Duplicate (kind, name) ->
fprintf ppf "@[The %s `%s'@ has multiple definitions in this object@]"
kind name
- | Closing_self_type self ->
+ | Closing_self_type sign ->
fprintf ppf
"@[Cannot close type of object literal:@ %a@,\
it has been unified with the self type of a class that is not yet@ \
completely defined.@]"
- Printtyp.type_scheme self
+ Printtyp.type_scheme sign.csig_self
let report_error env ppf err =
Printtyp.wrap_printing_env ~error:true
val approx_class_declarations:
Env.t -> Parsetree.class_description list -> class_type_info list
-val virtual_methods: Types.class_signature -> label list
-
(*
val type_classes :
bool ->
list * Env.t
*)
+type kind =
+ | Object
+ | Class
+ | Class_type
+
type error =
- | Unconsistent_constraint of Errortrace.unification Errortrace.t
- | Field_type_mismatch of string * string * Errortrace.unification Errortrace.t
+ | Unconsistent_constraint of Errortrace.unification_error
+ | Field_type_mismatch of string * string * Errortrace.unification_error
+ | Unexpected_field of type_expr * string
| Structure_expected of class_type
| Cannot_apply of class_type
| Apply_wrong_label of arg_label
| Unbound_class_2 of Longident.t
| Unbound_class_type_2 of Longident.t
| Abbrev_type_clash of type_expr * type_expr * type_expr
- | Constructor_type_mismatch of string * Errortrace.unification Errortrace.t
- | Virtual_class of bool * bool * string list * string list
+ | Constructor_type_mismatch of string * Errortrace.unification_error
+ | Virtual_class of kind * string list * string list
+ | Undeclared_methods of kind * string list
| Parameter_arity_mismatch of Longident.t * int * int
- | Parameter_mismatch of Errortrace.unification Errortrace.t
+ | Parameter_mismatch of Errortrace.unification_error
| Bad_parameters of Ident.t * type_expr * type_expr
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
- | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+ | Unbound_type_var of
+ (formatter -> unit) * (type_expr * bool * string * type_expr)
| Non_generalizable_class of Ident.t * Types.class_declaration
| Cannot_coerce_self of type_expr
| Non_collapsable_conjunction of
- Ident.t * Types.class_declaration * Errortrace.unification Errortrace.t
- | Final_self_clash of Errortrace.unification Errortrace.t
+ Ident.t * Types.class_declaration * Errortrace.unification_error
+ | Self_clash of Errortrace.unification_error
| Mutability_mismatch of string * mutable_flag
| No_overriding of string * string
| Duplicate of string * string
- | Closing_self_type of type_expr
+ | Closing_self_type of class_signature
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
valid_names: string list;
}
+type wrong_kind_context =
+ | Pattern
+ | Expression of type_forcing_context option
+
+type wrong_kind_sort =
+ | Constructor
+ | Record
+ | Boolean
+ | List
+ | Unit
+
+let wrong_kind_sort_of_constructor (lid : Longident.t) =
+ match lid with
+ | Lident "true" | Lident "false" | Ldot(_, "true") | Ldot(_, "false") ->
+ Boolean
+ | Lident "[]" | Lident "::" | Ldot(_, "[]") | Ldot(_, "::") -> List
+ | Lident "()" | Ldot(_, "()") -> Unit
+ | _ -> Constructor
+
type existential_restriction =
| At_toplevel (** no existential types at the toplevel *)
| In_group (** nor with let ... and ... *)
type error =
| Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * Errortrace.unification Errortrace.t
+ | Label_mismatch of Longident.t * Errortrace.unification_error
| Pattern_type_clash :
- Errortrace.unification Errortrace.t * _ pattern_desc option -> error
- | Or_pattern_type_clash of Ident.t * Errortrace.unification Errortrace.t
+ Errortrace.unification_error * _ pattern_desc option -> error
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification_error
| Multiply_bound_variable of string
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
- Errortrace.unification Errortrace.t * type_forcing_context option
+ Errortrace.unification_error * type_forcing_context option
* expression_desc option
| Apply_non_function of type_expr
| Apply_wrong_label of arg_label * type_expr * bool
| Name_type_mismatch of
Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
| Invalid_format of string
+ | Not_an_object of type_expr * type_forcing_context option
| Undefined_method of type_expr * string * string list option
- | Undefined_inherited_method of string * string list
+ | Undefined_self_method of string * string list
| Virtual_class of Longident.t
| Private_type of type_expr
| Private_label of Longident.t * type_expr
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
- | Not_subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
+ | Not_subtype of Errortrace.Subtype.error
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of
- type_expr * type_expr * Errortrace.unification Errortrace.t * bool
- | Too_many_arguments of bool * type_expr * type_forcing_context option
- | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
+ Errortrace.expanded_type * Errortrace.unification_error * bool
+ | Not_a_function of type_expr * type_forcing_context option
+ | Too_many_arguments of type_expr * type_forcing_context option
+ | Abstract_wrong_label of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ ; explanation : type_forcing_context option
+ }
| Scoping_let_module of string * type_expr
- | Not_a_variant_type of Longident.t
+ | Not_a_polymorphic_variant_type of Longident.t
| Incoherent_label_order
- | Less_general of string * Errortrace.unification Errortrace.t
+ | Less_general of string * Errortrace.unification_error
| Modules_not_allowed
| Cannot_infer_signature
| Not_a_packed_module of type_expr
| Illegal_letrec_pat
| Illegal_letrec_expr
| Illegal_class_expr
- | Letop_type_clash of string * Errortrace.unification Errortrace.t
- | Andop_type_clash of string * Errortrace.unification Errortrace.t
- | Bindings_type_clash of Errortrace.unification Errortrace.t
+ | Letop_type_clash of string * Errortrace.unification_error
+ | Andop_type_clash of string * Errortrace.unification_error
+ | Bindings_type_clash of Errortrace.unification_error
| Unbound_existential of Ident.t list * type_expr
| Missing_type_constraint
+ | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
+ | Expr_not_a_record_type of type_expr
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
let type_module =
ref ((fun _env _md -> assert false) :
- Env.t -> Parsetree.module_expr -> Typedtree.module_expr)
+ Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t)
(* Forward declaration, to be filled in by Typemod.type_open *)
let type_object =
ref (fun _env _s -> assert false :
Env.t -> Location.t -> Parsetree.class_structure ->
- Typedtree.class_structure * Types.class_signature * string list)
+ Typedtree.class_structure * string list)
(*
Saving and outputting type information.
(type_option texp.exp_type) texp.exp_loc texp.exp_env
let extract_option_type env ty =
- match expand_head env ty with {desc = Tconstr(path, [ty], _)}
- when Path.same path Predef.path_option -> ty
+ match get_desc (expand_head env ty) with
+ Tconstr(path, [ty], _) when Path.same path Predef.path_option -> ty
| _ -> assert false
+type record_extraction_result =
+ | Record_type of Path.t * Path.t * Types.label_declaration list
+ | Not_a_record_type
+ | Maybe_a_record_type
+
let extract_concrete_record env ty =
match extract_concrete_typedecl env ty with
- (p0, p, {type_kind=Type_record (fields, _)}) -> (p0, p, fields)
- | _ -> raise Not_found
+ | Typedecl(p0, p, {type_kind=Type_record (fields, _)}) ->
+ Record_type (p0, p, fields)
+ | Has_no_typedecl | Typedecl(_, _, _) -> Not_a_record_type
+ | May_have_typedecl -> Maybe_a_record_type
+
+type variant_extraction_result =
+ | Variant_type of Path.t * Path.t * Types.constructor_declaration list
+ | Not_a_variant_type
+ | Maybe_a_variant_type
let extract_concrete_variant env ty =
match extract_concrete_typedecl env ty with
- (p0, p, {type_kind=Type_variant (cstrs, _)}) -> (p0, p, cstrs)
- | (p0, p, {type_kind=Type_open}) -> (p0, p, [])
- | _ -> raise Not_found
+ | Typedecl(p0, p, {type_kind=Type_variant (cstrs, _)}) ->
+ Variant_type (p0, p, cstrs)
+ | Typedecl(p0, p, {type_kind=Type_open}) ->
+ Variant_type (p0, p, [])
+ | Has_no_typedecl | Typedecl(_, _, _) -> Not_a_variant_type
+ | May_have_typedecl -> Maybe_a_variant_type
let extract_label_names env ty =
- try
- let (_, _,fields) = extract_concrete_record env ty in
- List.map (fun l -> l.Types.ld_id) fields
- with Not_found ->
- assert false
+ match extract_concrete_record env ty with
+ | Record_type (_, _,fields) -> List.map (fun l -> l.Types.ld_id) fields
+ | Not_a_record_type | Maybe_a_record_type -> assert false
+
+let is_principal ty =
+ not !Clflags.principal || get_level ty = generic_level
(* Typing of patterns *)
try
unify env ty expected_ty
with
- Unify trace ->
- raise(Error(loc, env, Expr_type_clash(trace, None, None)))
+ Unify err ->
+ raise(Error(loc, env, Expr_type_clash(err, None, None)))
| Tags(l1,l2) ->
raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
unify !env ty ty';
nothing_equated
with
- | Unify trace ->
- raise(Error(loc, !env, Pattern_type_clash(trace, None)))
+ | Unify err ->
+ raise(Error(loc, !env, Pattern_type_clash(err, None)))
| Tags(l1,l2) ->
raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2)))
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)))
+ with Error (loc, env, Pattern_type_clash(err, None)) ->
+ raise(Error(loc, env, Pattern_type_clash(err, Some pat.pat_desc)))
(* unification of a type with a Tconstr with freshly created arguments *)
let unify_head_only ~refine loc env ty constr =
- let path =
- match (repr constr.cstr_res).desc with
- | Tconstr(p, _, _) -> p
- | _ -> assert false in
+ let path = cstr_type_path constr in
let decl = Env.find_type path !env in
let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
unify_pat_types ~refine loc env ty' ty
(* make all Reither present in open variants *)
let finalize_variant pat tag opat r =
let row =
- match expand_head pat.pat_env pat.pat_type with
- {desc = Tvariant row} -> r := row; row_repr row
+ match get_desc (expand_head pat.pat_env pat.pat_type) with
+ Tvariant row -> r := row; row
| _ -> assert false
in
- begin match row_field tag row with
+ let f = get_row_field tag row in
+ begin match row_field_repr f with
| Rabsent -> () (* assert false *)
- | Reither (true, [], _, e) when not row.row_closed ->
- set_row_field e (Rpresent None)
- | Reither (false, ty::tl, _, e) when not row.row_closed ->
- set_row_field e (Rpresent (Some ty));
+ | Reither (true, [], _) when not (row_closed row) ->
+ link_row_field_ext ~inside:f (rf_present None)
+ | Reither (false, ty::tl, _) when not (row_closed row) ->
+ link_row_field_ext ~inside:f (rf_present (Some ty));
begin match opat with None -> assert false
| Some pat ->
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))
+ | Reither (c, _l, true) when not (has_fixed_explanation row) ->
+ link_row_field_ext ~inside:f (rf_either [] ~no_arg:c ~matched:false)
| _ -> ()
end
(* Force check of well-formedness WHY? *)
unify_var env (newvar ()) t1;
unify env t1 t2
with
- | Unify trace ->
- raise(Error(loc, env, Or_pattern_type_clash(x1, trace)))
+ | Unify err ->
+ raise(Error(loc, env, Or_pattern_type_clash(x1, err)))
end;
(x2,x1)::unify_vars rem1 rem2
end
raise (Error (loc, env, err)) in
unify_vars p1_vs p2_vs
-let rec build_as_type env p =
- let as_ty = build_as_type_aux env p in
+let rec build_as_type ~refine (env : Env.t ref) p =
+ let as_ty = build_as_type_aux ~refine env p in
(* Cf. #1655 *)
List.fold_left (fun as_ty (extra, _loc, _attrs) ->
match extra with
end_def ();
generalize_structure ty;
(* This call to unify can't fail since the pattern is well typed. *)
- unify !env (instance as_ty) (instance ty);
+ unify_pat_types ~refine p.pat_loc env (instance as_ty) (instance ty);
ty
) as_ty p.pat_extra
-and build_as_type_aux env p =
+and build_as_type_aux ~refine (env : Env.t ref) p =
+ let build_as_type = build_as_type ~refine in
match p.pat_desc with
Tpat_alias(p1,_, _) -> build_as_type env p1
| Tpat_tuple pl ->
if keep then p.pat_type else
let tyl = List.map (build_as_type env) pl in
let ty_args, ty_res, _ = instance_constructor cstr in
- List.iter2 (fun (p,ty) -> unify_pat env {p with pat_type = ty})
+ List.iter2 (fun (p,ty) -> unify_pat ~refine env {p with pat_type = ty})
(List.combine pl tyl) ty_args;
ty_res
| Tpat_variant(l, p', _) ->
let ty = Option.map (build_as_type env) p' in
- newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
- row_bound=(); row_name=None;
- row_fixed=None; row_closed=false})
+ let fields = [l, rf_present ty] in
+ newty (Tvariant (create_row ~fields ~more:(newvar())
+ ~name:None ~fixed:None ~closed:false))
| Tpat_record (lpl,_) ->
let lbl = snd3 (List.hd lpl) in
if lbl.lbl_private = Private then p.pat_type else
let ppl = List.map (fun (_, l, p) -> l.lbl_pos, p) lpl in
let do_label lbl =
let _, ty_arg, ty_res = instance_label false lbl in
- unify_pat env {p with pat_type = ty} ty_res;
+ unify_pat ~refine env {p with pat_type = ty} ty_res;
let refinable =
lbl.lbl_mut = Immutable && List.mem_assoc lbl.lbl_pos ppl &&
- match (repr lbl.lbl_arg).desc with Tpoly _ -> false | _ -> true in
+ match get_desc lbl.lbl_arg with Tpoly _ -> false | _ -> true in
if refinable then begin
let arg = List.assoc lbl.lbl_pos ppl in
- unify_pat env {arg with pat_type = build_as_type env arg} ty_arg
+ unify_pat ~refine 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_pat env p ty_res'
+ unify_pat_types ~refine p.pat_loc env ty_arg ty_arg';
+ unify_pat ~refine env p ty_res'
end in
Array.iter do_label lbl.lbl_all;
ty
begin match row with
None ->
let ty1 = build_as_type env p1 and ty2 = build_as_type env p2 in
- unify_pat env {p2 with pat_type = ty2} ty1;
+ unify_pat ~refine env {p2 with pat_type = ty2} ty1;
ty1
| Some row ->
- let row = row_repr row in
- newty (Tvariant{row with row_closed=false; row_more=newvar()})
+ let Row {fields; fixed; name} = row_repr row in
+ newty (Tvariant (create_row ~fields ~fixed ~name
+ ~closed:false ~more:(newvar())))
end
| Tpat_any | Tpat_var _ | Tpat_constant _
| Tpat_array _ | Tpat_lazy _ -> p.pat_type
let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
unify_pat_types ~refine loc env ty (instance expected_ty);
pattern_force := force :: !pattern_force;
- match ty.desc with
+ match get_desc ty with
| Tpoly (body, tyl) ->
begin_def ();
init_def generic_level;
(cty, ty, ty')
| _ -> assert false
-let solve_Ppat_alias env pat =
+let solve_Ppat_alias ~refine env pat =
begin_def ();
- let ty_var = build_as_type env pat in
+ let ty_var = build_as_type ~refine env pat in
end_def ();
generalize ty_var;
ty_var
[ty2]
| _ ->
unify_pat_types cty.ctyp_loc env ty1 (newty (Ttuple ty_args));
- match repr (expand_head !env ty2) with
- {desc = Ttuple tyl} -> tyl
+ match get_desc (expand_head !env ty2) with
+ Ttuple tyl -> tyl
| _ -> assert false
in
if ids <> [] then ignore begin
let rem =
List.fold_left
(fun rem tv ->
- match repr tv with
- {desc = Tconstr(Path.Pident id, [], _)}
- when List.mem id rem ->
+ match get_desc tv with
+ Tconstr(Path.Pident id, [], _) when List.mem id rem ->
list_remove id rem
| _ ->
raise (Error (cty.ctyp_loc, !env,
solve_constructor_annotation env name_list sty ty_args ty_ex in
ty_args, ty_res, equated_types, existential_ctyp
in
+ if constr.cstr_existentials <> [] then
+ lower_variables_only !env expansion_scope ty_res;
end_def ();
generalize_structure expected_ty;
generalize_structure ty_res;
List.iter generalize_structure ty_args;
- if !Clflags.principal then begin
+ if !Clflags.principal && refine = None then begin
+ (* Do not warn for couter examples *)
let exception Warn_only_once in
try
TypePairs.iter
- (fun (t1, t2) () ->
+ (fun (t1, t2) ->
generalize_structure t1;
generalize_structure t2;
if not (fully_generic t1 && fully_generic t2) then
let (_, ty_arg, ty_res) = instance_label false label in
begin try
unify_pat_types ~refine loc env ty_res (instance record_ty)
- with Error(_loc, _env, Pattern_type_clash(trace, _)) ->
+ with Error(_loc, _env, Pattern_type_clash(err, _)) ->
raise(Error(label_lid.loc, !env,
- Label_mismatch(label_lid.txt, trace)))
+ Label_mismatch(label_lid.txt, err)))
end;
end_def ();
generalize_structure ty_res;
unify_pat_types ~refine loc env ty (instance expected_ty);
(cty, ty, expected_ty')
-let solve_Ppat_variant ~refine loc env tag constant expected_ty =
- let arg_type = if constant then [] else [newgenvar()] in
- let row = { row_fields =
- [tag, Reither(constant, arg_type, true, ref None)];
- row_bound = ();
- row_closed = false;
- row_more = newgenvar ();
- row_fixed = None;
- row_name = None } in
+let solve_Ppat_variant ~refine loc env tag no_arg expected_ty =
+ let arg_type = if no_arg then [] else [newgenvar()] in
+ let fields = [tag, rf_either ~no_arg arg_type ~matched:true] in
+ let make_row more =
+ create_row ~fields ~closed:false ~more ~fixed:None ~name:None
+ in
+ let row = make_row (newgenvar ()) in
let expected_ty = generic_instance expected_ty in
(* PR#7404: allow some_private_tag blindly, as it would not unify with
the abstract row variable *)
if tag <> Parmatch.some_private_tag then
unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty;
- (arg_type, row, instance expected_ty)
+ (arg_type, make_row (newvar ()), instance expected_ty)
(* Building the or-pattern corresponding to a polymorphic variant type *)
let build_or_pat env loc lid =
let tyl = List.map (fun _ -> newvar()) decl.type_params in
let row0 =
let ty = expand_head env (newty(Tconstr(path, tyl, ref Mnil))) in
- match ty.desc with
+ match get_desc ty with
Tvariant row when static_row row -> row
- | _ -> raise(Error(lid.loc, env, Not_a_variant_type lid.txt))
+ | _ -> raise(Error(lid.loc, env, Not_a_polymorphic_variant_type lid.txt))
in
let pats, fields =
List.fold_left
(fun (pats,fields) (l,f) ->
match row_field_repr f with
Rpresent None ->
+ let f = rf_either [] ~no_arg:true ~matched:true in
(l,None) :: pats,
- (l, Reither(true,[], true, ref None)) :: fields
+ (l, f) :: fields
| Rpresent (Some ty) ->
+ let f = rf_either [ty] ~no_arg:false ~matched:true in
(l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
pat_type=ty; pat_extra=[]; pat_attributes=[]})
:: pats,
- (l, Reither(false, [ty], true, ref None)) :: fields
+ (l, f) :: fields
| _ -> pats, fields)
- ([],[]) (row_repr row0).row_fields in
- let row =
- { row_fields = List.rev fields; row_more = newvar(); row_bound = ();
- row_closed = false; row_fixed = None; row_name = Some (path, tyl) }
- in
- let ty = newty (Tvariant row) in
+ ([],[]) (row_fields row0) in
+ let fields = List.rev fields in
+ let name = Some (path, tyl) in
+ let make_row more =
+ create_row ~fields ~more ~closed:false ~fixed:None ~name in
+ let ty = newty (Tvariant (make_row (newvar()))) in
let gloc = {loc with Location.loc_ghost=true} in
- let row' = ref {row with row_more=newvar()} in
+ let row' = ref (make_row (newvar())) in
let pats =
List.map
(fun (l,p) ->
[] ->
(* empty polymorphic variants: not possible with the concrete language
but valid at the ast level *)
- raise(Error(lid.loc, env, Not_a_variant_type lid.txt))
+ raise(Error(lid.loc, env, Not_a_polymorphic_variant_type lid.txt))
| pat :: pats ->
let r =
List.fold_left
in
match decl with
Some {type_manifest = Some ty} ->
- begin match repr ty with
- {desc=Tconstr(p,_,_)} -> expand_path env p
+ begin match get_desc ty with
+ Tconstr(p,_,_) -> expand_path env p
| _ -> assert false
end
| _ ->
exception Wrong_name_disambiguation of Env.t * wrong_name
let get_constr_type_path ty =
- match (repr ty).desc with
+ match get_desc ty with
| Tconstr(p, _, _) -> p
| _ -> assert false
(* warn if there are several distinct candidates in scope *)
let warn_if_ambiguous warn lid env lbl rest =
- Printtyp.Conflicts.reset ();
- let paths = ambiguous_types env lbl rest in
- let expansion =
- Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
- if paths <> [] then
- warn lid.loc
- (Warnings.Ambiguous_name ([Longident.last lid.txt],
- paths, false, expansion))
+ if Warnings.is_active (Ambiguous_name ([],[],false,"")) then begin
+ Printtyp.Conflicts.reset ();
+ let paths = ambiguous_types env lbl rest in
+ let expansion =
+ Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
+ if paths <> [] then
+ warn lid.loc
+ (Warnings.Ambiguous_name ([Longident.last lid.txt],
+ paths, false, expansion))
+ end
(* a non-principal type was used for disambiguation *)
let warn_non_principal warn lid =
(* we selected a name out of the lexical scope *)
let warn_out_of_scope warn lid env tpath =
- let path_s =
- Printtyp.wrap_printing_env ~error:true env
- (fun () -> Printtyp.string_of_path tpath) in
- warn lid.loc
- (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+ if Warnings.is_active (Name_out_of_scope ("",[],false)) then begin
+ let path_s =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> Printtyp.string_of_path tpath) in
+ warn lid.loc
+ (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+ end
(* warn if the selected name is not the last introduced in scope
-- in these cases the resolution is different from pre-disambiguation OCaml
let check_scope_escape loc env level ty =
try Ctype.check_scope_escape env level ty
- with Escape trace ->
- raise(Error(loc, env, Pattern_type_clash([Escape trace], None)))
+ with Escape esc ->
+ (* We don't expand the type here because if we do, we might expand to the
+ type that escaped, leading to confusing error messages. *)
+ let trace = Errortrace.[Escape (map_escape trivial_expansion esc)] in
+ raise (Error(loc,
+ env,
+ Pattern_type_clash(Errortrace.unification_error ~trace, None)))
type pattern_checking_mode =
| Normal
No variable information, as we only backtrack on
patterns without variables (cf. assert statements). *)
type state =
- { snapshot: Btype.snapshot;
+ { snapshot: snapshot;
levels: Ctype.levels;
env: Env.t; }
let save_state env =
| Ppat_alias(sq, name) ->
assert construction_not_used_in_counterexamples;
type_pat Value sq expected_ty (fun q ->
- let ty_var = solve_Ppat_alias env q in
+ let ty_var = solve_Ppat_alias ~refine env q in
let id =
enter_variable ~is_as_variable:true loc name ty_var sp.ppat_attributes
in
pat_env = !env })
| Ppat_construct(lid, sarg) ->
let expected_type =
- try
- let (p0, p, _) = extract_concrete_variant !env expected_ty in
- let principal =
- (repr expected_ty).level = generic_level || not !Clflags.principal
- in
- Some (p0, p, principal)
- with Not_found -> None
+ match extract_concrete_variant !env expected_ty with
+ | Variant_type(p0, p, _) ->
+ Some (p0, p, is_principal expected_ty)
+ | Maybe_a_variant_type -> None
+ | Not_a_variant_type ->
+ let srt = wrong_kind_sort_of_constructor lid.txt in
+ let error = Wrong_expected_kind(srt, Pattern, expected_ty) in
+ raise (Error (loc, !env, error))
in
let constr =
match lid.txt, mode with
solve_Ppat_variant ~refine loc env tag constant expected_ty in
let k arg =
rvp k {
- pat_desc = Tpat_variant(tag, arg, ref {row with row_more = newvar()});
+ pat_desc = Tpat_variant(tag, arg, ref row);
pat_loc = loc; pat_extra = [];
pat_type = pat_type;
pat_attributes = sp.ppat_attributes;
| Ppat_record(lid_sp_list, closed) ->
assert (lid_sp_list <> []);
let expected_type, record_ty =
- try
- let (p0, p,_) = extract_concrete_record !env expected_ty in
- let ty = generic_instance expected_ty in
- let principal =
- (repr expected_ty).level = generic_level || not !Clflags.principal
- in
- Some (p0, p, principal), ty
- with Not_found -> None, newvar ()
+ match extract_concrete_record !env expected_ty with
+ | Record_type(p0, p, _) ->
+ let ty = generic_instance expected_ty in
+ Some (p0, p, is_principal expected_ty), ty
+ | Maybe_a_record_type -> None, newvar ()
+ | Not_a_record_type ->
+ let error = Wrong_expected_kind(Record, Pattern, expected_ty) in
+ raise (Error (loc, !env, error))
in
let type_label_pat (label_lid, label, sarg) k =
let ty_arg =
in
(pat, pv, val_env, met_env)
-let type_self_pattern cl_num privty val_env met_env par_env spat =
+let type_self_pattern env spat =
let open Ast_helper in
- let spat =
- Pat.mk (Ppat_alias (Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")),
- mknoloc ("selfpat-" ^ cl_num)))
- in
+ let spat = Pat.mk(Ppat_alias (spat, mknoloc "selfpat-*")) in
reset_pattern false;
let nv = newvar() in
let pat =
- type_pat Value ~no_existentials:In_self_pattern (ref val_env) spat nv in
+ type_pat Value ~no_existentials:In_self_pattern (ref env) spat nv in
List.iter (fun f -> f()) (get_ref pattern_force);
- let meths = ref Meths.empty in
- let vars = ref Vars.empty in
let pv = !pattern_variables in
pattern_variables := [];
- let (val_env, met_env, par_env) =
- List.fold_right
- (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
- (val_env, met_env, par_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);
- val_attributes = pv_attributes;
- val_loc = pv_loc;
- val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
- }
- ~check:(fun s -> if pv_as_var then Warnings.Unused_var s
- else Warnings.Unused_var_strict s)
- met_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)
+ pat, pv
let delayed_checks = ref []
let reset_delayed_checks () = delayed_checks := []
| Texp_ifthenelse(_cond, ifso, ifnot) ->
is_nonexpansive ifso && is_nonexpansive_opt ifnot
| Texp_sequence (_e1, e2) -> is_nonexpansive e2 (* PR#4354 *)
- | Texp_new (_, _, cl_decl) -> Ctype.class_type_arity cl_decl.cty_type > 0
+ | Texp_new (_, _, cl_decl) -> Btype.class_type_arity cl_decl.cty_type > 0
(* Note: nonexpansive only means no _observable_ side effects *)
| Texp_lazy e -> is_nonexpansive e
| Texp_object ({cstr_fields=fields; cstr_type = { csig_vars=vars}}, _) ->
match sty.ptyp_desc with
Ptyp_arrow (p, _, sty) ->
let ty1 = if is_optional p then type_option (newvar ()) else newvar () in
- newty (Tarrow (p, ty1, approx_type env sty, Cok))
+ newty (Tarrow (p, ty1, approx_type env sty, commu_ok))
| Ptyp_tuple args ->
newty (Ttuple (List.map (approx_type env) args))
| Ptyp_constr (lid, ctl) ->
Pexp_let (_, _, e) -> type_approx env e
| Pexp_fun (p, _, _, e) ->
let ty = if is_optional p then type_option (newvar ()) else newvar () in
- newty (Tarrow(p, ty, type_approx env e, Cok))
+ newty (Tarrow(p, ty, type_approx env e, commu_ok))
| Pexp_function ({pc_rhs=e}::_) ->
- newty (Tarrow(Nolabel, newvar (), type_approx env e, Cok))
+ newty (Tarrow(Nolabel, newvar (), type_approx env e, commu_ok))
| Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e
| Pexp_try (e, _) -> type_approx env e
| Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
| Pexp_constraint (e, sty) ->
let ty = type_approx env e in
let ty1 = approx_type env sty in
- begin try unify env ty ty1 with Unify trace ->
- raise(Error(sexp.pexp_loc, env, Expr_type_clash (trace, None, None)))
+ begin try unify env ty ty1 with Unify err ->
+ raise(Error(sexp.pexp_loc, env, Expr_type_clash (err, None, None)))
end;
ty1
| Pexp_coerce (e, sty1, sty2) ->
let ty = type_approx env e
and ty1 = approx_ty_opt sty1
and ty2 = approx_type env sty2 in
- begin try unify env ty ty1 with Unify trace ->
- raise(Error(sexp.pexp_loc, env, Expr_type_clash (trace, None, None)))
+ begin try unify env ty ty1 with Unify err ->
+ raise(Error(sexp.pexp_loc, env, Expr_type_clash (err, None, None)))
end;
ty2
| _ -> newvar ()
(* List labels in a function type, and whether return type is a variable *)
let rec list_labels_aux env visited ls ty_fun =
let ty = expand_head env ty_fun in
- if List.memq ty visited then
+ if TypeSet.mem ty visited then
List.rev ls, false
- else match ty.desc with
+ else match get_desc ty with
Tarrow (l, _, ty_res, _) ->
- list_labels_aux env (ty::visited) (l::ls) ty_res
+ list_labels_aux env (TypeSet.add ty visited) (l::ls) ty_res
| _ ->
List.rev ls, is_Tvar ty
let list_labels env ty =
- wrap_trace_gadt_instances env (list_labels_aux env [] []) ty
+ wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
(* Check that all univars are safe in a type. Both exp.exp_type and
ty_expected should already be generalized. *)
let pty = instance ty_expected in
begin_def ();
let exp_ty, vars =
- match pty.desc with
+ match get_desc pty with
Tpoly (body, tl) ->
(* Enforce scoping for type_let:
since body is not generic, instance_poly only makes
let ty, complete = polyfy env exp_ty vars in
if not complete then
let ty_expected = instance ty_expected in
- raise (Error (exp.exp_loc, env,
- Less_general(kind, [Errortrace.diff ty ty_expected])))
+ raise (Error(exp.exp_loc,
+ env,
+ Less_general(kind,
+ Errortrace.unification_error
+ ~trace:[Ctype.expanded_diff env
+ ~got:ty ~expected:ty_expected])))
let generalize_and_check_univars env kind exp ty_expected vars =
generalize exp.exp_type;
List.iter generalize vars;
check_univars env kind exp ty_expected vars
-let check_partial_application statement exp =
- let rec f delay =
- let ty = (expand_head exp.exp_env exp.exp_type).desc in
- let check_statement () =
- match ty with
- | Tconstr (p, _, _) when Path.same p Predef.path_unit ->
- ()
- | _ ->
- if statement then
- let rec loop {exp_loc; exp_desc; exp_extra; _} =
- match exp_desc with
- | Texp_let (_, _, e)
- | Texp_sequence (_, e)
- | Texp_letexception (_, e)
- | Texp_letmodule (_, _, _, _, e) ->
- loop e
- | _ ->
- let loc =
- match List.find_opt (function
- | (Texp_constraint _, _, _) -> true
- | _ -> false) exp_extra
- with
- | Some (_, loc, _) -> loc
- | None -> exp_loc
- in
- Location.prerr_warning loc Warnings.Non_unit_statement
+(* [check_statement] implements the [non-unit-statement] check.
+
+ This check is called in contexts where the value of the expression is known
+ to be discarded (eg. the lhs of a sequence). We check that [exp] has type
+ unit, or has an explicit type annotation; otherwise we raise the
+ [non-unit-statement] warning. *)
+
+let check_statement exp =
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tconstr (p, _, _) when Path.same p Predef.path_unit -> ()
+ | Tvar _ -> ()
+ | _ ->
+ let rec loop {exp_loc; exp_desc; exp_extra; _} =
+ match exp_desc with
+ | Texp_let (_, _, e)
+ | Texp_sequence (_, e)
+ | Texp_letexception (_, e)
+ | Texp_letmodule (_, _, _, _, e) ->
+ loop e
+ | _ ->
+ let loc =
+ match List.find_opt (function
+ | (Texp_constraint _, _, _) -> true
+ | _ -> false) exp_extra
+ with
+ | Some (_, loc, _) -> loc
+ | None -> exp_loc
in
- loop exp
- in
- match ty, exp.exp_desc with
- | Tarrow _, _ ->
+ Location.prerr_warning loc Warnings.Non_unit_statement
+ in
+ loop exp
+
+
+(* [check_partial_application] implements the [ignored-partial-application]
+ warning (and if [statement] is [true], also [non-unit-statement]).
+
+ If [exp] has a function type, we check that it is not syntactically the
+ result of a function application, as this is often a bug in certain contexts
+ (eg the rhs of a let-binding or in the argument of [ignore]). For example,
+ [ignore (List.map print_int)] written by mistake instad of [ignore (List.map
+ print_int li)].
+
+ The check can be disabled by explicitly annotating the expression with a type
+ constraint, eg [(e : _ -> _)].
+
+ If [statement] is [true] and the [ignored-partial-application] is {em not}
+ triggered, then the [non-unit-statement] check is performaed (see
+ [check_statement]).
+
+ If the type of [exp] is not known at the time this function is called, the
+ check is retried again after typechecking. *)
+
+let check_partial_application ~statement exp =
+ let check_statement () = if statement then check_statement exp in
+ let doit () =
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tarrow _ ->
let rec check {exp_desc; exp_loc; exp_extra; _} =
if List.exists (function
| (Texp_constraint _, _, _) -> true
end
in
check exp
- | Tvar _, _ ->
- if delay then add_delayed_check (fun () -> f false)
| _ ->
check_statement ()
in
- f true
+ let ty = get_desc (expand_head exp.exp_env exp.exp_type) in
+ match ty with
+ | Tvar _ ->
+ (* The type of [exp] is not known. Delay the check until after
+ typechecking in order to give a chance for the type to become known
+ through unification. *)
+ add_delayed_check doit
+ | _ ->
+ doit ()
(* Check that a type is generalizable at some level *)
let generalizable level ty =
let rec check ty =
- let ty = repr ty in
if not_marked_node ty then
- if ty.level <= level then raise Exit else
+ if get_level ty <= level then raise Exit else
(flip_mark_node ty; iter_type_expr check ty)
in
try check ty; unmark_type ty; true
let contains_variant_either ty =
let rec loop ty =
- let ty = repr ty in
if try_mark_node ty then
- begin match ty.desc with
+ begin match get_desc ty with
Tvariant row ->
- let row = row_repr row in
if not (is_fixed row) then
List.iter
(fun (_,f) ->
match row_field_repr f with Reither _ -> raise Exit | _ -> ())
- row.row_fields;
+ (row_fields row);
iter_row loop row
| _ ->
iter_type_expr loop ty
iter_general_pattern { f = fun (type k) (pat : k general_pattern) ->
match pat.pat_desc with
| Tpat_variant (s, arg, row) ->
- let row = row_repr !row in
+ let row = !row in
if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
- row.row_fields
+ (row_fields row)
|| not (is_fixed row) && not (static_row row) (* same as Ctype.poly *)
then () else
let ty_arg =
match arg with None -> [] | Some p -> [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 = None; row_name = None} in
+ let fields = [s, rf_either ty_arg ~no_arg:(arg=None) ~matched:true] in
+ let row' =
+ create_row ~fields
+ ~more:(newvar ()) ~closed:false ~fixed:None ~name:None in
(* Should fail *)
unify_pat (ref env) {pat with pat_type = newty (Tvariant row')}
(correct_levels pat.pat_type)
let loc = proper_exp_loc exp in
try
unify_exp_types loc env exp.exp_type expected_ty
- with Error(loc, env, Expr_type_clash(trace, tfc, None)) ->
- raise (Error(loc, env, Expr_type_clash(trace, tfc, Some exp.exp_desc)))
+ with Error(loc, env, Expr_type_clash(err, tfc, None)) ->
+ raise (Error(loc, env, Expr_type_clash(err, tfc, Some exp.exp_desc)))
(* If [is_inferred e] is true, [e] will be typechecked without using
the "expected type" provided by the context. *)
| Apply
| Revapply
let check_apply_prim_type prim typ =
- match (repr typ).desc with
+ match get_desc typ with
| Tarrow (Nolabel,a,b,_) ->
- begin match (repr b).desc with
+ begin match get_desc b with
| Tarrow(Nolabel,c,d,_) ->
let f, x, res =
match prim with
| Apply -> a, c, d
| Revapply -> c, a, d
in
- let f, x, res = repr f, repr x, repr res in
- begin match f.desc with
+ begin match get_desc f with
| Tarrow(Nolabel,fl,fr,_) ->
- let fl, fr = repr fl, repr fr in
is_Tvar fl && is_Tvar fr && is_Tvar x && is_Tvar res
- && fl == x && fr == res
+ && Types.eq_type fl x && Types.eq_type fr res
| _ -> false
end
| _ -> false
| None -> f ()
| Some explanation ->
try f ()
- with Error (loc', env', Expr_type_clash(trace', None, exp'))
+ with Error (loc', env', Expr_type_clash(err', None, exp'))
when not loc'.Location.loc_ghost ->
- let err = Expr_type_clash(trace', Some explanation, exp') in
+ let err = Expr_type_clash(err', Some explanation, exp') in
raise (Error (loc', env', err))
let rec type_exp ?recarg env sexp =
match lid.txt with
Longident.Lident txt -> { txt; loc = lid.loc }
| _ -> assert false)
- | Val_self (_, _, cl_num, _) ->
+ | Val_self (_, _, _, cl_num) ->
let (path, _) =
Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
in
Path.(Pdot (Pident (Ident.create_persistent "CamlinternalFormatBasics"),
"format6"))
in
- let is_format = match ty_exp.desc with
+ let is_format = match get_desc ty_exp with
| Tconstr(path, _, _) when Path.same path fmt6_path ->
- if !Clflags.principal && ty_exp.level <> generic_level then
+ if !Clflags.principal && get_level ty_exp <> generic_level then
Location.prerr_warning loc
(Warnings.Not_principal "this coercion to format6");
true
assert (sargs <> []);
let rec lower_args seen ty_fun =
let ty = expand_head env ty_fun in
- if List.memq ty seen then () else
- match ty.desc with
+ if TypeSet.mem ty seen then () else
+ match get_desc ty with
Tarrow (_l, ty_arg, ty_fun, _com) ->
(try unify_var env (newvar()) ty_arg
with Unify _ -> assert false);
- lower_args (ty::seen) ty_fun
+ lower_args (TypeSet.add ty seen) ty_fun
| _ -> ()
in
let type_sfunct sfunct =
end;
let ty = instance funct.exp_type in
end_def ();
- wrap_trace_gadt_instances env (lower_args []) ty;
+ wrap_trace_gadt_instances env (lower_args TypeSet.empty) ty;
funct
in
let funct, sargs =
try rue exp
with Error (_, _, Expr_type_clash _) as err ->
Misc.reraise_preserving_backtrace err (fun () ->
- check_partial_application false exp)
+ check_partial_application ~statement:false exp)
end
| Pexp_match(sarg, caselist) ->
begin_def ();
(* Keep sharing *)
let ty_expected0 = instance ty_expected in
begin try match
- sarg, expand_head env ty_expected, expand_head env ty_expected0 with
- | Some sarg, {desc = Tvariant row}, {desc = Tvariant row0} ->
- let row = row_repr row and row0 = row_repr row0 in
- begin match row_field_repr (List.assoc l row.row_fields),
- row_field_repr (List.assoc l row0.row_fields) with
+ sarg, get_desc (expand_head env ty_expected),
+ get_desc (expand_head env ty_expected0)
+ with
+ | Some sarg, Tvariant row, Tvariant row0 ->
+ begin match
+ row_field_repr (get_row_field l row),
+ row_field_repr (get_row_field l row0)
+ with
Rpresent (Some ty), Rpresent (Some ty0) ->
let arg = type_argument env sarg ty ty0 in
re { exp_desc = Texp_variant(l, Some arg);
exp_type = ty_expected0;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
- | _ -> raise Not_found
+ | _ -> raise Exit
end
- | _ -> raise Not_found
- with Not_found ->
+ | _ -> raise Exit
+ with Exit ->
let arg = Option.map (type_exp env) sarg in
let arg_type = Option.map (fun arg -> arg.exp_type) arg in
+ let row =
+ create_row
+ ~fields: [l, rf_present arg_type]
+ ~more: (newvar ())
+ ~closed: false
+ ~fixed: None
+ ~name: None
+ in
rue {
exp_desc = Texp_variant(l, arg);
exp_loc = loc; exp_extra = [];
- exp_type= newty (Tvariant{row_fields = [l, Rpresent arg_type];
- row_more = newvar ();
- row_bound = ();
- row_closed = false;
- row_fixed = None;
- row_name = None});
+ exp_type = newty (Tvariant row);
exp_attributes = sexp.pexp_attributes;
exp_env = env }
end
Some exp
in
let ty_record, expected_type =
- let get_path ty =
- try
- let (p0, p,_) = extract_concrete_record env ty in
- let principal =
- (repr ty).level = generic_level || not !Clflags.principal
+ let expected_opath =
+ match extract_concrete_record env ty_expected with
+ | Record_type (p0, p, _) -> Some (p0, p, is_principal ty_expected)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error =
+ Wrong_expected_kind(Record, Expression explanation, ty_expected)
in
- Some (p0, p, principal)
- with Not_found -> None
+ raise (Error (loc, env, error))
in
- let opath = get_path ty_expected in
- match opath with
- None | Some (_, _, false) ->
- let ty = if opath = None then newvar () else ty_expected in
- begin match opt_exp with
- None -> ty, opath
- | Some exp ->
- match get_path exp.exp_type with
- None ->
- ty, opath
- | Some (_, p', _) as opath ->
- let decl = Env.find_type p' env in
- begin_def ();
- let ty =
- newconstr p' (instance_list decl.type_params) in
- end_def ();
- generalize_structure ty;
- ty, opath
- end
- | _ -> ty_expected, opath
+ let opt_exp_opath =
+ match opt_exp with
+ | None -> None
+ | Some exp ->
+ match extract_concrete_record env exp.exp_type with
+ | Record_type (p0, p, _) -> Some (p0, p, is_principal exp.exp_type)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error = Expr_not_a_record_type exp.exp_type in
+ raise (Error (exp.exp_loc, env, error))
+ in
+ match expected_opath, opt_exp_opath with
+ | None, None -> newvar (), None
+ | Some _, None -> ty_expected, expected_opath
+ | Some(_, _, true), Some _ -> ty_expected, expected_opath
+ | (None | Some (_, _, false)), Some (_, p', _) ->
+ let decl = Env.find_type p' env in
+ begin_def ();
+ let ty = newconstr p' (instance_list decl.type_params) in
+ end_def ();
+ generalize_structure ty;
+ ty, opt_exp_opath
in
let closed = (opt_sexp = None) in
let lbl_exp_list =
let arg = type_exp env sarg in
end_def ();
let tv = newvar () in
- let gen = generalizable tv.level arg.exp_type in
+ let gen = generalizable (get_level tv) arg.exp_type in
unify_var env tv arg.exp_type;
- begin match arg.exp_desc, !self_coercion, (repr ty').desc with
+ begin match arg.exp_desc, !self_coercion, get_desc ty' with
Texp_ident(_, _, {val_kind=Val_self _}), (path,r) :: _,
Tconstr(path',_,_) when Path.same path path' ->
(* prerr_endline "self coercion"; *)
if not gen && !Clflags.principal then
Location.prerr_warning loc
(Warnings.Not_principal "this ground coercion");
- with Subtype (tr1, tr2) ->
+ with Subtype err ->
(* prerr_endline "coercion failed"; *)
- raise(Error(loc, env, Not_subtype(tr1, tr2)))
+ raise (Error(loc, env, Not_subtype err))
end;
| _ ->
let ty, b = enlarge_type env ty' in
force ();
- begin try Ctype.unify env arg.exp_type ty with Unify trace ->
+ begin try Ctype.unify env arg.exp_type ty with Unify err ->
let expanded = full_expand ~may_forget_scope:true env ty' in
raise(Error(sarg.pexp_loc, env,
- Coercion_failure(ty', expanded, trace, b)))
+ Coercion_failure({ty = ty'; expanded}, err, b)))
end
end;
(arg, ty', None, cty')
and (cty', ty', force') =
Typetexp.transl_simple_type_delayed env sty'
in
- begin try
- let force'' = subtype env ty ty' in
- force (); force' (); force'' ()
- with Subtype (tr1, tr2) ->
- raise(Error(loc, env, Not_subtype(tr1, tr2)))
- end;
end_def ();
generalize_structure ty;
generalize_structure ty';
+ begin try
+ let force'' = subtype env (instance ty) (instance ty') in
+ force (); force' (); force'' ()
+ with Subtype err ->
+ raise (Error(loc, env, Not_subtype err))
+ end;
(type_argument env sarg ty (instance ty),
instance ty', Some cty, cty')
in
| Pexp_send (e, {txt=met}) ->
if !Clflags.principal then begin_def ();
let obj = type_exp env e in
- let obj_meths = ref None in
- begin try
- let (meth, exp, typ) =
- match obj.exp_desc with
- Texp_ident(_path, _, {val_kind = Val_self (meths, _, _, privty)}) ->
- obj_meths := Some meths;
- let (id, typ) =
- filter_self_method env met Private meths privty
- in
- if is_Tvar (repr typ) then
- Location.prerr_warning loc
- (Warnings.Undeclared_virtual_method met);
- (Tmeth_val id, None, typ)
- | Texp_ident(_path, lid, {val_kind = Val_anc (methods, cl_num)}) ->
- let method_id =
- begin try List.assoc met methods with Not_found ->
- let valid_methods = List.map fst methods in
- raise(Error(e.pexp_loc, env,
- Undefined_inherited_method (met, valid_methods)))
- end
- in
- begin match
- 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)),
- (path, _) ->
- obj_meths := Some meths;
- let (_, typ) =
- filter_self_method env met Private meths privty
- in
- let method_type = newvar () in
- let (obj_ty, res_ty) = filter_arrow env method_type Nolabel in
- unify env obj_ty desc.val_type;
- unify env res_ty (instance typ);
- let method_desc =
- {val_type = method_type;
- val_kind = Val_reg;
- val_attributes = [];
- val_loc = Location.none;
- val_uid = Uid.internal_not_actually_unique;
- }
+ let (meth, typ) =
+ match obj.exp_desc with
+ | Texp_ident(_, _, {val_kind = Val_self(sign, meths, _, _)}) ->
+ let id, typ =
+ match meths with
+ | Self_concrete meths ->
+ let id =
+ match Meths.find met meths with
+ | id -> id
+ | exception Not_found ->
+ let valid_methods =
+ Meths.fold (fun lab _ acc -> lab :: acc) meths []
+ in
+ raise (Error(e.pexp_loc, env,
+ Undefined_self_method (met, valid_methods)))
in
- let exp_env = Env.add_value method_id method_desc env in
- let exp =
- Texp_apply({exp_desc =
- Texp_ident(Path.Pident method_id,
- lid, method_desc);
- exp_loc = loc; exp_extra = [];
- exp_type = method_type;
- exp_attributes = []; (* check *)
- exp_env = exp_env},
- [ Nolabel,
- Some {exp_desc = Texp_ident(path, lid, desc);
- exp_loc = obj.exp_loc; exp_extra = [];
- exp_type = desc.val_type;
- exp_attributes = []; (* check *)
- exp_env = exp_env}
- ])
+ let typ = Btype.method_type met sign in
+ id, typ
+ | Self_virtual meths_ref -> begin
+ match Meths.find met !meths_ref with
+ | id -> id, Btype.method_type met sign
+ | exception Not_found ->
+ let id = Ident.create_local met in
+ let ty = newvar () in
+ meths_ref := Meths.add met id !meths_ref;
+ add_method env met Private Virtual ty sign;
+ Location.prerr_warning loc
+ (Warnings.Undeclared_virtual_method met);
+ id, ty
+ end
+ in
+ Tmeth_val id, typ
+ | Texp_ident(_, _, {val_kind = Val_anc (sign, meths, cl_num)}) ->
+ let id =
+ match Meths.find met meths with
+ | id -> id
+ | exception Not_found ->
+ let valid_methods =
+ Meths.fold (fun lab _ acc -> lab :: acc) meths []
in
- (Tmeth_name met, Some (re {exp_desc = exp;
- exp_loc = loc; exp_extra = [];
- exp_type = typ;
- exp_attributes = []; (* check *)
- exp_env = exp_env}), typ)
- | _ ->
- assert false
- end
- | _ ->
- (Tmeth_name met, None,
- filter_method env met Public obj.exp_type)
- in
- if !Clflags.principal then begin
- end_def ();
- generalize_structure typ;
- end;
- let typ =
- match repr typ with
- {desc = Tpoly (ty, [])} ->
- instance ty
- | {desc = Tpoly (ty, tl); level = l} ->
- if !Clflags.principal && l <> generic_level then
- Location.prerr_warning loc
- (Warnings.Not_principal "this use of a polymorphic method");
- snd (instance_poly false tl ty)
- | {desc = Tvar _} as ty ->
- let ty' = newvar () in
- unify env (instance ty) (newty(Tpoly(ty',[])));
- (* if not !Clflags.nolabels then
- Location.prerr_warning loc (Warnings.Unknown_method met); *)
- ty'
- | _ ->
- assert false
- in
- rue {
- exp_desc = Texp_send(obj, meth, exp);
- exp_loc = loc; exp_extra = [];
- exp_type = typ;
- exp_attributes = sexp.pexp_attributes;
- exp_env = env }
- with Unify _ ->
- let valid_methods =
- match !obj_meths with
- | Some meths ->
- Some (Meths.fold (fun meth _meth_ty li -> meth::li) !meths [])
- | None ->
- match (expand_head env obj.exp_type).desc with
- | Tobject (fields, _) ->
- let (fields, _) = Ctype.flatten_fields fields in
- let collect_fields li (meth, meth_kind, _meth_ty) =
- if meth_kind = Fpresent then meth::li else li in
- Some (List.fold_left collect_fields [] fields)
- | _ -> None
- in
- raise(Error(e.pexp_loc, env,
- Undefined_method (obj.exp_type, met, valid_methods)))
- end
+ raise (Error(e.pexp_loc, env,
+ Undefined_self_method (met, valid_methods)))
+ in
+ let typ = Btype.method_type met sign in
+ let (self_path, _) =
+ Env.find_value_by_name
+ (Longident.Lident ("self-" ^ cl_num)) env
+ in
+ Tmeth_ancestor(id, self_path), typ
+ | _ ->
+ let ty =
+ match filter_method env met obj.exp_type with
+ | ty -> ty
+ | exception Filter_method_failed err ->
+ let error =
+ match err with
+ | Unification_error err ->
+ Expr_type_clash(err, explanation, None)
+ | Not_an_object ty ->
+ Not_an_object(ty, explanation)
+ | Not_a_method ->
+ let valid_methods =
+ match get_desc (expand_head env obj.exp_type) with
+ | Tobject (fields, _) ->
+ let (fields, _) = Ctype.flatten_fields fields in
+ let collect_fields li (meth, meth_kind, _meth_ty) =
+ if field_kind_repr meth_kind = Fpublic
+ then meth::li else li
+ in
+ Some (List.fold_left collect_fields [] fields)
+ | _ -> None
+ in
+ Undefined_method(obj.exp_type, met, valid_methods)
+ in
+ raise (Error(e.pexp_loc, env, error))
+ in
+ Tmeth_name met, ty
+ in
+ if !Clflags.principal then begin
+ end_def ();
+ generalize_structure typ;
+ end;
+ let typ =
+ match get_desc typ with
+ | Tpoly (ty, []) ->
+ instance ty
+ | Tpoly (ty, tl) ->
+ if !Clflags.principal && get_level typ <> generic_level then
+ Location.prerr_warning loc
+ (Warnings.Not_principal "this use of a polymorphic method");
+ snd (instance_poly false tl ty)
+ | Tvar _ ->
+ let ty' = newvar () in
+ unify env (instance typ) (newty(Tpoly(ty',[])));
+ (* if not !Clflags.nolabels then
+ Location.prerr_warning loc (Warnings.Unknown_method met); *)
+ ty'
+ | _ ->
+ assert false
+ in
+ rue {
+ exp_desc = Texp_send(obj, meth);
+ exp_loc = loc; exp_extra = [];
+ exp_type = typ;
+ exp_attributes = sexp.pexp_attributes;
+ exp_env = env }
| Pexp_new cl ->
let (cl_path, cl_decl) = Env.lookup_class ~loc:cl.loc cl.txt env in
begin match cl_decl.cty_new with
with Not_found ->
raise(Error(loc, env, Outside_class))
with
- (_, {val_type = self_ty; val_kind = Val_self (_, vars, _, _)}),
+ (_, {val_type = self_ty; val_kind = Val_self (sign, _, vars, _)}),
(path_self, _) ->
let type_override (lab, snewval) =
begin try
- let (id, _, _, ty) = Vars.find lab.txt !vars in
- (Path.Pident id, lab,
- type_expect env snewval (mk_expected (instance ty)))
+ let id = Vars.find lab.txt vars in
+ let ty = Btype.instance_variable_type lab.txt sign in
+ (id, lab, type_expect env snewval (mk_expected (instance ty)))
with
Not_found ->
- let vars = Vars.fold (fun var _ li -> var::li) !vars [] in
+ let vars = Vars.fold (fun var _ li -> var::li) vars [] in
raise(Error(loc, env,
Unbound_instance_variable (lab.txt, vars)))
end
(* remember original level *)
begin_def ();
let context = Typetexp.narrow () in
- let modl = !type_module env smodl in
- Mtype.lower_nongen ty.level modl.mod_type;
+ let modl, md_shape = !type_module env smodl in
+ Mtype.lower_nongen (get_level ty) modl.mod_type;
let pres =
match modl.mod_type with
| Mty_alias _ -> Mp_absent
match name.txt with
| None -> None, env
| Some name ->
- let id, env = Env.enter_module_declaration ~scope name pres md env in
+ let id, env =
+ Env.enter_module_declaration ~scope ~shape:md_shape name pres md env
+ in
Some id, env
in
Typetexp.widen context;
exp_env = env;
}
| Pexp_object s ->
- let desc, sign, meths = !type_object env loc s in
+ let desc, meths = !type_object env loc s in
rue {
- exp_desc = Texp_object (desc, (*sign,*) meths);
+ exp_desc = Texp_object (desc, meths);
exp_loc = loc; exp_extra = [];
- exp_type = sign.csig_self;
+ exp_type = desc.cstr_type.csig_self;
exp_attributes = sexp.pexp_attributes;
exp_env = env;
}
| Pexp_poly(sbody, sty) ->
if !Clflags.principal then begin_def ();
let ty, cty =
- match sty with None -> repr ty_expected, None
+ match sty with None -> ty_expected, None
| Some sty ->
let sty = Ast_helper.Typ.force_poly sty in
let cty = Typetexp.transl_simple_type env false sty in
- repr cty.ctyp_type, Some cty
+ cty.ctyp_type, Some cty
in
if !Clflags.principal then begin
end_def ();
with_explanation (fun () ->
unify_exp_types loc env (instance ty) (instance ty_expected));
let exp =
- match (expand_head env ty).desc with
+ match get_desc (expand_head env ty) with
Tpoly (ty', []) ->
let exp = type_expect env sbody (mk_expected ty') in
{ exp with exp_type = instance ty }
type. *)
let seen = Hashtbl.create 8 in
let rec replace t =
- if Hashtbl.mem seen t.id then ()
+ if Hashtbl.mem seen (get_id t) then ()
else begin
- Hashtbl.add seen t.id ();
- match t.desc with
+ Hashtbl.add seen (get_id t) ();
+ match get_desc t with
| Tconstr (Path.Pident id', _, _) when id == id' -> link_type t ty
| _ -> Btype.iter_type_expr replace t
end
(Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra }
| Pexp_pack m ->
let (p, fl) =
- match Ctype.expand_head env (instance ty_expected) with
- {desc = Tpackage (p, fl)} ->
+ match get_desc (Ctype.expand_head env (instance ty_expected)) with
+ Tpackage (p, fl) ->
if !Clflags.principal &&
- (Ctype.expand_head env ty_expected).level < Btype.generic_level
+ get_level (Ctype.expand_head env ty_expected)
+ < Btype.generic_level
then
Location.prerr_warning loc
(Warnings.Not_principal "this module packing");
(p, fl)
- | {desc = Tvar _} ->
+ | Tvar _ ->
raise (Error (loc, env, Cannot_infer_signature))
| _ ->
raise (Error (loc, env, Not_a_packed_module ty_expected))
let op_type = instance op_desc.val_type in
let spat_params, ty_params = loop slet.pbop_pat (newvar ()) sands in
let ty_func_result = newvar () in
- let ty_func = newty (Tarrow(Nolabel, ty_params, ty_func_result, Cok)) in
+ let ty_func =
+ newty (Tarrow(Nolabel, ty_params, ty_func_result, commu_ok)) in
let ty_result = newvar () in
let ty_andops = newvar () in
let ty_op =
newty (Tarrow(Nolabel, ty_andops,
- newty (Tarrow(Nolabel, ty_func, ty_result, Cok)), Cok))
+ newty (Tarrow(Nolabel, ty_func, ty_result, commu_ok)), commu_ok))
in
begin try
unify env op_type ty_op
- with Unify trace ->
- raise(Error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, trace)))
+ with Unify err ->
+ raise(Error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, err)))
end;
if !Clflags.principal then begin
end_def ();
and type_ident env ?(recarg=Rejected) lid =
let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
let is_recarg =
- match (repr desc.val_type).desc with
+ match get_desc desc.val_type with
| Tconstr(p, _, _) -> Path.is_constructor_typath p
| _ -> false
in
- begin match is_recarg, recarg, (repr desc.val_type).desc with
+ begin match is_recarg, recarg, get_desc desc.val_type with
| _, Allowed, _
| true, Required, _
| false, Rejected, _ -> ()
match desc.val_kind with
| Val_ivar _ ->
fatal_error "Illegal name for instance variable"
- | Val_self (_, _, cl_num, _) ->
+ | Val_self (_, _, _, cl_num) ->
let path, _ =
Env.find_value_by_name (Longident.Lident ("self-" ^ cl_num)) env
in
if separate then begin_def ();
let (ty_arg, ty_res) =
try filter_arrow env (instance ty_expected) arg_label
- with Unify _ ->
- match expand_head env ty_expected with
- {desc = Tarrow _} as ty ->
- raise(Error(loc, env,
- Abstract_wrong_label(arg_label, ty, explanation)))
- | _ ->
- raise(Error(loc_fun, env,
- Too_many_arguments (in_function <> None,
- ty_fun,
- explanation)))
+ with Filter_arrow_failed err ->
+ let err = match err with
+ | Unification_error unif_err ->
+ Expr_type_clash(unif_err, explanation, None)
+ | Label_mismatch { got; expected; expected_type} ->
+ Abstract_wrong_label { got; expected; expected_type; explanation }
+ | Not_a_function -> begin
+ match in_function with
+ | Some _ -> Too_many_arguments(ty_fun, explanation)
+ | None -> Not_a_function(ty_fun, explanation)
+ end
+ in
+ raise (Error(loc_fun, env, err))
in
let ty_arg =
if is_optional arg_label then
re {
exp_desc = Texp_function { arg_label; param; cases; partial; };
exp_loc = loc; exp_extra = [];
- exp_type = instance (newgenty (Tarrow(arg_label, ty_arg, ty_res, Cok)));
+ exp_type =
+ instance (newgenty (Tarrow(arg_label, ty_arg, ty_res, commu_ok)));
exp_attributes = attrs;
exp_env = env }
end;
let ty_exp = record.exp_type in
let expected_type =
- try
- let (p0, p,_) = extract_concrete_record env ty_exp in
- Some(p0, p, (repr ty_exp).level = generic_level || not !Clflags.principal)
- with Not_found -> None
+ match extract_concrete_record env ty_exp with
+ | Record_type(p0, p, _) ->
+ Some(p0, p, is_principal ty_exp)
+ | Maybe_a_record_type -> None
+ | Not_a_record_type ->
+ let error = Expr_not_a_record_type ty_exp in
+ raise (Error (record.exp_loc, env, error))
in
let labels = Env.lookup_all_labels ~loc:lid.loc usage lid.txt env in
let label =
end;
begin try
unify env (instance ty_res) (instance ty_expected)
- with Unify trace ->
- raise (Error(lid.loc, env, Label_mismatch(lid.txt, trace)))
+ with Unify err ->
+ raise (Error(lid.loc, env, Label_mismatch(lid.txt, err)))
end;
(* Instantiate so that we can generalize internal nodes *)
let ty_arg = instance ty_arg in
let may_coerce =
if not (is_inferred sarg) then None else
let work () =
- match expand_head env ty_expected' with
- {desc = Tarrow(Nolabel,_,ty_res0,_); level} ->
- Some (no_labels ty_res0, level)
+ let te = expand_head env ty_expected' in
+ match get_desc te with
+ Tarrow(Nolabel,_,ty_res0,_) ->
+ Some (no_labels ty_res0, get_level te)
| _ -> None
in
(* Need to be careful not to expand local constraints here *)
generalize_structure texp.exp_type
end;
let rec make_args args ty_fun =
- match (expand_head env ty_fun).desc with
+ match get_desc (expand_head env ty_fun) with
| Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
let ty = option_none env (instance ty_arg) sarg.pexp_loc in
make_args ((l, Some ty) :: args) ty_fun
texp
end else begin
let warn = !Clflags.principal &&
- (lv <> generic_level || (repr ty_fun').level <> generic_level)
+ (lv <> generic_level || get_level ty_fun' <> generic_level)
and ty_fun = instance ty_fun' in
let ty_arg, ty_res =
- match expand_head env ty_expected' with
- {desc = Tarrow(Nolabel,ty_arg,ty_res,_)} -> ty_arg, ty_res
+ match get_desc (expand_head env ty_expected') with
+ Tarrow(Nolabel,ty_arg,ty_res,_) -> ty_arg, ty_res
| _ -> assert false
in
unify_exp env {texp with exp_type = ty_fun} ty_expected;
(* funct.exp_type may be generic *)
let result_type omitted ty_fun =
List.fold_left
- (fun ty_fun (l,ty,lv) -> newty2 lv (Tarrow(l,ty,ty_fun,Cok)))
+ (fun ty_fun (l,ty,lv) -> newty2 ~level:lv (Tarrow(l,ty,ty_fun,commu_ok)))
ty_fun omitted
in
let has_label l ty_fun =
let type_unknown_arg (ty_fun, typed_args) (lbl, sarg) =
let (ty_arg, ty_res) =
let ty_fun = expand_head env ty_fun in
- match ty_fun.desc with
+ match get_desc ty_fun with
| Tvar _ ->
let t1 = newvar () and t2 = newvar () in
- if ty_fun.level >= t1.level &&
+ if get_level ty_fun >= get_level t1 &&
not (is_prim ~name:"%identity" funct)
then
Location.prerr_warning sarg.pexp_loc
Warnings.Ignored_extra_argument;
- unify env ty_fun (newty (Tarrow(lbl,t1,t2,Clink(ref Cunknown))));
+ unify env ty_fun (newty (Tarrow(lbl,t1,t2,commu_var ())));
(t1, t2)
| Tarrow (l,t1,t2,_) when l = lbl
|| !Clflags.classic && lbl = Nolabel && not (is_optional l) ->
result_type (!omitted_parameters @ !eliminated_optional_arguments)
ty_fun
in
- match ty_res.desc with
+ match get_desc ty_res with
| Tarrow _ ->
if !Clflags.classic || not (has_label lbl ty_fun) then
raise (Error(sarg.pexp_loc, env,
in
let warned = ref false in
let rec type_args args ty_fun ty_fun0 sargs =
- match expand_head env ty_fun, expand_head env ty_fun0 with
- | {desc=Tarrow (l, ty, ty_fun, com); level=lv} as ty_fun',
- {desc=Tarrow (_, ty0, ty_fun0, _)}
- when sargs <> [] && commu_repr com = Cok ->
+ let ty_fun' = expand_head env ty_fun in
+ match get_desc ty_fun', get_desc (expand_head env ty_fun0) with
+ | Tarrow (l, ty, ty_fun, com), Tarrow (_, ty0, ty_fun0, _)
+ when sargs <> [] && is_commu_ok com ->
+ let lv = get_level ty_fun' in
let may_warn loc w =
if not !warned && !Clflags.principal && lv <> generic_level
then begin
let is_ignore funct =
is_prim ~name:"%ignore" funct &&
(try ignore (filter_arrow env (instance funct.exp_type) Nolabel); true
- with Unify _ -> false)
+ with Filter_arrow_failed _ -> false)
in
match sargs with
| (* Special case for ignore: avoid discarding warning *)
[Nolabel, sarg] when is_ignore funct ->
let ty_arg, ty_res = filter_arrow env (instance funct.exp_type) Nolabel in
let exp = type_expect env sarg (mk_expected ty_arg) in
- check_partial_application false exp;
+ check_partial_application ~statement:false exp;
([Nolabel, Some exp], ty_res)
| _ ->
let ty = funct.exp_type in
and type_construct env loc lid sarg ty_expected_explained attrs =
let { ty = ty_expected; explanation } = ty_expected_explained in
let expected_type =
- try
- let (p0, p,_) = extract_concrete_variant env ty_expected in
- let principal =
- (repr ty_expected).level = generic_level || not !Clflags.principal
- in
- Some(p0, p, principal)
- with Not_found -> None
+ match extract_concrete_variant env ty_expected with
+ | Variant_type(p0, p,_) ->
+ Some(p0, p, is_principal ty_expected)
+ | Maybe_a_variant_type -> None
+ | Not_a_variant_type ->
+ let srt = wrong_kind_sort_of_constructor lid.txt in
+ let ctx = Expression explanation in
+ let error = Wrong_expected_kind(srt, ctx, ty_expected) in
+ raise (Error (loc, env, error))
in
let constrs =
Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
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
+ if is_Tvar ty && get_level ty > get_level tv then
Location.prerr_warning
(final_subexpression exp).exp_loc
Warnings.Nonreturning_statement;
unify_exp env exp expected_ty);
exp
else begin
- check_partial_application true exp;
+ check_partial_application ~statement:true exp;
unify_var env tv ty;
exp
end
and type_unpacks ?(in_function : (Location.t * type_expr) option)
env (unpacks : to_unpack list) sbody expected_ty =
+ if unpacks = [] then type_expect ?in_function env sbody expected_ty else
let ty = newvar() in
(* remember original level *)
let extended_env, tunpacks =
List.fold_left (fun (env, tunpacks) unpack ->
begin_def ();
let context = Typetexp.narrow () in
- let modl =
+ let modl, md_shape =
!type_module env
Ast_helper.(
Mod.unpack ~loc:unpack.tu_loc
(mkloc (Longident.Lident unpack.tu_name.txt)
unpack.tu_name.loc)))
in
- Mtype.lower_nongen ty.level modl.mod_type;
+ Mtype.lower_nongen (get_level ty) modl.mod_type;
let pres =
match modl.mod_type with
| Mty_alias _ -> Mp_absent
md_uid = unpack.tu_uid; }
in
let (id, env) =
- Env.enter_module_declaration ~scope unpack.tu_name.txt pres md env
+ Env.enter_module_declaration ~scope ~shape:md_shape
+ unpack.tu_name.txt pres md env
in
Typetexp.widen context;
env, (id, unpack.tu_name, pres, modl) :: tunpacks
List.iter2
(fun pat binding ->
let pat =
- match pat.pat_type.desc with
+ match get_desc pat.pat_type with
| Tpoly (ty, tl) ->
{pat with pat_type =
snd (instance_poly ~keep_names:true false tl ty)}
List.map2
(fun {pvb_expr=sexp; pvb_attributes; _} (pat, slot) ->
if is_recursive then current_slot := slot;
- match pat.pat_type.desc with
+ match get_desc pat.pat_type with
| Tpoly (ty, tl) ->
if !Clflags.principal then begin_def ();
let vars, ty' = instance_poly ~keep_names:true true tl ty in
| {vb_pat = {pat_desc = Tpat_any; pat_extra; _}; vb_expr; _} ->
if not (List.exists (function (Tpat_constraint _, _, _) -> true
| _ -> false) pat_extra) then
- check_partial_application false vb_expr
+ check_partial_application ~statement:false vb_expr
| _ -> ()) l;
(l, new_env, unpacks)
let ty_arg = newvar () in
let ty_rest = newvar () in
let ty_result = newvar() in
- let ty_rest_fun = newty (Tarrow(Nolabel, ty_arg, ty_result, Cok)) in
- let ty_op = newty (Tarrow(Nolabel, ty_rest, ty_rest_fun, Cok)) in
+ let ty_rest_fun =
+ newty (Tarrow(Nolabel, ty_arg, ty_result, commu_ok)) in
+ let ty_op = newty (Tarrow(Nolabel, ty_rest, ty_rest_fun, commu_ok)) in
begin try
unify env op_type ty_op
- with Unify trace ->
- raise(Error(sop.loc, env, Andop_type_clash(sop.txt, trace)))
+ with Unify err ->
+ raise(Error(sop.loc, env, Andop_type_clash(sop.txt, err)))
end;
if !Clflags.principal then begin
end_def ();
let exp = type_expect env sexp (mk_expected ty_arg) in
begin try
unify env (instance ty_result) (instance expected_ty)
- with Unify trace ->
- raise(Error(loc, env, Bindings_type_clash(trace)))
+ with Unify err ->
+ raise(Error(loc, env, Bindings_type_clash(err)))
end;
let andop =
{ bop_op_name = sop;
| _, _ -> []
let report_literal_type_constraint const = function
- | Some Errortrace.{ expected = { t = { desc = Tconstr (typ, [], _) } } } ->
- report_literal_type_constraint typ const
- | Some _ | None -> []
+ | Some tr ->
+ begin match get_desc Errortrace.(tr.expected.ty) with
+ Tconstr (typ, [], _) ->
+ report_literal_type_constraint typ const
+ | _ -> []
+ end
+ | None -> []
let report_expr_type_clash_hints exp diff =
match exp with
| None -> ()
| Some expl -> report_type_expected_explanation expl ppf
-let report_unification_error ~loc ?sub env trace
+let report_unification_error ~loc ?sub env err
?type_expected_explanation txt1 txt2 =
Location.error_of_printer ~loc ?sub (fun ppf () ->
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_unification_error ppf env err
?type_expected_explanation txt1 txt2
) ()
"@[The constructor %a@ expects %i argument(s),@ \
but is applied here to %i argument(s)@]"
longident lid expected provided
- | Label_mismatch(lid, trace) ->
- report_unification_error ~loc env trace
+ | Label_mismatch(lid, err) ->
+ report_unification_error ~loc env err
(function ppf ->
fprintf ppf "The record field %a@ belongs to the type"
longident lid)
(function ppf ->
fprintf ppf "but is mixed here with fields of type")
- | Pattern_type_clash (trace, pat) ->
- let diff = type_clash_of_trace trace in
+ | Pattern_type_clash (err, pat) ->
+ let diff = type_clash_of_trace err.trace in
let sub = report_pattern_type_clash_hints pat diff in
- report_unification_error ~loc ~sub env trace
+ report_unification_error ~loc ~sub env err
(function ppf ->
fprintf ppf "This pattern matches values of type")
(function ppf ->
fprintf ppf "but a pattern was expected which matches values of \
type");
- | Or_pattern_type_clash (id, trace) ->
- report_unification_error ~loc env trace
+ | Or_pattern_type_clash (id, err) ->
+ report_unification_error ~loc env err
(function ppf ->
fprintf ppf "The variable %s on the left-hand side of this \
or-pattern has type" (Ident.name id))
(Ident.name id);
spellcheck_idents ppf id valid_idents
) ()
- | Expr_type_clash (trace, explanation, exp) ->
- let diff = type_clash_of_trace trace in
+ | Expr_type_clash (err, explanation, exp) ->
+ let diff = type_clash_of_trace err.trace in
let sub = report_expr_type_clash_hints exp diff in
- report_unification_error ~loc ~sub env trace
+ report_unification_error ~loc ~sub env err
~type_expected_explanation:
(report_type_expected_explanation_opt explanation)
(function ppf ->
(function ppf ->
fprintf ppf "but an expression was expected of type");
| Apply_non_function typ ->
- begin match (repr typ).desc with
+ begin match get_desc typ with
Tarrow _ ->
Location.errorf ~loc
"@[<v>@[<2>This function has type@ %a@]\
) ()
| Invalid_format msg ->
Location.errorf ~loc "%s" msg
+ | Not_an_object (ty, explanation) ->
+ Location.error_of_printer ~loc (fun ppf () ->
+ fprintf ppf "This expression is not an object;@ \
+ it has type %a"
+ Printtyp.type_expr ty;
+ report_type_expected_explanation_opt explanation ppf
+ ) ()
| Undefined_method (ty, me, valid_methods) ->
Location.error_of_printer ~loc (fun ppf () ->
Printtyp.wrap_printing_env ~error:true env (fun () ->
| Some valid_methods -> spellcheck ppf me valid_methods
end
)) ()
- | Undefined_inherited_method (me, valid_methods) ->
+ | Undefined_self_method (me, valid_methods) ->
Location.error_of_printer ~loc (fun ppf () ->
fprintf ppf "This expression has no method %s" me;
spellcheck ppf me valid_methods;
) ()
| Instance_variable_not_mutable v ->
Location.errorf ~loc "The instance variable %s is not mutable" v
- | Not_subtype(tr1, tr2) ->
+ | Not_subtype err ->
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.Subtype.report_error ppf env tr1 "is not a subtype of" tr2
+ Printtyp.Subtype.report_error ppf env err "is not a subtype of"
) ()
| Outside_class ->
Location.errorf ~loc
Location.errorf ~loc
"The instance variable %s is overridden several times"
v
- | Coercion_failure (ty, ty', trace, b) ->
+ | Coercion_failure (ty_exp, err, b) ->
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_unification_error ppf env err
(function ppf ->
- let ty, ty' = Printtyp.prepare_expansion (ty, ty') in
+ let ty_exp = Printtyp.prepare_expansion ty_exp in
fprintf ppf "This expression cannot be coerced to type@;<1 2>%a;@ \
it has type"
- (Printtyp.type_expansion ty) ty')
+ (Printtyp.type_expansion Type) ty_exp)
(function ppf ->
fprintf ppf "but is here used with type");
if b then
"Hint: Consider using a fully explicit coercion"
"of the form: `(foo : ty1 :> ty2)'."
) ()
- | Too_many_arguments (in_function, ty, explanation) ->
- if in_function then begin
- Location.errorf ~loc
- "This function expects too many arguments,@ \
- it should have type@ %a%t"
- Printtyp.type_expr ty
- (report_type_expected_explanation_opt explanation)
- end else begin
- Location.errorf ~loc
- "This expression should not be a function,@ \
- the expected type is@ %a%t"
- Printtyp.type_expr ty
- (report_type_expected_explanation_opt explanation)
- end
- | Abstract_wrong_label (l, ty, explanation) ->
- let label_mark = function
- | Nolabel -> "but its first argument is not labelled"
- | l -> sprintf "but its first argument is labelled %s"
- (prefixed_label_name l) in
+ | Not_a_function (ty, explanation) ->
+ Location.errorf ~loc
+ "This expression should not be a function,@ \
+ the expected type is@ %a%t"
+ Printtyp.type_expr ty
+ (report_type_expected_explanation_opt explanation)
+ | Too_many_arguments (ty, explanation) ->
Location.errorf ~loc
- "@[<v>@[<2>This function should have type@ %a%t@]@,%s@]"
+ "This function expects too many arguments,@ \
+ it should have type@ %a%t"
Printtyp.type_expr ty
(report_type_expected_explanation_opt explanation)
- (label_mark l)
+ | Abstract_wrong_label {got; expected; expected_type; explanation} ->
+ let label ~long = function
+ | Nolabel -> "unlabeled"
+ | l -> (if long then "labeled " else "") ^ prefixed_label_name l
+ in
+ let second_long = match got, expected with
+ | Nolabel, _ | _, Nolabel -> true
+ | _ -> false
+ in
+ Location.errorf ~loc
+ "@[<v>@[<2>This function should have type@ %a%t@]@,\
+ @[but its first argument is %s@ instead of %s%s@]@]"
+ Printtyp.type_expr expected_type
+ (report_type_expected_explanation_opt explanation)
+ (label ~long:true got)
+ (if second_long then "being " else "")
+ (label ~long:second_long expected)
| Scoping_let_module(id, ty) ->
Location.errorf ~loc
"This `let module' expression has type@ %a@ \
Location.errorf ~loc
"Cannot use private constructor %s to create values of type %a"
constr.cstr_name Printtyp.type_expr ty
- | Not_a_variant_type lid ->
+ | Not_a_polymorphic_variant_type lid ->
Location.errorf ~loc "The type %a@ is not a variant type" longident lid
| Incoherent_label_order ->
Location.errorf ~loc
"This function is applied to arguments@ \
in an order different from other calls.@ \
This is only allowed when the real type is known."
- | Less_general (kind, trace) ->
- report_unification_error ~loc env trace
+ | Less_general (kind, err) ->
+ report_unification_error ~loc env err
(fun ppf -> fprintf ppf "This %s has type" kind)
(fun ppf -> fprintf ppf "which is less general than")
| Modules_not_allowed ->
| Illegal_class_expr ->
Location.errorf ~loc
"This kind of recursive class expression is not allowed"
- | Letop_type_clash(name, trace) ->
- report_unification_error ~loc env trace
+ | Letop_type_clash(name, err) ->
+ report_unification_error ~loc env err
(function ppf ->
fprintf ppf "The operator %s has type" name)
(function ppf ->
fprintf ppf "but it was expected to have type")
- | Andop_type_clash(name, trace) ->
- report_unification_error ~loc env trace
+ | Andop_type_clash(name, err) ->
+ report_unification_error ~loc env err
(function ppf ->
fprintf ppf "The operator %s has type" name)
(function ppf ->
fprintf ppf "but it was expected to have type")
- | Bindings_type_clash(trace) ->
- report_unification_error ~loc env trace
+ | Bindings_type_clash(err) ->
+ report_unification_error ~loc env err
(function ppf ->
fprintf ppf "These bindings have type")
(function ppf ->
"@[%s@ %s@]"
"Existential types introduced in a constructor pattern"
"must be bound by a type constraint on the argument."
+ | Wrong_expected_kind(sort, ctx, ty) ->
+ let ctx, explanation =
+ match ctx with
+ | Expression explanation -> "expression", explanation
+ | Pattern -> "pattern", None
+ in
+ let sort =
+ match sort with
+ | Constructor -> "constructor"
+ | Boolean -> "boolean literal"
+ | List -> "list literal"
+ | Unit -> "unit literal"
+ | Record -> "record"
+ in
+ Location.errorf ~loc
+ "This %s should not be a %s,@ \
+ the expected type is@ %a%t"
+ ctx sort Printtyp.type_expr ty
+ (report_type_expected_explanation_opt explanation)
+ | Expr_not_a_record_type ty ->
+ Location.errorf ~loc
+ "This expression has type %a@ \
+ which is not a record type."
+ Printtyp.type_expr ty
let report_error ~loc env err =
Printtyp.wrap_printing_env ~error:true env
explanation: type_forcing_context option;
}
+(* Variables in patterns *)
+type pattern_variable =
+ {
+ pv_id: Ident.t;
+ pv_type: type_expr;
+ pv_loc: Location.t;
+ pv_as_var: bool;
+ pv_attributes: Typedtree.attributes;
+ }
+
val mk_expected:
?explanation:type_forcing_context ->
type_expr ->
valid_names: string list;
}
+type wrong_kind_context =
+ | Pattern
+ | Expression of type_forcing_context option
+
+type wrong_kind_sort =
+ | Constructor
+ | Record
+ | Boolean
+ | List
+ | Unit
+
type existential_restriction =
| At_toplevel (** no existential types at the toplevel *)
| In_group (** nor with [let ... and ...] *)
(Ident.t * Ident.t * type_expr) list *
Env.t * Env.t
val type_self_pattern:
- string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern ->
- Typedtree.pattern *
- (Ident.t * type_expr) Meths.t ref *
- (Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr)
- Vars.t ref *
- Env.t * Env.t * Env.t
+ Env.t -> Parsetree.pattern ->
+ Typedtree.pattern * pattern_variable list
val check_partial:
?lev:int -> Env.t -> type_expr ->
Location.t -> Typedtree.value Typedtree.case list -> Typedtree.partial
type error =
| Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * Errortrace.unification Errortrace.t
+ | Label_mismatch of Longident.t * Errortrace.unification_error
| Pattern_type_clash :
- Errortrace.unification Errortrace.t * _ Typedtree.pattern_desc option
+ Errortrace.unification_error * _ Typedtree.pattern_desc option
-> error
- | Or_pattern_type_clash of Ident.t * Errortrace.unification Errortrace.t
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification_error
| Multiply_bound_variable of string
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
- Errortrace.unification Errortrace.t * type_forcing_context option
+ Errortrace.unification_error * type_forcing_context option
* Typedtree.expression_desc option
| Apply_non_function of type_expr
| Apply_wrong_label of arg_label * type_expr * bool
| Name_type_mismatch of
Datatype_kind.t * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
| Invalid_format of string
+ | Not_an_object of type_expr * type_forcing_context option
| Undefined_method of type_expr * string * string list option
- | Undefined_inherited_method of string * string list
+ | Undefined_self_method of string * string list
| Virtual_class of Longident.t
| Private_type of type_expr
| Private_label of Longident.t * type_expr
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
- | Not_subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
+ | Not_subtype of Errortrace.Subtype.error
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of
- type_expr * type_expr * Errortrace.unification Errortrace.t * bool
- | Too_many_arguments of bool * type_expr * type_forcing_context option
- | Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
+ Errortrace.expanded_type * Errortrace.unification_error * bool
+ | Not_a_function of type_expr * type_forcing_context option
+ | Too_many_arguments of type_expr * type_forcing_context option
+ | Abstract_wrong_label of
+ { got : arg_label
+ ; expected : arg_label
+ ; expected_type : type_expr
+ ; explanation : type_forcing_context option
+ }
| Scoping_let_module of string * type_expr
- | Not_a_variant_type of Longident.t
+ | Not_a_polymorphic_variant_type of Longident.t
| Incoherent_label_order
- | Less_general of string * Errortrace.unification Errortrace.t
+ | Less_general of string * Errortrace.unification_error
| Modules_not_allowed
| Cannot_infer_signature
| Not_a_packed_module of type_expr
| Illegal_letrec_pat
| Illegal_letrec_expr
| Illegal_class_expr
- | Letop_type_clash of string * Errortrace.unification Errortrace.t
- | Andop_type_clash of string * Errortrace.unification Errortrace.t
- | Bindings_type_clash of Errortrace.unification Errortrace.t
+ | Letop_type_clash of string * Errortrace.unification_error
+ | Andop_type_clash of string * Errortrace.unification_error
+ | Bindings_type_clash of Errortrace.unification_error
| Unbound_existential of Ident.t list * type_expr
| Missing_type_constraint
+ | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
+ | Expr_not_a_record_type of type_expr
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
(** @deprecated. Use {!Location.error_of_exn}, {!Location.print_report}. *)
(* Forward declaration, to be filled in by Typemod.type_module *)
-val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref
+val type_module:
+ (Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t) ref
(* Forward declaration, to be filled in by Typemod.type_open *)
val type_open:
(?used_slot:bool ref -> override_flag -> Env.t -> Location.t ->
(* Forward declaration, to be filled in by Typeclass.class_structure *)
val type_object:
(Env.t -> Location.t -> Parsetree.class_structure ->
- Typedtree.class_structure * Types.class_signature * string list) ref
+ Typedtree.class_structure * string list) ref
val type_package:
(Env.t -> Parsetree.module_expr -> Path.t -> (Longident.t * type_expr) list ->
Typedtree.module_expr * (Longident.t * type_expr) list) ref
| Duplicate_label of string
| Recursive_abbrev of string
| Cycle_in_def of string * type_expr
- | Definition_mismatch of type_expr * Includecore.type_mismatch option
- | Constraint_failed of Env.t * Errortrace.unification Errortrace.t
- | Inconsistent_constraint of Env.t * Errortrace.unification Errortrace.t
- | Type_clash of Env.t * Errortrace.unification Errortrace.t
+ | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
+ | Constraint_failed of Env.t * Errortrace.unification_error
+ | Inconsistent_constraint of Env.t * Errortrace.unification_error
+ | Type_clash of Env.t * Errortrace.unification_error
| Non_regular of {
definition: Path.t;
used_as: type_expr;
| Unbound_type_var of type_expr * type_declaration
| Cannot_extend_private_type of Path.t
| Not_extensible_type of Path.t
- | Extension_mismatch of Path.t * Includecore.type_mismatch
+ | Extension_mismatch of Path.t * Env.t * Includecore.type_mismatch
| Rebind_wrong_type of
- Longident.t * Env.t * Errortrace.unification Errortrace.t
+ Longident.t * Env.t * Errortrace.unification_error
| Rebind_mismatch of Longident.t * Path.t * Path.t
| Rebind_private of Longident.t
| Variance of Typedecl_variance.error
| Some ty ->
let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
try Ctype.unify env (Ctype.newconstr path params) ty
- with Ctype.Unify trace ->
- raise (Error(loc, Type_clash (env, trace)))
-
-let get_unboxed_type_representation env ty =
- match Typedecl_unboxed.get_unboxed_type_representation env ty with
- | Typedecl_unboxed.This x -> Some x
- | _ -> None
+ with Ctype.Unify err ->
+ raise (Error(loc, Type_clash (env, err)))
(* Determine if a type's values are represented by floats at run-time. *)
let is_float env ty =
- match get_unboxed_type_representation env ty with
- Some {desc = Tconstr(p, _, _); _} -> Path.same p Predef.path_float
+ match Typedecl_unboxed.get_unboxed_type_representation env ty with
+ Some ty' ->
+ begin match get_desc ty' with
+ Tconstr(p, _, _) -> Path.same p Predef.path_float
+ | _ -> false
+ end
| _ -> false
(* Determine if a type definition defines a fixed type. (PW) *)
| Some t -> Ctype.expand_head env t
in
let rv =
- match tm.desc with
+ match get_desc tm with
Tvariant row ->
- let row = Btype.row_repr row in
- Btype.set_type_desc tm
- (Tvariant {row with row_fixed = Some Fixed_private});
+ let Row {fields; more; closed; name} = row_repr row in
+ set_type_desc tm
+ (Tvariant (create_row ~fields ~more ~closed ~name
+ ~fixed:(Some Fixed_private)));
if Btype.static_row row then
(* the syntax hinted at the existence of a row variable,
but there is in fact no row variable to make private, e.g.
[ type t = private [< `A > `A] ] *)
raise (Error(loc, Invalid_private_row_declaration tm))
- else row.row_more
+ else more
| Tobject (ty, _) ->
let r = snd (Ctype.flatten_fields ty) in
if not (Btype.is_Tvar r) then
r
| _ -> assert false
in
- Btype.set_type_desc rv (Tconstr (p, decl.type_params, ref Mnil))
+ set_type_desc rv (Tconstr (p, decl.type_params, ref Mnil))
(* Translate one type declaration *)
in
List.map make_param params
-let transl_labels env closed lbls =
+let transl_labels env univars closed lbls =
assert (lbls <> []);
let all_labels = ref String.Set.empty in
List.iter
Builtin_attributes.warning_scope attrs
(fun () ->
let arg = Ast_helper.Typ.force_poly arg in
- let cty = transl_simple_type env closed arg in
+ let cty = transl_simple_type env ?univars closed arg in
{ld_id = Ident.create_local name.txt;
ld_name = name; ld_mutable = mut;
ld_type = cty; ld_loc = loc; ld_attributes = attrs}
List.map
(fun ld ->
let ty = ld.ld_type.ctyp_type in
- let ty = match ty.desc with Tpoly(t,[]) -> t | _ -> ty in
+ let ty = match get_desc ty with Tpoly(t,[]) -> t | _ -> ty in
{Types.ld_id = ld.ld_id;
ld_mutable = ld.ld_mutable;
ld_type = ty;
lbls in
lbls, lbls'
-let transl_constructor_arguments env closed = function
+let transl_constructor_arguments env univars closed = function
| Pcstr_tuple l ->
- let l = List.map (transl_simple_type env closed) l in
+ let l = List.map (transl_simple_type env ?univars closed) l in
Types.Cstr_tuple (List.map (fun t -> t.ctyp_type) l),
Cstr_tuple l
| Pcstr_record l ->
- let lbls, lbls' = transl_labels env closed l in
+ let lbls, lbls' = transl_labels env univars closed l in
Types.Cstr_record lbls',
Cstr_record lbls
-let make_constructor env type_path type_params sargs sret_type =
+let make_constructor env loc type_path type_params svars sargs sret_type =
match sret_type with
| None ->
let args, targs =
- transl_constructor_arguments env true sargs
+ transl_constructor_arguments env None true sargs
in
targs, None, args, None
| Some sret_type ->
then widen so as to not introduce any new constraints *)
let z = narrow () in
reset_type_variables ();
+ let univars, closed =
+ match svars with
+ | [] -> None, false
+ | vs ->
+ Ctype.begin_def();
+ Some (make_poly_univars (List.map (fun v -> v.txt) vs)), true
+ in
let args, targs =
- transl_constructor_arguments env false sargs
+ transl_constructor_arguments env univars closed sargs
in
- let tret_type = transl_simple_type env false sret_type in
+ let tret_type = transl_simple_type env ?univars closed sret_type in
let ret_type = tret_type.ctyp_type in
(* TODO add back type_path as a parameter ? *)
- begin match (Ctype.repr ret_type).desc with
+ begin match get_desc ret_type with
| Tconstr (p', _, _) when Path.same type_path p' -> ()
| _ ->
- raise (Error (sret_type.ptyp_loc,
- Constraint_failed
- (env, [Errortrace.diff
- ret_type
- (Ctype.newconstr type_path type_params)])))
+ let trace =
+ (* Expansion is not helpful here -- the restriction on GADT return
+ types is purely syntactic. (In the worst case, expansion
+ produces gibberish.) *)
+ [Ctype.unexpanded_diff
+ ~got:ret_type
+ ~expected:(Ctype.newconstr type_path type_params)]
+ in
+ raise (Error(sret_type.ptyp_loc,
+ Constraint_failed(env,
+ Errortrace.unification_error ~trace)))
+ end;
+ begin match univars with
+ | None -> ()
+ | Some univars ->
+ Ctype.end_def();
+ Btype.iter_type_expr_cstr_args Ctype.generalize args;
+ Ctype.generalize ret_type;
+ let _vars = instance_poly_univars env loc univars in
+ let set_level t = Ctype.unify_var env (Ctype.newvar()) t in
+ Btype.iter_type_expr_cstr_args set_level args;
+ set_level ret_type;
end;
widen z;
targs, Some tret_type, args, Some ret_type
let make_cstr scstr =
let name = Ident.create_local scstr.pcd_name.txt in
let targs, tret_type, args, ret_type =
- make_constructor env (Path.Pident id) params
- scstr.pcd_args scstr.pcd_res
+ make_constructor env scstr.pcd_loc (Path.Pident id) params
+ scstr.pcd_vars scstr.pcd_args scstr.pcd_res
in
let tcstr =
{ cd_id = name;
cd_name = scstr.pcd_name;
+ cd_vars = scstr.pcd_vars;
cd_args = targs;
cd_res = tret_type;
cd_loc = scstr.pcd_loc;
let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
Ttype_variant tcstrs, Type_variant (cstrs, rep)
| Ptype_record lbls ->
- let lbls, lbls' = transl_labels env true lbls in
+ let lbls, lbls' = transl_labels env None true lbls in
let rep =
if unbox then Record_unboxed false
else if List.for_all (fun l -> is_float env l.Types.ld_type) lbls'
(fun (cty, cty', loc) ->
let ty = cty.ctyp_type in
let ty' = cty'.ctyp_type in
- try Ctype.unify env ty ty' with Ctype.Unify tr ->
- raise(Error(loc, Inconsistent_constraint (env, tr))))
+ try Ctype.unify env ty ty' with Ctype.Unify err ->
+ raise(Error(loc, Inconsistent_constraint (env, err))))
cstrs;
Ctype.end_def ();
(* Add abstract row *)
module TypeMap = Btype.TypeMap
let rec check_constraints_rec env loc visited ty =
- let ty = Ctype.repr ty in
if TypeSet.mem ty !visited then () else begin
visited := TypeSet.add ty !visited;
- match ty.desc with
+ match get_desc ty with
| Tconstr (path, args, _) ->
let decl =
try Env.find_type path env
raise (Error(loc, Unavailable_type_constructor path)) in
let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
begin
- try Ctype.matches env ty ty'
- with Ctype.Matches_failure (env, trace) ->
- raise (Error(loc, Constraint_failed (env, trace)))
+ (* We don't expand the error trace because that produces types that
+ *already* violate the constraints -- we need to report a problem with
+ the unexpanded types, or we get errors that talk about the same type
+ twice. This is generally true for constraint errors. *)
+ try Ctype.matches ~expand_error_trace:false env ty ty'
+ with Ctype.Matches_failure (env, err) ->
+ raise (Error(loc, Constraint_failed (env, err)))
end;
List.iter (check_constraints_rec env loc visited) args
| Tpoly (ty, tl) ->
match decl with
{ type_kind = (Type_variant _ | Type_record _| Type_open);
type_manifest = Some ty } ->
- begin match (Ctype.repr ty).desc with
+ begin match get_desc ty with
Tconstr(path, args, _) ->
begin try
let decl' = Env.find_type path env in
then Some Includecore.Arity
else begin
match Ctype.equal env false args decl.type_params with
- | exception Ctype.Equality trace ->
- Some (Includecore.Constraint (env, trace))
+ | exception Ctype.Equality err ->
+ Some (Includecore.Constraint err)
| () ->
Includecore.type_declarations ~loc ~equality:true env
~mark:true
end
in
if err <> None then
- raise(Error(loc, Definition_mismatch (ty, err)))
+ raise(Error(loc, Definition_mismatch (ty, env, err)))
with Not_found ->
raise(Error(loc, Unavailable_type_constructor path))
end
- | _ -> raise(Error(loc, Definition_mismatch (ty, None)))
+ | _ -> raise(Error(loc, Definition_mismatch (ty, env, None)))
end
| _ -> ()
let check_well_founded env loc path to_check ty =
let visited = ref TypeMap.empty in
let rec check ty0 parents ty =
- let ty = Btype.repr ty in
if TypeSet.mem ty parents then begin
(*Format.eprintf "@[%a@]@." Printtyp.raw_type_expr ty;*)
- if match ty0.desc with
+ if match get_desc ty0 with
| Tconstr (p, _, _) -> Path.same p path
| _ -> false
then raise (Error (loc, Recursive_abbrev (Path.name path)))
in
if fini then () else
let rec_ok =
- match ty.desc with
+ match get_desc ty with
Tconstr(p,_,_) ->
!Clflags.recursive_types && Ctype.is_contractive env p
| Tobject _ | Tvariant _ -> true
with e ->
visited := visited'; Some e
in
- match ty.desc with
+ match get_desc ty with
| Tconstr(p, _, _) when arg_exn <> None || to_check p ->
if to_check p then Option.iter raise arg_exn
else Btype.iter_type_expr (check ty0 TypeSet.empty) ty;
if decl.type_params = [] then () else
- let visited = ref [] in
+ let visited = ref TypeSet.empty in
let rec check_regular cpath args prev_exp prev_expansions ty =
- let ty = Ctype.repr ty in
- if not (List.memq ty !visited) then begin
- visited := ty :: !visited;
- match ty.desc with
+ if not (TypeSet.mem ty !visited) then begin
+ visited := TypeSet.add ty !visited;
+ match get_desc ty with
| Tconstr(path', args', _) ->
if Path.same path path' then begin
if not (Ctype.is_equal orig_env false args args') then
Ctype.instance_parameterized_type params0 body0 in
begin
try List.iter2 (Ctype.unify orig_env) params args'
- with Ctype.Unify trace ->
- raise (Error(loc, Constraint_failed (orig_env, trace)));
+ with Ctype.Unify err ->
+ raise (Error(loc, Constraint_failed (orig_env, err)));
end;
check_regular path' args
(path' :: prev_exp) ((ty,body) :: prev_expansions)
| { type_kind = Type_abstract;
type_manifest = Some ty;
type_private = Private; } when is_fixed_type sdecl ->
- let ty = Ctype.repr ty in
- let ty' = Btype.newty2 ty.level ty.desc in
+ let ty' = newty2 ~level:(get_level ty) (get_desc ty) in
if Ctype.deep_occur ty ty' then
let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
- Btype.link_type ty (Btype.newty2 ty.level td);
+ link_type ty (newty2 ~level:(get_level ty) td);
{decl with type_manifest = Some ty'}
else decl
| _ -> decl
let id = Ident.create_scoped ~scope sext.pext_name.txt in
let args, ret_type, kind =
match sext.pext_kind with
- Pext_decl(sargs, sret_type) ->
+ Pext_decl(svars, sargs, sret_type) ->
let targs, tret_type, args, ret_type =
- make_constructor env type_path typext_params
- sargs sret_type
+ make_constructor env sext.pext_loc type_path typext_params
+ svars sargs sret_type
in
- args, ret_type, Text_decl(targs, tret_type)
+ args, ret_type, Text_decl(svars, targs, tret_type)
| Pext_rebind lid ->
let usage : Env.constructor_usage =
if priv = Public then Env.Exported else Env.Exported_private
begin
try
Ctype.unify env cstr_res res
- with Ctype.Unify trace ->
+ with Ctype.Unify err ->
raise (Error(lid.loc,
- Rebind_wrong_type(lid.txt, env, trace)))
+ Rebind_wrong_type(lid.txt, env, err)))
end;
(* Remove "_" names from parameters used in the constructor *)
if not cdescr.cstr_generalized then begin
let vars =
Ctype.free_variables (Btype.newgenty (Ttuple args))
in
- List.iter
- (function {desc = Tvar (Some "_")} as ty
- when List.memq ty vars ->
- Btype.set_type_desc ty (Tvar None)
- | _ -> ())
- typext_params
+ List.iter
+ (fun ty ->
+ if get_desc ty = Tvar (Some "_")
+ && List.exists (eq_type ty) vars
+ then set_type_desc ty (Tvar None))
+ typext_params
end;
(* Ensure that constructor's type matches the type being extended *)
- let cstr_type_path, cstr_type_params =
- match cdescr.cstr_res.desc with
- Tconstr (p, _, _) ->
- let decl = Env.find_type p env in
- p, decl.type_params
- | _ -> assert false
- in
+ let cstr_type_path = Btype.cstr_type_path cdescr in
+ let cstr_type_params = (Env.find_type cstr_type_path env).type_params in
let cstr_types =
(Btype.newgenty
(Tconstr(cstr_type_path, cstr_type_params, ref Mnil)))
Types.Cstr_tuple args
| Some decl ->
let tl =
- match args with
- | [ {desc=Tconstr(_, tl, _)} ] -> tl
+ match List.map get_desc args with
+ | [ Tconstr(_, tl, _) ] -> tl
| _ -> assert false
in
let decl = Ctype.instance_declaration decl in
in
begin match err with
| None -> ()
- | Some err -> raise (Error(loc, Extension_mismatch (type_path, err)))
+ | Some err -> raise (Error(loc, Extension_mismatch (type_path, env, err)))
end;
let ttype_params = make_params env styext.ptyext_params in
let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
raise (Error (loc, Multiple_native_repr_attributes))
let native_repr_of_type env kind ty =
- match kind, (Ctype.expand_head_opt env ty).desc with
+ match kind, get_desc (Ctype.expand_head_opt env ty) with
| Untagged, Tconstr (path, _, _) when Path.same path Predef.path_int ->
Some Untagged_int
| Unboxed, Tconstr (path, _, _) when Path.same path Predef.path_float ->
end
let rec parse_native_repr_attributes env core_type ty ~global_repr =
- match core_type.ptyp_desc, (Ctype.repr ty).desc,
+ match core_type.ptyp_desc, get_desc ty,
get_native_repr_attribute core_type.ptyp_attributes ~global_repr:None
with
| Ptyp_arrow _, Tarrow _, Native_repr_attr_present kind ->
parse_native_repr_attributes env ct2 t2 ~global_repr
in
(repr_arg :: repr_args, repr_res)
+ | Ptyp_poly (_, t), _, _ ->
+ parse_native_repr_attributes env t ty ~global_repr
| Ptyp_arrow _, _, _ | _, Tarrow _, _ -> assert false
| _ -> ([], make_native_repr env core_type ty ~global_repr)
let check_unboxable env loc ty =
let check_type acc ty : Path.Set.t =
- let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
- try match ty.desc with
+ let ty = Ctype.expand_head_opt env ty in
+ try match get_desc ty with
| Tconstr (p, _, _) ->
let tydecl = Env.find_type p env in
if tydecl.type_unboxed_default then
if arity_ok then
List.iter2 (fun (cty, _) tparam ->
try Ctype.unify_var env cty.ctyp_type tparam
- with Ctype.Unify tr ->
- raise(Error(cty.ctyp_loc, Inconsistent_constraint (env, tr)))
+ with Ctype.Unify err ->
+ raise(Error(cty.ctyp_loc, Inconsistent_constraint (env, err)))
) tparams sig_decl.type_params;
List.iter (fun (cty, cty', loc) ->
(* Note: constraints must also be enforced in [sig_env] because
they may contain parameter variables from [tparams]
that have now be unified in [sig_env]. *)
try Ctype.unify env cty.ctyp_type cty'.ctyp_type
- with Ctype.Unify tr ->
- raise(Error(loc, Inconsistent_constraint (env, tr)))
+ with Ctype.Unify err ->
+ raise(Error(loc, Inconsistent_constraint (env, err)))
) constraints;
let priv =
if sdecl.ptype_private = Private then Private else
let ti = List.find (fun ti -> Ctype.deep_occur tv (typ ti)) tl in
let ty0 = (* Hack to force aliasing when needed *)
Btype.newgenty (Tobject(tv, ref None)) in
- Printtyp.reset_and_mark_loops_list [typ ti; ty0];
+ Printtyp.prepare_for_printing [typ ti; ty0];
fprintf ppf
".@ @[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
- kwd pr ti Printtyp.marked_type_expr tv
+ kwd pr ti Printtyp.prepared_type_expr tv
with Not_found -> ()
let explain_unbound ppf tv tl typ kwd lab =
explain_unbound_gen ppf tv tl typ kwd
(fun ppf ti ->
- fprintf ppf "%s%a" (lab ti) Printtyp.marked_type_expr (typ ti)
+ fprintf ppf "%s%a" (lab ti) Printtyp.prepared_type_expr (typ ti)
)
let explain_unbound_single ppf tv ty =
let trivial ty =
explain_unbound ppf tv [ty] (fun t -> t) "type" (fun _ -> "") in
- match (Ctype.repr ty).desc with
+ match get_desc ty with
Tobject(fi,_) ->
let (tl, rv) = Ctype.flatten_fields fi in
- if rv == tv then trivial ty else
+ if eq_type rv tv then trivial ty else
explain_unbound ppf tv tl (fun (_,_,t) -> t)
"method" (fun (lab,_,_) -> lab ^ ": ")
| Tvariant row ->
- let row = Btype.row_repr row in
- if row.row_more == tv then trivial ty else
- explain_unbound ppf tv row.row_fields
- (fun (_l,f) -> match Btype.row_field_repr f with
+ if eq_type (row_more row) tv then trivial ty else
+ explain_unbound ppf tv (row_fields row)
+ (fun (_l,f) -> match row_field_repr f with
Rpresent (Some t) -> t
- | Reither (_,[t],_,_) -> t
- | Reither (_,tl,_,_) -> Btype.newgenty (Ttuple tl)
+ | Reither (_,[t],_) -> t
+ | Reither (_,tl,_) -> Btype.newgenty (Ttuple tl)
| _ -> Btype.newgenty (Ttuple[]))
"case" (fun (lab,_) -> "`" ^ lab ^ " of ")
| _ -> trivial ty
| Cycle_in_def (s, ty) ->
fprintf ppf "@[<v>The definition of %s contains a cycle:@ %a@]"
s Printtyp.type_expr ty
- | Definition_mismatch (ty, None) ->
+ | Definition_mismatch (ty, _env, None) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
"This variant or record definition" "does not match that of type"
Printtyp.type_expr ty
- | Definition_mismatch (ty, Some err) ->
+ | Definition_mismatch (ty, env, Some err) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
"This variant or record definition" "does not match that of type"
Printtyp.type_expr ty
- (Includecore.report_type_mismatch "the original" "this" "definition")
+ (Includecore.report_type_mismatch
+ "the original" "this" "definition" env)
err
- | Constraint_failed (env, trace) ->
+ | Constraint_failed (env, err) ->
fprintf ppf "@[<v>Constraints are not satisfied in this type.@ ";
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_unification_error ppf env err
(fun ppf -> fprintf ppf "Type")
(fun ppf -> fprintf ppf "should be an instance of");
fprintf ppf "@]"
let comma ppf () = Format.fprintf ppf ",@;<1 2>" in
let pp_expansions ppf expansions =
Format.(pp_print_list ~pp_sep:comma pp_expansion) ppf expansions in
- Printtyp.reset_and_mark_loops used_as;
- Printtyp.mark_loops defined_as;
+ Printtyp.prepare_for_printing [used_as; defined_as];
Printtyp.Naming_context.reset ();
begin match expansions with
| [] ->
All uses need to match the definition for the recursive type \
to be regular.@]"
(Path.name definition)
- !Oprint.out_type (Printtyp.tree_of_typexp false defined_as)
- !Oprint.out_type (Printtyp.tree_of_typexp false used_as)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type defined_as)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type used_as)
| _ :: _ ->
fprintf ppf
"@[<hv>This recursive type is not regular.@ \
All uses need to match the definition for the recursive type \
to be regular.@]"
(Path.name definition)
- !Oprint.out_type (Printtyp.tree_of_typexp false defined_as)
- !Oprint.out_type (Printtyp.tree_of_typexp false used_as)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type defined_as)
+ !Oprint.out_type (Printtyp.tree_of_typexp Type used_as)
pp_expansions expansions
end
- | Inconsistent_constraint (env, trace) ->
+ | Inconsistent_constraint (env, err) ->
fprintf ppf "@[<v>The type constraints are not consistent.@ ";
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_unification_error ppf env err
(fun ppf -> fprintf ppf "Type")
(fun ppf -> fprintf ppf "is not compatible with type");
fprintf ppf "@]"
- | Type_clash (env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ | Type_clash (env, err) ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "This type constructor expands to type")
(function ppf ->
for native-code compilation@]"
| Unbound_type_var (ty, decl) ->
fprintf ppf "@[A type variable is unbound in this type declaration";
- let ty = Ctype.repr ty in
begin match decl.type_kind, decl.type_manifest with
| Type_variant (tl, _rep), _ ->
explain_unbound_gen ppf ty tl (fun c ->
"Type definition"
Printtyp.path path
"is not extensible"
- | Extension_mismatch (path, err) ->
+ | Extension_mismatch (path, env, err) ->
fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%s@]%a@]"
"This extension" "does not match the definition of type"
(Path.name path)
(Includecore.report_type_mismatch
- "the type" "this extension" "definition")
+ "the type" "this extension" "definition" env)
err
- | Rebind_wrong_type (lid, env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ | Rebind_wrong_type (lid, env, err) ->
+ Printtyp.report_unification_error ppf env err
(function ppf ->
fprintf ppf "The constructor %a@ has type"
Printtyp.longident lid)
| false, true -> inj ^ "contravariant"
| false, false -> if inj = "" then "unrestricted" else inj
in
- let suffix n =
- let teen = (n mod 100)/10 = 1 in
- match n mod 10 with
- | 1 when not teen -> "st"
- | 2 when not teen -> "nd"
- | 3 when not teen -> "rd"
- | _ -> "th"
- in
(match n with
| Variance_not_reflected ->
fprintf ppf "@[%s@ %s@ It"
fprintf ppf "@[%s@ %s@ The %d%s type parameter"
"In this definition, expected parameter"
"variances are not satisfied."
- n (suffix n));
+ n (Misc.ordinal_suffix n));
(match n with
| No_variable -> ()
| _ ->
(* for fixed types *)
val is_fixed_type : Parsetree.type_declaration -> bool
-(* for typeopt.ml *)
-val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option
-
type native_repr_kind = Unboxed | Untagged
type error =
| Duplicate_label of string
| Recursive_abbrev of string
| Cycle_in_def of string * type_expr
- | Definition_mismatch of type_expr * Includecore.type_mismatch option
- | Constraint_failed of Env.t * Errortrace.unification Errortrace.t
- | Inconsistent_constraint of Env.t * Errortrace.unification Errortrace.t
- | Type_clash of Env.t * Errortrace.unification Errortrace.t
+ | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
+ | Constraint_failed of Env.t * Errortrace.unification_error
+ | Inconsistent_constraint of Env.t * Errortrace.unification_error
+ | Type_clash of Env.t * Errortrace.unification_error
| Non_regular of {
definition: Path.t;
used_as: type_expr;
| Unbound_type_var of type_expr * type_declaration
| Cannot_extend_private_type of Path.t
| Not_extensible_type of Path.t
- | Extension_mismatch of Path.t * Includecore.type_mismatch
+ | Extension_mismatch of Path.t * Env.t * Includecore.type_mismatch
| Rebind_wrong_type of
- Longident.t * Env.t * Errortrace.unification Errortrace.t
+ Longident.t * Env.t * Errortrace.unification_error
| Rebind_mismatch of Longident.t * Path.t * Path.t
| Rebind_private of Longident.t
| Variance of Typedecl_variance.error
Variant_unboxed)
| Type_record ([{ld_type = arg; _}], Record_unboxed _)), _ ->
begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
- | 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
+ | None -> Type_immediacy.Unknown
+ | Some argrepr -> Ctype.immediacy env argrepr
end
| (Type_variant (_ :: _ as cstrs, _), _) ->
if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
let params =
match def.type_kind with
| Type_variant ([{cd_res = Some ret_type}], _) ->
- begin match Ctype.repr ret_type with
- | {desc=Tconstr (_, tyl, _)} ->
- List.map Ctype.repr tyl
+ begin match get_desc ret_type with
+ | Tconstr (_, tyl, _) -> tyl
| _ -> assert false
end
| _ -> def.type_params
parameters as well as the subtype
- it performs a shallow traversal of object types,
while our implementation collects all method types *)
- match (Ctype.repr ty).desc with
+ match get_desc ty with
(* these are the important cases,
on which immediate_subtypes is called from [check_type] *)
| Tarrow(_,ty1,ty2,_) ->
| Tpoly (pty, _) -> [pty]
| Tconstr (_path, tys, _) -> tys
-and immediate_subtypes_object_row acc ty = match (Ctype.repr ty).desc with
+and immediate_subtypes_object_row acc ty = match get_desc ty with
| Tnil -> acc
| Tfield (_label, _kind, ty, rest) ->
let acc = ty :: acc in
let add_subtypes acc =
let add_subtype acc (_l, rf) =
immediate_subtypes_variant_row_field acc rf in
- List.fold_left add_subtype acc desc.row_fields in
+ List.fold_left add_subtype acc (row_fields desc) in
let add_row acc =
- let row = Ctype.repr desc.row_more in
- match row.desc with
+ let row = row_more desc in
+ match get_desc row with
| Tvariant more -> immediate_subtypes_variant_row acc more
| _ -> row :: acc
in
add_row (add_subtypes acc)
-and immediate_subtypes_variant_row_field acc = function
+and immediate_subtypes_variant_row_field acc f =
+ match row_field_repr f with
| Rpresent(None)
| Rabsent -> acc
| Rpresent(Some(ty)) -> ty :: acc
- | Reither(_,field_types,_,r) ->
- let acc = List.rev_append field_types acc in
- begin match !r with
- | None -> acc
- | Some rf -> immediate_subtypes_variant_row_field acc rf
- end
+ | Reither(_,field_types,_) ->
+ List.rev_append field_types acc
let free_variables ty =
- Ctype.free_variables (Ctype.repr ty)
- |> List.map (fun {desc; id; _} ->
- match desc with
- | Tvar text -> {text; id}
+ Ctype.free_variables ty
+ |> List.map (fun ty ->
+ match get_desc ty with
+ Tvar text -> {text; id = get_id ty}
| _ ->
(* Ctype.free_variables only returns Tvar nodes *)
assert false)
: Env.t -> type_expr -> mode -> context
= fun env ty m ->
let rec check_type hyps ty m =
- let ty = Ctype.repr ty in
if Hyps.safe ty m hyps then empty
else if Hyps.unsafe ty m hyps then worst_case ty
else
let hyps = Hyps.add ty m hyps in
- match (ty.desc, m) with
+ match (get_desc ty, m) with
(* Impossible case due to the call to [Ctype.repr]. *)
| (Tlink _ , _ ) -> assert false
(* Impossible case (according to comment in [typing/types.mli]. *)
| (_ , Ind ) -> empty
(* Variable case, add constraint. *)
| (Tvar(alpha) , m ) ->
- TVarMap.singleton {text = alpha; id = ty.Types.id} m
+ TVarMap.singleton {text = alpha; id = get_id ty} m
(* "Separable" case for constructors with known memory representation. *)
| (Tarrow _ , Sep )
| (Ttuple _ , Sep )
we build a list of modes by repeated consing into
an accumulator variable [acc], setting existential variables
to Ind as we go. *)
- let param_instance = Ctype.repr param_instance in
let get context var =
try TVarMap.find var context with Not_found -> Ind in
let set_ind context var =
let is_ind context var = match get context var with
| Ind -> true
| Sep | Deepsep -> false in
- match param_instance.desc with
+ match get_desc param_instance with
| Tvar text ->
- let var = {text; id = param_instance.Types.id} in
+ let var = {text; id = get_id param_instance} in
(get context var) :: acc, (set_ind context var)
| _ ->
let instance_exis = free_variables param_instance in
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 Unavailable else
- let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
- match ty.desc with
+ if fuel < 0 then None else
+ let ty = Ctype.expand_head_opt env ty in
+ match get_desc ty with
| Tconstr (p, args, _) ->
begin match Env.find_type p env with
- | exception Not_found -> This ty
- | {type_immediate = Always; _} ->
- This Predef.type_int
- | {type_immediate = Always_on_64bits; _} ->
- Only_on_64_bits Predef.type_int
+ | exception Not_found -> Some ty
| {type_params; type_kind =
Type_record ([{ld_type = ty2; _}], Record_unboxed _)
| Type_variant ([{cd_args = Cstr_tuple [ty2]; _}], Variant_unboxed)
| Type_variant ([{cd_args = Cstr_record [{ld_type = ty2; _}]; _}],
Variant_unboxed)}
->
- let ty2 = match ty2.desc with Tpoly (t, _) -> t | _ -> ty2 in
+ let ty2 = match get_desc ty2 with Tpoly (t, _) -> t | _ -> ty2 in
get_unboxed_type_representation env
(Ctype.apply env type_params ty2 args) (fuel - 1)
- | _ -> This ty
+ | _ -> Some ty
end
- | _ -> This ty
+ | _ -> Some ty
let get_unboxed_type_representation env ty =
(* Do not give too much fuel: PR#7424 *)
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 -> t
+val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option
let compute_variance env visited vari ty =
let rec compute_variance_rec vari ty =
(* Format.eprintf "%a: %x@." Printtyp.type_expr ty (Obj.magic vari); *)
- let ty = Ctype.repr ty in
let vari' = get_variance ty visited in
if Variance.subset vari vari' then () else
let vari = Variance.union vari vari' in
visited := TypeMap.add ty vari !visited;
let compute_same = compute_variance_rec vari in
- match ty.desc with
+ match get_desc ty with
Tarrow (_, ty1, ty2, _) ->
let open Variance in
let v = conjugate vari in
| Tsubst _ ->
assert false
| Tvariant row ->
- let row = Btype.row_repr row in
List.iter
(fun (_,f) ->
- match Btype.row_field_repr f with
+ match row_field_repr f with
Rpresent (Some ty) ->
compute_same ty
- | Reither (_, tyl, _, _) ->
+ | Reither (_, tyl, _) ->
let open Variance in
let upper =
List.fold_left (fun s f -> set f true s)
if List.length tyl > 1 then upper else inter vari upper *)
List.iter (compute_variance_rec v) tyl
| _ -> ())
- row.row_fields;
- compute_same row.row_more
+ (row_fields row);
+ compute_same (row_more row)
| Tpoly (ty, _) ->
compute_same ty
| Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
required
in
(* Prepare *)
- let params = List.map Btype.repr decl.type_params in
+ let params = decl.type_params in
let tvl = ref TypeMap.empty in
(* Compute occurrences in the body *)
let open Variance in
if Btype.is_Tvar ty || mem Inj (get_variance ty tvl) then () else
let visited = ref TypeSet.empty in
let rec check ty =
- let ty = Ctype.repr ty in
if TypeSet.mem ty !visited then () else begin
visited := TypeSet.add ty !visited;
if mem Inj (get_variance ty tvl) then () else
- match ty.desc with
+ match get_desc ty with
| Tvar _ -> raise Exit
| Tconstr _ ->
let old = !visited in
with Exit ->
visited := old;
let ty' = Ctype.expand_head_opt env ty in
- if ty == ty' then raise Exit else check ty'
+ if eq_type ty ty' then raise Exit else check ty'
end
| _ -> Btype.iter_type_expr check ty
end
(* Check propagation from constrained parameters *)
let args = Btype.newgenty (Ttuple params) in
let fvl = Ctype.free_variables args in
- let fvl = List.filter (fun v -> not (List.memq v params)) fvl in
+ let fvl =
+ List.filter (fun v -> not (List.exists (eq_type v) params)) fvl in
(* If there are no extra variables there is nothing to do *)
if fvl = [] then () else
let tvl2 = ref TypeMap.empty in
params required;
let visited = ref TypeSet.empty in
let rec check ty =
- let ty = Ctype.repr ty in
if TypeSet.mem ty !visited then () else
let visited' = TypeSet.add ty !visited in
visited := visited';
Btype.backtrack snap;
let (c1,n1) = get_upper v1 and (c2,n2,_,i2) = get_lower v2 in
if c1 && not c2 || n1 && not n2 then
- if List.memq ty fvl then
+ if List.exists (eq_type ty) fvl then
let code = if not i2 then No_variable
else if c2 || n2 then Variance_not_reflected
else Variance_not_deducible in
(* A parameter is constrained if it is either instantiated,
or it is a variable appearing in another parameter *)
let constrained vars ty =
- match ty.desc with
- | Tvar _ -> List.exists (fun tl -> List.memq ty tl) vars
+ match get_desc ty with
+ | Tvar _ -> List.exists (List.exists (eq_type ty)) vars
| _ -> true
let for_constr = function
compute_variance_type env ~check rloc {decl with type_private = Private}
(for_constr tl)
| Some ret_type ->
- match Ctype.repr ret_type with
- | {desc=Tconstr (_, tyl, _)} ->
+ match get_desc ret_type with
+ | Tconstr (_, tyl, _) ->
(* let tyl = List.map (Ctype.expand_head env) tyl in *)
- let tyl = List.map Ctype.repr tyl in
let fvl = List.map (Ctype.free_variables ?env:None) tyl in
let _ =
List.fold_left2
| Texp_for of
Ident.t * Parsetree.pattern * expression * expression * direction_flag *
expression
- | Texp_send of expression * meth * expression option
+ | Texp_send of expression * meth
| Texp_new of Path.t * Longident.t loc * Types.class_declaration
| Texp_instvar of Path.t * Path.t * string loc
| Texp_setinstvar of Path.t * Path.t * string loc * expression
- | Texp_override of Path.t * (Path.t * string loc * expression) list
+ | Texp_override of Path.t * (Ident.t * string loc * expression) list
| Texp_letmodule of
Ident.t option * string option loc * Types.module_presence * module_expr *
expression
| Texp_open of open_declaration * expression
and meth =
- Tmeth_name of string
+ | Tmeth_name of string
| Tmeth_val of Ident.t
+ | Tmeth_ancestor of Ident.t * Path.t
and 'k case =
{
| Tcl_let of rec_flag * value_binding list *
(Ident.t * expression) list * class_expr
| Tcl_constraint of
- class_expr * class_type option * string list * string list * Concr.t
+ class_expr * class_type option * string list * string list * MethSet.t
(* Visible instance variables, methods and concrete methods *)
| Tcl_open of open_description * class_expr
{
cd_id: Ident.t;
cd_name: string loc;
+ cd_vars: string loc list;
cd_args: constructor_arguments;
cd_res: core_type option;
cd_loc: Location.t;
}
and extension_constructor_kind =
- Text_decl of constructor_arguments * core_type option
+ Text_decl of string loc list * constructor_arguments * core_type option
| Text_rebind of Path.t * Longident.t loc
and class_type =
type implementation = {
structure: structure;
coercion: module_coercion;
- signature: Types.signature
+ signature: Types.signature;
+ shape: Shape.t;
}
| Texp_for of
Ident.t * Parsetree.pattern * expression * expression * direction_flag *
expression
- | Texp_send of expression * meth * expression option
+ | Texp_send of expression * meth
| Texp_new of Path.t * Longident.t loc * Types.class_declaration
| Texp_instvar of Path.t * Path.t * string loc
| Texp_setinstvar of Path.t * Path.t * string loc * expression
- | Texp_override of Path.t * (Path.t * string loc * expression) list
+ | Texp_override of Path.t * (Ident.t * string loc * expression) list
| Texp_letmodule of
Ident.t option * string option loc * Types.module_presence * module_expr *
expression
and meth =
Tmeth_name of string
| Tmeth_val of Ident.t
+ | Tmeth_ancestor of Ident.t * Path.t
and 'k case =
{
| Tcl_let of rec_flag * value_binding list *
(Ident.t * expression) list * class_expr
| Tcl_constraint of
- class_expr * class_type option * string list * string list * Types.Concr.t
+ class_expr * class_type option * string list * string list
+ * Types.MethSet.t
(* Visible instance variables, methods and concrete methods *)
| Tcl_open of open_description * class_expr
{
cd_id: Ident.t;
cd_name: string loc;
+ cd_vars: string loc list;
cd_args: constructor_arguments;
cd_res: core_type option;
cd_loc: Location.t;
}
and extension_constructor_kind =
- Text_decl of constructor_arguments * core_type option
+ Text_decl of string loc list * constructor_arguments * core_type option
| Text_rebind of Path.t * Longident.t loc
and class_type =
type implementation = {
structure: structure;
coercion: module_coercion;
- signature: Types.signature
+ signature: Types.signature;
+ shape: Shape.t;
}
(** A typechecked implementation including its module structure, its exported
signature, and a coercion of the module against that signature.
let () = Includemod_errorprinter.register ()
+module Sig_component_kind = Shape.Sig_component_kind
module String = Misc.Stdlib.String
-module Sig_component_kind = struct
- type t =
- | Value
- | Type
- | Module
- | Module_type
- | Extension_constructor
- | Class
- | Class_type
-
- let to_string = function
- | Value -> "value"
- | Type -> "type"
- | Module -> "module"
- | Module_type -> "module type"
- | Extension_constructor -> "extension constructor"
- | Class -> "class"
- | Class_type -> "class type"
-
- (** Whether the name of a component of that kind can appear in a type. *)
- let can_appear_in_types = function
- | Value
- | Extension_constructor ->
- false
- | Type
- | Module
- | Module_type
- | Class
- | Class_type ->
- true
-end
-
type hiding_error =
| Illegal_shadowing of {
shadowed_item_id: Ident.t;
| With_cannot_remove_constrained_type
| Repeated_name of Sig_component_kind.t * string
| Non_generalizable of type_expr
- | Non_generalizable_class of Ident.t * class_declaration
| Non_generalizable_module of module_type
| Implementation_is_required of string
| Interface_not_compiled of string
(* Merge one "with" constraint in a signature *)
-let check_type_decl env loc id row_id newdecl decl rec_group =
- let env = Env.add_type ~check:true id newdecl env in
- let env =
+let check_type_decl env sg loc id row_id newdecl decl =
+ let fresh_id = Ident.rename id in
+ let path = Pident fresh_id in
+ let sub = Subst.add_type id path Subst.identity in
+ let fresh_row_id, sub =
match row_id with
- | None -> env
- | Some id -> Env.add_type ~check:false id newdecl env
+ | None -> None, sub
+ | Some id ->
+ let fresh_row_id = Some (Ident.rename id) in
+ let sub = Subst.add_type id (Pident fresh_id) sub in
+ fresh_row_id, sub
in
+ let newdecl = Subst.type_declaration sub newdecl in
+ let decl = Subst.type_declaration sub decl in
+ let sg = List.map (Subst.signature_item Keep sub) sg in
+ let env = Env.add_type ~check:false fresh_id newdecl env in
let env =
- let add_sigitem env x =
- Env.add_signature Signature_group.(x.src :: x.post_ghosts) env
- in
- List.fold_left add_sigitem env rec_group in
- Includemod.type_declarations ~mark:Mark_both ~loc env id newdecl decl;
- Typedecl.check_coherence env loc (Path.Pident id) newdecl
+ match fresh_row_id with
+ | None -> env
+ | Some fresh_row_id -> Env.add_type ~check:false fresh_row_id newdecl env
+ in
+ let env = Env.add_signature sg env in
+ Includemod.type_declarations ~mark:Mark_both ~loc env fresh_id newdecl decl;
+ Typedecl.check_coherence env loc path newdecl
let make_variance p n i =
let open Variance in
T was not used as a path for a packed module
*)
let check_usage_of_module_types ~error ~paths ~loc env super =
- let it_do_type_expr it ty = match ty.desc with
+ let it_do_type_expr it ty = match get_desc ty with
| Tpackage (p, _) ->
begin match List.find_opt (Path.same p) paths with
| Some p -> raise (Error(loc,Lazy.force !env,error p))
let rec loop = function
| [] -> false
| hd :: tl ->
- match (Btype.repr hd).desc with
+ match get_desc hd with
| Tvar _ -> List.memq hd tl || loop tl
| _ -> true
in
in
split [] ghosts
in
- let rec patch_item constr namelist sig_env ~rec_group ~ghosts item =
+ let rec patch_item constr namelist outer_sig_env sg_for_env ~ghosts item =
let return ?(ghosts=ghosts) ~replace_by info =
Some (info, {Signature_group.ghosts; replace_by})
in
let initial_env =
Env.add_type ~check:false id_row decl_row initial_env
in
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let tdecl =
Typedecl.transl_with_constraint id ~fixed_row_path:(Pident id_row)
~sig_env ~sig_decl:decl ~outer_env:initial_env sdecl in
let newdecl = tdecl.typ_type in
let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
- check_type_decl sig_env sdecl.ptype_loc id row_id newdecl decl
- rec_group;
+ check_type_decl outer_sig_env sg_for_env sdecl.ptype_loc
+ id row_id newdecl decl;
let decl_row = {decl_row with type_params = newdecl.type_params} in
let rs' = if rs = Trec_first then Trec_not else rs in
let ghosts =
| Sig_type(id, sig_decl, rs, priv) , [s],
(With_type sdecl | With_typesubst sdecl as constr)
when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let tdecl =
Typedecl.transl_with_constraint id
~sig_env ~sig_decl ~outer_env:initial_env sdecl in
let newdecl = tdecl.typ_type and loc = sdecl.ptype_loc in
let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
let ghosts = List.rev_append before_ghosts after_ghosts in
- check_type_decl sig_env loc id row_id newdecl sig_decl rec_group;
+ check_type_decl outer_sig_env sg_for_env loc
+ id row_id newdecl sig_decl;
begin match constr with
With_type _ ->
return ~ghosts
| Sig_modtype(id, mtd, priv), [s],
(With_modtype mty | With_modtypesubst mty)
when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let () = match mtd.mtd_type with
| None -> ()
| Some previous_mty ->
| Sig_module(id, pres, md, rs, priv), [s],
With_module {lid=lid'; md=md'; path; remove_aliases}
when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let mty = md'.md_type in
let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
let md'' = { md' with md_type = mty } in
(Pident id, lid, Twith_module (path, lid'))
| Sig_module(id, _, md, _rs, _), [s], With_modsubst (lid',path,md')
when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let aliasable = not (Env.is_functor_arg path sig_env) in
ignore
(Includemod.strengthened_module_decl ~loc ~mark:Mark_both
return ~replace_by:None (Pident id, lid, Twith_modsubst (path, lid'))
| Sig_module(id, _, md, rs, priv) as item, s :: namelist, constr
when Ident.name id = s ->
+ let sig_env = Env.add_signature sg_for_env outer_sig_env in
let sg = extract_sig sig_env loc md.md_type in
let ((path, _, tcstr), newsg) = merge_signature sig_env sg namelist in
let path = path_concat id path in
return ~replace_by:(Some item) (path, lid, tcstr)
| _ -> None
and merge_signature env sg namelist =
- let sig_env = Env.add_signature sg env in
match
- Signature_group.replace_in_place (patch_item constr namelist sig_env) sg
+ Signature_group.replace_in_place (patch_item constr namelist env sg) sg
with
| Some (x,sg) -> x, sg
- | None -> raise(Error(loc, sig_env, With_no_component lid.txt))
+ | None -> raise(Error(loc, env, With_no_component lid.txt))
in
try
let names = Longident.flatten lid.txt in
let rec approx_modtype env smty =
match smty.pmty_desc with
Pmty_ident lid ->
- let (path, _info) =
- Env.lookup_modtype ~use:false ~loc:smty.pmty_loc lid.txt env
+ let path =
+ Env.lookup_modtype_path ~use:false ~loc:smty.pmty_loc lid.txt env
in
Mty_ident path
| Pmty_alias lid ->
| Pwith_module (_, lid') ->
(* Lookup the module to make sure that it is not recursive.
(GPR#1626) *)
- ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env)
+ ignore (Env.lookup_module_path ~use:false ~load:false
+ ~loc:lid'.loc lid'.txt env)
| Pwith_modsubst (_, lid') ->
- ignore (Env.lookup_module ~use:false ~loc:lid'.loc lid'.txt env))
+ ignore (Env.lookup_module_path ~use:false ~load:false
+ ~loc:lid'.loc lid'.txt env))
constraints;
body
| Pmty_typeof smod ->
(* Check and translate a module type expression *)
let transl_modtype_longident loc env lid =
- let (path, _info) = Env.lookup_modtype ~loc lid env in
- path
+ Env.lookup_modtype_path ~loc lid env
let transl_module_alias loc env lid =
Env.lookup_module_path ~load:false ~loc lid env
Typedecl.transl_value_decl env item.psig_loc sdesc
in
Signature_names.check_value names tdesc.val_loc tdesc.val_id;
+ Env.register_uid tdesc.val_val.val_uid tdesc.val_loc;
let (trem,rem, final_env) = transl_sig newenv srem in
mksig (Tsig_value tdesc) env loc :: trem,
Sig_value(tdesc.val_id, tdesc.val_val, Exported) :: rem,
Typedecl.transl_type_decl env rec_flag sdecls
in
List.iter (fun td ->
- Signature_names.check_type names td.typ_loc td.typ_id
+ Signature_names.check_type names td.typ_loc td.typ_id;
+ if not (Btype.is_row_name (Ident.name td.typ_id)) then
+ Env.register_uid td.typ_type.type_uid td.typ_loc
) decls;
let (trem, rem, final_env) = transl_sig newenv srem in
let sg =
in
Some (`Substituted_away subst)
in
- Signature_names.check_type ?info names td.typ_loc td.typ_id
+ Signature_names.check_type ?info names td.typ_loc td.typ_id;
+ Env.register_uid td.typ_type.type_uid td.typ_loc
) decls;
let (trem, rem, final_env) = transl_sig newenv srem in
let sg = rem
in
let constructors = tyext.tyext_constructors in
List.iter (fun ext ->
- Signature_names.check_typext names ext.ext_loc ext.ext_id
+ Signature_names.check_typext names ext.ext_loc ext.ext_id;
+ Env.register_uid ext.ext_type.ext_uid ext.ext_loc
) constructors;
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_typext tyext) env loc :: trem,
let constructor = ext.tyexn_constructor in
Signature_names.check_typext names constructor.ext_loc
constructor.ext_id;
+ Env.register_uid
+ constructor.ext_type.ext_uid
+ constructor.ext_loc;
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_exception ext) env loc :: trem,
Sig_typext(constructor.ext_id,
Signature_names.check_module names pmd.pmd_name.loc id;
Some id, newenv
in
+ Env.register_uid md.md_uid md.md_loc;
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;
`Substituted_away (Subst.add_module id path Subst.identity)
in
Signature_names.check_module ~info names pms.pms_name.loc id;
+ Env.register_uid md.md_uid md.md_loc;
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;
let (tdecls, newenv) =
transl_recmodule_modtypes env sdecls in
let decls =
- List.filter_map (fun (md, uid) ->
+ List.filter_map (fun (md, uid, _) ->
match md.md_id with
| None -> None
| Some id -> Some (id, md, uid)
) tdecls
in
- List.iter (fun (id, md, _) ->
- Signature_names.check_module names md.md_loc id
+ List.iter (fun (id, md, uid) ->
+ Signature_names.check_module names md.md_loc id;
+ Env.register_uid uid md.md_loc
) decls;
let (trem, rem, final_env) = transl_sig newenv srem in
- mksig (Tsig_recmodule (List.map fst tdecls)) env loc :: trem,
+ mksig (Tsig_recmodule (List.map (fun (md, _, _) -> md) tdecls))
+ env loc :: trem,
map_rec (fun rs (id, md, uid) ->
let d = {Types.md_type = md.md_type.mty_type;
md_attributes = md.md_attributes;
decls rem,
final_env
| Psig_modtype pmtd ->
- let newenv, mtd, sg = transl_modtype_decl env pmtd in
+ let newenv, mtd, decl = transl_modtype_decl env pmtd in
Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
+ Env.register_uid decl.mtd_uid mtd.mtd_loc;
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_modtype mtd) env loc :: trem,
- sg :: rem,
+ Sig_modtype (mtd.mtd_id, decl, Exported) :: rem,
final_env
| Psig_modtypesubst pmtd ->
- let newenv, mtd, _sg = transl_modtype_decl env pmtd in
+ let newenv, mtd, decl = transl_modtype_decl env pmtd in
let info =
let mty = match mtd.mtd_type with
| Some tmty -> tmty.mty_type
| _ -> `Unpackable_modtype_substituted_away (mtd.mtd_id,subst)
in
Signature_names.check_modtype ~info names pmtd.pmtd_loc mtd.mtd_id;
+ Env.register_uid decl.mtd_uid mtd.mtd_loc;
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_modtypesubst mtd) env loc :: trem,
rem,
Signature_names.check_class names loc cls.cls_id;
Signature_names.check_class_type names loc cls.cls_ty_id;
Signature_names.check_type names loc cls.cls_typesharp_id;
+ Env.register_uid cls.cls_decl.cty_uid cls.cls_decl.cty_loc;
) classes;
let (trem, rem, final_env) = transl_sig newenv srem in
let sg =
Signature_names.check_class_type names loc decl.clsty_ty_id;
Signature_names.check_type names loc decl.clsty_obj_id;
Signature_names.check_type names loc decl.clsty_typesharp_id;
+ Env.register_uid
+ decl.clsty_ty_decl.clty_uid
+ decl.clsty_ty_decl.clty_loc;
) classes;
let (trem,rem, final_env) = transl_sig newenv srem in
let sg =
mtd_loc=pmtd_loc;
}
in
- newenv, mtd, Sig_modtype(id, decl, Exported)
+ newenv, mtd, decl
and transl_recmodule_modtypes env sdecls =
let make_env curr =
- List.fold_left
- (fun env (id, _, md, _) ->
- Option.fold ~none:env
- ~some:(fun id -> Env.add_module_declaration ~check:true ~arg:true
- id Mp_present md env) id)
- env curr in
+ List.fold_left (fun env (id_shape, _, md, _) ->
+ Option.fold ~none:env ~some:(fun (id, shape) ->
+ Env.add_module_declaration ~check:true ~shape ~arg:true
+ id Mp_present md env
+ ) id_shape
+ ) env curr
+ in
let transition env_c curr =
List.map2
- (fun pmd (id, id_loc, md, _) ->
+ (fun pmd (id_shape, id_loc, md, _) ->
let tmty =
Builtin_attributes.warning_scope pmd.pmd_attributes
(fun () -> transl_modtype env_c pmd.pmd_type)
in
let md = { md with Types.md_type = tmty.mty_type } in
- (id, id_loc, md, tmty))
+ (id_shape, id_loc, md, tmty))
sdecls curr in
let map_mtys curr =
List.filter_map
- (fun (id, _, md, _) -> Option.map (fun id -> (id, md)) id)
+ (fun (id_shape, _, md, _) ->
+ Option.map (fun (id, _) -> (id, md)) id_shape)
curr
in
let scope = Ctype.create_scope () in
let init =
List.map2
(fun id pmd ->
+ let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
let md =
{ md_type = approx_modtype approx_env pmd.pmd_type;
md_loc = pmd.pmd_loc;
md_attributes = pmd.pmd_attributes;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+ md_uid }
in
- (id, pmd.pmd_name, md, ()))
+ let id_shape =
+ Option.map (fun id -> id, Shape.var md_uid id) id
+ in
+ (id_shape, pmd.pmd_name, md, ()))
ids sdecls
in
let env0 = make_env init in
let env2 = make_env dcl2 in
check_recmod_typedecls env2 (map_mtys dcl2);
let dcl2 =
- List.map2 (fun pmd (id, id_loc, md, mty) ->
+ List.map2 (fun pmd (id_shape, id_loc, md, mty) ->
let tmd =
- {md_id=id; md_name=id_loc; md_type=mty;
+ {md_id=Option.map fst id_shape; md_name=id_loc; md_type=mty;
md_presence=Mp_present;
md_loc=pmd.pmd_loc;
md_attributes=pmd.pmd_attributes}
in
- tmd, md.md_uid
+ tmd, md.md_uid, Option.map snd id_shape
) sdecls dcl2
in
(dcl2, env2)
let path_of_module mexp =
try Some (path_of_module mexp) with Not_a_path -> None
-(* Check that all core type schemes in a structure are closed *)
+(* Check that all core type schemes in a structure
+ do not contain non-generalized type variable *)
-let rec closed_modtype env = function
- Mty_ident _ -> true
- | Mty_alias _ -> true
+let rec nongen_modtype env = function
+ Mty_ident _ -> false
+ | Mty_alias _ -> false
| Mty_signature sg ->
let env = Env.add_signature sg env in
- List.for_all (closed_signature_item env) sg
+ List.exists (nongen_signature_item env) sg
| Mty_functor(arg_opt, body) ->
let env =
match arg_opt with
| Named (Some id, param) ->
Env.add_module ~arg:true id Mp_present param env
in
- closed_modtype env body
+ nongen_modtype env body
-and closed_signature_item env = function
- Sig_value(_id, desc, _) -> Ctype.closed_schema env desc.val_type
- | Sig_module(_id, _, md, _, _) -> closed_modtype env md.md_type
- | _ -> true
+and nongen_signature_item env = function
+ Sig_value(_id, desc, _) -> Ctype.nongen_schema env desc.val_type
+ | Sig_module(_id, _, md, _, _) -> nongen_modtype env md.md_type
+ | _ -> false
-let check_nongen_scheme env sig_item =
+let check_nongen_signature_item env sig_item =
match sig_item with
Sig_value(_id, vd, _) ->
- if not (Ctype.closed_schema env vd.val_type) then
+ if Ctype.nongen_schema env vd.val_type then
raise (Error (vd.val_loc, env, Non_generalizable vd.val_type))
| Sig_module (_id, _, md, _, _) ->
- if not (closed_modtype env md.md_type) then
+ if nongen_modtype env md.md_type then
raise(Error(md.md_loc, env, Non_generalizable_module md.md_type))
| _ -> ()
-let check_nongen_schemes env sg =
- List.iter (check_nongen_scheme env) sg
+let check_nongen_signature env sg =
+ List.iter (check_nongen_signature_item env) sg
(* Helpers for typing recursive modules *)
(* 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, _uid) ->
+ (fun (id, _name, _mty_decl, _modl,
+ mty_actual, _attrs, _loc, shape, _uid) ->
let ids =
Option.map
(fun id -> (id, Ident.create_scoped ~scope (Ident.name id))) id
in
- (ids, mty_actual))
+ (ids, mty_actual, shape))
bindings in
(* Enter the Y_i in the environment with their actual types substituted
by the input substitution s *)
let env' =
List.fold_left
- (fun env (ids, mty_actual) ->
+ (fun env (ids, mty_actual, shape) ->
match ids with
| None -> env
| Some (id, id') ->
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.add_module ~arg:false ~shape id' Mp_present mty_actual' env)
env bindings1 in
(* Build the output substitution Y_i <- X_i *)
let s' =
List.fold_left
- (fun s (ids, _mty_actual) ->
+ (fun s (ids, _mty_actual, _shape) ->
match ids with
| None -> s
| Some (id, id') -> Subst.add_module id (Pident id') s)
(* Base case: check inclusion of s(mty_actual) in s(mty_decl)
and insert coercion if needed *)
let check_inclusion
- (id, name, mty_decl, modl, mty_actual, attrs, loc, uid) =
+ (id, name, mty_decl, modl, mty_actual, attrs, loc, shape, uid) =
let mty_decl' = Subst.modtype (Rescope scope) s mty_decl.mty_type
and mty_actual' = subst_and_strengthen env scope s id mty_actual in
- let coercion =
+ let coercion, shape =
try
- Includemod.modtypes ~loc:modl.mod_loc ~mark:Mark_both env
- mty_actual' mty_decl'
+ Includemod.modtypes_with_shape ~shape
+ ~loc:modl.mod_loc ~mark:Mark_both
+ env mty_actual' mty_decl'
with Includemod.Error msg ->
raise(Error(modl.mod_loc, env, Not_included msg)) in
let modl' =
mb_loc = loc;
}
in
- mb, uid
+ mb, shape, uid
in
List.map check_inclusion bindings
end
mod_attributes = [];
mod_loc = arg.mod_loc }
+let wrap_constraint_with_shape env mark arg mty
+ shape explicit =
+ let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
+ let coercion, shape =
+ try
+ Includemod.modtypes_with_shape ~shape ~loc:arg.mod_loc env ~mark
+ arg.mod_type mty
+ with Includemod.Error msg ->
+ raise(Error(arg.mod_loc, env, Not_included msg)) in
+ { mod_desc = Tmod_constraint(arg, mty, explicit, coercion);
+ mod_type = mty;
+ mod_env = env;
+ mod_attributes = [];
+ mod_loc = arg.mod_loc }, shape
+
(* Type a module value expression *)
f_loc: Location.t; (* loc for F *)
arg_is_syntactic_unit: bool;
arg: Typedtree.module_expr;
- arg_path:Path.t option
+ arg_path: Path.t option;
+ shape: Shape.t
}
let simplify_app_summary app_view =
mod_attributes = smod.pmod_attributes;
mod_loc = smod.pmod_loc } in
let aliasable = not (Env.is_functor_arg path env) in
+ let shape =
+ Env.shape_of_path ~namespace:Shape.Sig_component_kind.Module env path
+ in
let md =
if alias && aliasable then
(Env.add_required_global (Path.head path); md)
- else match (Env.find_module path env).md_type with
- | Mty_alias p1 when not alias ->
- let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
- let mty = Includemod.expand_module_alias env p1 in
- { md with
- mod_desc =
- Tmod_constraint (md, mty, Tmodtype_implicit,
- Tcoerce_alias (env, path, Tcoerce_none));
- mod_type =
- if sttn then Mtype.strengthen ~aliasable:true env mty p1
- else mty }
- | mty ->
- let mty =
- if sttn then Mtype.strengthen ~aliasable env mty path
- else mty
- in
- { md with mod_type = mty }
- in md
+ else begin
+ let mty =
+ if sttn then
+ Env.find_strengthened_module ~aliasable path env
+ else
+ (Env.find_module path env).md_type
+ in
+ match mty with
+ | Mty_alias p1 when not alias ->
+ let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
+ let mty = Includemod.expand_module_alias
+ ~strengthen:sttn env p1 in
+ { md with
+ mod_desc =
+ Tmod_constraint (md, mty, Tmodtype_implicit,
+ Tcoerce_alias (env, path, Tcoerce_none));
+ mod_type = mty }
+ | mty ->
+ { md with mod_type = mty }
+ end
+ in
+ md, shape
| Pmod_structure sstr ->
- let (str, sg, names, _finalenv) =
+ let (str, sg, names, shape, _finalenv) =
type_structure funct_body anchor env sstr in
let md =
{ mod_desc = Tmod_structure str;
mod_loc = smod.pmod_loc }
in
let sg' = Signature_names.simplify _finalenv names sg in
- if List.length sg' = List.length sg then md else
- wrap_constraint env false md (Mty_signature sg')
- Tmodtype_implicit
+ if List.length sg' = List.length sg then md, shape else
+ wrap_constraint_with_shape env false md
+ (Mty_signature sg') shape Tmodtype_implicit
| Pmod_functor(arg_opt, sbody) ->
- let t_arg, ty_arg, newenv, funct_body =
+ let t_arg, ty_arg, newenv, funct_shape_param, funct_body =
match arg_opt with
- | Unit -> Unit, Types.Unit, env, false
+ | Unit ->
+ Unit, Types.Unit, env, Shape.for_unnamed_functor_param, false
| Named (param, smty) ->
let mty = transl_modtype_functor_arg env smty in
let scope = Ctype.create_scope () in
- let (id, newenv) =
+ let (id, newenv, var) =
match param.txt with
- | None -> None, env
+ | None -> None, env, Shape.for_unnamed_functor_param
| Some name ->
+ let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
let arg_md =
{ md_type = mty.mty_type;
md_attributes = [];
md_loc = param.loc;
- md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ md_uid;
}
in
- let id, newenv =
- Env.enter_module_declaration ~scope ~arg:true name Mp_present
- arg_md env
+ let id = Ident.create_scoped ~scope name in
+ let shape = Shape.var md_uid id in
+ let newenv = Env.add_module_declaration
+ ~shape ~arg:true ~check:true id Mp_present arg_md env
in
- Some id, newenv
+ Some id, newenv, id
in
- Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
+ Named (id, param, mty), Types.Named (id, mty.mty_type), newenv,
+ var, true
in
- let body = type_module true funct_body None newenv sbody in
+ let body, body_shape = type_module true funct_body None newenv sbody in
{ mod_desc = Tmod_functor(t_arg, body);
mod_type = Mty_functor(ty_arg, body.mod_type);
mod_env = env;
mod_attributes = smod.pmod_attributes;
- mod_loc = smod.pmod_loc }
+ mod_loc = smod.pmod_loc },
+ Shape.abs funct_shape_param body_shape
| Pmod_apply _ ->
type_application smod.pmod_loc sttn funct_body env smod
| Pmod_constraint(sarg, smty) ->
- let arg = type_module ~alias true funct_body anchor env sarg in
+ let arg, arg_shape = type_module ~alias true funct_body anchor env sarg in
let mty = transl_modtype env smty in
- let md =
- wrap_constraint env true arg mty.mty_type (Tmodtype_explicit mty)
+ let md, final_shape =
+ wrap_constraint_with_shape env true arg mty.mty_type arg_shape
+ (Tmodtype_explicit mty)
in
{ md with
mod_loc = smod.pmod_loc;
mod_attributes = smod.pmod_attributes;
- }
+ },
+ final_shape
| Pmod_unpack sexp ->
if !Clflags.principal then Ctype.begin_def ();
let exp = Typecore.type_exp env sexp in
Ctype.generalize_structure exp.exp_type
end;
let mty =
- match Ctype.expand_head env exp.exp_type with
- {desc = Tpackage (p, fl)} ->
+ match get_desc (Ctype.expand_head env exp.exp_type) with
+ Tpackage (p, fl) ->
if List.exists (fun (_n, t) -> Ctype.free_variables t <> []) fl then
raise (Error (smod.pmod_loc, env,
Incomplete_packed_module exp.exp_type));
Location.prerr_warning smod.pmod_loc
(Warnings.Not_principal "this module unpacking");
modtype_of_package env smod.pmod_loc p fl
- | {desc = Tvar _} ->
+ | Tvar _ ->
raise (Typecore.Error
(smod.pmod_loc, env, Typecore.Cannot_infer_signature))
| _ ->
mod_type = mty;
mod_env = env;
mod_attributes = smod.pmod_attributes;
- mod_loc = smod.pmod_loc }
+ mod_loc = smod.pmod_loc },
+ Shape.leaf_for_unpack
| Pmod_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
let rec extract_application funct_body env sargs smod =
match smod.pmod_desc with
| Pmod_apply(f, sarg) ->
- let arg = type_module true funct_body None env sarg in
+ let arg, shape = type_module true funct_body None env sarg in
let summary =
{ loc=smod.pmod_loc;
attributes=smod.pmod_attributes;
f_loc = f.pmod_loc;
arg_is_syntactic_unit = sarg.pmod_desc = Pmod_structure [];
arg;
- arg_path = path_of_module arg
+ arg_path = path_of_module arg;
+ shape
}
in
extract_application funct_body env (summary::sargs) f
| _ -> smod, sargs
in
let sfunct, args = extract_application funct_body env [] smod in
- let funct =
+ let funct, funct_shape =
let strengthen =
strengthen && List.for_all (fun {arg_path;_} -> arg_path <> None) args
in
type_module strengthen funct_body None env sfunct
in
List.fold_left (type_one_application ~ctx:(loc, funct, args) funct_body env)
- funct args
+ (funct, funct_shape) args
-and type_one_application ~ctx:(apply_loc,md_f,args) funct_body env funct
- app_view =
+and type_one_application ~ctx:(apply_loc,md_f,args)
+ funct_body env (funct, funct_shape) app_view =
match Env.scrape_alias env funct.mod_type with
| Mty_functor (Unit, mty_res) ->
if not app_view.arg_is_syntactic_unit then
mod_type = mty_res;
mod_env = env;
mod_attributes = app_view.attributes;
- mod_loc = funct.mod_loc }
+ mod_loc = funct.mod_loc },
+ Shape.app funct_shape ~arg:app_view.shape
| Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
let coercion =
try
mod_type = mty_appl;
mod_env = env;
mod_attributes = app_view.attributes;
- mod_loc = app_view.loc }
+ mod_loc = app_view.loc },
+ Shape.app ~arg:app_view.shape funct_shape
| Mty_alias path ->
raise(Error(app_view.f_loc, env, Cannot_scrape_alias path))
| _ ->
} in
open_descr, [], newenv
| _ ->
- let md = type_module true funct_body None env od.popen_expr in
+ let md, mod_shape = type_module true funct_body None env od.popen_expr in
let scope = Ctype.create_scope () in
let sg, newenv =
- Env.enter_signature ~scope (extract_sig_open env md.mod_loc md.mod_type)
- env
+ Env.enter_signature ~scope ~mod_shape
+ (extract_sig_open env md.mod_loc md.mod_type) env
in
let info, visibility =
match toplevel with
and type_structure ?(toplevel = false) funct_body anchor env sstr =
let names = Signature_names.create () in
- let type_str_item env {pstr_loc = loc; pstr_desc = desc} =
+ let type_str_item env shape_map {pstr_loc = loc; pstr_desc = desc} =
match desc with
| Pstr_eval (sexpr, attrs) ->
let expr =
Builtin_attributes.warning_scope attrs
(fun () -> Typecore.type_expression env sexpr)
in
- Tstr_eval (expr, attrs), [], env
+ Tstr_eval (expr, attrs), [], shape_map, env
| Pstr_value(rec_flag, sdefs) ->
let (defs, newenv) =
Typecore.type_binding env rec_flag sdefs in
in
(* Note: Env.find_value does not trigger the value_used event. Values
will be marked as being used during the signature inclusion test. *)
+ let items, shape_map =
+ List.fold_left
+ (fun (acc, shape_map) (id, { Asttypes.loc; _ }, _typ)->
+ Signature_names.check_value names loc id;
+ let vd = Env.find_value (Pident id) newenv in
+ Env.register_uid vd.val_uid vd.val_loc;
+ Sig_value(id, vd, Exported) :: acc,
+ Shape.Map.add_value shape_map id vd.val_uid
+ )
+ ([], shape_map)
+ (let_bound_idents_full defs)
+ in
Tstr_value(rec_flag, defs),
- List.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_full defs),
+ List.rev items,
+ shape_map,
newenv
| Pstr_primitive sdesc ->
let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
Signature_names.check_value names desc.val_loc desc.val_id;
+ Env.register_uid desc.val_val.val_uid desc.val_val.val_loc;
Tstr_primitive desc,
[Sig_value(desc.val_id, desc.val_val, Exported)],
+ Shape.Map.add_value shape_map desc.val_id desc.val_val.val_uid,
newenv
| Pstr_type (rec_flag, sdecls) ->
let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
List.iter
Signature_names.(fun td -> check_type names td.typ_loc td.typ_id)
decls;
- Tstr_type (rec_flag, decls),
- map_rec_type_with_row_types ~rec_flag
+ let items = map_rec_type_with_row_types ~rec_flag
(fun rs info -> Sig_type(info.typ_id, info.typ_type, rs, Exported))
- decls [],
+ decls []
+ in
+ let shape_map = List.fold_left
+ (fun shape_map -> function
+ | Sig_type (id, vd, _, _) ->
+ if not (Btype.is_row_name (Ident.name id)) then begin
+ Env.register_uid vd.type_uid vd.type_loc;
+ Shape.Map.add_type shape_map id vd.type_uid
+ end else shape_map
+ | _ -> assert false
+ )
+ shape_map
+ items
+ in
+ Tstr_type (rec_flag, decls),
+ items,
+ shape_map,
enrich_type_decls anchor decls env newenv
| Pstr_typext styext ->
let (tyext, newenv) =
Typedecl.transl_type_extension true env loc styext
in
let constructors = tyext.tyext_constructors in
- List.iter
- Signature_names.(fun ext -> check_typext names ext.ext_loc ext.ext_id)
- constructors;
+ let shape_map = List.fold_left (fun shape_map ext ->
+ Signature_names.check_typext names ext.ext_loc ext.ext_id;
+ Env.register_uid ext.ext_type.ext_uid ext.ext_loc;
+ Shape.Map.add_extcons shape_map ext.ext_id ext.ext_type.ext_uid
+ ) shape_map constructors
+ in
(Tstr_typext tyext,
map_ext
(fun es ext -> Sig_typext(ext.ext_id, ext.ext_type, es, Exported))
constructors [],
+ shape_map,
newenv)
| Pstr_exception sext ->
let (ext, newenv) = Typedecl.transl_type_exception env sext in
let constructor = ext.tyexn_constructor in
Signature_names.check_typext names constructor.ext_loc
constructor.ext_id;
+ Env.register_uid
+ constructor.ext_type.ext_uid
+ constructor.ext_loc;
Tstr_exception ext,
[Sig_typext(constructor.ext_id,
constructor.ext_type,
Text_exception,
Exported)],
+ Shape.Map.add_extcons shape_map
+ constructor.ext_id
+ constructor.ext_type.ext_uid,
newenv
| Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs;
pmb_loc;
} ->
let outer_scope = Ctype.get_current_level () in
let scope = Ctype.create_scope () in
- let modl =
+ let modl, md_shape =
Builtin_attributes.warning_scope attrs
(fun () ->
type_module ~alias:true true funct_body
md_uid;
}
in
+ let md_shape = Shape.set_uid_if_none md_shape md_uid in
+ Env.register_uid md_uid pmb_loc;
(*prerr_endline (Ident.unique_toplevel_name id);*)
Mtype.lower_nongen outer_scope md.md_type;
let id, newenv, sg =
match name.txt with
| None -> None, env, []
| Some name ->
- let id, e = Env.enter_module_declaration ~scope name pres md env in
+ let id, e = Env.enter_module_declaration
+ ~scope ~shape:md_shape name pres md env
+ in
Signature_names.check_module names pmb_loc id;
Some id, e,
[Sig_module(id, pres,
md_uid;
}, Trec_not, Exported)]
in
+ let shape_map = match id with
+ | Some id -> Shape.Map.add_module shape_map id md_shape
+ | None -> shape_map
+ in
Tstr_module {mb_id=id; mb_name=name; mb_expr=modl;
mb_presence=pres; mb_attributes=attrs; mb_loc=pmb_loc; },
sg,
+ shape_map,
newenv
| Pstr_recmodule sbind ->
let sbind =
pmd_attributes=attrs; pmd_loc=loc}) sbind
) in
List.iter
- (fun (md, _) ->
- Option.iter Signature_names.(check_module names md.md_loc) md.md_id)
- decls;
+ (fun (md, _, _) ->
+ Option.iter Signature_names.(check_module names md.md_loc) md.md_id
+ ) decls;
let bindings1 =
List.map2
- (fun ({md_id=id; md_type=mty}, uid) (name, _, smodl, attrs, loc) ->
- let modl =
+ (fun ({md_id=id; md_type=mty}, uid, _prev_shape)
+ (name, _, smodl, attrs, loc) ->
+ let modl, shape =
Builtin_attributes.warning_scope attrs
(fun () ->
type_module true funct_body (anchor_recmodule id)
let mty' =
enrich_module_type anchor name.txt modl.mod_type newenv
in
- (id, name, mty, modl, mty', attrs, loc, uid))
+ (id, name, mty, modl, mty', attrs, loc, shape, uid))
decls sbind in
let newenv = (* allow aliasing recursive modules from outside *)
List.fold_left
- (fun env (md, uid) ->
- match md.md_id with
+ (fun env (id_opt, _, mty, _, _, attrs, loc, shape, uid) ->
+ match id_opt with
| None -> env
| Some id ->
let mdecl =
{
- md_type = md.md_type.mty_type;
- md_attributes = md.md_attributes;
- md_loc = md.md_loc;
+ md_type = mty.mty_type;
+ md_attributes = attrs;
+ md_loc = loc;
md_uid = uid;
}
in
- Env.add_module_declaration ~check:true
+ Env.add_module_declaration ~check:true ~shape
id Mp_present mdecl env
)
- env decls
+ env bindings1
in
let bindings2 =
check_recmodule_inclusion newenv bindings1 in
let mbs =
- List.filter_map (fun (mb, uid) ->
- Option.map (fun id -> id, mb, uid) mb.mb_id
+ List.filter_map (fun (mb, shape, uid) ->
+ Option.map (fun id -> id, mb, uid, shape) mb.mb_id
) bindings2
in
- Tstr_recmodule (List.map fst bindings2),
- map_rec (fun rs (id, mb, uid) ->
+ let shape_map =
+ List.fold_left (fun map (id, mb, uid, shape) ->
+ Env.register_uid uid mb.mb_loc;
+ Shape.Map.add_module map id shape
+ ) shape_map mbs
+ in
+ Tstr_recmodule (List.map (fun (mb, _, _) -> mb) bindings2),
+ map_rec (fun rs (id, mb, uid, _shape) ->
Sig_module(id, Mp_present, {
md_type=mb.mb_expr.mod_type;
md_attributes=mb.mb_attributes;
md_uid = uid;
}, rs, Exported))
mbs [],
+ shape_map,
newenv
| Pstr_modtype pmtd ->
(* check that it is non-abstract *)
- let newenv, mtd, sg = transl_modtype_decl env pmtd in
+ let newenv, mtd, decl = transl_modtype_decl env pmtd in
Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
- Tstr_modtype mtd, [sg], newenv
+ Env.register_uid decl.mtd_uid decl.mtd_loc;
+ let id = mtd.mtd_id in
+ let map = Shape.Map.add_module_type shape_map id decl.mtd_uid in
+ Tstr_modtype mtd, [Sig_modtype (id, decl, Exported)], map, newenv
| Pstr_open sod ->
let (od, sg, newenv) =
type_open_decl ~toplevel funct_body names env sod
in
- Tstr_open od, sg, newenv
+ Tstr_open od, sg, shape_map, newenv
| Pstr_class cl ->
let (classes, new_env) = Typeclass.class_declarations env cl in
- List.iter (fun cls ->
- let open Typeclass in
- let loc = cls.cls_id_loc.Location.loc in
- Signature_names.check_class names loc cls.cls_id;
- Signature_names.check_class_type names loc cls.cls_ty_id;
- Signature_names.check_type names loc cls.cls_obj_id;
- Signature_names.check_type names loc cls.cls_typesharp_id;
- ) classes;
+ let shape_map = List.fold_left (fun acc cls ->
+ let open Typeclass in
+ let loc = cls.cls_id_loc.Location.loc in
+ Signature_names.check_class names loc cls.cls_id;
+ Signature_names.check_class_type names loc cls.cls_ty_id;
+ Signature_names.check_type names loc cls.cls_obj_id;
+ Signature_names.check_type names loc cls.cls_typesharp_id;
+ Env.register_uid cls.cls_decl.cty_uid loc;
+ let map f id acc = f acc id cls.cls_decl.cty_uid in
+ map Shape.Map.add_class cls.cls_id acc
+ |> map Shape.Map.add_class_type cls.cls_ty_id
+ |> map Shape.Map.add_type cls.cls_obj_id
+ |> map Shape.Map.add_type cls.cls_typesharp_id
+ ) shape_map classes
+ in
Tstr_class
(List.map (fun cls ->
(cls.Typeclass.cls_info,
Sig_type(cls.cls_obj_id, cls.cls_obj_abbr, rs, Exported);
Sig_type(cls.cls_typesharp_id, cls.cls_abbr, rs, Exported)])
classes []),
+ shape_map,
new_env
| Pstr_class_type cl ->
let (classes, new_env) = Typeclass.class_type_declarations env cl in
- List.iter (fun decl ->
- let open Typeclass in
- let loc = decl.clsty_id_loc.Location.loc in
- Signature_names.check_class_type names loc decl.clsty_ty_id;
- Signature_names.check_type names loc decl.clsty_obj_id;
- Signature_names.check_type names loc decl.clsty_typesharp_id;
- ) classes;
+ let shape_map = List.fold_left (fun acc decl ->
+ let open Typeclass in
+ let loc = decl.clsty_id_loc.Location.loc in
+ Signature_names.check_class_type names loc decl.clsty_ty_id;
+ Signature_names.check_type names loc decl.clsty_obj_id;
+ Signature_names.check_type names loc decl.clsty_typesharp_id;
+ Env.register_uid decl.clsty_ty_decl.clty_uid loc;
+ let map f id acc = f acc id decl.clsty_ty_decl.clty_uid in
+ map Shape.Map.add_class_type decl.clsty_ty_id acc
+ |> map Shape.Map.add_type decl.clsty_obj_id
+ |> map Shape.Map.add_type decl.clsty_typesharp_id
+ ) shape_map classes
+ in
Tstr_class_type
(List.map (fun cl ->
(cl.Typeclass.clsty_ty_id,
Exported)
])
classes []),
+ shape_map,
new_env
| Pstr_include sincl ->
let smodl = sincl.pincl_mod in
- let modl =
+ let modl, modl_shape =
Builtin_attributes.warning_scope sincl.pincl_attributes
(fun () -> type_module true funct_body None env smodl)
in
let scope = Ctype.create_scope () in
(* Rename all identifiers bound by this signature to avoid clashes *)
- let sg, new_env = Env.enter_signature ~scope
- (extract_sig_open env smodl.pmod_loc modl.mod_type) env in
+ let sg, shape, new_env =
+ Env.enter_signature_and_shape ~scope ~parent_shape:shape_map
+ modl_shape (extract_sig_open env smodl.pmod_loc modl.mod_type) env
+ in
Signature_group.iter (Signature_names.check_sig_item names loc) sg;
let incl =
{ incl_mod = modl;
incl_loc = sincl.pincl_loc;
}
in
- Tstr_include incl, sg, new_env
+ Tstr_include incl, sg, shape, new_env
| Pstr_extension (ext, _attrs) ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
| Pstr_attribute x ->
Builtin_attributes.warning_attribute x;
- Tstr_attribute x, [], env
+ Tstr_attribute x, [], shape_map, env
in
- let rec type_struct env sstr =
+ let rec type_struct env shape_map sstr =
match sstr with
- | [] -> ([], [], env)
+ | [] -> ([], [], shape_map, env)
| pstr :: srem ->
let previous_saved_types = Cmt_format.get_saved_types () in
- let desc, sg, new_env = type_str_item env pstr in
+ let desc, sg, shape_map, new_env = type_str_item env shape_map pstr in
let str = { str_desc = desc; str_loc = pstr.pstr_loc; str_env = env } in
Cmt_format.set_saved_types (Cmt_format.Partial_structure_item str
:: previous_saved_types);
- let (str_rem, sig_rem, final_env) = type_struct new_env srem in
- (str :: str_rem, sg @ sig_rem, final_env)
+ let (str_rem, sig_rem, shape_map, final_env) =
+ type_struct new_env shape_map srem
+ in
+ (str :: str_rem, sg @ sig_rem, shape_map, final_env)
in
let previous_saved_types = Cmt_format.get_saved_types () in
let run () =
- let (items, sg, final_env) = type_struct env sstr in
+ let (items, sg, shape_map, final_env) =
+ type_struct env Shape.Map.empty sstr
+ in
let str = { str_items = items; str_type = sg; str_final_env = final_env } in
Cmt_format.set_saved_types
(Cmt_format.Partial_structure str :: previous_saved_types);
- str, sg, names, final_env
+ str, sg, names, Shape.str shape_map, final_env
in
if toplevel then run ()
else Builtin_attributes.warning_scope [] run
let type_toplevel_phrase env s =
Env.reset_required_globals ();
- let (str, sg, to_remove_from_sg, env) =
- type_structure ~toplevel:true false None env s in
- (str, sg, to_remove_from_sg, env)
+ type_structure ~toplevel:true false None env s
let type_module_alias = type_module ~alias:true true false None
let type_module = type_module true false None
mod_env = env;
mod_attributes = smod.pmod_attributes;
mod_loc = smod.pmod_loc }
- | _ -> type_module env smod
+ | _ ->
+ let me, _shape = type_module env smod in
+ me
in
let mty = Mtype.scrape_for_type_of ~remove_aliases env tmty.mod_type in
(* PR#5036: must not contain non-generalized type variables *)
- if not (closed_modtype env mty) then
+ if nongen_modtype env mty then
raise(Error(smod.pmod_loc, env, Non_generalizable_module mty));
tmty, mty
(* remember original level *)
Ctype.begin_def ();
let context = Typetexp.narrow () in
- let modl = type_module env m in
+ let modl, _mod_shape = type_module env m in
let scope = Ctype.create_scope () in
Typetexp.widen context;
let fl', env =
Env.reset_required_globals ();
if !Clflags.print_types then (* #7656 *)
ignore @@ Warnings.parse_options false "-32-34-37-38-60";
- let (str, sg, names, finalenv) =
+ let (str, sg, names, shape, finalenv) =
type_structure initial_env ast in
+ let shape =
+ Shape.set_uid_if_none shape
+ (Uid.of_compilation_unit_id (Ident.create_persistent modulename))
+ in
let simple_sg = Signature_names.simplify finalenv names sg in
if !Clflags.print_types then begin
Typecore.force_delayed_checks ();
+ let shape = Shape.local_reduce shape in
Printtyp.wrap_printing_env ~error:false initial_env
(fun () -> fprintf std_formatter "%a@."
(Printtyp.printed_signature sourcefile) simple_sg
gen_annot outputprefix sourcefile (Cmt_format.Implementation str);
{ structure = str;
coercion = Tcoerce_none;
+ shape;
signature = simple_sg
} (* result is ignored by Compile.implementation *)
end else begin
raise(Error(Location.in_file sourcefile, Env.empty,
Interface_not_compiled sourceintf)) in
let dclsig = Env.read_signature modulename intf_file in
- let coercion =
+ let coercion, shape =
Includemod.compunit initial_env ~mark:Mark_positive
- sourcefile sg intf_file dclsig
+ sourcefile sg intf_file dclsig shape
in
Typecore.force_delayed_checks ();
(* It is important to run these checks after the inclusion test above,
so that value declarations which are not used internally but
exported are not reported as being unused. *)
+ let shape = Shape.local_reduce shape in
let annots = Cmt_format.Implementation str in
Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
- annots (Some sourcefile) initial_env None;
+ annots (Some sourcefile) initial_env None (Some shape);
gen_annot outputprefix sourcefile annots;
{ structure = str;
coercion;
+ shape;
signature = dclsig
}
end else begin
Location.prerr_warning (Location.in_file sourcefile)
Warnings.Missing_mli;
- let coercion =
+ let coercion, shape =
Includemod.compunit initial_env ~mark:Mark_positive
- sourcefile sg "(inferred signature)" simple_sg
+ sourcefile sg "(inferred signature)" simple_sg shape
in
- check_nongen_schemes finalenv simple_sg;
+ check_nongen_signature finalenv simple_sg;
normalize_signature simple_sg;
Typecore.force_delayed_checks ();
(* See comment above. Here the target signature contains all
the value being exported. We can still capture unused
declarations like "let x = true;; let x = 1;;", because in this
case, the inferred signature contains only the last declaration. *)
+ let shape = Shape.local_reduce shape in
if not !Clflags.dont_write_files then begin
let alerts = Builtin_attributes.alerts_of_str ast in
let cmi =
in
let annots = Cmt_format.Implementation str in
Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
- annots (Some sourcefile) initial_env (Some cmi);
+ annots (Some sourcefile) initial_env (Some cmi) (Some shape);
gen_annot outputprefix sourcefile annots
end;
{ structure = str;
coercion;
+ shape;
signature = simple_sg
}
end
(Array.of_list (Cmt_format.get_saved_types ()))
in
Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
- annots (Some sourcefile) initial_env None;
+ annots (Some sourcefile) initial_env None None;
gen_annot outputprefix sourcefile annots
)
let save_signature modname tsg outputprefix source_file initial_env cmi =
Cmt_format.save_cmt (outputprefix ^ ".cmti") modname
- (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi)
+ (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi) None
let type_interface env ast =
transl_signature env ast
(* Compute signature of packaged unit *)
Ident.reinit();
let sg = package_signatures units in
- (* See if explicit interface is provided *)
+ (* Compute the shape of the package *)
let prefix = Filename.remove_extension cmifile in
+ let pack_uid = Uid.of_compilation_unit_id (Ident.create_persistent prefix) in
+ let shape =
+ List.fold_left (fun map (name, _sg) ->
+ let id = Ident.create_persistent name in
+ Shape.Map.add_module map id (Shape.for_persistent_unit name)
+ ) Shape.Map.empty units
+ |> Shape.str ~uid:pack_uid
+ in
+ (* See if explicit interface is provided *)
let mlifile = prefix ^ !Config.interface_suffix in
if Sys.file_exists mlifile then begin
if not (Sys.file_exists cmifile) then begin
Interface_not_compiled mlifile))
end;
let dclsig = Env.read_signature modulename cmifile in
+ let cc, _shape =
+ Includemod.compunit initial_env ~mark:Mark_both
+ "(obtained by packing)" sg mlifile dclsig shape
+ in
Cmt_format.save_cmt (prefix ^ ".cmt") modulename
- (Cmt_format.Packed (sg, objfiles)) None initial_env None ;
- Includemod.compunit initial_env ~mark:Mark_both
- "(obtained by packing)" sg mlifile dclsig
+ (Cmt_format.Packed (sg, objfiles)) None initial_env None (Some shape);
+ cc
end else begin
(* Determine imports *)
let unit_names = List.map fst units in
in
Cmt_format.save_cmt (prefix ^ ".cmt") modulename
(Cmt_format.Packed (cmi.Cmi_format.cmi_sign, objfiles)) None initial_env
- (Some cmi)
+ (Some cmi) (Some shape);
end;
Tcoerce_none
end
Location.errorf ~loc
"@[The type of this expression,@ %a,@ \
contains type variables that cannot be generalized@]" type_scheme typ
- | Non_generalizable_class (id, desc) ->
- Location.errorf ~loc
- "@[The type of this class,@ %a,@ \
- contains type variables that cannot be generalized@]"
- (class_declaration id) desc
| Non_generalizable_module mty ->
Location.errorf ~loc
"@[The type of this module,@ %a,@ \
end
val type_module:
- Env.t -> Parsetree.module_expr -> Typedtree.module_expr
+ Env.t -> Parsetree.module_expr -> Typedtree.module_expr * Shape.t
val type_structure:
Env.t -> Parsetree.structure ->
- Typedtree.structure * Types.signature * Signature_names.t * Env.t
+ Typedtree.structure * Types.signature * Signature_names.t * Shape.t *
+ Env.t
val type_toplevel_phrase:
Env.t -> Parsetree.structure ->
- Typedtree.structure * Types.signature * Signature_names.t * Env.t
+ Typedtree.structure * Types.signature * Signature_names.t * Shape.t *
+ Env.t
val type_implementation:
string -> string -> string -> Env.t ->
Parsetree.structure -> Typedtree.implementation
Env.t -> Parsetree.signature -> Typedtree.signature
val transl_signature:
Env.t -> Parsetree.signature -> Typedtree.signature
-val check_nongen_schemes:
+val check_nongen_signature:
Env.t -> Types.signature -> unit
(*
val type_open_:
| With_cannot_remove_constrained_type
| Repeated_name of Sig_component_kind.t * string
| Non_generalizable of type_expr
- | Non_generalizable_class of Ident.t * class_declaration
| Non_generalizable_module of module_type
| Implementation_is_required of string
| Interface_not_compiled of string
open Lambda
let scrape_ty env ty =
- let ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
- match ty.desc with
- | Tconstr (p, _, _) ->
- begin match Env.find_type p env with
- | {type_kind = ( Type_variant (_, Variant_unboxed)
- | Type_record (_, Record_unboxed _) ); _} ->
- begin match Typedecl.get_unboxed_type_representation env ty with
- | None -> ty
- | Some ty2 -> ty2
- end
- | _ -> ty
- | exception Not_found -> ty
+ match get_desc ty with
+ | Tconstr _ ->
+ let ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
+ begin match get_desc ty with
+ | Tconstr (p, _, _) ->
+ begin match Env.find_type p env with
+ | {type_kind = ( Type_variant (_, Variant_unboxed)
+ | Type_record (_, Record_unboxed _) ); _} -> begin
+ match Typedecl_unboxed.get_unboxed_type_representation env ty with
+ | None -> ty
+ | Some ty2 -> ty2
+ end
+ | _ -> ty
+ | exception Not_found -> ty
+ end
+ | _ ->
+ ty
end
| _ -> ty
let scrape env ty =
- (scrape_ty env ty).desc
+ get_desc (scrape_ty env ty)
+
+let scrape_poly env ty =
+ let ty = scrape_ty env ty in
+ match get_desc ty with
+ | Tpoly (ty, _) -> get_desc ty
+ | d -> d
let is_function_type env ty =
match scrape env ty with
| Tconstr(p, _, _) -> Path.same p base_ty_path
| _ -> false
+let is_immediate = function
+ | Type_immediacy.Unknown -> false
+ | Type_immediacy.Always -> true
+ | Type_immediacy.Always_on_64bits ->
+ (* In bytecode, we don't know at compile time whether we are
+ targeting 32 or 64 bits. *)
+ !Clflags.native_code && Sys.word_size = 64
+
let maybe_pointer_type env ty =
let ty = scrape_ty env ty in
- if Ctype.maybe_pointer_type env ty then
- Pointer
- else
- Immediate
+ if is_immediate (Ctype.immediacy env ty) then Immediate
+ else Pointer
let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type
let classify env ty =
let ty = scrape_ty env ty in
if maybe_pointer_type env ty = Immediate then Int
- else match ty.desc with
+ else match get_desc ty with
| Tvar _ | Tunivar _ ->
Any
| Tconstr (p, _args, _abbrev) ->
assert false
let array_type_kind env ty =
- match scrape env ty with
- | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
- when Path.same p Predef.path_array ->
+ match scrape_poly env ty with
+ | Tconstr(p, [elt_ty], _) when Path.same p Predef.path_array ->
begin match classify env elt_ty with
| Any -> if Config.flat_float_array then Pgenarray else Paddrarray
| Float -> if Config.flat_float_array then Pfloatarray else Paddrarray
| Addr | Lazy -> Paddrarray
| Int -> Pintarray
end
- | Tconstr(p, [], _) | Tpoly({desc = Tconstr(p, [], _)}, _)
- when Path.same p Predef.path_floatarray ->
+ | Tconstr(p, [], _) when Path.same p Predef.path_floatarray ->
Pfloatarray
| _ ->
(* This can happen with e.g. Obj.field *)
(Pbigarray_unknown, Pbigarray_unknown_layout)
let value_kind env ty =
- match scrape env ty with
- | Tconstr(p, _, _) when Path.same p Predef.path_int ->
- Pintval
- | Tconstr(p, _, _) when Path.same p Predef.path_char ->
- Pintval
- | Tconstr(p, _, _) when Path.same p Predef.path_float ->
- Pfloatval
- | Tconstr(p, _, _) when Path.same p Predef.path_int32 ->
- Pboxedintval Pint32
- | Tconstr(p, _, _) when Path.same p Predef.path_int64 ->
- Pboxedintval Pint64
- | Tconstr(p, _, _) when Path.same p Predef.path_nativeint ->
- Pboxedintval Pnativeint
- | _ ->
- Pgenval
+ let ty = scrape_ty env ty in
+ if is_immediate (Ctype.immediacy env ty) then Pintval
+ else begin
+ match get_desc ty with
+ | Tconstr(p, _, _) when Path.same p Predef.path_float ->
+ Pfloatval
+ | Tconstr(p, _, _) when Path.same p Predef.path_int32 ->
+ Pboxedintval Pint32
+ | Tconstr(p, _, _) when Path.same p Predef.path_int64 ->
+ Pboxedintval Pint64
+ | Tconstr(p, _, _) when Path.same p Predef.path_nativeint ->
+ Pboxedintval Pnativeint
+ | _ ->
+ Pgenval
+ end
let function_return_value_kind env ty =
match is_function_type env ty with
(* Type expressions for the core language *)
-type type_expr =
+type transient_expr =
{ mutable desc: type_desc;
mutable level: int;
mutable scope: int;
id: int }
+and type_expr = transient_expr
+
and type_desc =
Tvar of string option
| Tarrow of arg_label * type_expr * type_expr * commutable
and row_desc =
{ row_fields: (label * row_field) list;
row_more: type_expr;
- row_bound: unit;
row_closed: bool;
row_fixed: fixed_explanation option;
row_name: (Path.t * type_expr list) option }
and fixed_explanation =
| Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
-and row_field =
- Rpresent of type_expr option
- | Reither of bool * type_expr list * bool * row_field option ref
- (* 1st true denotes a constant constructor *)
- (* 2nd true denotes a tag in a pattern matching, and
- is erased later *)
- | Rabsent
+and row_field = [`some] row_field_gen
+and _ row_field_gen =
+ RFpresent : type_expr option -> [> `some] row_field_gen
+ | RFeither :
+ { no_arg: bool;
+ arg_type: type_expr list;
+ matched: bool;
+ ext: [`some | `none] row_field_gen ref} -> [> `some] row_field_gen
+ | RFabsent : [> `some] row_field_gen
+ | RFnone : [> `none] row_field_gen
and abbrev_memo =
Mnil
| Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
| Mlink of abbrev_memo ref
-and field_kind =
- Fvar of field_kind option ref
- | Fpresent
- | Fabsent
-
-and commutable =
- Cok
- | Cunknown
- | Clink of commutable ref
-
-module TypeOps = struct
+and any = [`some | `none | `var]
+and field_kind = [`some|`var] field_kind_gen
+and _ field_kind_gen =
+ FKvar : {mutable field_kind: any field_kind_gen} -> [> `var] field_kind_gen
+ | FKprivate : [> `none] field_kind_gen (* private method; only under FKvar *)
+ | FKpublic : [> `some] field_kind_gen (* public method *)
+ | FKabsent : [> `some] field_kind_gen (* hidden private method *)
+
+and commutable = [`some|`var] commutable_gen
+and _ commutable_gen =
+ Cok : [> `some] commutable_gen
+ | Cunknown : [> `none] commutable_gen
+ | Cvar : {mutable commu: any commutable_gen} -> [> `var] commutable_gen
+
+module TransientTypeOps = struct
type t = type_expr
let compare t1 t2 = t1.id - t2.id
let hash t = t.id
let equal t1 t2 = t1 == t2
end
-module Private_type_expr = struct
- let create desc ~level ~scope ~id = {desc; level; scope; id}
- let set_desc ty d = ty.desc <- d
- let set_level ty lv = ty.level <- lv
- let set_scope ty sc = ty.scope <- sc
-end
(* *)
-module Uid = struct
- type t =
- | Compilation_unit of string
- | Item of { comp_unit: string; id: int }
- | Internal
- | Predef of string
-
- include Identifiable.Make(struct
- type nonrec t = t
-
- let equal (x : t) y = x = y
- let compare (x : t) y = compare x y
- let hash (x : t) = Hashtbl.hash x
-
- let print fmt = function
- | Internal -> Format.pp_print_string fmt "<internal>"
- | Predef name -> Format.fprintf fmt "<predef:%s>" name
- | Compilation_unit s -> Format.pp_print_string fmt s
- | Item { comp_unit; id } -> Format.fprintf fmt "%s.%d" comp_unit id
-
- let output oc t =
- let fmt = Format.formatter_of_out_channel oc in
- print fmt t
- end)
-
- let id = ref (-1)
-
- let reinit () = id := (-1)
-
- let mk ~current_unit =
- incr id;
- Item { comp_unit = current_unit; id = !id }
-
- let of_compilation_unit_id id =
- if not (Ident.persistent id) then
- Misc.fatal_errorf "Types.Uid.of_compilation_unit_id %S" (Ident.name id);
- Compilation_unit (Ident.name id)
-
- let of_predef_id id =
- if not (Ident.is_predef id) then
- Misc.fatal_errorf "Types.Uid.of_predef_id %S" (Ident.name id);
- Predef (Ident.name id)
-
- let internal_not_actually_unique = Internal
-
- let for_actual_declaration = function
- | Item _ -> true
- | _ -> false
-end
+module Uid = Shape.Uid
(* Maps of methods and instance variables *)
+module MethSet = Misc.Stdlib.String.Set
+module VarSet = Misc.Stdlib.String.Set
+
module Meths = Misc.Stdlib.String.Map
-module Vars = Meths
+module Vars = Misc.Stdlib.String.Map
+
(* Value descriptions *)
Val_reg (* Regular value *)
| Val_prim of Primitive.description (* Primitive *)
| Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
- | Val_self of (Ident.t * type_expr) Meths.t ref *
- (Ident.t * Asttypes.mutable_flag *
- Asttypes.virtual_flag * type_expr) Vars.t ref *
- string * type_expr
+ | Val_self of
+ class_signature * self_meths * Ident.t Vars.t * string
(* Self *)
- | Val_anc of (string * Ident.t) list * string
+ | Val_anc of class_signature * Ident.t Meths.t * string
(* Ancestor *)
+and self_meths =
+ | Self_concrete of Ident.t Meths.t
+ | Self_virtual of Ident.t Meths.t ref
+
+and class_signature =
+ { csig_self: type_expr;
+ mutable csig_self_row: type_expr;
+ mutable csig_vars: (mutable_flag * virtual_flag * type_expr) Vars.t;
+ mutable csig_meths: (method_privacy * virtual_flag * type_expr) Meths.t; }
+
+and method_privacy =
+ | Mpublic
+ | Mprivate of field_kind
+
(* Variance *)
module Variance = struct
(* Type expressions for the class language *)
-module Concr = Misc.Stdlib.String.Set
-
type class_type =
Cty_constr of Path.t * type_expr list * class_type
| Cty_signature of class_signature
| Cty_arrow of arg_label * type_expr * class_type
-and class_signature =
- { csig_self: type_expr;
- csig_vars:
- (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
- csig_concr: Concr.t;
- csig_inher: (Path.t * type_expr list) list }
-
type class_declaration =
{ cty_params: type_expr list;
mutable cty_type: class_type;
cstr_tag: constructor_tag; (* Tag for heap blocks *)
cstr_consts: int; (* Number of constant constructors *)
cstr_nonconsts: int; (* Number of non-const constructors *)
- cstr_normal: int; (* Number of non generalized constrs *)
cstr_generalized: bool; (* Constrained return type? *)
cstr_private: private_flag; (* Read-only constructor? *)
cstr_loc: Location.t;
| tag1, tag2 ->
equal_tag tag1 tag2)
+let item_visibility = function
+ | Sig_value (_, _, vis)
+ | Sig_type (_, _, _, vis)
+ | Sig_typext (_, _, _, vis)
+ | Sig_module (_, _, _, _, vis)
+ | Sig_modtype (_, _, vis)
+ | Sig_class (_, _, _, vis)
+ | Sig_class_type (_, _, _, vis) -> vis
+
type label_description =
{ lbl_name: string; (* Short name *)
lbl_res: type_expr; (* Type of the result *)
| Sig_class (id, _, _, _)
| Sig_class_type (id, _, _, _)
-> id
+
+(**** Definitions for backtracking ****)
+
+type change =
+ Ctype of type_expr * type_desc
+ | Ccompress of type_expr * type_desc * type_desc
+ | Clevel of type_expr * int
+ | Cscope of type_expr * int
+ | Cname of
+ (Path.t * type_expr list) option ref * (Path.t * type_expr list) option
+ | Crow of [`none|`some] row_field_gen ref
+ | Ckind of [`var] field_kind_gen
+ | Ccommu of [`var] commutable_gen
+ | Cuniv of type_expr option ref * type_expr option
+
+type changes =
+ Change of change * changes ref
+ | Unchanged
+ | Invalid
+
+let trail = Local_store.s_table ref Unchanged
+
+let log_change ch =
+ let r' = ref Unchanged in
+ !trail := Change (ch, r');
+ trail := r'
+
+(* constructor and accessors for [field_kind] *)
+
+type field_kind_view =
+ Fprivate
+ | Fpublic
+ | Fabsent
+
+let rec field_kind_internal_repr : field_kind -> field_kind = function
+ | FKvar {field_kind = FKvar _ | FKpublic | FKabsent as fk} ->
+ field_kind_internal_repr fk
+ | kind -> kind
+
+let field_kind_repr fk =
+ match field_kind_internal_repr fk with
+ | FKvar _ -> Fprivate
+ | FKpublic -> Fpublic
+ | FKabsent -> Fabsent
+
+let field_public = FKpublic
+let field_absent = FKabsent
+let field_private () = FKvar {field_kind=FKprivate}
+
+(* Constructor and accessors for [commutable] *)
+
+let rec is_commu_ok : type a. a commutable_gen -> bool = function
+ | Cvar {commu} -> is_commu_ok commu
+ | Cunknown -> false
+ | Cok -> true
+
+let commu_ok = Cok
+let commu_var () = Cvar {commu=Cunknown}
+
+(**** Representative of a type ****)
+
+let rec repr_link (t : type_expr) d : type_expr -> type_expr =
+ function
+ {desc = Tlink t' as d'} ->
+ repr_link t d' t'
+ | {desc = Tfield (_, k, _, t') as d'}
+ when field_kind_internal_repr k = FKabsent ->
+ repr_link t d' t'
+ | t' ->
+ log_change (Ccompress (t, t.desc, d));
+ t.desc <- d;
+ t'
+
+let repr_link1 t = function
+ {desc = Tlink t' as d'} ->
+ repr_link t d' t'
+ | {desc = Tfield (_, k, _, t') as d'}
+ when field_kind_internal_repr k = FKabsent ->
+ repr_link t d' t'
+ | t' -> t'
+
+let repr t =
+ match t.desc with
+ Tlink t' ->
+ repr_link1 t t'
+ | Tfield (_, k, _, t') when field_kind_internal_repr k = FKabsent ->
+ repr_link1 t t'
+ | _ -> t
+
+(* getters for type_expr *)
+
+let get_desc t = (repr t).desc
+let get_level t = (repr t).level
+let get_scope t = (repr t).scope
+let get_id t = (repr t).id
+
+(* transient type_expr *)
+
+module Transient_expr = struct
+ let create desc ~level ~scope ~id = {desc; level; scope; id}
+ let set_desc ty d = ty.desc <- d
+ let set_stub_desc ty d = assert (ty.desc = Tvar None); ty.desc <- d
+ let set_level ty lv = ty.level <- lv
+ let set_scope ty sc = ty.scope <- sc
+ let coerce ty = ty
+ let repr = repr
+ let type_expr ty = ty
+end
+
+(* Comparison for [type_expr]; cannot be used for functors *)
+
+let eq_type t1 t2 = t1 == t2 || repr t1 == repr t2
+let compare_type t1 t2 = compare (get_id t1) (get_id t2)
+
+(* Constructor and accessors for [row_desc] *)
+
+let create_row ~fields ~more ~closed ~fixed ~name =
+ { row_fields=fields; row_more=more;
+ row_closed=closed; row_fixed=fixed; row_name=name }
+
+(* [row_fields] subsumes the original [row_repr] *)
+let rec row_fields row =
+ match get_desc row.row_more with
+ | Tvariant row' ->
+ row.row_fields @ row_fields row'
+ | _ ->
+ row.row_fields
+
+let rec row_repr_no_fields row =
+ match get_desc row.row_more with
+ | Tvariant row' -> row_repr_no_fields row'
+ | _ -> row
+
+let row_more row = (row_repr_no_fields row).row_more
+let row_closed row = (row_repr_no_fields row).row_closed
+let row_fixed row = (row_repr_no_fields row).row_fixed
+let row_name row = (row_repr_no_fields row).row_name
+
+let rec get_row_field tag row =
+ let rec find = function
+ | (tag',f) :: fields ->
+ if tag = tag' then f else find fields
+ | [] ->
+ match get_desc row.row_more with
+ | Tvariant row' -> get_row_field tag row'
+ | _ -> RFabsent
+ in find row.row_fields
+
+let set_row_name row row_name =
+ let row_fields = row_fields row in
+ let row = row_repr_no_fields row in
+ {row with row_fields; row_name}
+
+type row_desc_repr =
+ Row of { fields: (label * row_field) list;
+ more:type_expr;
+ closed:bool;
+ fixed:fixed_explanation option;
+ name:(Path.t * type_expr list) option }
+
+let row_repr row =
+ let fields = row_fields row in
+ let row = row_repr_no_fields row in
+ Row { fields;
+ more = row.row_more;
+ closed = row.row_closed;
+ fixed = row.row_fixed;
+ name = row.row_name }
+
+type row_field_view =
+ Rpresent of type_expr option
+ | Reither of bool * type_expr list * bool
+ (* 1st true denotes a constant constructor *)
+ (* 2nd true denotes a tag in a pattern matching, and
+ is erased later *)
+ | Rabsent
+
+let rec row_field_repr_aux tl : row_field -> row_field = function
+ | RFeither ({ext = {contents = RFnone}} as r) ->
+ RFeither {r with arg_type = tl@r.arg_type}
+ | RFeither {arg_type;
+ ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ row_field_repr_aux (tl@arg_type) rf
+ | RFpresent (Some _) when tl <> [] ->
+ RFpresent (Some (List.hd tl))
+ | RFpresent _ as rf -> rf
+ | RFabsent -> RFabsent
+
+let row_field_repr fi =
+ match row_field_repr_aux [] fi with
+ | RFeither {no_arg; arg_type; matched} -> Reither (no_arg, arg_type, matched)
+ | RFpresent t -> Rpresent t
+ | RFabsent -> Rabsent
+
+let rec row_field_ext (fi : row_field) =
+ match fi with
+ | RFeither {ext = {contents = RFnone} as ext} -> ext
+ | RFeither {ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ row_field_ext rf
+ | _ -> Misc.fatal_error "Types.row_field_ext "
+
+let rf_present oty = RFpresent oty
+let rf_absent = RFabsent
+let rf_either ?use_ext_of ~no_arg arg_type ~matched =
+ let ext =
+ match use_ext_of with
+ Some rf -> row_field_ext rf
+ | None -> ref RFnone
+ in
+ RFeither {no_arg; arg_type; matched; ext}
+
+let rf_either_of = function
+ | None ->
+ RFeither {no_arg=true; arg_type=[]; matched=false; ext=ref RFnone}
+ | Some ty ->
+ RFeither {no_arg=false; arg_type=[ty]; matched=false; ext=ref RFnone}
+
+let eq_row_field_ext rf1 rf2 =
+ row_field_ext rf1 == row_field_ext rf2
+
+let changed_row_field_exts l f =
+ let exts = List.map row_field_ext l in
+ f ();
+ List.exists (fun r -> !r <> RFnone) exts
+
+let match_row_field ~present ~absent ~either (f : row_field) =
+ match f with
+ | RFabsent -> absent ()
+ | RFpresent t -> present t
+ | RFeither {no_arg; arg_type; matched; ext} ->
+ let e : row_field option =
+ match !ext with
+ | RFnone -> None
+ | RFeither _ | RFpresent _ | RFabsent as e -> Some e
+ in
+ either no_arg arg_type matched e
+
+
+(**** Some type creators ****)
+
+let new_id = Local_store.s_ref (-1)
+
+let create_expr = Transient_expr.create
+
+let newty3 ~level ~scope desc =
+ incr new_id;
+ create_expr desc ~level ~scope ~id:!new_id
+
+let newty2 ~level desc =
+ newty3 ~level ~scope:Ident.lowest_scope desc
+
+ (**********************************)
+ (* Utilities for backtracking *)
+ (**********************************)
+
+let undo_change = function
+ Ctype (ty, desc) -> Transient_expr.set_desc ty desc
+ | Ccompress (ty, desc, _) -> Transient_expr.set_desc ty desc
+ | Clevel (ty, level) -> Transient_expr.set_level ty level
+ | Cscope (ty, scope) -> Transient_expr.set_scope ty scope
+ | Cname (r, v) -> r := v
+ | Crow r -> r := RFnone
+ | Ckind (FKvar r) -> r.field_kind <- FKprivate
+ | Ccommu (Cvar r) -> r.commu <- Cunknown
+ | Cuniv (r, v) -> r := v
+
+type snapshot = changes ref * int
+let last_snapshot = Local_store.s_ref 0
+
+let log_type ty =
+ if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc))
+let link_type ty ty' =
+ let ty = repr ty in
+ let ty' = repr ty' in
+ if ty == ty' then () else begin
+ log_type ty;
+ let desc = ty.desc in
+ Transient_expr.set_desc ty (Tlink ty');
+ (* Name is a user-supplied name for this unification variable (obtained
+ * through a type annotation for instance). *)
+ match desc, ty'.desc with
+ Tvar name, Tvar name' ->
+ begin match name, name' with
+ | Some _, None -> log_type ty'; Transient_expr.set_desc ty' (Tvar name)
+ | None, Some _ -> ()
+ | Some _, Some _ ->
+ if ty.level < ty'.level then
+ (log_type ty'; Transient_expr.set_desc ty' (Tvar name))
+ | None, None -> ()
+ end
+ | _ -> ()
+ end
+ (* ; assert (check_memorized_abbrevs ()) *)
+ (* ; check_expans [] ty' *)
+(* TODO: consider eliminating set_type_desc, replacing it with link types *)
+let set_type_desc ty td =
+ let ty = repr ty in
+ if td != ty.desc then begin
+ log_type ty;
+ Transient_expr.set_desc ty td
+ end
+(* TODO: separate set_level into two specific functions: *)
+(* set_lower_level and set_generic_level *)
+let set_level ty level =
+ let ty = repr ty in
+ if level <> ty.level then begin
+ if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
+ Transient_expr.set_level ty level
+ end
+(* TODO: introduce a guard and rename it to set_higher_scope? *)
+let set_scope ty scope =
+ let ty = repr ty in
+ if scope <> ty.scope then begin
+ if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
+ Transient_expr.set_scope ty scope
+ end
+let set_univar rty ty =
+ log_change (Cuniv (rty, !rty)); rty := Some ty
+let set_name nm v =
+ log_change (Cname (nm, !nm)); nm := v
+
+let rec link_row_field_ext ~(inside : row_field) (v : row_field) =
+ match inside with
+ | RFeither {ext = {contents = RFnone} as e} ->
+ let RFeither _ | RFpresent _ | RFabsent as v = v in
+ log_change (Crow e); e := v
+ | RFeither {ext = {contents = RFeither _ | RFpresent _ | RFabsent as rf}} ->
+ link_row_field_ext ~inside:rf v
+ | _ -> invalid_arg "Types.link_row_field_ext"
+
+let rec link_kind ~(inside : field_kind) (k : field_kind) =
+ match inside with
+ | FKvar ({field_kind = FKprivate} as rk) as inside ->
+ (* prevent a loop by normalizing k and comparing it with inside *)
+ let FKvar _ | FKpublic | FKabsent as k = field_kind_internal_repr k in
+ if k != inside then begin
+ log_change (Ckind inside);
+ rk.field_kind <- k
+ end
+ | FKvar {field_kind = FKvar _ | FKpublic | FKabsent as inside} ->
+ link_kind ~inside k
+ | _ -> invalid_arg "Types.link_kind"
+
+let rec commu_repr : commutable -> commutable = function
+ | Cvar {commu = Cvar _ | Cok as commu} -> commu_repr commu
+ | c -> c
+
+let rec link_commu ~(inside : commutable) (c : commutable) =
+ match inside with
+ | Cvar ({commu = Cunknown} as rc) as inside ->
+ (* prevent a loop by normalizing c and comparing it with inside *)
+ let Cvar _ | Cok as c = commu_repr c in
+ if c != inside then begin
+ log_change (Ccommu inside);
+ rc.commu <- c
+ end
+ | Cvar {commu = Cvar _ | Cok as inside} ->
+ link_commu ~inside c
+ | _ -> invalid_arg "Types.link_commu"
+
+let set_commu_ok c = link_commu ~inside:c Cok
+
+let snapshot () =
+ let old = !last_snapshot in
+ last_snapshot := !new_id;
+ (!trail, old)
+
+let rec rev_log accu = function
+ Unchanged -> accu
+ | Invalid -> assert false
+ | Change (ch, next) ->
+ let d = !next in
+ next := Invalid;
+ rev_log (ch::accu) d
+
+let backtrack ~cleanup_abbrev (changes, old) =
+ match !changes with
+ Unchanged -> last_snapshot := old
+ | Invalid -> failwith "Types.backtrack"
+ | Change _ as change ->
+ cleanup_abbrev ();
+ let backlog = rev_log [] change in
+ List.iter undo_change backlog;
+ changes := Unchanged;
+ last_snapshot := old;
+ trail := changes
+
+let undo_first_change_after (changes, _) =
+ match !changes with
+ | Change (ch, _) ->
+ undo_change ch
+ | _ -> ()
+
+let rec rev_compress_log log r =
+ match !r with
+ Unchanged | Invalid ->
+ log
+ | Change (Ccompress _, next) ->
+ rev_compress_log (r::log) next
+ | Change (_, next) ->
+ rev_compress_log log next
+
+let undo_compress (changes, _old) =
+ match !changes with
+ Unchanged
+ | Invalid -> ()
+ | Change _ ->
+ let log = rev_compress_log [] changes in
+ List.iter
+ (fun r -> match !r with
+ Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
+ Transient_expr.set_desc ty desc; r := !next
+ | _ -> ())
+ log
Note on mutability: TBD.
*)
-type type_expr = private
- { mutable desc: type_desc;
- mutable level: int;
- mutable scope: int;
- id: int }
+type type_expr
+type row_desc
+type row_field
+type field_kind
+type commutable
-and type_desc =
+type type_desc =
| Tvar of string option
(** [Tvar (Some "a")] ==> ['a] or ['_a]
[Tvar None] ==> [_] *)
*)
| Tfield of string * field_kind * type_expr * type_expr
- (** [Tfield ("foo", Fpresent, t, ts)] ==> [<...; foo : t; ts>] *)
+ (** [Tfield ("foo", field_public, t, ts)] ==> [<...; foo : t; ts>] *)
| Tnil
(** [Tnil] ==> [<...; >] *)
| Tpackage of Path.t * (Longident.t * type_expr) list
(** Type of a first-class module (a.k.a package). *)
-(** [ `X | `Y ] (row_closed = true)
- [< `X | `Y ] (row_closed = true)
- [> `X | `Y ] (row_closed = false)
- [< `X | `Y > `X ] (row_closed = true)
-
- type t = [> `X ] as 'a (row_more = Tvar a)
- type t = private [> `X ] (row_more = Tconstr (t#row, [], ref Mnil))
-
- And for:
-
- let f = function `X -> `X -> | `Y -> `X
-
- the type of "f" will be a [Tarrow] whose lhs will (basically) be:
-
- Tvariant { row_fields = [("X", _)];
- row_more =
- Tvariant { row_fields = [("Y", _)];
- row_more =
- Tvariant { row_fields = [];
- row_more = _;
- _ };
- _ };
- _
- }
-
-*)
-and row_desc =
- { row_fields: (label * row_field) list;
- row_more: type_expr;
- row_bound: unit; (* kept for compatibility *)
- row_closed: 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
- (* 1st true denotes a constant constructor *)
- (* 2nd true denotes a tag in a pattern matching, and
- is erased later *)
- | Rabsent
(** [abbrev_memo] allows one to keep track of different expansions of a type
alias. This is done for performance purposes.
| Mlink of abbrev_memo ref
(** Abbreviations can be found after this indirection *)
-and field_kind =
- Fvar of field_kind option ref
- | Fpresent
- | Fabsent
-
(** [commutable] is a flag appended to every arrow type.
When typing an application, if the type of the functional is
- known, its type is instantiated with [Cok] arrows, otherwise as
- [Clink (ref Cunknown)].
+ known, its type is instantiated with [commu_ok] arrows, otherwise as
+ [commu_var ()].
When the type is not known, the application will be used to infer
the actual type. This is fragile in presence of labels where
there is no principal type.
- Two incompatible applications relying on [Cunknown] arrows will
- trigger an error.
+ Two incompatible applications must rely on [is_commu_ok] arrows,
+ otherwise they will trigger an error.
let f g =
g ~a:() ~b:();
in an order different from other calls.
This is only allowed when the real type is known.
*)
-and commutable =
- Cok
- | Cunknown
- | Clink of commutable ref
-
-module Private_type_expr : sig
- val create : type_desc -> level: int -> scope: int -> id: int -> type_expr
- val set_desc : type_expr -> type_desc -> unit
- val set_level : type_expr -> int -> unit
- val set_scope : type_expr -> int -> unit
+
+val is_commu_ok: commutable -> bool
+val commu_ok: commutable
+val commu_var: unit -> commutable
+
+(** [field_kind] indicates the accessibility of a method.
+
+ An [Fprivate] field may become [Fpublic] or [Fabsent] during unification,
+ but not the other way round.
+
+ The same [field_kind] is kept shared when copying [Tfield] nodes
+ so that the copies of the self-type of a class share the same accessibility
+ (see also PR#10539).
+ *)
+
+type field_kind_view =
+ Fprivate
+ | Fpublic
+ | Fabsent
+
+val field_kind_repr: field_kind -> field_kind_view
+val field_public: field_kind
+val field_absent: field_kind
+val field_private: unit -> field_kind
+val field_kind_internal_repr: field_kind -> field_kind
+ (* Removes indirections in [field_kind].
+ Only needed for performance. *)
+
+(** Getters for type_expr; calls repr before answering a value *)
+
+val get_desc: type_expr -> type_desc
+val get_level: type_expr -> int
+val get_scope: type_expr -> int
+val get_id: type_expr -> int
+
+(** Transient [type_expr].
+ Should only be used immediately after [Transient_expr.repr] *)
+type transient_expr = private
+ { mutable desc: type_desc;
+ mutable level: int;
+ mutable scope: int;
+ id: int }
+
+module Transient_expr : sig
+ (** Operations on [transient_expr] *)
+
+ val create: type_desc -> level: int -> scope: int -> id: int -> transient_expr
+ val set_desc: transient_expr -> type_desc -> unit
+ val set_level: transient_expr -> int -> unit
+ val set_scope: transient_expr -> int -> unit
+ val repr: type_expr -> transient_expr
+ val type_expr: transient_expr -> type_expr
+ val coerce: type_expr -> transient_expr
+ (** Coerce without normalizing with [repr] *)
+
+ val set_stub_desc: type_expr -> type_desc -> unit
+ (** Instantiate a not yet instantiated stub.
+ Fail if already instantiated. *)
end
-module TypeOps : sig
- type t = type_expr
+val create_expr: type_desc -> level: int -> scope: int -> id: int -> type_expr
+
+(** Functions and definitions moved from Btype *)
+
+val newty3: level:int -> scope:int -> type_desc -> type_expr
+ (** Create a type with a fresh id *)
+
+val newty2: level:int -> type_desc -> type_expr
+ (** Create a type with a fresh id and no scope *)
+
+module TransientTypeOps : sig
+ (** Comparisons for functors *)
+
+ type t = transient_expr
val compare : t -> t -> int
val equal : t -> t -> bool
val hash : t -> int
end
-(* *)
+(** Comparisons for [type_expr]; cannot be used for functors *)
-module Uid : sig
- type t
+val eq_type: type_expr -> type_expr -> bool
+val compare_type: type_expr -> type_expr -> int
+
+(** Constructor and accessors for [row_desc] *)
+
+(** [ `X | `Y ] (row_closed = true)
+ [< `X | `Y ] (row_closed = true)
+ [> `X | `Y ] (row_closed = false)
+ [< `X | `Y > `X ] (row_closed = true)
- val reinit : unit -> unit
+ type t = [> `X ] as 'a (row_more = Tvar a)
+ type t = private [> `X ] (row_more = Tconstr ("t#row", [], ref Mnil))
- val mk : current_unit:string -> t
- val of_compilation_unit_id : Ident.t -> t
- val of_predef_id : Ident.t -> t
- val internal_not_actually_unique : t
+ And for:
- val for_actual_declaration : t -> bool
+ let f = function `X -> `X -> | `Y -> `X
- include Identifiable.S with type t := t
-end
+ the type of "f" will be a [Tarrow] whose lhs will (basically) be:
+
+ Tvariant { row_fields = [("X", _)];
+ row_more =
+ Tvariant { row_fields = [("Y", _)];
+ row_more =
+ Tvariant { row_fields = [];
+ row_more = _;
+ _ };
+ _ };
+ _
+ }
+
+*)
-(* Maps of methods and instance variables *)
+val create_row:
+ fields:(label * row_field) list ->
+ more:type_expr ->
+ closed:bool ->
+ fixed:fixed_explanation option ->
+ name:(Path.t * type_expr list) option -> row_desc
+
+val row_fields: row_desc -> (label * row_field) list
+val row_more: row_desc -> type_expr
+val row_closed: row_desc -> bool
+val row_fixed: row_desc -> fixed_explanation option
+val row_name: row_desc -> (Path.t * type_expr list) option
+
+val set_row_name: row_desc -> (Path.t * type_expr list) option -> row_desc
+
+val get_row_field: label -> row_desc -> row_field
+
+(** get all fields at once; different from the old [row_repr] *)
+type row_desc_repr =
+ Row of { fields: (label * row_field) list;
+ more: type_expr;
+ closed: bool;
+ fixed: fixed_explanation option;
+ name: (Path.t * type_expr list) option }
+
+val row_repr: row_desc -> row_desc_repr
+
+(** Current contents of a row field *)
+type row_field_view =
+ Rpresent of type_expr option
+ | Reither of bool * type_expr list * bool
+ (* 1st true denotes a constant constructor *)
+ (* 2nd true denotes a tag in a pattern matching, and
+ is erased later *)
+ | Rabsent
+
+val row_field_repr: row_field -> row_field_view
+val rf_present: type_expr option -> row_field
+val rf_absent: row_field
+val rf_either:
+ ?use_ext_of:row_field ->
+ no_arg:bool -> type_expr list -> matched:bool -> row_field
+val rf_either_of: type_expr option -> row_field
+
+val eq_row_field_ext: row_field -> row_field -> bool
+val changed_row_field_exts: row_field list -> (unit -> unit) -> bool
+
+val match_row_field:
+ present:(type_expr option -> 'a) ->
+ absent:(unit -> 'a) ->
+ either:(bool -> type_expr list -> bool -> row_field option ->'a) ->
+ row_field -> 'a
+
+(* *)
+
+module Uid = Shape.Uid
+
+(* Sets and maps of methods and instance variables *)
+
+module MethSet : Set.S with type elt = string
+module VarSet : Set.S with type elt = string
module Meths : Map.S with type key = string
module Vars : Map.S with type key = string
Val_reg (* Regular value *)
| Val_prim of Primitive.description (* Primitive *)
| Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
- | Val_self of (Ident.t * type_expr) Meths.t ref *
- (Ident.t * mutable_flag * virtual_flag * type_expr) Vars.t ref *
- string * type_expr
+ | Val_self of class_signature * self_meths * Ident.t Vars.t * string
(* Self *)
- | Val_anc of (string * Ident.t) list * string
+ | Val_anc of class_signature * Ident.t Meths.t * string
(* Ancestor *)
+and self_meths =
+ | Self_concrete of Ident.t Meths.t
+ | Self_virtual of Ident.t Meths.t ref
+
+and class_signature =
+ { csig_self: type_expr;
+ mutable csig_self_row: type_expr;
+ mutable csig_vars: (mutable_flag * virtual_flag * type_expr) Vars.t;
+ mutable csig_meths: (method_privacy * virtual_flag * type_expr) Meths.t; }
+
+and method_privacy =
+ | Mpublic
+ | Mprivate of field_kind
+ (* The [field_kind] is always [Fabsent] in a complete class type. *)
+
(* Variance *)
module Variance : sig
(* Type expressions for the class language *)
-module Concr : Set.S with type elt = string
-
type class_type =
Cty_constr of Path.t * type_expr list * class_type
| Cty_signature of class_signature
| Cty_arrow of arg_label * type_expr * class_type
-and class_signature =
- { csig_self: type_expr;
- csig_vars:
- (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
- csig_concr: Concr.t;
- csig_inher: (Path.t * type_expr list) list }
-
type class_declaration =
{ cty_params: type_expr list;
mutable cty_type: class_type;
| Text_next (* not first constructor in an extension *)
| Text_exception
+val item_visibility : signature_item -> visibility
(* Constructor and record label descriptions inserted held in typing
environments *)
cstr_tag: constructor_tag; (* Tag for heap blocks *)
cstr_consts: int; (* Number of constant constructors *)
cstr_nonconsts: int; (* Number of non-const constructors *)
- cstr_normal: int; (* Number of non generalized constrs *)
cstr_generalized: bool; (* Constrained return type? *)
cstr_private: private_flag; (* Read-only constructor? *)
cstr_loc: Location.t;
val bound_value_identifiers: signature -> Ident.t list
val signature_item_id : signature_item -> Ident.t
+
+(**** Utilities for backtracking ****)
+
+type snapshot
+ (* A snapshot for backtracking *)
+val snapshot: unit -> snapshot
+ (* Make a snapshot for later backtracking. Costs nothing *)
+val backtrack: cleanup_abbrev:(unit -> unit) -> snapshot -> unit
+ (* Backtrack to a given snapshot. Only possible if you have
+ not already backtracked to a previous snapshot.
+ Calls [cleanup_abbrev] internally *)
+val undo_first_change_after: snapshot -> unit
+ (* Backtrack only the first change after a snapshot.
+ Does not update the list of changes *)
+val undo_compress: snapshot -> unit
+ (* Backtrack only path compression. Only meaningful if you have
+ not already backtracked to a previous snapshot.
+ Does not call [cleanup_abbrev] *)
+
+(** Functions to use when modifying a type (only Ctype?).
+ The old values are logged and reverted on backtracking.
+ *)
+
+val link_type: type_expr -> type_expr -> unit
+ (* Set the desc field of [t1] to [Tlink t2], logging the old
+ value if there is an active snapshot *)
+val set_type_desc: type_expr -> type_desc -> unit
+ (* Set directly the desc field, without sharing *)
+val set_level: type_expr -> int -> unit
+val set_scope: type_expr -> int -> unit
+val set_name:
+ (Path.t * type_expr list) option ref ->
+ (Path.t * type_expr list) option -> unit
+val link_row_field_ext: inside:row_field -> row_field -> unit
+ (* Extract the extension variable of [inside] and set it to the
+ second argument *)
+val set_univar: type_expr option ref -> type_expr -> unit
+val link_kind: inside:field_kind -> field_kind -> unit
+val link_commu: inside:commutable -> commutable -> unit
+val set_commu_ok: commutable -> unit
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
- | Type_mismatch of Errortrace.unification Errortrace.t
- | Alias_type_mismatch of Errortrace.unification Errortrace.t
+ | Type_mismatch of Errortrace.unification_error
+ | Alias_type_mismatch of Errortrace.unification_error
| Present_has_conjunction of string
| Present_has_no_type of string
| Constructor_mismatch of type_expr * type_expr
let new_pre_univar ?name () =
let v = newvar ?name () in pre_univars := v :: !pre_univars; v
+type poly_univars = (string * type_expr) list
+let make_poly_univars vars =
+ List.map (fun name -> name, newvar ~name ()) vars
+
+let check_poly_univars env loc vars =
+ vars |> List.iter (fun (_, v) -> generalize v);
+ vars |> List.map (fun (name, ty1) ->
+ let v = Btype.proxy ty1 in
+ begin match get_desc v with
+ | Tvar name when get_level v = Btype.generic_level ->
+ set_type_desc v (Tunivar name)
+ | _ ->
+ raise (Error (loc, env, Cannot_quantify(name, v)))
+ end;
+ v)
+
+let instance_poly_univars env loc vars =
+ let vs = check_poly_univars env loc vars in
+ vs |> List.iter (fun v ->
+ match get_desc v with
+ | Tunivar name ->
+ set_type_desc v (Tvar name)
+ | _ -> assert false);
+ vs
+
+
type policy = Fixed | Extensible | Univars
let rec transl_type env policy styp =
if Btype.is_optional l
then newty (Tconstr(Predef.path_option,[ty1], ref Mnil))
else ty1 in
- let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, Cok)) in
+ let ty = newty (Tarrow(l, ty1, cty2.ctyp_type, commu_ok)) in
ctyp (Ttyp_arrow (l, cty1, cty2)) ty
| Ptyp_tuple stl ->
assert (List.length stl >= 2);
match decl.type_manifest with
None -> unify_var
| Some ty ->
- if (repr ty).level = Btype.generic_level then unify_var else unify
+ if get_level ty = Btype.generic_level then unify_var else unify
in
List.iter2
(fun (sty, cty) ty' ->
- try unify_param env ty' cty.ctyp_type with Unify trace ->
- let trace = Errortrace.swap_trace trace in
- raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
+ try unify_param env ty' cty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise (Error(sty.ptyp_loc, env, Type_mismatch err))
)
(List.combine stl args) params;
let constr =
match decl.type_manifest with
None -> raise Not_found
| Some ty ->
- match (repr ty).desc with
+ match get_desc ty with
Tvariant row when Btype.static_row row -> ()
| Tconstr (path, _, _) ->
check (Env.find_type path env)
let params = instance_list decl.type_params in
List.iter2
(fun (sty, cty) ty' ->
- try unify_var env ty' cty.ctyp_type with Unify trace ->
- let trace = Errortrace.swap_trace trace in
- raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
+ try unify_var env ty' cty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise (Error(sty.ptyp_loc, env, Type_mismatch err))
)
(List.combine stl args) params;
let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
- let ty =
- try Ctype.expand_head env (newconstr path ty_args)
- with Unify trace ->
- raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
- in
- let ty = match ty.desc with
+ let ty = Ctype.expand_head env (newconstr path ty_args) in
+ let ty = match get_desc ty with
Tvariant row ->
- let row = Btype.row_repr row in
let fields =
List.map
(fun (l,f) -> l,
- match Btype.row_field_repr f with
- | Rpresent (Some ty) ->
- Reither(false, [ty], false, ref None)
- | Rpresent None ->
- Reither (true, [], false, ref None)
+ match row_field_repr f with
+ | Rpresent oty -> rf_either_of oty
| _ -> f)
- row.row_fields
+ (row_fields row)
in
- let row = { row_closed = true; row_fields = fields;
- row_bound = (); row_name = Some (path, ty_args);
- row_fixed = None; row_more = newvar () } in
- let static = Btype.static_row row in
+ (* NB: row is always non-static here; more is thus never Tnil *)
+ let more =
+ if policy = Univars then new_pre_univar () else newvar () in
let row =
- if static then { row with row_more = newty Tnil }
- else if policy <> Univars then row
- else { row with row_more = new_pre_univar () }
- in
+ create_row ~fields ~more
+ ~closed:true ~fixed:None ~name:(Some (path, ty_args)) in
newty (Tvariant row)
| Tobject (fi, _) ->
let _, tv = flatten_fields fi in
instance (fst(TyVarMap.find alias !used_variables))
in
let ty = transl_type env policy st in
- begin try unify_var env t ty.ctyp_type with Unify trace ->
- let trace = Errortrace.swap_trace trace in
- raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
+ begin try unify_var env t ty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise(Error(styp.ptyp_loc, env, Alias_type_mismatch err))
end;
ty
with Not_found ->
used_variables :=
TyVarMap.add alias (t, styp.ptyp_loc) !used_variables;
let ty = transl_type env policy st in
- begin try unify_var env t ty.ctyp_type with Unify trace ->
- let trace = Errortrace.swap_trace trace in
- raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
+ begin try unify_var env t ty.ctyp_type with Unify err ->
+ let err = Errortrace.swap_unification_error err in
+ raise(Error(styp.ptyp_loc, env, Alias_type_mismatch err))
end;
if !Clflags.principal then begin
end_def ();
end;
let t = instance t in
let px = Btype.proxy t in
- begin match px.desc with
- | Tvar None -> Btype.set_type_desc px (Tvar (Some alias))
- | Tunivar None -> Btype.set_type_desc px (Tunivar (Some alias))
+ begin match get_desc px with
+ | Tvar None -> set_type_desc px (Tvar (Some alias))
+ | Tunivar None -> set_type_desc px (Tunivar (Some alias))
| _ -> ()
end;
{ ty with ctyp_type = t }
| Ptyp_variant(fields, closed, present) ->
let name = ref None in
let mkfield l f =
- newty (Tvariant {row_fields=[l,f]; row_more=newvar();
- row_bound=(); row_closed=true;
- row_fixed=None; row_name=None}) in
+ newty (Tvariant (create_row ~fields:[l,f] ~more:(newvar())
+ ~closed:true ~fixed:None ~name:None)) in
let hfields = Hashtbl.create 17 in
let add_typed_field loc l f =
let h = Btype.hash_variant l in
let f = match present with
Some present when not (List.mem l.txt present) ->
let ty_tl = List.map (fun cty -> cty.ctyp_type) tl in
- Reither(c, ty_tl, false, ref None)
+ rf_either ty_tl ~no_arg:c ~matched:false
| _ ->
if List.length stl > 1 || c && stl <> [] then
raise(Error(styp.ptyp_loc, env,
Present_has_conjunction l.txt));
- match tl with [] -> Rpresent None
- | st :: _ ->
- Rpresent (Some st.ctyp_type)
+ match tl with [] -> rf_present None
+ | st :: _ -> rf_present (Some st.ctyp_type)
in
add_typed_field styp.ptyp_loc l.txt f;
Ttag (l,c,tl)
let cty = transl_type env policy sty in
let ty = cty.ctyp_type in
let nm =
- match repr cty.ctyp_type with
- {desc=Tconstr(p, tl, _)} -> Some(p, tl)
- | _ -> None
+ match get_desc cty.ctyp_type with
+ Tconstr(p, tl, _) -> Some(p, tl)
+ | _ -> None
in
name := if Hashtbl.length hfields <> 0 then None else nm;
- let fl = match expand_head env cty.ctyp_type, nm with
- {desc=Tvariant row}, _ when Btype.static_row row ->
- let row = Btype.row_repr row in
- row.row_fields
- | {desc=Tvar _}, Some(p, _) ->
+ let fl = match get_desc (expand_head env cty.ctyp_type), nm with
+ Tvariant row, _ when Btype.static_row row ->
+ row_fields row
+ | Tvar _, Some(p, _) ->
raise(Error(sty.ptyp_loc, env, Undefined_type_constructor p))
| _ ->
raise(Error(sty.ptyp_loc, env, Not_a_variant ty))
(fun (l, f) ->
let f = match present with
Some present when not (List.mem l present) ->
- begin match f with
- Rpresent(Some ty) ->
- Reither(false, [ty], false, ref None)
- | Rpresent None ->
- Reither(true, [], false, ref None)
- | _ ->
- assert false
+ begin match row_field_repr f with
+ Rpresent oty -> rf_either_of oty
+ | _ -> assert false
end
| _ -> f
in
{ rf_desc; rf_loc; rf_attributes; }
in
let tfields = List.map add_field fields in
- let fields = Hashtbl.fold (fun _ p l -> p :: l) hfields [] in
+ let fields = List.rev (Hashtbl.fold (fun _ p l -> p :: l) hfields []) in
begin match present with None -> ()
| Some present ->
List.iter
raise(Error(styp.ptyp_loc, env, Present_has_no_type l)))
present
end;
- let row =
- { row_fields = List.rev fields; row_more = newvar ();
- row_bound = (); row_closed = (closed = Closed);
- 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 }
- else if policy <> Univars then row
- else { row with row_more = new_pre_univar () }
+ let name = !name in
+ let make_row more =
+ create_row ~fields ~more ~closed:(closed = Closed) ~fixed:None ~name
in
- let ty = newty (Tvariant row) in
+ let more =
+ if Btype.static_row (make_row (newvar ())) then newty Tnil else
+ if policy = Univars then new_pre_univar () else newvar ()
+ in
+ let ty = newty (Tvariant (make_row more)) in
ctyp (Ttyp_variant (tfields, closed, present)) ty
| Ptyp_poly(vars, st) ->
let vars = List.map (fun v -> v.txt) vars in
begin_def();
- let new_univars = List.map (fun name -> name, newvar ~name ()) vars in
+ let new_univars = make_poly_univars vars in
let old_univars = !univars in
univars := new_univars @ !univars;
let cty = transl_type env policy st in
univars := old_univars;
end_def();
generalize ty;
- let ty_list =
- List.fold_left
- (fun tyl (name, ty1) ->
- let v = Btype.proxy ty1 in
- if deep_occur v ty then begin
- match v.desc with
- Tvar name when v.level = Btype.generic_level ->
- Btype.set_type_desc v (Tunivar name);
- v :: tyl
- | _ ->
- raise (Error (styp.ptyp_loc, env, Cannot_quantify (name, v)))
- end else tyl)
- [] new_univars
- in
- let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
+ let ty_list = check_poly_univars env styp.ptyp_loc new_univars in
+ let ty_list = List.filter (fun v -> deep_occur v ty) ty_list in
+ let ty' = Btype.newgenty (Tpoly(ty, ty_list)) in
unify_var env (newvar()) ty';
ctyp (Ttyp_poly (vars, cty)) ty'
| Ptyp_package (p, l) ->
| Ptyp_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
-and transl_poly_type env policy t =
- transl_type env policy (Ast_helper.Typ.force_poly t)
-
and transl_fields env policy o fields =
let hfields = Hashtbl.create 17 in
let add_typed_field loc l ty =
| Otag (s, ty1) -> begin
let ty1 =
Builtin_attributes.warning_scope of_attributes
- (fun () -> transl_poly_type env policy ty1)
+ (fun () -> transl_type env policy (Ast_helper.Typ.force_poly ty1))
in
let field = OTtag (s, ty1) in
add_typed_field ty1.ctyp_loc s.txt ty1.ctyp_type;
| Oinherit sty -> begin
let cty = transl_type env policy sty in
let nm =
- match repr cty.ctyp_type with
- {desc=Tconstr(p, _, _)} -> Some p
- | _ -> None in
+ match get_desc cty.ctyp_type with
+ Tconstr(p, _, _) -> Some p
+ | _ -> None in
let t = expand_head env cty.ctyp_type in
- match t, nm with
- {desc=Tobject ({desc=(Tfield _ | Tnil) as tf}, _)}, _ -> begin
- if opened_object t then
- raise (Error (sty.ptyp_loc, env, Opened_object nm));
- let rec iter_add = function
- | Tfield (s, _k, ty1, ty2) -> begin
- add_typed_field sty.ptyp_loc s ty1;
- iter_add ty2.desc
- end
- | Tnil -> ()
- | _ -> assert false in
- iter_add tf;
- OTinherit cty
+ match get_desc t, nm with
+ Tobject (tf, _), _
+ when (match get_desc tf with Tfield _ | Tnil -> true | _ -> false) ->
+ begin
+ if opened_object t then
+ raise (Error (sty.ptyp_loc, env, Opened_object nm));
+ let rec iter_add ty =
+ match get_desc ty with
+ | Tfield (s, _k, ty1, ty2) ->
+ add_typed_field sty.ptyp_loc s ty1;
+ iter_add ty2
+ | Tnil -> ()
+ | _ -> assert false
+ in
+ iter_add tf;
+ OTinherit cty
end
- | {desc=Tvar _}, Some p ->
+ | Tvar _, Some p ->
raise (Error (sty.ptyp_loc, env, Undefined_type_constructor p))
| _ -> raise (Error (sty.ptyp_loc, env, Not_an_object t))
end in
| Open, Univars -> new_pre_univar ()
| Open, _ -> newvar () in
let ty = List.fold_left (fun ty (s, ty') ->
- newty (Tfield (s, Fpresent, ty', ty))) ty_init fields in
+ newty (Tfield (s, field_public, ty', ty))) ty_init fields in
ty, object_fields
(* Make the rows "fixed" in this type, to make universal check easier *)
let rec make_fixed_univars ty =
- let ty = repr ty in
if Btype.try_mark_node ty then
- begin match ty.desc with
+ begin match get_desc ty with
| Tvariant row ->
- let row = Btype.row_repr row in
- let more = Btype.row_more row in
+ let Row {fields; more; name; closed} = row_repr row in
if Btype.is_Tunivar more then
- Btype.set_type_desc ty
+ let fields =
+ List.map
+ (fun (s,f as p) -> match row_field_repr f with
+ Reither (no_arg, tl, _m) ->
+ s, rf_either tl ~use_ext_of:f ~no_arg ~matched:true
+ | _ -> p)
+ fields
+ in
+ set_type_desc ty
(Tvariant
- {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)
- | _ -> p)
- row.row_fields});
+ (create_row ~fields ~more ~name ~closed
+ ~fixed:(Some (Univar more))));
Btype.iter_row make_fixed_univars row
| _ ->
Btype.iter_type_expr make_fixed_univars ty
then try
r := (loc, v, TyVarMap.find name !type_variables) :: !r
with Not_found ->
- if fixed && Btype.is_Tvar (repr ty) then
+ if fixed && Btype.is_Tvar ty then
raise(Error(loc, env, Unbound_type_variable ("'"^name)));
let v2 = new_global_var () in
r := (loc, v, v2) :: !r;
fun () ->
List.iter
(function (loc, t1, t2) ->
- try unify env t1 t2 with Unify trace ->
- raise (Error(loc, env, Type_mismatch trace)))
+ try unify env t1 t2 with Unify err ->
+ raise (Error(loc, env, Type_mismatch err)))
!r
-let transl_simple_type env fixed styp =
- univars := []; used_variables := TyVarMap.empty;
+let transl_simple_type env ?univars:(uvs=[]) fixed styp =
+ univars := uvs; used_variables := TyVarMap.empty;
let typ = transl_type env (if fixed then Fixed else Extensible) styp in
globalize_used_variables env fixed ();
make_fixed_univars typ.ctyp_type;
let univs =
List.fold_left
(fun acc v ->
- let v = repr v in
- match v.desc with
- Tvar name when v.level = Btype.generic_level ->
- Btype.set_type_desc v (Tunivar name); v :: acc
+ match get_desc v with
+ Tvar name when get_level v = Btype.generic_level ->
+ set_type_desc v (Tunivar name); v :: acc
| _ -> acc)
[] !pre_univars
in
let transl_type_scheme env styp =
reset_type_variables();
- begin_def();
- let typ = transl_simple_type env false styp in
- end_def();
- generalize typ.ctyp_type;
- typ
+ match styp.ptyp_desc with
+ | Ptyp_poly (vars, st) ->
+ begin_def();
+ let vars = List.map (fun v -> v.txt) vars in
+ let univars = make_poly_univars vars in
+ let typ = transl_simple_type env ~univars true st in
+ end_def();
+ generalize typ.ctyp_type;
+ let _ = instance_poly_univars env styp.ptyp_loc univars in
+ { ctyp_desc = Ttyp_poly (vars, typ);
+ ctyp_type = typ.ctyp_type;
+ ctyp_env = env;
+ ctyp_loc = styp.ptyp_loc;
+ ctyp_attributes = styp.ptyp_attributes }
+ | _ ->
+ begin_def();
+ let typ = transl_simple_type env false styp in
+ end_def();
+ generalize typ.ctyp_type;
+ typ
(* Error report *)
l l
| Constructor_mismatch (ty, ty') ->
wrap_printing_env ~error:true env (fun () ->
- Printtyp.reset_and_mark_loops_list [ty; ty'];
+ Printtyp.prepare_for_printing [ty; ty'];
fprintf ppf "@[<hov>%s %a@ %s@ %a@]"
"This variant type contains a constructor"
- !Oprint.out_type (tree_of_typexp false ty)
+ !Oprint.out_type (tree_of_typexp Type ty)
"which should be"
- !Oprint.out_type (tree_of_typexp false ty'))
+ !Oprint.out_type (tree_of_typexp Type ty'))
| Not_a_variant ty ->
fprintf ppf
"@[The type %a@ does not expand to a polymorphic variant type@]"
Printtyp.type_expr ty;
- begin match ty.desc with
+ begin match get_desc ty with
| Tvar (Some s) ->
(* PR#7012: help the user that wrote 'Foo instead of `Foo *)
Misc.did_you_mean ppf (fun () -> ["`" ^ s])
val valid_tyvar_name : string -> bool
+type poly_univars
+val make_poly_univars : string list -> poly_univars
+ (* Create a set of univars with given names *)
+val check_poly_univars :
+ Env.t -> Location.t -> poly_univars -> type_expr list
+ (* Verify that the given univars are universally quantified,
+ and return the list of variables. The type in which the
+ univars are used must be generalised *)
+val instance_poly_univars :
+ Env.t -> Location.t -> poly_univars -> type_expr list
+ (* Same as [check_poly_univars], but instantiates the resulting
+ type scheme (i.e. variables become Tvar rather than Tunivar) *)
+
val transl_simple_type:
- Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
+ Env.t -> ?univars:poly_univars -> bool -> Parsetree.core_type
+ -> Typedtree.core_type
val transl_simple_type_univars:
Env.t -> Parsetree.core_type -> Typedtree.core_type
val transl_simple_type_delayed
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
- | Type_mismatch of Errortrace.unification Errortrace.t
- | Alias_type_mismatch of Errortrace.unification Errortrace.t
+ | Type_mismatch of Errortrace.unification_error
+ | Alias_type_mismatch of Errortrace.unification_error
| Present_has_conjunction of string
| Present_has_no_type of string
| Constructor_mismatch of type_expr * type_expr
let loc = sub.location sub cd.cd_loc in
let attrs = sub.attributes sub cd.cd_attributes in
Type.constructor ~loc ~attrs
+ ~vars:cd.cd_vars
~args:(constructor_arguments sub cd.cd_args)
?res:(Option.map (sub.typ sub) cd.cd_res)
(map_loc sub cd.cd_name)
Te.constructor ~loc ~attrs
(map_loc sub ext.ext_name)
(match ext.ext_kind with
- | Text_decl (args, ret) ->
- Pext_decl (constructor_arguments sub args,
+ | Text_decl (vs, args, ret) ->
+ Pext_decl (vs, constructor_arguments sub args,
Option.map (sub.typ sub) ret)
| Text_rebind (_p, lid) -> Pext_rebind (map_loc sub lid)
)
Pexp_for (name,
sub.expr sub exp1, sub.expr sub exp2,
dir, sub.expr sub exp3)
- | Texp_send (exp, meth, _) ->
+ | Texp_send (exp, meth) ->
Pexp_send (sub.expr sub exp, match meth with
Tmeth_name name -> mkloc name loc
- | Tmeth_val id -> mkloc (Ident.name id) loc)
+ | Tmeth_val id -> mkloc (Ident.name id) loc
+ | Tmeth_ancestor(id, _) -> mkloc (Ident.name id) loc)
| Texp_new (_path, lid, _) -> Pexp_new (map_loc sub lid)
| Texp_instvar (_, path, name) ->
Pexp_ident ({loc = sub.location sub name.loc ; txt = lident_of_path path})
$(call SUBST,FORCE_SAFE_STRING) \
$(call SUBST,DEFAULT_SAFE_STRING) \
$(call SUBST,WINDOWS_UNICODE) \
+ $(call SUBST,NAKED_POINTERS) \
$(call SUBST,SUPPORTS_SHARED_LIBRARIES) \
$(call SUBST,SYSTEM) \
$(call SUBST,SYSTHREAD_SUPPORT) \
and all_ppx = ref ([] : string list) (* -ppx *)
let absname = ref false (* -absname *)
let annotations = ref false (* -annot *)
-let binary_annotations = ref false (* -annot *)
+let binary_annotations = ref false (* -bin-annot *)
and use_threads = ref false (* -thread *)
and noassert = ref false (* -noassert *)
and verbose = ref false (* -verbose *)
let dump_source = ref false (* -dsource *)
let dump_parsetree = ref false (* -dparsetree *)
and dump_typedtree = ref false (* -dtypedtree *)
+and dump_shape = ref false (* -dshape *)
and dump_rawlambda = ref false (* -drawlambda *)
and dump_lambda = ref false (* -dlambda *)
and dump_rawclambda = ref false (* -drawclambda *)
let native_code = ref false (* set to true under ocamlopt *)
+let force_tmc = ref false (* -force-tmc *)
let force_slash = ref false (* for ocamldep *)
let clambda_checks = ref false (* -clambda-checks *)
let cmm_invariants =
end
let dump_into_file = ref false (* -dump-into-file *)
+let dump_dir: string option ref = ref None (* -dump-dir *)
type 'a env_reader = {
parse : string -> 'a option;
val dump_source : bool ref
val dump_parsetree : bool ref
val dump_typedtree : bool ref
+val dump_shape : bool ref
val dump_rawlambda : bool ref
val dump_lambda : bool ref
val dump_rawclambda : bool ref
val pic_code : bool ref
val runtime_variant : string ref
val with_runtime : bool ref
+val force_tmc : bool ref
val force_slash : bool ref
val keep_docs : bool ref
val keep_locs : bool ref
val set_dumped_pass : string -> bool -> unit
val dump_into_file : bool ref
+val dump_dir : string option ref
(* Support for flags that can also be set from an environment variable *)
type 'a env_reader = {
val windows_unicode: bool
(** Whether Windows Unicode runtime is enabled *)
+val naked_pointers : bool
+(** Whether the runtime supports naked pointers
+
+ @since 4.14.0 *)
+
val supports_shared_libraries: bool
(** Whether shared libraries are supported
(* *)
(**************************************************************************)
-(* The main OCaml version string has moved to ../VERSION *)
+(* The main OCaml version string has moved to ../build-aux/ocaml_version.m4 *)
let version = Sys.ocaml_version
let bindir = "%%BINDIR%%"
let safe_string = %%FORCE_SAFE_STRING%%
let default_safe_string = %%DEFAULT_SAFE_STRING%%
let windows_unicode = %%WINDOWS_UNICODE%% != 0
+let naked_pointers = %%NAKED_POINTERS%%
let flat_float_array = %%FLAT_FLOAT_ARRAY%%
let function_sections = %%FUNCTION_SECTIONS%%
let afl_instrument = %%AFL_INSTRUMENT%%
-let exec_magic_number = "Caml1999X030"
+let exec_magic_number = "Caml1999X031"
(* exec_magic_number is duplicated in runtime/caml/exec.h *)
-and cmi_magic_number = "Caml1999I030"
-and cmo_magic_number = "Caml1999O030"
-and cma_magic_number = "Caml1999A030"
+and cmi_magic_number = "Caml1999I031"
+and cmo_magic_number = "Caml1999O031"
+and cma_magic_number = "Caml1999A031"
and cmx_magic_number =
if flambda then
- "Caml1999y030"
+ "Caml1999y031"
else
- "Caml1999Y030"
+ "Caml1999Y031"
and cmxa_magic_number =
if flambda then
- "Caml1999z030"
+ "Caml1999z031"
else
- "Caml1999Z030"
-and ast_impl_magic_number = "Caml1999M030"
-and ast_intf_magic_number = "Caml1999N030"
-and cmxs_magic_number = "Caml1999D030"
-and cmt_magic_number = "Caml1999T030"
-and linear_magic_number = "Caml1999L030"
+ "Caml1999Z031"
+and ast_impl_magic_number = "Caml1999M031"
+and ast_intf_magic_number = "Caml1999N031"
+and cmxs_magic_number = "Caml1999D031"
+and cmt_magic_number = "Caml1999T031"
+and linear_magic_number = "Caml1999L031"
let interface_suffix = ref ".mli"
p_bool "afl_instrument" afl_instrument;
p_bool "windows_unicode" windows_unicode;
p_bool "supports_shared_libraries" supports_shared_libraries;
+ p_bool "naked_pointers" naked_pointers;
p "exec_magic_number" exec_magic_number;
p "cmi_magic_number" cmi_magic_number;
*)
+(** Shared types *)
+type change_kind =
+ | Deletion
+ | Insertion
+ | Modification
+ | Preservation
+
+let style = function
+ | Preservation -> Misc.Color.[ FG Green ]
+ | Deletion -> Misc.Color.[ FG Red; Bold]
+ | Insertion -> Misc.Color.[ FG Red; Bold]
+ | Modification -> Misc.Color.[ FG Magenta; Bold]
+
+let prefix ppf (pos, p) =
+ let sty = style p in
+ Format.pp_open_stag ppf (Misc.Color.Style sty);
+ Format.fprintf ppf "%i. " pos;
+ Format.pp_close_stag ppf ()
+
+
let (let*) = Option.bind
let (let+) x f = Option.map f x
let (let*!) x f = Option.iter f x
-type ('left, 'right, 'eq, 'diff) change =
+module type Defs = sig
+ type left
+ type right
+ type eq
+ type diff
+ type state
+end
+
+type ('left,'right,'eq,'diff) change =
| Delete of 'left
| Insert of 'right
- | Keep of 'left * 'right * 'eq
+ | Keep of 'left * 'right *' eq
| Change of 'left * 'right * 'diff
-type ('l, 'r, 'eq, 'diff) patch = ('l, 'r, 'eq, 'diff) change list
+let classify = function
+ | Delete _ -> Deletion
+ | Insert _ -> Insertion
+ | Change _ -> Modification
+ | Keep _ -> Preservation
+
+module Define(D:Defs) = struct
+ open D
+
+type nonrec change = (left,right,eq,diff) change
+
+type patch = change list
+module type S = sig
+ val diff: state -> left array -> right array -> patch
+end
-let map f g = function
- | Delete x -> Delete (f x)
- | Insert x -> Insert (g x)
- | Keep (x,y,k) -> Keep (f x, g y, k)
- | Change (x,y,k) -> Change (f x, g y, k)
-type ('st,'left,'right) full_state = {
- line: 'left array;
- column: 'right array;
- state: 'st
+type full_state = {
+ line: left array;
+ column: right array;
+ state: state
}
(* The matrix supporting our dynamic programming implementation.
type shape = { l : int ; c : int }
- type ('state,'left,'right,'eq,'diff) t
+ type t
- val make : shape -> ('st,'l,'r,'e,'d) t
- val reshape : shape -> ('st,'l,'r,'e,'d) t -> ('st,'l,'r,'e,'d) t
+ val make : shape -> t
+ val reshape : shape -> t -> t
(** accessor functions *)
- val diff : (_,'l,'r,'e,'d) t -> int -> int -> ('l,'r,'e,'d) change option
- val state :
- ('st,'l,'r,'e,'d) t -> int -> int -> ('st, 'l, 'r) full_state option
- val weight : _ t -> int -> int -> int
+ val diff : t -> int -> int -> change option
+ val state : t -> int -> int -> full_state option
+ val weight : t -> int -> int -> int
- val line : (_,'l,_,_,_) t -> int -> int -> 'l option
- val column : (_,_,'r,_,_) t -> int -> int -> 'r option
+ val line : t -> int -> int -> left option
+ val column : t -> int -> int -> right option
val set :
- ('st,'l,'r,'e,'d) t -> int -> int ->
- diff:('l,'r,'e,'d) change option ->
+ t -> int -> int ->
+ diff:change option ->
weight:int ->
- state:('st, 'l, 'r) full_state ->
+ state:full_state ->
unit
(** the shape when starting filling the matrix *)
- val shape : _ t -> shape
+ val shape : t -> shape
(** [shape m i j] is the shape as seen from the state at position (i,j)
after some possible extensions
*)
- val shape_at : _ t -> int -> int -> shape option
+ val shape_at : t -> int -> int -> shape option
(** the maximal shape on the whole matrix *)
- val real_shape : _ t -> shape
+ val real_shape : t -> shape
(** debugging printer *)
- val[@warning "-32"] pp : Format.formatter -> _ t -> unit
+ val[@warning "-32"] pp : Format.formatter -> t -> unit
end = struct
type shape = { l : int ; c : int }
- type ('state,'left,'right,'eq,'diff) t =
- { states: ('state,'left,'right) full_state option array array;
+ type t =
+ { states: full_state option array array;
weight: int array array;
- diff: ('left,'right,'eq,'diff) change option array array;
+ diff: change option array array;
columns: int;
lines: int;
}
end
+
+(* Building the patch.
+
+ We first select the best final cell. A potential final cell
+ is a cell where the local shape (i.e., the size of the strings) correspond
+ to its position in the matrix. In other words: it's at the end of both its
+ strings. We select the final cell with the smallest weight.
+
+ We then build the patch by walking backward from the final cell to the
+ origin.
+*)
+
+let select_final_state m0 =
+ let maybe_final i j =
+ match Matrix.shape_at m0 i j with
+ | Some shape_here -> shape_here.l = i && shape_here.c = j
+ | None -> false
+ in
+ let best_state (i0,j0,weigth0) (i,j) =
+ let weight = Matrix.weight m0 i j in
+ if weight < weigth0 then (i,j,weight) else (i0,j0,weigth0)
+ in
+ let res = ref (0,0,max_int) in
+ let shape = Matrix.shape m0 in
+ for i = 0 to shape.l do
+ for j = 0 to shape.c do
+ if maybe_final i j then
+ res := best_state !res (i,j)
+ done
+ done;
+ let i_final, j_final, _ = !res in
+ assert (i_final <> 0 || j_final <> 0);
+ (i_final, j_final)
+
+let construct_patch m0 =
+ let rec aux acc (i, j) =
+ if i = 0 && j = 0 then
+ acc
+ else
+ match Matrix.diff m0 i j with
+ | None -> assert false
+ | Some d ->
+ let next = match d with
+ | Keep _ | Change _ -> (i-1, j-1)
+ | Delete _ -> (i-1, j)
+ | Insert _ -> (i, j-1)
+ in
+ aux (d::acc) next
+ in
+ aux [] (select_final_state m0)
+
(* Computation of new cells *)
let select_best_proposition l =
in
List.fold_left compare_proposition None l
-(* Boundary cell update *)
-let compute_column0 ~weight ~update tbl i =
- let*! st = Matrix.state tbl (i-1) 0 in
- let*! line = Matrix.line tbl (i-1) 0 in
- let diff = Delete line in
- Matrix.set tbl i 0
- ~weight:(weight diff + Matrix.weight tbl (i-1) 0)
- ~state:(update diff st)
- ~diff:(Some diff)
-
-let compute_line0 ~weight ~update tbl j =
- let*! st = Matrix.state tbl 0 (j-1) in
- let*! column = Matrix.column tbl 0 (j-1) in
- let diff = Insert column in
- Matrix.set tbl 0 j
- ~weight:(weight diff + Matrix.weight tbl 0 (j-1))
- ~state:(update diff st)
- ~diff:(Some diff)
-
-let compute_inner_cell ~weight ~test ~update tbl i j =
+ module type Full_core = sig
+ type update_result
+ type update_state
+ val weight: change -> int
+ val test: state -> left -> right -> (eq, diff) result
+ val update: change -> update_state -> update_result
+ end
+
+module Generic
+ (X: Full_core
+ with type update_result := full_state
+ and type update_state := full_state) = struct
+ open X
+
+ (* Boundary cell update *)
+ let compute_column0 tbl i =
+ let*! st = Matrix.state tbl (i-1) 0 in
+ let*! line = Matrix.line tbl (i-1) 0 in
+ let diff = Delete line in
+ Matrix.set tbl i 0
+ ~weight:(weight diff + Matrix.weight tbl (i-1) 0)
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+ let compute_line0 tbl j =
+ let*! st = Matrix.state tbl 0 (j-1) in
+ let*! column = Matrix.column tbl 0 (j-1) in
+ let diff = Insert column in
+ Matrix.set tbl 0 j
+ ~weight:(weight diff + Matrix.weight tbl 0 (j-1))
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+let compute_inner_cell tbl i j =
let compute_proposition i j diff =
let* diff = diff in
let+ localstate = Matrix.state tbl i j in
let state = update diff localstate in
Matrix.set tbl i j ~weight:newweight ~state ~diff:(Some diff)
-let compute_cell ~weight ~test ~update m i j =
+let compute_cell m i j =
match i, j with
| _ when Matrix.diff m i j <> None -> ()
| 0,0 -> ()
- | 0,j -> compute_line0 ~update ~weight m j
- | i,0 -> compute_column0 ~update ~weight m i;
- | _ -> compute_inner_cell ~weight ~test ~update m i j
+ | 0,j -> compute_line0 m j
+ | i,0 -> compute_column0 m i;
+ | _ -> compute_inner_cell m i j
(* Filling the matrix
If any list have been extended, we need to reshape the matrix
and repeat the process
*)
-let compute_matrix ~weight ~test ~update state0 =
+let compute_matrix state0 =
let m0 = Matrix.make { l = 0 ; c = 0 } in
Matrix.set m0 0 0 ~weight:0 ~state:state0 ~diff:None;
let rec loop m =
let m = Matrix.reshape new_shape m in
for i = 0 to new_shape.l do
for j = 0 to new_shape.c do
- compute_cell ~update ~test ~weight m i j
+ compute_cell m i j
done
done;
loop m
m
in
loop m0
+ end
-(* Building the patch.
-
- We first select the best final cell. A potential final cell
- is a cell where the local shape (i.e., the size of the strings) correspond
- to its position in the matrix. In other words: it's at the end of both its
- strings. We select the final cell with the smallest weight.
-
- We then build the patch by walking backward from the final cell to the
- origin.
-*)
-let select_final_state m0 =
- let maybe_final i j =
- match Matrix.shape_at m0 i j with
- | Some shape_here -> shape_here.l = i && shape_here.c = j
- | None -> false
- in
- let best_state (i0,j0,weigth0) (i,j) =
- let weight = Matrix.weight m0 i j in
- if weight < weigth0 then (i,j,weight) else (i0,j0,weigth0)
- in
- let res = ref (0,0,max_int) in
- let shape = Matrix.shape m0 in
- for i = 0 to shape.l do
- for j = 0 to shape.c do
- if maybe_final i j then
- res := best_state !res (i,j)
- done
- done;
- let i_final, j_final, _ = !res in
- assert (i_final <> 0 || j_final <> 0);
- (i_final, j_final)
+ module type Parameters = Full_core with type update_state := state
-let construct_patch m0 =
- let rec aux acc (i, j) =
- if i = 0 && j = 0 then
- acc
- else
- match Matrix.diff m0 i j with
- | None -> assert false
- | Some d ->
- let next = match d with
- | Keep _ | Change _ -> (i-1, j-1)
- | Delete _ -> (i-1, j)
- | Insert _ -> (i, j-1)
- in
- aux (d::acc) next
- in
- aux [] (select_final_state m0)
+ module Simple(X:Parameters with type update_result := state) = struct
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs = { fs with state = X.update d fs.state }
+ end)
-let diff ~weight ~test ~update state line column =
- let update d fs = { fs with state = update d fs.state } in
- let fullstate = { line; column; state } in
- compute_matrix ~weight ~test ~update fullstate
- |> construct_patch
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
-type ('l, 'r, 'e, 'd, 'state) update =
- | Without_extensions of (('l,'r,'e,'d) change -> 'state -> 'state)
- | With_left_extensions of
- (('l,'r,'e,'d) change -> 'state -> 'state * 'l array)
- | With_right_extensions of
- (('l,'r,'e,'d) change -> 'state -> 'state * 'r array)
-let variadic_diff ~weight ~test ~(update:_ update) state line column =
let may_append x = function
| [||] -> x
- | y -> Array.append x y in
- let update = match update with
- | Without_extensions up ->
- fun d fs ->
- let state = up d fs.state in
- { fs with state }
- | With_left_extensions up ->
- fun d fs ->
- let state, a = up d fs.state in
+ | y -> Array.append x y
+
+
+ module Left_variadic
+ (X:Parameters with type update_result := state * left array) = struct
+ open X
+
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs =
+ let state, a = update d fs.state in
{ fs with state ; line = may_append fs.line a }
- | With_right_extensions up ->
- fun d fs ->
- let state, a = up d fs.state in
+ end)
+
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
+
+ module Right_variadic
+ (X:Parameters with type update_result := state * right array) = struct
+ open X
+
+ module Internal = Generic(struct
+ let test = X.test
+ let weight = X.weight
+ let update d fs =
+ let state, a = update d fs.state in
{ fs with state ; column = may_append fs.column a }
- in
- let fullstate = { line; column; state } in
- compute_matrix ~weight ~test ~update fullstate
- |> construct_patch
+ end)
+
+ let diff state line column =
+ let fullstate = { line; column; state } in
+ Internal.compute_matrix fullstate
+ |> construct_patch
+ end
+
+end
-
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(**************************************************************************)
-(** {0 Parametric diffing}
+(** Parametric diffing
This module implements diffing over lists of arbitrary content.
It is parameterized by
*)
-(** The type of potential changes on a list. *)
-type ('left, 'right, 'eq, 'diff) change =
+(** The core types of a diffing implementation *)
+module type Defs = sig
+ type left
+ type right
+ type eq
+ (** Detailed equality trace *)
+
+ type diff
+ (** Detailed difference trace *)
+
+ type state
+ (** environment of a partial patch *)
+end
+
+(** The kind of changes which is used to share printing and styling
+ across implementation*)
+type change_kind =
+ | Deletion
+ | Insertion
+ | Modification
+ | Preservation
+val prefix: Format.formatter -> (int * change_kind) -> unit
+val style: change_kind -> Misc.Color.style list
+
+
+type ('left,'right,'eq,'diff) change =
| Delete of 'left
| Insert of 'right
- | Keep of 'left * 'right * 'eq
+ | Keep of 'left * 'right *' eq
| Change of 'left * 'right * 'diff
-val map :
- ('l1 -> 'l2) -> ('r1 -> 'r2) ->
- ('l1, 'r1, 'eq, 'diff) change ->
- ('l2, 'r2, 'eq, 'diff) change
-
-(** A patch is an ordered list of changes. *)
-type ('l, 'r, 'eq, 'diff) patch = ('l, 'r, 'eq, 'diff) change list
-
-(** [diff ~weight ~test ~update state l r] computes
- the diff between [l] and [r], using the initial state [state].
- - [test st xl xr] tests if the elements [xl] and [xr] are
- compatible ([Ok]) or not ([Error]).
- - [weight ch] returns the weight of the change [ch].
- Used to find the smallest patch.
- - [update ch st] returns the new state after applying a change.
+val classify: _ change -> change_kind
+
+(** [Define(Defs)] creates the diffing types from the types
+ defined in [Defs] and the functors that need to be instantatied
+ with the diffing algorithm parameters
*)
-val diff :
- weight:(('l, 'r, 'eq, 'diff) change -> int) ->
- test:('state -> 'l -> 'r -> ('eq, 'diff) result) ->
- update:(('l, 'r, 'eq, 'diff) change -> 'state -> 'state) ->
- 'state -> 'l array -> 'r array -> ('l, 'r, 'eq, 'diff) patch
+module Define(D:Defs): sig
+ open D
-(** {1 Variadic diffing}
+ (** The type of potential changes on a list. *)
+ type nonrec change = (left,right,eq,diff) change
+ type patch = change list
+ (** A patch is an ordered list of changes. *)
- Variadic diffing allows to expand the lists being diffed during diffing.
-*)
+ module type Parameters = sig
+ type update_result
-type ('l, 'r, 'e, 'd, 'state) update =
- | Without_extensions of (('l,'r,'e,'d) change -> 'state -> 'state)
- | With_left_extensions of
- (('l,'r,'e,'d) change -> 'state -> 'state * 'l array)
- | With_right_extensions of
- (('l,'r,'e,'d) change -> 'state -> 'state * 'r array)
-
-(** [variadic_diff ~weight ~test ~update state l r] behaves as [diff]
- with the following difference:
- - [update] must now be an {!update} which indicates in which direction
- the expansion takes place.
-*)
-val variadic_diff :
- weight:(('l, 'r, 'eq, 'diff) change -> int) ->
- test:('state -> 'l -> 'r -> ('eq, 'diff) result) ->
- update:('l, 'r, 'eq, 'diff, 'state) update ->
- 'state -> 'l array -> 'r array -> ('l, 'r, 'eq, 'diff) patch
+ val weight: change -> int
+ (** [weight ch] returns the weight of the change [ch].
+ Used to find the smallest patch. *)
+
+ val test: state -> left -> right -> (eq, diff) result
+ (**
+ [test st xl xr] tests if the elements [xl] and [xr] are
+ co mpatible ([Ok]) or not ([Error]).
+ *)
+
+ val update: change -> state -> update_result
+ (** [update ch st] returns the new state after applying a change.
+ The [update_result] type also contains expansions in the variadic
+ case.
+ *)
+ end
+
+ module type S = sig
+ val diff: state -> left array -> right array -> patch
+ (** [diff state l r] computes the optimal patch between [l] and [r],
+ using the initial state [state].
+ *)
+ end
+
+
+ module Simple: (Parameters with type update_result := state) -> S
+
+ (** {1 Variadic diffing}
+
+ Variadic diffing allows to expand the lists being diffed during diffing.
+ in one specific direction.
+ *)
+ module Left_variadic:
+ (Parameters with type update_result := state * left array) -> S
+
+ module Right_variadic:
+ (Parameters with type update_result := state * right array) -> S
+
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+
+type 'a with_pos = {pos:int; data:'a}
+let with_pos l = List.mapi (fun n data -> {pos=n+1; data}) l
+
+(** Composite change and mismatches *)
+type ('l,'r,'diff) mismatch =
+ | Name of {pos:int; got:string; expected:string; types_match:bool}
+ | Type of {pos:int; got:'l; expected:'r; reason:'diff}
+
+type ('l,'r,'diff) change =
+ | Change of ('l,'r,'diff) mismatch
+ | Swap of { pos: int * int; first: string; last: string }
+ | Move of {name:string; got:int; expected:int}
+ | Insert of {pos:int; insert:'r}
+ | Delete of {pos:int; delete:'l}
+
+let prefix ppf x =
+ let kind = match x with
+ | Change _ | Swap _ | Move _ -> Diffing.Modification
+ | Insert _ -> Diffing.Insertion
+ | Delete _ -> Diffing.Deletion
+ in
+ let style k ppf inner =
+ let sty = Diffing.style k in
+ Format.pp_open_stag ppf (Misc.Color.Style sty);
+ Format.kfprintf (fun ppf -> Format.pp_close_stag ppf () ) ppf inner
+ in
+ match x with
+ | Change (Name {pos; _ } | Type {pos; _})
+ | Insert { pos; _ } | Delete { pos; _ } ->
+ style kind ppf "%i. " pos
+ | Swap { pos = left, right; _ } ->
+ style kind ppf "%i<->%i. " left right
+ | Move { got; expected; _ } ->
+ style kind ppf "%i->%i. " expected got
+
+
+
+(** To detect [move] and [swaps], we are using the fact that
+ there are 2-cycles in the graph of name renaming.
+ - [Change (x,y,_) is then an edge from
+ [key_left x] to [key_right y].
+ - [Insert x] is an edge between the special node epsilon and
+ [key_left x]
+ - [Delete x] is an edge between [key_right] and the epsilon node
+ Since for 2-cycle, knowing one edge is enough to identify the cycle
+ it might belong to, we are using maps of partial 2-cycles.
+*)
+module Two_cycle: sig
+ type t = private (string * string)
+ val create: string -> string -> t
+end = struct
+ type t = string * string
+ let create kx ky =
+ if kx <= ky then kx, ky else ky, kx
+end
+module Swap = Map.Make(struct
+ type t = Two_cycle.t
+ let compare: t -> t -> int = Stdlib.compare
+ end)
+module Move = Misc.Stdlib.String.Map
+
+
+module Define(D:Diffing.Defs with type eq := unit) = struct
+
+ module Internal_defs = struct
+ type left = D.left with_pos
+ type right = D.right with_pos
+ type diff = (D.left, D.right, D.diff) mismatch
+ type eq = unit
+ type state = D.state
+ end
+ module Diff = Diffing.Define(Internal_defs)
+
+ type left = Internal_defs.left
+ type right = Internal_defs.right
+ type diff = (D.left, D.right, D.diff) mismatch
+ type composite_change = (D.left,D.right,D.diff) change
+ type nonrec change = (left, right, unit, diff) Diffing.change
+ type patch = composite_change list
+
+ module type Parameters = sig
+ include Diff.Parameters with type update_result := D.state
+ val key_left: D.left -> string
+ val key_right: D.right -> string
+ end
+
+ module Simple(Impl:Parameters) = struct
+ open Impl
+
+ (** Partial 2-cycles *)
+ type ('l,'r) partial_cycle =
+ | Left of int * D.state * 'l
+ | Right of int * D.state * 'r
+ | Both of D.state * 'l * 'r
+
+ (** Compute the partial cycle and edge associated to an edge *)
+ let edge state (x:left) (y:right) =
+ let kx, ky = key_left x.data, key_right y.data in
+ let edge =
+ if kx <= ky then
+ Left (x.pos, state, (x,y))
+ else
+ Right (x.pos,state, (x,y))
+ in
+ Two_cycle.create kx ky, edge
+
+ let merge_edge ex ey = match ex, ey with
+ | ex, None -> Some ex
+ | Left (lpos, lstate, l), Some Right (rpos, rstate,r)
+ | Right (rpos, rstate,r), Some Left (lpos, lstate, l) ->
+ let state = if lpos < rpos then rstate else lstate in
+ Some (Both (state,l,r))
+ | Both _ as b, _ | _, Some (Both _ as b) -> Some b
+ | l, _ -> Some l
+
+ let two_cycles state changes =
+ let add (state,(swaps,moves)) (d:change) =
+ update d state,
+ match d with
+ | Change (x,y,_) ->
+ let k, edge = edge state x y in
+ Swap.update k (merge_edge edge) swaps, moves
+ | Insert nx ->
+ let k = key_right nx.data in
+ let edge = Right (nx.pos, state,nx) in
+ swaps, Move.update k (merge_edge edge) moves
+ | Delete nx ->
+ let k, edge = key_left nx.data, Left (nx.pos, state, nx) in
+ swaps, Move.update k (merge_edge edge) moves
+ | _ -> swaps, moves
+ in
+ List.fold_left add (state,(Swap.empty,Move.empty)) changes
+
+ (** Check if an edge belongs to a known 2-cycle *)
+ let swap swaps x y =
+ let kx, ky = key_left x.data, key_right y.data in
+ let key = Two_cycle.create kx ky in
+ match Swap.find_opt key swaps with
+ | None | Some (Left _ | Right _)-> None
+ | Some Both (state, (ll,lr),(rl,rr)) ->
+ match test state ll rr, test state rl lr with
+ | Ok _, Ok _ ->
+ Some ({pos=ll.pos; data=kx}, {pos=rl.pos; data=ky})
+ | Error _, _ | _, Error _ -> None
+
+ let move moves x =
+ let name =
+ match x with
+ | Either.Left x -> key_left x.data
+ | Either.Right x -> key_right x.data
+ in
+ match Move.find_opt name moves with
+ | None | Some (Left _ | Right _)-> None
+ | Some Both (state,got,expected) ->
+ match test state got expected with
+ | Ok _ ->
+ Some (Move {name; got=got.pos; expected=expected.pos})
+ | Error _ -> None
+
+ let refine state patch =
+ let _, (swaps, moves) = two_cycles state patch in
+ let filter: change -> composite_change option = function
+ | Keep _ -> None
+ | Insert x ->
+ begin match move moves (Either.Right x) with
+ | Some _ as move -> move
+ | None -> Some (Insert {pos=x.pos;insert=x.data})
+ end
+ | Delete x ->
+ begin match move moves (Either.Left x) with
+ | Some _ -> None
+ | None -> Some (Delete {pos=x.pos; delete=x.data})
+ end
+ | Change(x,y, reason) ->
+ match swap swaps x y with
+ | Some ({pos=pos1; data=first}, {pos=pos2; data=last}) ->
+ if x.pos = pos1 then
+ Some (Swap { pos = pos1, pos2; first; last})
+ else None
+ | None -> Some (Change reason)
+ in
+ List.filter_map filter patch
+
+ let diff state left right =
+ let left = with_pos left in
+ let right = with_pos right in
+ let module Raw = Diff.Simple(Impl) in
+ let raw = Raw.diff state (Array.of_list left) (Array.of_list right) in
+ refine state raw
+
+ end
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(**
+
+ When diffing lists where each element has a distinct key, we can refine
+ the diffing patch by introducing two composite edit moves: swaps and moves.
+
+ [Swap]s exchange the position of two elements. [Swap] cost is set to
+ [2 * change - epsilon].
+ [Move]s change the position of one element. [Move] cost is set to
+ [delete + addition - epsilon].
+
+ When the cost [delete + addition] is greater than [change] and with those
+ specific weights, the optimal patch with [Swap]s and [Move]s can be computed
+ directly and cheaply from the original optimal patch.
+
+*)
+
+type 'a with_pos = {pos: int; data:'a}
+val with_pos: 'a list -> 'a with_pos list
+
+type ('l,'r,'diff) mismatch =
+ | Name of {pos:int; got:string; expected:string; types_match:bool}
+ | Type of {pos:int; got:'l; expected:'r; reason:'diff}
+
+(** This specialized version of changes introduces two composite
+ changes: [Move] and [Swap]
+*)
+type ('l,'r,'diff) change =
+ | Change of ('l,'r,'diff) mismatch
+ | Swap of { pos: int * int; first: string; last: string }
+ | Move of {name:string; got:int; expected:int}
+ | Insert of {pos:int; insert:'r}
+ | Delete of {pos:int; delete:'l}
+
+val prefix: Format.formatter -> ('l,'r,'diff) change -> unit
+
+module Define(D:Diffing.Defs with type eq := unit): sig
+
+ type diff = (D.left, D.right, D.diff) mismatch
+ type left = D.left with_pos
+ type right = D.right with_pos
+
+ (** Composite changes and patches *)
+ type composite_change = (D.left,D.right,D.diff) change
+ type patch = composite_change list
+
+ (** Atomic changes *)
+ type change = (left,right,unit,diff) Diffing.change
+
+ module type Parameters = sig
+ val weight: change -> int
+ val test: D.state -> left -> right -> (unit, diff) result
+ val update: change -> D.state -> D.state
+
+ val key_left: D.left -> string
+ val key_right: D.right -> string
+ end
+
+ module Simple: Parameters -> sig
+ val diff: D.state -> D.left list -> D.right list -> patch
+ end
+
+end
let get_arg x =
match !x with Thunk a -> Some a | _ -> None
+let get_contents x =
+ match !x with
+ | Thunk a -> Either.Left a
+ | Done b -> Either.Right b
+ | Raise e -> raise e
+
let create x =
ref (Thunk x)
val force : ('a -> 'b) -> ('a,'b) t -> 'b
val create : 'a -> ('a,'b) t
val get_arg : ('a,'b) t -> 'a option
+val get_contents : ('a,'b) t -> ('a,'b) Either.t
val create_forced : 'b -> ('a, 'b) t
val create_failed : exn -> ('a, 'b) t
(** {1 Creators} *)
val s_ref : 'a -> 'a ref
-(** Similar to {!ref}, except the allocated reference is registered into the
- store. *)
+(** Similar to {!val:ref}, except the allocated reference is registered into
+ the store. *)
val s_table : ('a -> 'b) -> 'a -> 'b ref
(** Used to register hash tables. Those also need to be placed into refs to be
initialized to those values. *)
val with_store : store -> (unit -> 'a) -> 'a
-(** [with_scope s f] resets all the registered references to the value they have
+(** [with_store s f] resets all the registered references to the value they have
in [s] for the run of [f].
If [f] updates any of the registered refs, [s] is updated to remember those
changes. *)
that new instances start with). *)
val is_bound : unit -> bool
-(** Returns [true] when a scope is active (i.e. when called from the callback
- passed to {!with_scope}), [false] otherwise. *)
+(** Returns [true] when a store is active (i.e. when called from the callback
+ passed to {!with_store}), [false] otherwise. *)
let pos = String.index s c in
String.sub s 0 pos, String.sub s (pos+1) (String.length s - pos - 1)
+let ordinal_suffix n =
+ let teen = (n mod 100)/10 = 1 in
+ match n mod 10 with
+ | 1 when not teen -> "st"
+ | 2 when not teen -> "nd"
+ | 3 when not teen -> "rd"
+ | _ -> "th"
+
(* Color handling *)
module Color = struct
(* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *)
module Array : sig
val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
- (* Same as [Array.exists], but for a two-argument predicate. Raise
- Invalid_argument if the two arrays are determined to have
- different lengths. *)
+ (** Same as [Array.exists2] from the standard library. *)
val for_alli : (int -> 'a -> bool) -> 'a array -> bool
- (** Same as {!Array.for_all}, but the
+ (** Same as [Array.for_all] from the standard library, but the
function is applied with the index of the element as first argument,
and the element itself as second argument. *)
@since 4.01
*)
+val ordinal_suffix : int -> string
+(** [ordinal_suffix n] is the appropriate suffix to append to the numeral [n] as
+ an ordinal number: [1] -> ["st"], [2] -> ["nd"], [3] -> ["rd"],
+ [4] -> ["th"], and so on. Handles larger numbers (e.g., [42] -> ["nd"]) and
+ the numbers 11--13 (which all get ["th"]) correctly. *)
+
(* Color handling *)
module Color : sig
type color =
| Match_on_mutable_state_prevent_uncurry (* 68 *)
| Unused_field of string * field_usage_warning (* 69 *)
| Missing_mli (* 70 *)
+ | Unused_tmc_attribute (* 71 *)
+ | Tmc_breaks_tailcall (* 72 *)
;;
(* If you remove a warning, leave a hole in the numbering. NEVER change
| Match_on_mutable_state_prevent_uncurry -> 68
| Unused_field _ -> 69
| Missing_mli -> 70
+ | Unused_tmc_attribute -> 71
+ | Tmc_breaks_tailcall -> 72
;;
-let last_warning_number = 70
+let last_warning_number = 72
;;
-(* Third component of each tuple is the list of names for each warning. The
- first element of the list is the current name, any following ones are
- deprecated. The current name should always be derived mechanically from the
- constructor name. *)
+type description =
+ { number : int;
+ names : string list;
+ (* The first element of the list is the current name, any following ones are
+ deprecated. The current name should always be derived mechanically from
+ the constructor name. *)
+ description : string; }
-let descriptions =
- [
- 1, "Suspicious-looking start-of-comment mark.",
- ["comment-start"];
- 2, "Suspicious-looking end-of-comment mark.",
- ["comment-not-end"];
- 3, "Deprecated synonym for the 'deprecated' alert.",
- [];
- 4, "Fragile pattern matching: matching that will remain complete even\n\
- \ if additional constructors are added to one of the variant types\n\
- \ matched.",
- ["fragile-match"];
- 5, "Partially applied function: expression whose result has function\n\
- \ type and is ignored.",
- ["ignored-partial-application"];
- 6, "Label omitted in function application.",
- ["labels-omitted"];
- 7, "Method overridden.",
- ["method-override"];
- 8, "Partial match: missing cases in pattern-matching.",
- ["partial-match"];
- 9, "Missing fields in a record pattern.",
- ["missing-record-field-pattern"];
- 10,
- "Expression on the left-hand side of a sequence that doesn't have type\n\
- \ \"unit\" (and that is not a function, see warning number 5).",
- ["non-unit-statement"];
- 11, "Redundant case in a pattern matching (unused match case).",
- ["redundant-case"];
- 12, "Redundant sub-pattern in a pattern-matching.",
- ["redundant-subpat"];
- 13, "Instance variable overridden.",
- ["instance-variable-override"];
- 14, "Illegal backslash escape in a string constant.",
- ["illegal-backslash"];
- 15, "Private method made public implicitly.",
- ["implicit-public-methods"];
- 16, "Unerasable optional argument.",
- ["unerasable-optional-argument"];
- 17, "Undeclared virtual method.",
- ["undeclared-virtual-method"];
- 18, "Non-principal type.",
- ["not-principal"];
- 19, "Type without principality.",
- ["non-principal-labels"];
- 20, "Unused function argument.",
- ["ignored-extra-argument"];
- 21, "Non-returning statement.",
- ["nonreturning-statement"];
- 22, "Preprocessor warning.",
- ["preprocessor"];
- 23, "Useless record \"with\" clause.",
- ["useless-record-with"];
- 24,
- "Bad module name: the source file name is not a valid OCaml module name.",
- ["bad-module-name"];
- 25, "Ignored: now part of warning 8.",
- [];
- 26,
+let descriptions = [
+ { number = 1;
+ names = ["comment-start"];
+ description = "Suspicious-looking start-of-comment mark." };
+ { number = 2;
+ names = ["comment-not-end"];
+ description = "Suspicious-looking end-of-comment mark." };
+ { number = 3;
+ names = [];
+ description = "Deprecated synonym for the 'deprecated' alert." };
+ { number = 4;
+ names = ["fragile-match"];
+ description =
+ "Fragile pattern matching: matching that will remain complete even\n\
+ \ if additional constructors are added to one of the variant types\n\
+ \ matched." };
+ { number = 5;
+ names = ["ignored-partial-application"];
+ description =
+ "Partially applied function: expression whose result has function\n\
+ \ type and is ignored." };
+ { number = 6;
+ names = ["labels-omitted"];
+ description = "Label omitted in function application." };
+ { number = 7;
+ names = ["method-override"];
+ description = "Method overridden." };
+ { number = 8;
+ names = ["partial-match"];
+ description = "Partial match: missing cases in pattern-matching." };
+ { number = 9;
+ names = ["missing-record-field-pattern"];
+ description = "Missing fields in a record pattern." };
+ { number = 10;
+ names = ["non-unit-statement"];
+ description =
+ "Expression on the left-hand side of a sequence that doesn't have type\n\
+ \ \"unit\" (and that is not a function, see warning number 5)." };
+ { number = 11;
+ names = ["redundant-case"];
+ description =
+ "Redundant case in a pattern matching (unused match case)." };
+ { number = 12;
+ names = ["redundant-subpat"];
+ description = "Redundant sub-pattern in a pattern-matching." };
+ { number = 13;
+ names = ["instance-variable-override"];
+ description = "Instance variable overridden." };
+ { number = 14;
+ names = ["illegal-backslash"];
+ description = "Illegal backslash escape in a string constant." };
+ { number = 15;
+ names = ["implicit-public-methods"];
+ description = "Private method made public implicitly." };
+ { number = 16;
+ names = ["unerasable-optional-argument"];
+ description = "Unerasable optional argument." };
+ { number = 17;
+ names = ["undeclared-virtual-method"];
+ description = "Undeclared virtual method." };
+ { number = 18;
+ names = ["not-principal"];
+ description = "Non-principal type." };
+ { number = 19;
+ names = ["non-principal-labels"];
+ description = "Type without principality." };
+ { number = 20;
+ names = ["ignored-extra-argument"];
+ description = "Unused function argument." };
+ { number = 21;
+ names = ["nonreturning-statement"];
+ description = "Non-returning statement." };
+ { number = 22;
+ names = ["preprocessor"];
+ description = "Preprocessor warning." };
+ { number = 23;
+ names = ["useless-record-with"];
+ description = "Useless record \"with\" clause." };
+ { number = 24;
+ names = ["bad-module-name"];
+ description =
+ "Bad module name: the source file name is not a valid OCaml module name."};
+ { number = 25;
+ names = [];
+ description = "Ignored: now part of warning 8." };
+ { number = 26;
+ names = ["unused-var"];
+ description =
"Suspicious unused variable: unused variable that is bound\n\
\ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
- \ character.",
- ["unused-var"];
- 27, "Innocuous unused variable: unused variable that is not bound with\n\
- \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
- \ character.",
- ["unused-var-strict"];
- 28, "Wildcard pattern given as argument to a constant constructor.",
- ["wildcard-arg-to-constant-constr"];
- 29, "Unescaped end-of-line in a string constant (non-portable code).",
- ["eol-in-string"];
- 30, "Two labels or constructors of the same name are defined in two\n\
- \ mutually recursive types.",
- ["duplicate-definitions"];
- 31, "A module is linked twice in the same executable.",
- ["module-linked-twice"];
- 32, "Unused value declaration.",
- ["unused-value-declaration"];
- 33, "Unused open statement.",
- ["unused-open"];
- 34, "Unused type declaration.",
- ["unused-type-declaration"];
- 35, "Unused for-loop index.",
- ["unused-for-index"];
- 36, "Unused ancestor variable.",
- ["unused-ancestor"];
- 37, "Unused constructor.",
- ["unused-constructor"];
- 38, "Unused extension constructor.",
- ["unused-extension"];
- 39, "Unused rec flag.",
- ["unused-rec-flag"];
- 40, "Constructor or label name used out of scope.",
- ["name-out-of-scope"];
- 41, "Ambiguous constructor or label name.",
- ["ambiguous-name"];
- 42, "Disambiguated constructor or label name (compatibility warning).",
- ["disambiguated-name"];
- 43, "Nonoptional label applied as optional.",
- ["nonoptional-label"];
- 44, "Open statement shadows an already defined identifier.",
- ["open-shadow-identifier"];
- 45, "Open statement shadows an already defined label or constructor.",
- ["open-shadow-label-constructor"];
- 46, "Error in environment variable.",
- ["bad-env-variable"];
- 47, "Illegal attribute payload.",
- ["attribute-payload"];
- 48, "Implicit elimination of optional arguments.",
- ["eliminated-optional-arguments"];
- 49, "Absent cmi file when looking up module alias.",
- ["no-cmi-file"];
- 50, "Unexpected documentation comment.",
- ["unexpected-docstring"];
- 51, "Function call annotated with an incorrect @tailcall attribute",
- ["wrong-tailcall-expectation"];
- 52, "Fragile constant pattern.",
- ["fragile-literal-pattern"];
- 53, "Attribute cannot appear in this context.",
- ["misplaced-attribute"];
- 54, "Attribute used more than once on an expression.",
- ["duplicated-attribute"];
- 55, "Inlining impossible.",
- ["inlining-impossible"];
- 56, "Unreachable case in a pattern-matching (based on type information).",
- ["unreachable-case"];
- 57, "Ambiguous or-pattern variables under guard.",
- ["ambiguous-var-in-pattern-guard"];
- 58, "Missing cmx file.",
- ["no-cmx-file"];
- 59, "Assignment to non-mutable value.",
- ["flambda-assignment-to-non-mutable-value"];
- 60, "Unused module declaration.",
- ["unused-module"];
- 61, "Unboxable type in primitive declaration.",
- ["unboxable-type-in-prim-decl"];
- 62, "Type constraint on GADT type declaration.",
- ["constraint-on-gadt"];
- 63, "Erroneous printed signature.",
- ["erroneous-printed-signature"];
- 64, "-unsafe used with a preprocessor returning a syntax tree.",
- ["unsafe-array-syntax-without-parsing"];
- 65, "Type declaration defining a new '()' constructor.",
- ["redefining-unit"];
- 66, "Unused open! statement.",
- ["unused-open-bang"];
- 67, "Unused functor parameter.",
- ["unused-functor-parameter"];
- 68, "Pattern-matching depending on mutable state prevents the remaining \
- arguments from being uncurried.",
- ["match-on-mutable-state-prevent-uncurry"];
- 69, "Unused record field.",
- ["unused-field"];
- 70, "Missing interface file.",
- ["missing-mli"]
- ]
+ \ character." };
+ { number = 27;
+ names = ["unused-var-strict"];
+ description =
+ "Innocuous unused variable: unused variable that is not bound with\n\
+ \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
+ \ character." };
+ { number = 28;
+ names = ["wildcard-arg-to-constant-constr"];
+ description =
+ "Wildcard pattern given as argument to a constant constructor." };
+ { number = 29;
+ names = ["eol-in-string"];
+ description =
+ "Unescaped end-of-line in a string constant (non-portable code)." };
+ { number = 30;
+ names = ["duplicate-definitions"];
+ description =
+ "Two labels or constructors of the same name are defined in two\n\
+ \ mutually recursive types." };
+ { number = 31;
+ names = ["module-linked-twice"];
+ description = "A module is linked twice in the same executable." };
+ { number = 32;
+ names = ["unused-value-declaration"];
+ description = "Unused value declaration." };
+ { number = 33;
+ names = ["unused-open"];
+ description = "Unused open statement." };
+ { number = 34;
+ names = ["unused-type-declaration"];
+ description = "Unused type declaration." };
+ { number = 35;
+ names = ["unused-for-index"];
+ description = "Unused for-loop index." };
+ { number = 36;
+ names = ["unused-ancestor"];
+ description = "Unused ancestor variable." };
+ { number = 37;
+ names = ["unused-constructor"];
+ description = "Unused constructor." };
+ { number = 38;
+ names = ["unused-extension"];
+ description = "Unused extension constructor." };
+ { number = 39;
+ names = ["unused-rec-flag"];
+ description = "Unused rec flag." };
+ { number = 40;
+ names = ["name-out-of-scope"];
+ description = "Constructor or label name used out of scope." };
+ { number = 41;
+ names = ["ambiguous-name"];
+ description = "Ambiguous constructor or label name." };
+ { number = 42;
+ names = ["disambiguated-name"];
+ description =
+ "Disambiguated constructor or label name (compatibility warning)." };
+ { number = 43;
+ names = ["nonoptional-label"];
+ description = "Nonoptional label applied as optional." };
+ { number = 44;
+ names = ["open-shadow-identifier"];
+ description = "Open statement shadows an already defined identifier." };
+ { number = 45;
+ names = ["open-shadow-label-constructor"];
+ description =
+ "Open statement shadows an already defined label or constructor." };
+ { number = 46;
+ names = ["bad-env-variable"];
+ description = "Error in environment variable." };
+ { number = 47;
+ names = ["attribute-payload"];
+ description = "Illegal attribute payload." };
+ { number = 48;
+ names = ["eliminated-optional-arguments"];
+ description = "Implicit elimination of optional arguments." };
+ { number = 49;
+ names = ["no-cmi-file"];
+ description = "Absent cmi file when looking up module alias." };
+ { number = 50;
+ names = ["unexpected-docstring"];
+ description = "Unexpected documentation comment." };
+ { number = 51;
+ names = ["wrong-tailcall-expectation"];
+ description =
+ "Function call annotated with an incorrect @tailcall attribute" };
+ { number = 52;
+ names = ["fragile-literal-pattern"];
+ description = "Fragile constant pattern." };
+ { number = 53;
+ names = ["misplaced-attribute"];
+ description = "Attribute cannot appear in this context." };
+ { number = 54;
+ names = ["duplicated-attribute"];
+ description = "Attribute used more than once on an expression." };
+ { number = 55;
+ names = ["inlining-impossible"];
+ description = "Inlining impossible." };
+ { number = 56;
+ names = ["unreachable-case"];
+ description =
+ "Unreachable case in a pattern-matching (based on type information)." };
+ { number = 57;
+ names = ["ambiguous-var-in-pattern-guard"];
+ description = "Ambiguous or-pattern variables under guard." };
+ { number = 58;
+ names = ["no-cmx-file"];
+ description = "Missing cmx file." };
+ { number = 59;
+ names = ["flambda-assignment-to-non-mutable-value"];
+ description = "Assignment to non-mutable value." };
+ { number = 60;
+ names = ["unused-module"];
+ description = "Unused module declaration." };
+ { number = 61;
+ names = ["unboxable-type-in-prim-decl"];
+ description = "Unboxable type in primitive declaration." };
+ { number = 62;
+ names = ["constraint-on-gadt"];
+ description = "Type constraint on GADT type declaration." };
+ { number = 63;
+ names = ["erroneous-printed-signature"];
+ description = "Erroneous printed signature." };
+ { number = 64;
+ names = ["unsafe-array-syntax-without-parsing"];
+ description =
+ "-unsafe used with a preprocessor returning a syntax tree." };
+ { number = 65;
+ names = ["redefining-unit"];
+ description = "Type declaration defining a new '()' constructor." };
+ { number = 66;
+ names = ["unused-open-bang"];
+ description = "Unused open! statement." };
+ { number = 67;
+ names = ["unused-functor-parameter"];
+ description = "Unused functor parameter." };
+ { number = 68;
+ names = ["match-on-mutable-state-prevent-uncurry"];
+ description =
+ "Pattern-matching depending on mutable state prevents the remaining \n\
+ \ arguments from being uncurried." };
+ { number = 69;
+ names = ["unused-field"];
+ description = "Unused record field." };
+ { number = 70;
+ names = ["missing-mli"];
+ description = "Missing interface file." };
+ { number = 71;
+ names = ["unused-tmc-attribute"];
+ description = "Unused @tail_mod_cons attribute" };
+ { number = 72;
+ names = ["tmc-breaks-tailcall"];
+ description = "A tail call is turned into a non-tail call \
+ by the @tail_mod_cons transformation." };
+]
;;
let name_to_number =
let h = Hashtbl.create last_warning_number in
- List.iter (fun (num, _, names) ->
- List.iter (fun name -> Hashtbl.add h name num) names
+ List.iter (fun {number; names; _} ->
+ List.iter (fun name -> Hashtbl.add h name number) names
) descriptions;
fun s -> Hashtbl.find_opt h s
;;
let (set, pos) = (!current).alert_errors in
Misc.Stdlib.String.Set.mem kind set = pos
+let with_state state f =
+ let prev = backup () in
+ restore state;
+ try
+ let r = f () in
+ restore prev;
+ r
+ with exn ->
+ restore prev;
+ raise exn
+
let mk_lazy f =
let state = backup () in
- lazy
- (
- let prev = backup () in
- restore state;
- try
- let r = f () in
- restore prev;
- r
- with exn ->
- restore prev;
- raise exn
- )
+ lazy (with_state state f)
let set_alert ~error ~enable s =
let upd =
| Redundant_case -> "this match case is unused."
| Redundant_subpat -> "this sub-pattern is unused."
| Instance_variable_override [lab] ->
- "the instance variable " ^ lab ^ " is overridden.\n" ^
- "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+ "the instance variable " ^ lab ^ " is overridden."
| Instance_variable_override (cname :: slist) ->
String.concat " "
("the following instance variables are overridden by the class"
- :: cname :: ":\n " :: slist) ^
- "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+ :: cname :: ":\n " :: slist)
| Instance_variable_override [] -> assert false
| Illegal_backslash -> "illegal backslash escape in string."
| Implicit_public_methods l ->
| Inlining_impossible reason ->
Printf.sprintf "Cannot inline: %s" reason
| Ambiguous_var_in_pattern_guard vars ->
- let msg =
- let vars = List.sort String.compare vars in
+ let vars = List.sort String.compare vars in
+ let vars_explanation =
+ let in_different_places =
+ "in different places in different or-pattern alternatives"
+ in
match vars with
| [] -> assert false
- | [x] -> "variable " ^ x
+ | [x] -> "variable " ^ x ^ " appears " ^ in_different_places
| _::_ ->
- "variables " ^ String.concat "," vars in
+ let vars = String.concat ", " vars in
+ "variables " ^ vars ^ " appear " ^ in_different_places
+ in
Printf.sprintf
"Ambiguous or-pattern variables under guard;\n\
- %s may match different arguments. %t"
- msg ref_manual_explanation
+ %s.\n\
+ Only the first match will be used to evaluate the guard expression.\n\
+ %t"
+ vars_explanation ref_manual_explanation
| No_cmx_file name ->
Printf.sprintf
"no cmx file was found in path for module %s, \
" is never mutated."
| Missing_mli ->
"Cannot find interface file."
+ | Unused_tmc_attribute ->
+ "This function is marked @tail_mod_cons\n\
+ but is never applied in TMC position."
+ | Tmc_breaks_tailcall ->
+ "This call\n\
+ is in tail-modulo-cons positionin a TMC function,\n\
+ but the function called is not itself specialized for TMC,\n\
+ so the call will not be transformed into a tail call.\n\
+ Please either mark the called function with the [@tail_mod_cons]\n\
+ attribute, or mark this call with the [@tailcall false] attribute\n\
+ to make its non-tailness explicit."
;;
let nerrors = ref 0;;
let id_name w =
let n = number w in
- match List.find_opt (fun (m, _, _) -> m = n) descriptions with
- | Some (_, _, s :: _) ->
+ match List.find_opt (fun {number; _} -> number = n) descriptions with
+ | Some {names = s :: _; _} ->
Printf.sprintf "%d [%s]" n s
| _ ->
string_of_int n
let help_warnings () =
List.iter
- (fun (i, s, names) ->
+ (fun {number; description; names} ->
let name =
match names with
| s :: _ -> " [" ^ s ^ "]"
| [] -> ""
in
- Printf.printf "%3i%s %s\n" i name s)
+ Printf.printf "%3i%s %s\n" number name description)
descriptions;
print_endline " A all warnings";
for i = Char.code 'b' to Char.code 'z' do
| Match_on_mutable_state_prevent_uncurry (* 68 *)
| Unused_field of string * field_usage_warning (* 69 *)
| Missing_mli (* 70 *)
+ | Unused_tmc_attribute (* 71 *)
+ | Tmc_breaks_tailcall (* 72 *)
;;
type alert = {kind:string; message:string; def:loc; use:loc}
type state
val backup: unit -> state
val restore: state -> unit
+val with_state : state -> (unit -> 'a) -> 'a
val mk_lazy: (unit -> 'a) -> 'a Lazy.t
(** Like [Lazy.of_fun], but the function is applied with
the warning/alert settings at the time [mk_lazy] is called. *)
+
+type description =
+ { number : int;
+ names : string list;
+ description : string; }
+
+val descriptions : description list
ocamlyacc_OBJECTS := $(ocamlyacc_SOURCES:.c=.$(O))
-generated_files := ocamlyacc$(EXE) $(ocamlyacc_OBJECTS) version.h
+generated_files := ocamlyacc$(EXE) $(ocamlyacc_OBJECTS)
all: ocamlyacc$(EXE)
ocamlyacc$(EXE): $(ocamlyacc_OBJECTS)
$(MKEXE) -o $@ $^ $(EXTRALIBS)
-version.h : $(ROOTDIR)/VERSION
- echo "#define OCAML_VERSION \"`sed -e 1q $< | tr -d '\r'`\"" > $@
-
+.PHONY: clean
clean:
- rm -f ocamlyacc ocamlyacc.exe wstr.o wstr.obj version.h \
+ rm -f ocamlyacc ocamlyacc.exe wstr.o wstr.obj \
$(ocamlyacc_SOURCES:.c=.o) $(ocamlyacc_SOURCES:.c=.obj)
depend:
error.$(O): defs.h
lalr.$(O): defs.h
lr0.$(O): defs.h
-main.$(O): defs.h version.h
+main.$(O): defs.h
mkpar.$(O): defs.h
output.$(O): defs.h
reader.$(O): defs.h
#include "caml/config.h"
#include "caml/mlvalues.h"
#include "caml/osdeps.h"
+#include "caml/misc.h"
#define caml_stat_strdup strdup
#include <unistd.h>
#endif
-#include "version.h"
+#include "caml/version.h"
char lflag;
char rflag;
case 'v':
if (!strcmp_os (argv[i], T("-version"))){
printf ("The OCaml parser generator, version "
- OCAML_VERSION "\n");
+ OCAML_VERSION_STRING "\n");
exit (0);
}else if (!strcmp_os (argv[i], T("-vnum"))){
- printf (OCAML_VERSION "\n");
+ printf (OCAML_VERSION_STRING "\n");
exit (0);
}else{
vflag = 1;
open_error(interface_file_name);
}
-#ifdef _WIN32
-int wmain(int argc, wchar_t **argv)
-#else
-int main(int argc, char **argv)
-#endif
+int main_os(int argc, char_os **argv)
{
set_signals();
getargs(argc, argv);
projects / ocaml.git / commitdiff